all tables and figs added

R/as_gt.R

@@ -0,0 +1,81 @@
+##' .. content for \description{} (no empty lines) ..
+##'
+##' .. content for \details{} ..
+##'
+##' @title
+##' @param tbl_md_strat
+as_gt <- function(tbl_md_strat,
+                  model_labels,
+                  additional_missing_labels,
+                  md_method_labels,
+                  rspec) {
+
+  gt_md_strat <- tbl_md_strat %>%
+    map(
+      ~ {
+        gt_data <- .x %>%
+          mutate(
+            model = recode(model, !!!model_labels),
+            additional_missing_pct = factor(
+              additional_missing_pct,
+              levels = additional_missing_labels,
+              labels = names(additional_missing_labels)
+            ),
+            md_strat = str_replace(md_strat, 'mia', 'mia_si'),
+            table_val = if_else(
+              md_strat == 'meanmode_si',
+              true = table_glue("{est} ({lwr}, {upr})", rspec=rspec),
+              false = table_glue("{pm(est)}{est} ({lwr}, {upr})", rspec=rspec)
+            )
+          ) %>%
+          select(-est, -lwr, -upr) %>%
+          separate(md_strat, into = c('md_method', 'md_type')) %>%
+          pivot_wider(names_from = md_type, values_from = table_val) %>%
+          mutate(
+            md_method = factor(md_method,
+                               levels = names(md_method_labels),
+                               labels = md_method_labels)
+          ) %>%
+          arrange(md_method) %>%
+          filter(!(md_method == 'Missingness as an attribute' &
+                     model == 'Proportional hazards')) %>%
+          rename(MI = mi, SI = si) %>%
+          pivot_wider(names_from = model, values_from = c(SI, MI)) %>%
+          select(
+            additional_missing_pct,
+            md_method,
+            `SI_Proportional hazards`,
+            `MI_Proportional hazards`,
+            `SI_Gradient boosted decision trees`,
+            `MI_Gradient boosted decision trees`
+          )
+
+        cols <- str_detect(names(gt_data), pattern = 'MI$|SI$')
+        cols <- names(gt_data)[cols]
+
+        gt(gt_data,
+           groupname_col = 'additional_missing_pct',
+           rowname_col = 'md_method') %>%
+          tab_stubhead(label = 'Imputation method') %>%
+          fmt_missing(columns = everything(),
+                      missing_text = '--') %>%
+          tab_spanner(label = 'Proportional hazards',
+                      columns = c("SI_Proportional hazards",
+                                  "MI_Proportional hazards")) %>%
+          tab_spanner(label = "Gradient boosted decision trees",
+                      columns = c("SI_Gradient boosted decision trees",
+                                  "MI_Gradient boosted decision trees")) %>%
+          cols_label(
+            "MI_Proportional hazards" = 'Multiple Imputation',
+            "SI_Proportional hazards" = 'Single Imputation',
+            "MI_Gradient boosted decision trees" = 'Multiple Imputation',
+            "SI_Gradient boosted decision trees" = 'Single Imputation',
+          ) %>%
+          cols_align('center')
+
+      }
+    )
+
+  list(md_strat = gt_md_strat)
+
+}

R/gt_latex.R

@@ -0,0 +1,39 @@
+##' .. content for \description{} (no empty lines) ..
+##'
+##' .. content for \details{} ..
+##'
+##' @title
+##' @param gt_object
+##' @param caption
+##' @param label
+gt_latex <- function(gt_object, caption, label) {
+
+    header = paste0(
+      '\\begin{table} \n \\caption{',caption,'} \n'
+    )
+
+    if(!is.null(label)){
+      header = paste0(header, '\\label{', label, '} \n')
+    }
+
+    gt_object %>%
+      as_latex() %>%
+      as.character() %>%
+      gsub("*", "", ., fixed = T) %>%
+      gsub("\\\\ \n\\small \\\\ \n", "", ., fixed = T) %>%
+      gsub("\n\\large", "", ., fixed = T) %>%
+      gsub("\\captionsetup[table]{labelformat=empty,skip=1pt}",
+           "",
+           .,
+           fixed = T) %>%
+      gsub("longtable", "table", ., fixed = T) %>%
+      gsub('\\begin{table}',
+           '\\begin{table} \n\\begin{tabular}',
+           .,
+           fixed = T) %>%
+      gsub('\\end{table}', '\\end{tabular} \n \\end{table}', ., fixed = T) %>%
+      gsub('\\begin{table}', header, ., fixed = T) %>%
+      cat()
+
+
+}

R/load_mccv.R

@@ -8,7 +8,7 @@
 ##'
 ##' @title
 
