-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathr_rki_setup.R
178 lines (153 loc) · 10 KB
/
r_rki_setup.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
# Setup R for RKI Analysis and Corporate Identity Graphics (unofficial)
###########################################################
# Version 1.0
# Author: L. E. Kroll from www.rki.de
# Standard Libraries
#===================
library(tidyverse) # All main tidyverse libs in one single package
library(extrafont) # Font library for Graphics
library(haven) # Stata-Import
library(readxl) # XLSX-Import
library(httr) # Solve Problem using curl behind proxy w/o special config
library(survey) # Survey Methods
library(srvyr) # Tidy Survey Methods
library(tableone) # Descriptives Table
library(stargazer) # Regression Table Output
library(labelled) # Variable labels attribute
# Proxy-Settings (not included due to confidentiality)
# set_config(use_proxy(SERVERNAME , port = SERVERPORT ), override = TRUE)
# RKI-Theme
# =========
# Environment
rki <- new.env()
local({
# RKI Colors
rkihc1 <- rgb(0/255,94/255,184/255) # Blau dunkel
rkihc2 <- rgb(89/255,150/255,209/255)
rkihc3 <- rgb(178/255,206/255,234/255) # Blau hell
rkihc4 <- rgb(103/255,103/255,103/255) # Grau dunkel
rkihc5 <- rgb(150/255,150/255,150/255)
rkihc6 <- rgb(209/255,209/255,209/255) # Grau Hell
rkihc7 <- rgb(184/255,0/255,94/255) # rot dunkel
rkihc8 <- rgb(209/255,89/255,150/255)
rkihc9 <- rgb(234/255,178/255,206/255) # rot hell
rkihc10 <- rgb(94/255,184/255,0/255) # grün dunkel
rkihc11 <- rgb(150/255,209/255,89/255)
rkihc12 <- rgb(206/255,234/255,178/255) # grün hell
rki1 <- rgb(0/255,94/255,184/255) # Blau dunkel
rki2 <- rgb(51/255,126/255,194/255)
rki3 <- rgb(102/255,158/255,212/255) # Blau mittel
rki4 <- rgb(153/255,191/255,227/255)
rki5 <- rgb(178/255,206/255,234/255) # Blau hell
# Schemes
palette5blues <- c(rki$rki1, rki$rki2 , rki$rki3 ,rki$rki4 ,rki$rki5)
palette3c <- c(rki$rkihc1, rki$rkihc2 , rki$rkihc3)
palette4c <- c(rki$rkihc1, rki$rkihc2 , rki$rkihc4, rki$rkihc5)
palette5c <- c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc4, rki$rkihc5, rki$rkihc6)
palette6c <- c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc4, rki$rkihc5, rki$rkihc6)
palette8c <- c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc4, rki$rkihc5,rki$rkihc6,rki$rkihc7,rki$rkihc8)
palette12c <- c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc4, rki$rkihc5,rki$rkihc6,rki$rkihc7,rki$rkihc8,rki$rkihc9, rki$rkihc10 , rki$rkihc11, rki$rkihc12)
rkifill_3c <- scale_fill_manual(values = c(rki$rkihc1, rki$rkihc2 , rki$rkihc3))
rkifill_4c <- scale_fill_manual(values = c(rki$rkihc1, rki$rkihc2 , rki$rkihc4, rki$rkihc5))
rkifill_5c <- scale_fill_manual(values = c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc4, rki$rkihc5, rki$rkihc6))
rkifill_6c <- scale_fill_manual(values = c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc4, rki$rkihc5, rki$rkihc6))
rkifill_8c <- scale_fill_manual(values = c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc4, rki$rkihc5, rki$rkihc6, rki$rkihc7, rki$rkihc8))
rkifill_blue_red_6 <- scale_fill_manual(values = c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc7, rki$rkihc8, rki$rkihc9))
rkifill_blue_red_4 <- scale_fill_manual(values = c(rki$rkihc1, rki$rkihc2 , rki$rkihc7, rki$rkihc8))
rkifill_blue_red_4 <- scale_fill_manual(values = c(rki$rkihc1, rki$rkihc7))
rkicolour_3c <- scale_colour_manual(values = c(rki$rkihc1, rki$rkihc2 , rki$rkihc3))
rkicolour_4c <- scale_colour_manual(values = c(rki$rkihc1, rki$rkihc2 , rki$rkihc4, rki$rkihc5))
rkicolour_5c <- scale_colour_manual(values = c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc4, rki$rkihc5))
rkicolour_6c <- scale_colour_manual(values = c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc4, rki$rkihc5, rki$rkihc6))
rkicolour_8c <- scale_colour_manual(values = c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc4, rki$rkihc5, rki$rkihc6, rki$rkihc7, rki$rkihc8))
rkicolour_blue_red_6 <- scale_colour_manual(values = c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc7, rki$rkihc8, rki$rkihc9))
rkicolour_blue_red_4 <- scale_colour_manual(values = c(rki$rkihc1, rki$rkihc2 , rki$rkihc7, rki$rkihc8))
rkicolour_blue_red_4 <- scale_colour_manual(values = c(rki$rkihc1, rki$rkihc7))
# Reversed Schemes
revrkifill_3c <- scale_fill_manual(values = rev(c(rki$rkihc1, rki$rkihc2 , rki$rkihc3)))
revrkifill_4c <- scale_fill_manual(values = rev(c(rki$rkihc1, rki$rkihc2 , rki$rkihc4, rki$rkihc5)))
revrkifill_5c <- scale_fill_manual(values = rev(c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc4, rki$rkihc5, rki$rkihc6)))
revrkifill_6c <- scale_fill_manual(values = rev(c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc4, rki$rkihc5, rki$rkihc6)))
revrkifill_8c <- scale_fill_manual(values = rev(c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc4, rki$rkihc5)))
revrkifill_blue_red_6 <- scale_fill_manual(values = rev(c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc7, rki$rkihc8, rki$rkihc9)) )
revrkifill_blue_red_4 <- scale_fill_manual(values = rev(c(rki$rkihc1, rki$rkihc2 , rki$rkihc7, rki$rkihc8)) )
revrkifill_blue_red_4 <- scale_fill_manual(values = rev(c(rki$rkihc1, rki$rkihc7)) )
revrkicolour_3c <- scale_colour_manual(values = rev(c(rki$rkihc1, rki$rkihc2 , rki$rkihc3)))
revrkicolour_4c <- scale_colour_manual(values = rev(c(rki$rkihc1, rki$rkihc2 , rki$rkihc4, rki$rkihc5)))
revrkicolour_5c <- scale_colour_manual(values = rev(c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc4, rki$rkihc5, rki$rkihc6)))
revrkicolour_6c <- scale_colour_manual(values = rev(c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc4, rki$rkihc5, rki$rkihc6)))
revrkicolour_8c <- scale_colour_manual(values = rev(c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc4, rki$rkihc5)))
revrkicolour_blue_red_6 <- scale_colour_manual(values = rev(c(rki$rkihc1, rki$rkihc2 , rki$rkihc3, rki$rkihc7, rki$rkihc8, rki$rkihc9)) )
revrkicolour_blue_red_4 <- scale_colour_manual(values = rev(c(rki$rkihc1, rki$rkihc2 , rki$rkihc7, rki$rkihc8)) )
revrkicolour_blue_red_4 <- scale_colour_manual(values = rev(c(rki$rkihc1, rki$rkihc7)))
# Palettes
rkicpalette <- colorRampPalette(rki$palette12c)
rkicpalette_blues <- colorRampPalette(rki$palette5blues)
# Main ggplot-Theme
###################
# If "ScalaLF" is not installed "Calibri" is a viable alternative on a Standard Windows Desktop.
# Check available fonts with
# library(extrafont)
# font_import(prompt = FALSE)
# loadfonts()
# View(fonttable())
rkifont_bold <- "ScalaSansLF-Bold" # Alternative "Calibri-Bold"
rkifont_regular <-"ScalaSansLF-Regular" # Alternative "Calibri"
rkitheme <- theme(plot.margin = margin(.5, .5, .5, .5, "cm"),
text=element_text(family=rki$rkifont_regular, face="plain"),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_line(colour=rki$rkihc6 ) ,
panel.background = element_rect(fill=NA),
strip.background = element_rect(fill=NA),
strip.text = element_text(family=rki$rkifont_bold, face="plain", size = rel(1.1)),
plot.title = element_text(family=rki$rkifont_bold, face="plain", size = rel(1.2)),
axis.title = element_text(family=rki$rkifont_bold, face="plain", size = rel(1.1)),
axis.text = element_text(colour="black", size = rel(1.0)),
axis.line = element_line(colour="black", size = 0.3 ) ,
axis.ticks.length = unit(.25, "cm") ,
legend.key = element_blank(),
legend.title = element_text(family=rki$rkifont_bold, face="plain", size = rel(1.0)))
rkitheme_void <- theme(plot.margin = margin(.5, .5, .5, .5, "cm"),
text=element_text(family=rki$rkifont_regular, face="plain"),
panel.grid.major.x = element_blank(),
panel.grid.major.y = element_blank(),
panel.background = element_rect(fill=NA),
strip.background = element_rect(fill=NA),
strip.text = element_text(family=rki$rkifont_bold, face="plain", size = rel(1.1)),
plot.title = element_text(family=rki$rkifont_bold, face="plain", size = rel(1.2)),
axis.title = element_blank(),
axis.text = element_blank(),
axis.line = element_blank(),
axis.ticks = element_blank(),
legend.key = element_blank(),
legend.title = element_text(family=rki$rkifont_bold, face="plain", size = rel(1.0)))
# Some Special Functions
## Konditional mutation
mutate_cond <- function(.data, condition, ..., envir = parent.frame()) {
condition <- eval(substitute(condition), .data, envir)
.data[condition, ] <- .data[condition, ] %>% mutate(...)
.data
}
## Describe labelled haven Datasets
describe <- function(dta) {
labels <- unlist(sapply(dta, function(x) attr(x, "label")))
tibble(name = names(labels),
label = labels)
}
## Random String generator
myrandomgen <- function() { sprintf("%s%s%s",
stringi::stri_rand_strings(7, 5, '[a-z0-9A-Z,_)!=(%$)]'),
stringi::stri_rand_strings(7, 5, '[a-z0-9A-Z,_)!=(%$)]'),
stringi::stri_rand_strings(7, 5, '[a-z0-9A-Z,_)!=(%$)]'))}
## Function to generate Ridits credits to http://blog.rguha.net/?p=1368
ridit <- function(var) { ## props should be in order of levels (highest to lowest)
props <- var / sum(var)
r <- rep(-1, length(props))
for (i in 1:length(props)) {
if (i == length(props)) vals <- 0
else vals <- props[(i+1):length(props)]
r[i] <- sum(vals) + 0.5*props[i]
}
return(r)
}
}, envir = rki )