generalisation for 3/6/12 month imputation

Run-3-6-12m-imputation-report.R

+rmarkdown::render(
+  input = 'imputation-report.Rmd',
+  params = list(imputation_time=90, per_protocol_window=c(77,126)),
+  output_file = 'Imputation_GOSE_3month.html')
+
+rmarkdown::render(
+  input = 'imputation-report.Rmd',
+  params = list(imputation_time=180.0, per_protocol_window=c(150,240)),
+  output_file = 'Imputation_GOSE_6month.html')
+
+rmarkdown::render(
+  input = 'imputation-report.Rmd',
+  params = list(imputation_time=360.0, per_protocol_window=c(300,420)),
+  output_file = 'Imputation_GOSE_12month.html')

imputation-report.Rmd

 ---
-title: "Impute 6-months GOSe for CENTER-TBI"
+title: "`r sprintf('Impute %i month GOSe for CENTER-TBI',params$imputation_time/30)`"
 
 date: "`r Sys.time()`"
       
-author: "Kevin Kunzmann (kevin.kunzmann@mrc-bsu.cam.ac.uk)"
+author: 
+- Kevin Kunzmann (kevin.kunzmann@mrc-bsu.cam.ac.uk)
+- Kristien Wouters (kristien.wouters@uza.be)
 
 output: 
     html_document:
@@ -12,6 +14,7 @@ output:
 params:
     seed:                 42
     age_range:           !r c(0, Inf)
+    imputation_time:      180.0
     per_protocol_window: !r c(150.0, 240)
 ---
 
@@ -84,9 +87,9 @@ tbl_combined <- readr::read_csv("tbl_gose.csv", col_types = "cinncD") %>%
         !is.na(Outcomes.DerivedCompositeGOSE),
         # throw out all observations without a precise timestamp
         !is.na(Outcomes.DerivedCompositeGOSEDaysPostInjury),
-        # throw out all observations after 18 months 
-        # (for 12 months imputation!)
-        Outcomes.DerivedCompositeGOSEDaysPostInjury < 18*30
+        # throw out all observations after 18 months for 3 and 6 months imputation
+        # (for 12 months imputation: throw out observations > 24 months)
+        Outcomes.DerivedCompositeGOSEDaysPostInjury < ifelse(params$imputation_time < 360,18*30,24*30)
     ) %>% 
     mutate(
         Subject.PatientType = case_when(
@@ -136,7 +139,7 @@ tbl_combined <- tbl_combined %>%
     group_by(gupi) %>% 
     filter(
         # all GOSEs before 180 days post injury must be > 1 (dead)
-        all(Outcomes.DerivedCompositeGOSE[Outcomes.DerivedCompositeGOSEDaysPostInjury <= 180] > 1),
+        all(Outcomes.DerivedCompositeGOSE[Outcomes.DerivedCompositeGOSEDaysPostInjury <= params$imputation_time] > 1),
         # ensure age-bracket
         Subject.Age >= params$age_range[1],
         Subject.Age <= params$age_range[2],
@@ -164,11 +167,11 @@ tbl_gose_msm <- tbl_combined %>%
         gose = Outcomes.DerivedCompositeGOSE
     ) %>% 
     rbind(
-      # add censored states at 180.1 days to make prediction for
+      # add censored states at imputation time + 0.1 days to make prediction for
       tibble(
           gupi             = unique(.$gupi),
           # needed to offset to get a prediction in all cases
-          days_post_injury = 180 + .1, 
+          days_post_injury = params$imputation_time + .1, 
           gose             = 99
       )
     ) %>% 
@@ -208,7 +211,7 @@ fit <- msm::msm(
   gen.inits     = TRUE,
   qmatrix       = Q,
   censor        = 99,
-  pci           = c(90, 270),
+  pci           = c(ifelse(params$imputation_time==90,80,90), 270),
   censor.states = 2:7, # cannot be dead since these were filtered previously 
   control   = list(
       fnscale = 12000,
@@ -235,7 +238,7 @@ tbl_posteriors <- tibble(
         `2_or_3` = `3`
     ) %>%
     filter(
-        t == 180.1
+        t == params$imputation_time + 0.1
     ) %>%
     select(
         gupi, `1`, `2_or_3`, `4`, `5`, `6`, `7`, `8`
@@ -252,7 +255,7 @@ tbl_posteriors <- tibble(
 ```
 
 ```{r final-imputations}
-# start by adding confirmed <= 180d deaths back in
+# start by adding confirmed deaths (<= imputation time) back in
 tbl_final_imputations <- readr::read_csv(
         "tbl_gose.csv", 
         col_types = "cinncD"
@@ -272,7 +275,7 @@ tbl_final_imputations <- readr::read_csv(
     ) %>% 
     mutate(
         probability = ifelse(
-            is.na(death_days) | (death_days > 180),
+            is.na(death_days) | (death_days > params$imputation_time),
             probability,
             ifelse(gose != "gose_1_probability", 0.0, 1.0)
         )
@@ -312,8 +315,8 @@ tbl_final_imputations <- readr::read_csv(
         ) %>% 
         group_by(gupi) %>% 
         summarize(
-            gose = gose[which.min(abs(days - 180))],
-            days = days[which.min(abs(days - 180))],
+            gose = gose[which.min(abs(days - params$imputation_time))],
+            days = days[which.min(abs(days - params$imputation_time))],
             .groups = "drop"
         ) %>% 
         transmute(
@@ -346,7 +349,6 @@ tbl_final_imputations <- readr::read_csv(
     )
 ```
 
-
 ```{r plausi-check}
 tbl_final_imputations %>% 
     select(
@@ -374,25 +376,24 @@ tbl_final_imputations %>%
       coord_fixed(expand = FALSE) + 
       scale_fill_continuous(low = "#FFFFFF", high = "#555555") +
       theme_bw() +
-      ggtitle("Confusion matrix: imputed vs. per-protocol")
+      ggtitle(sprintf("Confusion matrix: imputed vs. per-protocol: %i days",params$imputation_time))
 ```
 
+
 ```{r save-imputed-values}
 tbl_final_imputations %>% {
-    tmp <- .
-    names(tmp) <- gsub("gose", "Subject.DerivedImputed180DaysGOSE", x = names(.))
-    tmp } %>% 
-    rename(
-      "Subject.GOSE6monthEndpointDerived" = "Subject.DerivedImputed180DaysGOSE_map_per_protocol_combined"
-    ) %>% 
-    write_csv("tbl_gose_imputed.csv")
+  tmp <- .
+  names(tmp) <- gsub("gose", sprintf("Subject.DerivedImputed%iDaysGOSE",params$imputation_time), x = names(.))
+  tmp } %>% 
+  rename(
+    !! sprintf("Subject.GOSE%imonthEndpointDerived",round(params$imputation_time/30)) := sprintf("Subject.DerivedImputed%iDaysGOSE_map_per_protocol_combined",params$imputation_time)
+  ) %>% 
+  write_csv(sprintf("tbl_gose_imputed%i.csv",params$imputation_time))
 ```
 
+<!-- # Session Info# -->
 
-
-# Session Info
-
-```{r session-info}
-sessionInfo() %>%
-    knitr::kable()
-``` 
+<!-- ```{r session-info} -->
+<!-- sessionInfo() %>% -->
+<!--   knitr::kable() -->
+<!-- ```  -->