-load_mccv <- function(output_path = "slurm/results_old",
+load_mccv <- function(output_path = "slurm/results",
                       output_pattern = '^output',
                       nruns = 12000) {
 

R/make_bayes_mccv_fit.R

@@ -6,19 +6,34 @@
 ##' @param risk_evaluation
 make_bayes_mccv_fit <- function(risk_evaluation) {
 
-  risk_evaluation %>%
+  model_data <- risk_evaluation %>%
     mutate(md_strat = fct_relevel(md_strat, 'meanmode_si')) %>%
     select(-bri) %>%
-    pivot_longer(cols = c(auc, ipa), names_to = 'metric') %>%
-    split(f = list(.$outcome,
-                   .$model,
-                   .$metric,
-                   .$additional_missing_pct)) %>%
-    map(
-      ~ stan_lmer(
-        formula = value ~ md_strat + (1 | iteration),
-        data = .x
+    pivot_longer(cols = c(auc, ipa, cal_error), names_to = 'metric') %>%
+    split(
+      f = list(
+        .$outcome,
+        .$model,
+        .$metric
+        #.$additional_missing_pct
       )
     )
 
+  output <- vector(mode = 'list', length = length(model_data))
+  names(output) <- names(model_data)
+
+  for(i in seq_along(output)){
+
+    output[[i]] <- stan_lm(
+      formula = value ~ md_strat + additional_missing_pct,
+      #+ (1 | iteration),
+      data = model_data[[i]],
+      prior = R2(0.50),
+      iter = 5000
+    )
+
+  }
+
+  output
+
 }

R/make_risk_evaluation.R

@@ -54,6 +54,7 @@ make_risk_evaluation <- function(mc_cv_results, im, resamples, times) {
 
   }
 
-  bind_rows(risk_eval, .id = 'iteration')
+  bind_rows(risk_eval, .id = 'iteration') %>%
+    mutate(cal_error = cal_error * 100)
 
 }

R/plan.R

@@ -50,8 +50,8 @@ the_plan <- drake_plan(
   # creates intermacs_clean.csv
   im = clean_intermacs(),
 
-  # tabulate characteristics
-  tbl_characteristics = tabulate_characteristics(im),
+  # tabulate descriptives
+  tbl_descriptives = tabulate_descriptives(im),
 
   # creates resamples.csv
   resamples = mc_cv_light(data = im, train_prop = 1/2, ntimes = 200),
@@ -63,37 +63,42 @@ the_plan <- drake_plan(
 
   risk_evaluation = make_risk_evaluation(mc_cv_results, im, resamples, times),
 
-  # bayes_mccv_fits = make_bayes_mccv_fit(risk_evaluation),
-  #
+  bayes_mccv_fits = make_bayes_mccv_fit(risk_evaluation),
+
   fig_risk_evaluation = visualize_risk_evaluation(risk_evaluation,
                                                   md_method_labels,
                                                   md_type_labels,
                                                   model_labels,
                                                   outcome_labels,
                                                   additional_missing_labels,
-                                                  times)
-  #
-  # fig_md_strat_infer = visualize_md_strat_inference(bayes_mccv_fits,
-  #                                                   md_type_labels,
-  #                                                   md_method_labels,
-  #                                                   outcome_labels,
-  #                                                   rspec),
-  #
-  #
-  # tbl_md_strat = tabulate_md_strat(risk_evaluation,
-  #                                  md_method_labels,
-  #                                  md_type_labels,
-  #                                  model_labels,
-  #                                  outcome_labels,
-  #                                  additional_missing_labels,
-  #                                  rspec),
-  #
-  # arxiv_preprint = target(
-  #   command = {
-  #     rmarkdown::render(knitr_in("doc_arxiv/doc_arxiv.Rmd"))
-  #     file_out("doc_arxiv/doc_arxiv.pdf")
-  #   }
-  # )
+                                                  times),
+
+  fig_md_strat_infer = visualize_md_strat_inference(bayes_mccv_fits,
+                                                    md_type_labels,
+                                                    md_method_labels,
+                                                    outcome_labels,
+                                                    rspec),
+
+  tbl_md_strat = tabulate_md_strat(risk_evaluation,
+                                   md_method_labels,
+                                   md_type_labels,
+                                   model_labels,
+                                   outcome_labels,
+                                   additional_missing_labels,
+                                   rspec),
+
+  gt_tbls = as_gt(tbl_md_strat,
+                  model_labels,
+                  additional_missing_labels,
+                  md_method_labels,
+                  rspec),
+
+  arxiv_preprint = target(
+    command = {
+      rmarkdown::render(knitr_in("doc_arxiv/doc_arxiv.Rmd"))
+      file_out("doc_arxiv/doc_arxiv.pdf")
+    }
+  )
 
 
 )

R/pm.R

@@ -0,0 +1,11 @@
+##' .. content for \description{} (no empty lines) ..
+##'
+##' .. content for \details{} ..
+##'
+##' @title
+##' @param x
+pm <- function(x) {
+
+  ifelse(x > 0, "+", "")
+
+}