-
Notifications
You must be signed in to change notification settings - Fork 0
/
articletwo-officer.R
185 lines (167 loc) · 8.23 KB
/
articletwo-officer.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
179
180
181
182
183
184
185
characteristics <- function(dset, tableone.names, tableone.factors, extras = list()) {
title <- "Characteristics"
overall <- paste0("Cases, n=", dim(dset)[1])
tableobject <- tableone::CreateTableOne(data = dset, vars = names(tableone.names), factorVars = tableone.factors)
tablecsv <- print(tableobject,
exact = "stage",
quote = FALSE,
noSpaces = TRUE,
printToggle = FALSE,
digits = 1,
pDigits = 3,
contDigits=1)
tableone.fullnames <- c(tableone.names, extras)
tablecsv %>%
as.data.frame %>%
tibble::rownames_to_column(var = "rowname") %>%
dplyr::filter(row_number() > 1) %>%
format(justify = "left", trim = TRUE) %>%
rowwise() %>%
mutate(id = gsub("^ *([A-Za-z_0-9]+).*", "\\1", rowname)) %>%
mutate(present = id %in% names(tableone.fullnames)) %>%
mutate(rowname = ifelse(present == TRUE, tableone.fullnames[[id]], rowname)) %>%
select(rowname, Overall)
}
tableone <- function(dset) {
tableone.names <- list("BL_AGE" = "Age, y (SD)",
"SEX" = "Female, N (%)",
"BMI" = "BMI, kg/m² (SD)",
"oSYSTM" = "Systolic BP, mmHg (SD)",
"oDIASM" = "Diastolic BP, mmHg (SD)",
"oPULSEPRESSURE" = "Pulse pressure, mmHg (SD)",
"oMAP" = "Mean arterial pressure, mmHg (SD)",
"HYPERTENSION" = "Hypertension, N (%)",
"CURR_SMOKE" = "Current smoker, N (%)",
"PREVAL_DIAB" = "Diabetes mellitus, N (%)",
"Q57X" = "Exercise, N (%)",
"ANYDRUG" = "Antihypertensive medication, N (%)",
"BL_USE_RX_C03" = " Diuretics, N (%)",
"BL_USE_RX_C07" = " Beta blockers, N (%)",
"BL_USE_RX_C08" = " Calcium channel blockers, N (%)",
"BL_USE_RX_C09" = " RAS blockers, N (%)")
extras <- list("1" = " Light",
"2" = " Moderate",
"3" = " Heavy")
tableone.factors <- c("SEX", "HYPERTENSION", "ANYDRUG", "CURR_SMOKE", "PREVAL_DIAB",
"BL_USE_RX_C03", "BL_USE_RX_C07", "BL_USE_RX_C08", "BL_USE_RX_C09")
data <- characteristics(dset, tableone.names, tableone.factors, extras)
flextable(data = data) %>%
set_header_labels(rowname = "Characteristics",
Overall = paste0("Cases, n=", dim(dset)[1])) %>%
flextable::width(j = 1, width = 3) %>%
flextable::width(j = 2, width = 1.2) %>%
flextable::border(border = fp_border(width=0), part="body") %>%
flextable::border(border = fp_border(width=0), part="header") %>%
flextable::border(part="header", border.bottom = fp_border(width=1)) %>%
flextable::border(i = nrow(data), part="body", border.bottom = fp_border(width=1)) %>%
flextable::bold(bold = FALSE, part = "header") %>%
flextable::bold(bold = FALSE, part = "body") %>%
flextable::fontsize(size = 12, part = "header") %>%
flextable::fontsize(size = 12, part = "body") %>%
flextable::align(align = "center", part = "all") %>%
flextable::align(align = "left", part = "header", j = 1) %>%
flextable::align(align = "left", part = "body", j = 1)
}
typologyformatter <- function(data, font = 12, typology, left = c(1), hleft = c(1)) {
flex <- flextable(data = data) %>%
flextable::theme_booktabs() %>%
flextable::border(border = fp_border(width=0), part="body") %>%
flextable::border(border = fp_border(width=0), part="header") %>%
flextable::border(part="header", border.bottom = fp_border(width=1))
if (!missing(typology)) {
flex <- flex %>%
set_header_df(mapping = typology, key = "col_keys") %>%
merge_h(part = "header") %>%
flextable::border(part="header", border.bottom = fp_border(width=1))
if (missing(hleft)) {
hleft <- c(2)
}
}
flex %>%
flextable::border(i = nrow(data), part="body", border.bottom = fp_border(width=1)) %>%
flextable::bold(bold = FALSE, part = "header") %>%
flextable::bold(bold = FALSE, part = "body") %>%
flextable::fontsize(size = font, part = "header") %>%
flextable::fontsize(size = font, part = "body") %>%
flextable::align(align = "center", part = "all") %>%
flextable::align(align = "left", part = "header", j = left, i = hleft) %>%
flextable::align(align = "left", part = "body", j = left)
}
xtableformatter <- function(table, font = 12) {
xtable_to_flextable(x = xtable(table),
NA.string = "",
include.rownames = FALSE) %>%
flextable::border(border.top = fp_border(width=0), part="header", border.bottom = fp_border()) %>%
flextable::bold(bold = FALSE, part = "header") %>%
flextable::bold(bold = FALSE, part = "body") %>%
flextable::fontsize(size = font, part = "header") %>%
flextable::fontsize(size = font, part = "body") %>%
flextable::align(align = "center", part = "all") %>%
flextable::align(align = "left", part = "header", j = 1) %>%
flextable::align(align = "left", part = "body", j = 1)
}
riskmodel.getn <- function(df, riskclass, inviduals = FALSE, cols = c("htn")) {
ret <- df %>%
group_by(.dots = riskclass) %>%
summarize(n=n(), htn=sum(HT == 1)) %>%
select(cols)
return(rbind(c("", ""), c("", ""), c("", ""), ret))
}
riskmodel.onecolumn <- function(riskmodels) {
lapply(riskmodels, function(result) {
cbind(
rbind(result$unadj_persd$mean_ci,
result$unadj_persd$p,
"",
"1.0 (referent)",
cbind(result$unadj_class$mean_ci)),
rbind(result$adj_persd$mean_ci,
result$adj_persd$p,
"",
"1.0 (referent)",
cbind(result$adj_class$mean_ci)))
})
}
riskmodel.joincolumns <- function(rset, riskmodels, idforn = "fwdbonf_riskclass", order = list()) {
beginning.list <- cbind(
c("Per 1-SD", "p", "Quartile", " Q1", " Q2", " Q3", " Q4"),
riskmodel.getn(rset, idforn, cols = "n")
)
col.list <- lapply(order, function(ord) {
cbind(riskmodel.getn(rset, paste0(ord, "_riskclass")),
get(ord, riskmodels))
})
col.names <- lapply(order, function(ord) {
c(paste0(ord, ".event"), paste0(ord, "unadjusted"), paste0(ord, ".adjusted"))
})
list <- do.call(cbind, list(beginning.list, col.list)[lapply(list(beginning.list, col.list), length)>0])
colnames(list) <- c("term", "n", unlist(col.names))
list
}
writetable <- function(doc, tbl, number = 0, head, foot) {
text.bold <- fp_text(font.size = 12, bold = TRUE, font.family = "Arial")
text.normal <- fp_text(font.size = 12, font.family = "Arial")
doc <- doc %>%
body_add_fpar(fpar(ftext(paste0("Table ", number, ". "), prop = text.bold), ftext(head, prop = text.normal)), style = "Table Caption") %>%
body_add_flextable(tbl, align = "left") %>%
body_add_par(foot, style = "footnote text") %>%
body_add_break(pos = "after")
}
writeimage <- function(doc, number = 0, filename, header, footer, width = 7) {
text.bold <- fp_text(font.size = 12, bold = TRUE, font.family = "Arial")
text.normal <- fp_text(font.size = 12, font.family = "Arial")
img <- readPNG(filename)
doc <- doc %>%
body_add_fpar(fpar(ftext(paste0("Figure ", number, ". "), prop = text.bold), ftext(header, prop = text.normal)), style = "Image Caption") %>%
body_add_img(src = filename, width = width, height = width*dim(img)[1]/dim(img)[2]) %>%
body_add_par(footer, style = "footnote text") %>%
body_add_break(pos = "after")
}
myspread <- function(ret, list = c2l("lfc_se", "p.value"), term = "Feature", key = "Name") {
lapply(list, function(x) ret %>%
select(term, key, x) %>%
spread(key, x) %>%
rename_at(vars(-term), funs(paste0(., "_", x)))) %>%
Reduce(function(...) full_join(..., by = term), .) %>%
dplyr::select(term, noquote(order(colnames(.))))
}