generated from opensafely/research-template
/
table_two.R
159 lines (149 loc) · 6.2 KB
/
table_two.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
## ###########################################################
## This script:
## - Imports effect estimates ./output/tables/wave*_effect_estimates.csv
## - Makes 'table two'
## linda.nab@thedatalab.com - 20220413
## ###########################################################
# Load libraries & functions ---
library(here)
library(readr)
library(purrr)
library(dplyr)
library(jsonlite)
library(gt)
# load json file listing demographics, comorbidities and start dates waves
config <- fromJSON(here("analysis", "config.json"))
# create vector containing subgroups
# each model is stratified by region so region is excluded here
subgroups_vctr <- c(config$demographics[config$demographics != "region"],
config$comorbidities)
# multilevel comorbidities get a reference in table two
comorbidities_multilevel_vctr <- c("asthma",
"bp",
"diabetes_controlled",
"dialysis_kidney_transplant",
"ckd",
"organ_kidney_transplant")
comorbidities_binary_vctr <-
config$comorbidities[!config$comorbidities %in% comorbidities_multilevel_vctr]
# vector with waves
waves_vctr <- c("wave1", "wave2", "wave3")
# needed to add reference values to table two
source(here("analysis", "utils", "reference_values.R"))
# Import data extracts of waves ---
input_files_effect_estimates <-
Sys.glob(here("output", "tables", "wave*_effect_estimates.csv"))
effect_estimates_list <-
map(.x = input_files_effect_estimates,
.f = ~ read_csv(.x))
names(effect_estimates_list) <- waves_vctr
# Make reference_table_two ---
# Needed to add reference values to table two
reference_table_two <-
reference_values %>%
filter(subgroup %in% c(config$demographics[config$demographics != "region"],
"agegroup",
"sex",
comorbidities_multilevel_vctr)) %>%
mutate(reference =
case_when(subgroup == "sex" & reference == "F" ~ "Female",
TRUE ~ reference)) %>%
mutate(HR_95CI = "1.00 (ref)")
colnames(reference_table_two) <- c("subgroup", "level", "HR_95CI")
# Mutate table with effect estimates ---
# Function 'mutate_table_two'
# arguments:
# - effect_estimates: data.frame with HR and CIs (typically found in
# ./output/tables/wave*_effect_estimates.csv)
# - subgroups_vctr: vector of strings with all subgroups in the study
# - reference_table_two: data.frame with columns 'subgroup' and 'level',
# and a third column "HR_95CI' with "1.00 (ref)" for every combination of
# subgroup and level
# output:
# mutated data.frame with three columns, 'Characteristic', 'Category' and
# 'COVID-19 Death HR (95% CI)'
mutate_table_two <- function(effect_estimates,
subgroups_vctr,
reference_table_two){
effect_estimates <-
effect_estimates %>%
mutate(HR = round(HR, 2),
LowerCI = round(LowerCI, 2),
UpperCI = round(UpperCI, 2)) %>%
mutate(HR_95CI = paste0(HR, " (", LowerCI, ";", UpperCI, ")")) %>%
select(subgroup, level, HR_95CI) %>%
rbind(reference_table_two, .)
# group by subgroup
effect_estimates <-
effect_estimates[
match(effect_estimates$subgroup, subgroups_vctr) %>% order(), ]
effect_estimates
}
# Mutate table with effect_estimates to one with three columns and with
# reference values using function 'mutate_table_two' (see output of function
# for names of the three columns)
effect_estimates_list <-
map(.x = effect_estimates_list,
.f = ~ mutate_table_two(.x, subgroups_vctr, reference_table_two))
# Create table two ---
# Join three waves to one table
table2 <-
effect_estimates_list$wave1 %>%
left_join(effect_estimates_list$wave2,
by = c("subgroup", "level"),
suffix = c(".1", ".2")) %>%
left_join(effect_estimates_list$wave3,
by = c("subgroup", "level"))
# Add suffix to last column
colnames(table2)[5] <- paste0(colnames(table2)[5], ".3")
table2 <-
table2 %>%
mutate(subgroup = case_when(
subgroup == "agegroup" ~ "Age Group",
subgroup == "sex" ~ "Sex",
subgroup == "bmi" ~ "Body Mass Index",
subgroup == "ethnicity" ~ "Ethnicity",
subgroup == "smoking_status_comb" ~ "Smoking status",
subgroup == "imd" ~ "IMD quintile",
subgroup == "hypertension" ~ "Hypertension",
subgroup == "chronic_respiratory_disease" ~ "Chronic respiratory disease",
subgroup == "asthma" ~ "Asthma",
subgroup == "bp" ~ "Blood pressure",
subgroup == "chronic_cardiac_disease" ~ "Chronic cardiac disease",
subgroup == "diabetes_controlled" ~ "Diabetes",
subgroup == "cancer" ~ "Cancer (non haematological)",
subgroup == "haem_cancer" ~ "Haematological malignancy",
subgroup == "dialysis_kidney_transplant" ~ "Dialysis",
subgroup == "ckd" ~ "Chronic kidney disease",
subgroup == "chronic_liver_disease" ~ "Chronic liver disease",
subgroup == "stroke" ~ "Stroke",
subgroup == "dementia" ~ "Dementia",
subgroup == "other_neuro" ~ "Other neurological disease",
subgroup == "organ_kidney_transplant" ~ "Organ transplant",
subgroup == "asplenia" ~ "Asplenia",
subgroup == "ra_sle_psoriasis" ~ "Rheumatoid arthritis/ lupus/ psoriasis",
subgroup == "immunosuppression" ~ "Immunosuppressive condition",
subgroup == "learning_disability" ~ "Learning disability",
subgroup == "sev_mental_ill" ~ "Severe mental illness"
)
)
# relocate reference value agegroup
# references values is first, but for agegroup it should be third since
# reference value for agegroup is 50-59
table2 <- table2[c(2, 3, 1, 4:nrow(table2)),]
# modify table (rename columns and add spanner)
table2 <-
table2 %>% gt()
table2$`_boxhead`$column_label <-
c("Characteristic",
"Category",
"Wave 1",
"Wave 2",
"Wave 3")
# does not work on server
# tab_spanner(label = "COVID-19 Death HR (95% CI) (adjusted for age and sex)",
# columns = c(HR_95CI.1, HR_95CI.2, HR_95CI.3))
# Save output --
output_dir <- here("output", "tables")
ifelse(!dir.exists(output_dir), dir.create(output_dir), FALSE)
gtsave(table2, paste0(output_dir, "/table2.html"))