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
---
title: "Imputing GOSE scores in CENTER-TBI, assessing final imputations"
date: "`r Sys.time()`"
author: "Kevin Kunzmann (kevin.kunzmann@mrc-bsu.cam.ac.uk)"
output: html_document
params:
data_dir: "../output/v1.1/data"
imputations: "../output/v1.1/data/imputation/msm/df_gose_imputed.csv"
config_file: "../config.yml"
---
```{r setup-chunk, include=FALSE}
options(tidyverse.quiet = TRUE) # supresses filter/lag conflicts
require(tidyverse, quietly = TRUE)
config <- yaml::read_yaml(params$config_file)
set.seed(config$seed)
df_imputations <- read_csv(params$imputations)
```
Since we do not use the raw imputed values but give preference to the per
protocol values (when a derived composite GOSE is availabel within 5-8 months
after injury), we start by comparing the final combined version with the raw
imputations.
Note that this plot also includes the confirmed deaths before 6 months!
```{r, fig.height=7, fig.width=7}
caret::confusionMatrix(
df_imputations$Subject.DerivedImputed180DaysGOSE %>% factor(levels = 1:8),
df_imputations$Subject.GOSE6monthEndpointDerived %>% factor(levels = 1:8)
) %>%
as.matrix %>% as_tibble %>%
mutate(
Subject.DerivedImputed180DaysGOSE = row_number() %>% as.character
) %>%
gather(Subject.GOSE6monthEndpointDerived, n, `1`:`8`) %>%
ggplot(aes(Subject.GOSE6monthEndpointDerived, Subject.DerivedImputed180DaysGOSE, fill = n)) +
geom_raster() +
geom_hline(yintercept = c(2, 4, 6) + .5, color = "black") +
geom_vline(xintercept = c(2, 4, 6) + .5, color = "black") +
geom_text(aes(label = sprintf("%i", n)), vjust = 1) +
scale_fill_gradient(low = "white", high = "black") +
coord_fixed(expand = FALSE) +
theme_bw() +
theme(
panel.grid = element_blank()
) +
ggtitle("Confusion matrix (absolute counts)")
ggsave(filename = "confusion_matrix.pdf", width = 7, height = 7)
ggsave(filename = "confusion_matrix.png", width = 7, height = 7)
```
```{r}
df_gose <- readRDS(sprintf("%s/df_gose.rds", params$data_dir))
df_per_protocol_gose <- df_gose %>%
filter(
Outcomes.DerivedCompositeGOSEDaysPostInjury >= 5*30,
Outcomes.DerivedCompositeGOSEDaysPostInjury <= 8*30
) %>%
# pick closest to 180
group_by(gupi) %>%
summarize(
closest_per_protocol_GOSE = Outcomes.DerivedCompositeGOSE[
which.min(abs(Outcomes.DerivedCompositeGOSEDaysPostInjury - 180))
]
)
```
Overall, only `r nrow(df_per_protocol_gose)` six-months GOSE are observed,
i.e., `r nrow(df_imputations %>% filter(complete.cases(.) & Subject.DerivedImputed180DaysGOSE > 1)) - nrow(df_per_protocol_gose)`
model-based values are used.
```{r, fig.height=8}
df_posteriors <- df_imputations %>%
select(-Subject.GOSE6monthEndpointDerived) %>%
gather(GOSE, probability, 3:10) %>%
arrange(gupi, GOSE) %>%
mutate(
GOSE = factor(GOSE) %>% as.numeric,
t = 180
)
idx <- unique(df_gose$gupi)[1:40]
df_gose %>%
filter(gupi %in% idx) %>%
transmute(
gupi,
t = Outcomes.DerivedCompositeGOSEDaysPostInjury,
GOSE = Outcomes.DerivedCompositeGOSE %>% as.numeric
) %>%
ggplot(aes(t, GOSE)) +
geom_rect(
aes(
xmin = t - 14,
xmax = t + 14,
ymin = GOSE -.5,
ymax = GOSE + .5,
fill = probability
),
data = df_posteriors %>% filter(gupi %in% idx)
) +
facet_wrap(~gupi, ncol = 5) +
geom_point(size = .5, color = "red") +
theme_bw() +
theme(
panel.grid = element_blank(),
strip.background = element_blank(),
strip.text.x = element_blank()
) +
scale_fill_gradient2(low = "white", high = "black", limits = c(0, 1)) +
scale_y_continuous(breaks = 1:8, limits = c(.5, 8.5)) +
ggtitle("First 30 GOSE trajectories with 6-months predicted probabilities.")
ggsave(filename = "sample_probs.pdf", width = 7, height = 8)
ggsave(filename = "sample_probs.png", width = 7, height = 8)
```
# Session Info
```{r zip-figures}
system("zip figures.zip *.png *.pdf")
system("rm *.png *.pdf")
```
```{r session-info}
sessionInfo()
```