transfer from old repo

2 Longterm/260315/_targets.R

@@ -0,0 +1,285 @@
+# Created by use_targets().
+# Follow the comments below to fill in this target script.
+# Then follow the manual to check and run the pipeline:
+#   https://books.ropensci.org/targets/walkthrough.html#inspect-the-pipeline
+
+# Load packages required to define the pipeline:
+library(targets)
+library(tarchetypes) # Load other packages as needed.
+
+# Set target options:
+tar_option_set(
+  seed = 142,
+  packages = c("tibble"), # packages that your targets need to run
+  format = "qs" # , # Optionally set the default storage format. qs is fast.
+  #
+  # For distributed computing in tar_make(), supply a {crew} controller
+  # as discussed at https://books.ropensci.org/targets/crew.html.
+  # Choose a controller that suits your needs. For example, the following
+  # sets a controller with 2 workers which will run as local R processes:
+  #
+  #   controller = crew::crew_controller_local(workers = 2)
+  #
+  # Alternatively, if you want workers to run on a high-performance computing
+  # cluster, select a controller from the {crew.cluster} package. The following
+  # example is a controller for Sun Grid Engine (SGE).
+  #
+  #   controller = crew.cluster::crew_controller_sge(
+  #     workers = 50,
+  #     # Many clusters install R as an environment module, and you can load it
+  #     # with the script_lines argument. To select a specific verison of R,
+  #     # you may need to include a version string, e.g. "module load R/4.3.0".
+  #     # Check with your system administrator if you are unsure.
+  #     script_lines = "module load R"
+  #   )
+  #
+  # Set other options as needed.
+)
+
+# tar_make_clustermq() is an older (pre-{crew}) way to do distributed computing
+# in {targets}, and its configuration for your machine is below.
+options(clustermq.scheduler = "multiprocess")
+
+# tar_make_future() is an older (pre-{crew}) way to do distributed computing
+# in {targets}, and its configuration for your machine is below.
+future::plan(future.callr::callr)
+
+# Run the R scripts in the R/ folder with your custom functions:
+tar_source()
+source(here::here("R/glmnet-reg.R")) # Source other scripts as needed.
+
+# Replace the target list below with your own:
+list(
+  tar_target(
+    name = pop_df,
+    command = get_clinical()
+  ),
+  tar_target(
+    name = reg_list,
+    command = get_reg_ls()
+  ),
+  tar_target(
+    name = df_deaths,
+    command = get_deaths(reg_list)
+  ),
+  tar_target(
+    name = df_events,
+    command = get_events(reg_list)
+  ),
+  tar_target(
+    name = df_events_deaths,
+    command = merge_events(list(events = df_events, deaths = df_deaths, clinical = pop_df))
+  ),
+  tar_target(
+    name = df_treated,
+    command = get_treated(reg_list)
+  ),
+  tar_target(
+    name = df_dst,
+    command = get_dst(reg_list, pop_df)
+  ),
+  tar_target(
+    name = list_filtered,
+    command = list(all_events = df_events_deaths, clinical = pop_df, dst = df_dst)
+  ),
+  tar_target(
+    name = df_all_data,
+    command = collectall(list_filtered)
+  ),
+  tar_target(
+    name = df_all_data_formatted,
+    command = data_formatting(df_all_data)
+  ),
+  tar_target(
+    name = ls_all_events,
+    command = all_events(list(events = df_events, deaths = df_deaths, clinical = pop_df))
+  ),
+  tar_target(
+    name = df_event_data,
+    command = events_ready(df_all_data_formatted)
+  ),
+  tar_target(
+    name = df_talos_data,
+    command = talos_ready(df_all_data_formatted)
+  ),
+  tar_target(
+    name = df_talos_data_imp,
+    command = talos_imp(df_talos_data)
+  ),
+  tar_target(
+    name = tbl_events_summary,
+    command = events_tblone(df_event_data)
+  ),
+  tar_target(
+    name = tbl_events_cox_regression,
+    command = show_table_regression(df_event_data, use.mice = FALSE)
+  ),
+  tar_target(
+    name = tbl_events_cox_regression_uv,
+    command = uv_cox_table(df_event_data)
+  ),
+  tar_target(
+    name = df_event_data_small,
+    command = events_ready_small(df_all_data_formatted)
+  ),
+  tar_target(
+    name = tbl_events_summary_small,
+    command = events_tblone(df_event_data_small)
+  ),
+  tar_target(
+    name = tbl_events_cox_regression_small,
+    command = show_table_regression(df_event_data_small, use.mice = FALSE)
+  ),
+  tar_target(
+    name = df_events_mids,
+    command = events_dataset(df_event_data, impute = TRUE)
+  ),
+  tar_target(
+    name = df_events_complete,
+    command = complete_preds_data(df_event_data)
+  ),
+  tar_target(
+    name = tbl_events_mids_cox_regression,
+    command = show_table_regression(df_event_data, use.mice = TRUE)
+  ),
+  tar_target(
+    name = plot_events_survival_smooth,
+    command = df_event_data |> events_dataset(impute = FALSE) |> cox_regression(include_formula=TRUE) |> plot_survival_smooth()
+  )#,
+  # tar_target(
+  #   name = plot_events_survival_smooth_mids,
+  #   command = df_events_mids |> cox_regression() |> plot_survival_smooth()
+  # ),
+  # tar_target(
+  #   name = df_pred_data,
+  #   command = prediction_ready(df_all_data_formatted)
+  # ),
+  # tar_target(
+  #   name = tbl_pred_summary,
+  #   command = preds_tblone(df_pred_data)
+  # ),
+  # tar_target(
+  #   name = tbl_pred_summary_true,
+  #   command = df_pred_data |>
+  #     dplyr::select(pase_0, pase_4, soc_status_nowork, fam_indk_hl, edu_level_hl) |>
+  #     true_pred_sum_plot()
+  # ),
+  # tar_target(
+  #   name = tbl_pred_summary_exp,
+  #   command = df_pred_data |>
+  #     dplyr::select(pase_0, pase_4, soc_status_nowork, fam_indk_hl, edu_level_hl) |>
+  #     preds_tblone()
+  # ),
+  # tar_target(
+  #   name = tbl_pred_summary_exp_sex,
+  #   command = df_pred_data |>
+  #     dplyr::select(reg_female, soc_status_nowork, fam_indk_hl, edu_level_hl) |>
+  #     summary_tblone()
+  # ),
+  # tar_target(
+  #   name = tbl_pred_summary_exp_pase,
+  #   command = df_pred_data |> sum_pase_tables()
+  # ),
+  # tar_target(
+  #   name = tbl_pred_summary_exp_missing_edu,
+  #   command = df_pred_data |>
+  #     dplyr::select(age,reg_female, reg_trombolyse, reg_trombektomi, reg_hyperten, reg_diabetes, nihss_0, pase_0, pase_4, soc_status_nowork, fam_indk_hl, edu_level_hl) |>
+  #     who_is_missing(var="edu_level_hl")
+  # ),
+  # tar_target(
+  #   name = tbl_pred_summary_exp_missing_bmi,
+  #   command = df_pred_data |>
+  #     dplyr::select(age,reg_female, reg_trombolyse, reg_trombektomi, reg_hyperten, reg_diabetes, nihss_0, pase_0, pase_4, reg_bmi, soc_status_nowork, fam_indk_hl, edu_level_hl) |>
+  #     who_is_missing(var="reg_bmi")
+  # ),
+  # tar_target(
+  #   name = ls_pred_models,
+  #   command = pred_models(df_pred_data,auto.l = TRUE,weighted = FALSE)
+  # ),
+  # tar_target(
+  #   name = ls_pred_models_anyupdown,
+  #   command = pred_models(df_pred_data,auto.l = TRUE,weighted = FALSE,split.type="anyupdown")
+  # ),
+  # tar_target(
+  #   name = ls_pred_models_relupdown_20,
+  #   command = pred_models(df_pred_data,auto.l = TRUE,weighted = FALSE,split.type="relupdown",rel.bin=20)
+  # ),
+  # tar_target(
+  #   name = ls_pred_models_relupdown_50,
+  #   command = pred_models(df_pred_data,auto.l = TRUE,weighted = FALSE,split.type="relupdown",rel.bin=50)
+  # ),
+  # tar_target(
+  #   name = df_pred_mids,
+  #   command = fun_impute(data = df_pred_data, outcome.vars = c("pase_0", "pase_4"))
+  # ),
+  # tar_target(
+  #   name = ls_pred_mids_reg,
+  #   command = mids_regularisation(df_pred_mids)
+  # ),
+  # tar_target(
+  #   name = ls_pred_mids_reg_anyupdown,
+  #   command = mids_regularisation(df_pred_mids,split.type="anyupdown")
+  # ),
+  # tar_target(
+  #   name = ls_pred_mids_reg_relupdown_20,
+  #   command = mids_regularisation(df_pred_mids,split.type="relupdown",rel.bin=20)
+  # ),
+  # tar_target(
+  #   name = ls_pred_mids_reg_relupdown_50,
+  #   command = mids_regularisation(df_pred_mids,split.type="relupdown",rel.bin=50)
+  # ),
+  # tar_target(
+  #   name = ls_pred_summary,
+  #   command = multi_summary(ls_pred_models)
+  # ),
+  # tar_target(
+  #   name = ls_pred_mids_summary,
+  #   command = multi_summary(ls_pred_mids_reg)
+  # ),
+  # tar_target(
+  #   name = tbl_preds_log_reg,
+  #   command = pred_log_reg(df_pred_data)
+  # ),
+  # tar_target(
+  #   name = tbl_preds_lin_reg,
+  #   command = pred_lin_reg(df_pred_data)
+  # ),
+  # tar_target(
+  #   name = tbl_preds_lin_imp_reg,
+  #   command = pred_lin_reg(df_pred_mids)
+  # ),
+  # tar_target(
+  #   name = list_pred_clusters,
+  #   command = get_clusters(df_events_complete,rm.out = TRUE)
+  # ),
+  # tar_target(
+  #   name = list_pred_clusters_seq,
+  #   command = get_clusters(df_events_complete,n.cl=4)
+  # )#,
+  # tar_target(
+  #   name = list_df_multi_grouping,
+  #   command = multi_grouping_df_list(df_all_data_formatted,args.list=df_mega_list())
+  # ),
+  # tar_target(
+  #   name = list_multi_group_results,
+  #   command = multi_results_list(list_df_multi_grouping)
+  # ),
+  # tar_target(
+  #   name = list_multi_group_results_direct,
+  #   command = df_all_data_formatted |> multi_grouping_df_list(args.list=df_mega_list()) |> multi_cox_performance_test()
+  # )
+  
+  
+  #,
+  # tar_quarto(
+  #   name = report,
+  #   path = "index.qmd"
+  # ),
+  # tar_target(
+  #   name = pa_change_export_files,
+  #   command = quarto::quarto_render(here::here("doc/pa_change.qmd"), output_format = "docx")
+  # )
+)
+
+## TODO
+## - modify pipeline to only perform imputation once and have the rest use this single object.

2 Longterm/260315/alternative_grouping.R

@@ -0,0 +1,268 @@
+source("R/functions.R")
+
+### FUNCTIONALISE --> DONE
+
+df <- targets::tar_read(df_all_data_formatted) |>
+  group_format(binning.fun = bin_anyupdown) |>
+  dplyr::mutate(pase_change = factor(pase_change, levels = c("high", "up", "low", "down")))
+
+
+df |> gtsummary::tbl_summary(by = pase_change)
+
+cox <- df |>
+  # dplyr::select(-pase_0,-pase_4,-pase_rel_dif) |>
+  cox_regression(all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_change")
+
+
+df |>
+  # dplyr::select(-pase_0,-pase_4,-pase_rel_dif) |>
+  cox_regression(all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_change") |>
+  tbl_regression_standard()
+
+df |>
+  # dplyr::select(-pase_0,-pase_4,-pase_rel_dif) |>
+  cox_regression() |>
+  ggsurvfit::survfit2() |>
+  ggsurvfit::ggsurvfit() + ggsurvfit::add_confidence_interval() +
+  ggsurvfit::scale_ggsurvfit() +
+  ggsurvfit::add_risktable()
+
+
+###
+
+
+data <- targets::tar_read(df_all_data_formatted)
+
+
+df <- targets::tar_read(df_all_data_formatted) |>
+  group_format(binning.fun = bin_relupdown, rel.bin = 50)
+
+
+df |> gtsummary::tbl_summary(by = pase_change)
+
+df |>
+  # dplyr::select(-pase_0,-pase_4,-pase_rel_dif) |>
+  cox_regression(all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_change") |>
+  tbl_regression_standard()
+
+df |>
+  # dplyr::select(-pase_0,-pase_4,-pase_rel_dif) |>
+  cox_regression() |>
+  ggsurvfit::survfit2() |>
+  ggsurvfit::ggsurvfit() + ggsurvfit::add_confidence_interval() +
+  ggsurvfit::scale_ggsurvfit() +
+  ggsurvfit::add_risktable()
+
+
+
+targets::tar_read(list_df_multi_grouping) |> purrr::map(\(.x)  summary(.x[["pase_change"]]))
+
+
+
+
+
+## BMI out
+
+### Univariable models
+
+
+
+ls_df <- targets::tar_read(df_all_data_formatted) |> 
+  multi_grouping_df_list(args.list=df_mega_list(strategies=c(
+  # "bin_original", 
+  # "bin_anyupdown", 
+  "bin_relupdown", 
+  "bin_absupdown",
+  "bin_quantile", 
+  # "bin_clusterlcm",
+  "bin_percentage")),remove="pase_0")
+
+
+performance_overview_uni <- ls_df |> multi_cox_performance_test(all.vars = FALSE, use.strata = FALSE, outcome.var = "pase_change") 
+
+# performance_overview_uni
+
+# Comparing the best and the original
+
+
+cox_models_uni <- ls_df|>
+  purrr::map(\(.x){
+    .x |>
+      cox_regression(all.vars = FALSE, use.strata = FALSE, outcome.var = "pase_change")
+  }) 
+
+ls_df[c(pick_non_duplicated(performance_overview_uni,"Name","AIC_wt",1:3),"lowest_percentage_25")]|>
+  purrr::map(\(.x){
+    .x |> dplyr::select(pase_change) |> 
+      gtsummary::tbl_summary()
+  }) |> tbl_merged_named()
+
+
+lapply(best_models_uni, performance::model_performance) |> 
+  (\(.x){
+    dplyr::bind_cols(model=names(.x), dplyr::bind_rows(.x))
+  })()
+ 
+
+models_ls_uni <- best_models_uni |> lapply(\(.x){
+  .x |> gtsummary::tbl_regression(exponentiate=TRUE) |> gtsummary::bold_p()
+}) 
+
+
+models_ls_uni |> tbl_merged_named()
+
+
+## Multivariable models
+
+performance_overview_multi <- ls_df |> multi_cox_performance_test(all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_change")
+
+# performance_overview_multi
+
+# Comparing the best and the original
+# best_models_multi <- head(performance_overview_multi,10)
+
+cox_models_multi <- ls_df |>
+  purrr::map(\(.x){
+    .x |>
+      cox_regression(all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_change")
+  }) 
+
+ls_df[c(pick_non_duplicated(performance_overview_multi,"Name","AIC_wt",1:3),"lowest_percentage_25")]|>
+  purrr::map(\(.x){
+    .x |> dplyr::select(pase_change) |> 
+      gtsummary::tbl_summary()
+  }) |> tbl_merged_named()
+
+lapply(best_models_multi, performance::model_performance) |> 
+  (\(.x){
+    dplyr::bind_cols(model=names(.x), dplyr::bind_rows(.x))
+  })()
+
+
+models_ls_multi <- best_models_multi |> lapply(\(.x){
+  .x |> gtsummary::tbl_regression(exponentiate=TRUE) |> gtsummary::bold_p()
+}) 
+
+
+models_ls_multi |> tbl_merged_named()
+
+
+
+## Handle for mids objects
+# targets::tar_read(df_events_mids)
+# targets::tar_read(df_event_data)
+
+ls_df_mids <- targets::tar_read(df_events_mids) |> multi_grouping_df_list(args.list=df_mega_list(strategies=c(
+  # "bin_original", 
+  # "bin_anyupdown", 
+  "bin_relupdown", 
+  "bin_absupdown",
+  "bin_quantile", 
+  # "bin_clusterlcm",
+  "bin_percentage")),remove="pase_0")
+
+cox_models_mids <- ls_df_mids|>
+  purrr::map(\(.x){
+    .x |>
+      cox_regression(all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_change")
+  }) 
+
+performance_overview_mids <- lapply(cox_models_mids,mids_model_aic)|>
+  (\(.x){
+    dplyr::bind_cols(Name=names(.x), AIC=Reduce(c,.x))
+  })() |> dplyr::arrange(AIC) |> 
+  dplyr::mutate(rank=rank(AIC,ties.method = "min"))
+
+# performance_overview_mids|> head(20)
+
+# Comparing the best and the original
+
+best_models_mids <- head(performance_overview_mids,10)
+
+# best_models_mids <- cox_models_mids[c(pick_non_duplicated(performance_overview_mids,"Name","AIC",1:3),"quantile_change_6_2_ANY","lowest_percentage_25")]
+
+models_ls_mids <- best_models_mids |> lapply(\(.x){
+  .x |> gtsummary::tbl_regression(exponentiate=TRUE) |> gtsummary::bold_p() |> gtsummary::add_glance_source_note()
+}) 
+
+models_ls_mids |> tbl_merged_named()
+
+## Difference between mids-results
+# targets::tar_read(df_event_data)
+
+## NOTE on investigation
+# In the original grouping, PASE-cutting was performed based only on patients without prior events.
+# In the new multi-grouping strategies evaluation, PASE grouping is based on all TALOS-patients.
+# We already did export some data, so we should probably stick with this. On the other hand, 
+# this is probably a minor thing, and we should perform analyses based on all patients like intended.
+# MAYBE
+# 
+
+## 
+
+
+
+
+best_models <- list("uni"=performance_overview_uni,
+                    "multi"=performance_overview_multi,
+                    "mids"=performance_overview_mids) |> 
+  lapply(\(.x){
+    .x |> dplyr::select(Name,rank,AIC)
+  }) |> dplyr::bind_rows()
+
+models_overall_rank <- split(best_models,best_models$Name) |> 
+  purrr::imap(\(.x,.i){
+    tibble::tibble(name=.i,rank_sum=sum(.x$rank), median_AIC=median(.x$AIC))
+  })|> dplyr::bind_rows() |> 
+  dplyr::arrange(rank_sum)
+
+models_overall_rank[models_overall_rank$name %in% c("quantile_change_10_1","quantile_change_8_2","quantile_change_8_2_ANY"),]
+
+all_cox_models <- list(
+  "Univariable"=cox_models_uni,
+    "Multivariable"=cox_models_multi,
+    "Imputed multivariable"=cox_models_mids
+)
+
+names_best <- models_overall_rank$name[c(1:6)]
+
+best_sum_tables <- names_best|> 
+  lapply(\(.x){
+    ls_df[[.x]] |> 
+      dplyr::select(pase_change) |> gtsummary::tbl_summary()
+  }) |> 
+  setNames(glue::glue("{rank(models_overall_rank$rank_sum,ties.method = 'min')[c(1:6)]}_{names_best}")) 
+
+best_cox_tables <- names_best |> 
+  lapply(\(.x){
+    list("Group counts"=ls_df[[.x]] |> 
+        dplyr::select(pase_change) |> gtsummary::tbl_summary() |> fix_labels(),
+      all_cox_models |> 
+      lapply(\(.y){
+      .y[[.x]] |> tbl_regression_standard() |> gtsummary::modify_table_styling(columns=tidyselect::starts_with("p.value"),hide = TRUE) |> 
+          gtsummary::remove_row_type(variables=-pase_change,type="all")
+    })) |> purrr::list_flatten() |> 
+      tbl_merged_named()
+  }) |> 
+  setNames(glue::glue("{rank(models_overall_rank$rank_sum,ties.method = 'min')[c(1:6)]}_{names_best}"))
+
+## Counts also for multivariable analyses could be added as well
+
+best_stack <- best_cox_tables |> tbl_stack_named()
+
+best_stack |> gtsummary::as_gt() |> 
+  gt::gtsave(filename = here::here("out/sens_cox.docx"))
+
+## Checking on a specific model
+ls_df_fun[[24]] |>
+  # dplyr::select(-pase_0,-pase_4,-pase_rel_dif) |>
+  cox_regression() |>
+  ggsurvfit::survfit2() |>
+  ggsurvfit::ggsurvfit() + ggsurvfit::add_confidence_interval() +
+  ggsurvfit::scale_ggsurvfit() +
+  ggsurvfit::add_risktable()
+
+ls_df_fun[[24]] |>
+  # dplyr::select(-pase_0,-pase_4,-pase_rel_dif) |>
+  cox_regression(all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_change") |>
+  tbl_regression_standard()

2 Longterm/260315/combined_script.R

@@ -0,0 +1,740 @@
+# Code from: cont_pase_sens.qmd
+targets::tar_config_set(store = here::here("_targets"))
+source(here::here("R/functions.R"))
+source(here::here("R/glmnet-reg.R"))
+library(targets)
+library(tidyverse)
+tbl_cont_0 <- targets::tar_read("df_all_data_formatted")|> 
+  dplyr::filter(!is.na(pase_0),!is.na(pase_4)) |> 
+  # pase_cutter(drop.nas = TRUE) |>
+  events_ready(v.groups=c("clin","lifestyle.events","ses", "assess.events","quartiles"))  |>
+  dplyr::select(dplyr::all_of(c("pase_0", "age", "reg_female", "nihss_0", "reg_trombolyse", 
+"reg_trombektomi", "rtreat_placebo", "reg_alone", "reg_smoker", 
+"reg_more_alc", "reg_hyperten", "reg_diabetes", "reg_atriefli", 
+"reg_ami", "soc_status_nowork", "fam_indk_hl", "edu_level_hl", 
+"who_4", "mdi_4", "mfi_gen_4", "mrs_4_above1", "time", "status"
+))) |>
+  (\(data){
+    # c("pase_0","pase_4") |> 
+    #   purrr::map(\(exp){
+        list("Univariable"=cox_regression(data=data,all.vars = FALSE, use.strata = FALSE, outcome.var = "pase_0"),
+             "Multivariable"=cox_regression(data=data,all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_0")) |> 
+          purrr::map(\(.x){
+            .x |> gtsummary::tbl_regression(exponentiate=TRUE) |> gtsummary::add_nevent()|> 
+  fix_labels()
+          }) |> 
+          tbl_merged_named()
+      # })
+    })()   |>
+      gtsummary::modify_table_body( ~ filter(.x, variable == "pase_0"))
+tbl_cont_4 <- targets::tar_read("df_all_data_formatted")|> 
+  dplyr::filter(!is.na(pase_0),!is.na(pase_4)) |> 
+  # pase_cutter(drop.nas = TRUE) |>
+  events_ready(v.groups=c("clin","lifestyle.events","ses", "assess.events","quartiles"))  |>
+  dplyr::select(dplyr::all_of(c("pase_4", "age", "reg_female", "nihss_0", "reg_trombolyse", 
+"reg_trombektomi", "rtreat_placebo", "reg_alone", "reg_smoker", 
+"reg_more_alc", "reg_hyperten", "reg_diabetes", "reg_atriefli", 
+"reg_ami", "soc_status_nowork", "fam_indk_hl", "edu_level_hl", 
+"who_4", "mdi_4", "mfi_gen_4", "mrs_4_above1", "time", "status"
+))) |>
+  (\(data){
+    # c("pase_0","pase_4") |> 
+    #   purrr::map(\(exp){
+        list("Univariable"=cox_regression(data=data,all.vars = FALSE, use.strata = FALSE, outcome.var = "pase_4"),
+             "Multivariable"=cox_regression(data=data,all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_4")) |> 
+          purrr::map(\(.x){
+            .x |> gtsummary::tbl_regression(exponentiate=TRUE) |> gtsummary::add_nevent()|> 
+  fix_labels()
+          }) |> 
+          tbl_merged_named()
+      # })
+    })()   |>
+      gtsummary::modify_table_body( ~ filter(.x, variable == "pase_4"))
+list("PASE 0"=tbl_cont_0,
+     "PASE 6"=tbl_cont_4) |> tbl_stack_named()
+
+
+
+# Code from: events_type_sens.qmd
+targets::tar_config_set(store = here::here("_targets"))
+source(here::here("R/functions.R"))
+source(here::here("R/glmnet-reg.R"))
+library(targets)
+library(tidyverse)
+df <- targets::tar_read(df_all_data_formatted) |> 
+  dplyr::mutate(
+  status.all=dplyr::if_else(
+    startsWith(as.character(event),"death"),"death","cve",missing = NA_character_)|> factor()
+  )|>
+  get_vars(vars.groups = c("clin","lifestyle.events","ses", "ssri")) |> 
+  dplyr::rename(status=status.all,
+                time=time.all)
+df$status |> summary()
+tbl <- df |>
+  pase_cutter(drop.nas = TRUE, drop.pase = TRUE) |>
+  (\(.x) {
+    list(
+      "death" = .x |> dplyr::mutate(status = dplyr::if_else(status == "death", 1, 0, 0)),
+      "cve" = .x |> dplyr::mutate(status = dplyr::if_else(status == "cve", 1, 0, 0))
+    )
+  })() |>  lapply(\(.x) {
+    ls <- list(
+      "Univariate" = .x |> dplyr::select(-rtreat) |>
+        standard_multi_cox_table(all.vars = FALSE) |> gtsummary::add_nevent(),
+      "Multivariate" = .x |> dplyr::select(-rtreat) |>
+        standard_multi_cox_table(all.vars = TRUE) |> gtsummary::add_nevent()
+    ) |>
+      purrr::map(gtsummary::bold_p) |>
+      
+      tbl_merged_named()
+    ls |>
+      gtsummary::modify_table_body( ~ filter(.x, variable == "pase_change"))
+  })   |>
+  gtsummary::tbl_stack(group_header = c("death","cve"))# |>
+  # gtsummary::as_gt() |>
+  # gt::gtsave(here::here("out/trial_strat_sens.docx"))
+     
+tbl
+
+names(tbl)
+
+
+
+# Code from: mrs_sensitivity.qmd
+source(here::here("R/functions.R"))
+ls_mrs0 <- targets::tar_read(df_all_data_formatted) |> 
+  dplyr::filter(mrs_0==0)|>
+    dplyr::filter(!is.na(pase_0),!is.na(pase_4)) |> 
+  events_ready() |> 
+  (\(.x){
+    list(
+      std=.x,
+      imp=.x |> events_dataset(impute = TRUE)
+    )
+  })() |> 
+  purrr::map(\(.x){
+    .x |>
+      pase_cutter(drop.pase = TRUE,drop.nas = TRUE)
+  }) 
+
+# targets::tar_read(df_all_data_formatted) |> 
+#   dplyr::filter(mrs_0==0) |>
+#     dplyr::filter(!is.na(pase_0),!is.na(pase_4)) |> events_ready() |>
+#   pase_cutter(drop.pase = TRUE,drop.nas = TRUE) |>
+#     cox_regression(all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_change") |>
+#     tbl_regression_standard()
+
+ls <- list(
+  "Univariable"= ls_mrs0$std |>
+    dplyr::select(pase_change,dplyr::everything()) |> 
+    splitdf4uvcox(include=c("time","status")) |> 
+    purrr::map(\(.x){
+      .x |> tbl_regression_standard()
+    }) |> 
+    gtsummary::tbl_stack(),
+  "Multivariable" = ls_mrs0$std |>
+    cox_regression(all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_change") |>
+    tbl_regression_standard() |> gtsummary::add_glance_source_note(),
+  "Multivariable Imputed"= ls_mrs0$imp |>
+    cox_regression(all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_change") |>
+    tbl_regression_standard()
+) |> purrr::map(\(.x){
+  .x|> 
+    gtsummary::modify_table_styling(column = p.value,
+                                    hide=TRUE)
+}) |> tbl_merged_named()
+
+ls
+# |> gtsummary::as_gt() |>
+#   gt::gtsave(filename = here::here(glue::glue("out/sens_subset_mrs0_0.docx")))
+
+# ls_mrs0$std |>
+#   cox_regression(all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_change") |> performance::check_model()
+targets::tar_read(df_all_data_formatted)|>
+    dplyr::filter(!is.na(pase_0),!is.na(pase_4)) |> 
+  dplyr::filter(mrs_0==0) |>
+  dplyr::select(pase_0,pase_4) |> 
+  summary()
+# ls_mrs0$std |> gtsummary::tbl_summary(by = pase_change) |> fix_labels()
+ls_mrs0_change <- targets::tar_read(df_all_data_formatted) |>
+  get_vars(vars.groups =c("clin","lifestyle.events","ses", "assess.events.pre")) |>
+  dplyr::filter(event.include) |>
+  dplyr::select(-tidyselect::all_of("event.include")) |> 
+  (\(.x){
+    list(
+      std=.x,
+      imp=.x |>
+      dplyr::select(-tidyselect::any_of("reg_bmi"))|>
+      fun_impute(ignore = c("pase_0","pase_4"),pase.mod = FALSE) 
+    )
+  })() |> 
+  purrr::map(\(.x){
+    .x |>
+      pase_cutter(drop.pase = TRUE,drop.nas = TRUE)
+  }) 
+
+# targets::tar_read(df_all_data_formatted) |> 
+#   dplyr::filter(mrs_0==0) |>
+#     dplyr::filter(!is.na(pase_0),!is.na(pase_4)) |> events_ready() |>
+#   pase_cutter(drop.pase = TRUE,drop.nas = TRUE) |>
+#     cox_regression(all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_change") |>
+#     tbl_regression_standard()
+
+ls_change <- list(
+  "Univariable"= ls_mrs0_change$std |>
+    dplyr::select(pase_change,dplyr::everything()) |> 
+    splitdf4uvcox(include=c("time","status")) |> 
+    purrr::map(\(.x){
+      .x |> tbl_regression_standard()
+    }) |> 
+    gtsummary::tbl_stack(),
+  "Multivariable" = ls_mrs0_change$std |>
+    cox_regression(all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_change") |>
+    tbl_regression_standard() |> gtsummary::add_glance_source_note(),
+  "Multivariable Imputed"= ls_mrs0_change$imp |>
+    cox_regression(all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_change") |>
+    tbl_regression_standard()
+) |> purrr::map(\(.x){
+  .x|> 
+    gtsummary::modify_table_styling(column = p.value,
+                                    hide=TRUE)
+}) |> tbl_merged_named()
+
+ls_change
+#| eval: false
+coll <- list(
+  mrs0_0=ls_mrs0$std|>
+    cox_regression(all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_change"),
+  pase_change_mrs0 = ls_mrs0_change$std|>
+  cox_regression(all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_change"),
+  pase_change=df |>
+    get_vars(vars.groups =c("clin","lifestyle.events","ses", "assess.events")) |>
+    dplyr::filter(event.include) |>
+    dplyr::select(-tidyselect::all_of("event.include")) |> 
+    pase_cutter(drop.pase = TRUE,drop.nas = TRUE)|>
+    cox_regression(all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_change"),
+  prestroke_pase=df |>
+    pase_cutter(drop.nas = FALSE) |>
+    get_vars(vars.groups = c("clin", "lifestyle.events", "ses", "assess.pred", "quartiles"), vars.vec = c("inc_time",
+                                                                                                          "time",
+                                                                                                          "status")) |>
+    dplyr::mutate(time = time + inc_time / 365) |>
+    dplyr::select(-dplyr::any_of(c("pase_0", "pase_4", "pase_change", "inc_time", "event.include", "pase_4_quartile")))|>
+    cox_regression(all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_0_quartile")) |> 
+    purrr::map(performance::check_collinearity)
+
+coll |> purrr::imap(\(.x,.i){
+  .x |> dplyr::as_tibble() |>  gt::gt() |> gt::tab_header(.i)|> 
+  gt::gtsave(filename = here::here(glue::glue("out/coll_{.i}.docx")))
+})
+
+
+
+# Code from: pa_event_plots.qmd
+targets::tar_config_set(store = here::here("_targets"))
+source(here::here("R/functions.R"))
+source(here::here("R/glmnet-reg.R"))
+library(targets)
+library(tidyverse)
+# targets::tar_read(plot_events_survival_smooth)
+p1 <- targets::tar_read(df_event_data) |>
+  events_dataset(impute = FALSE) |>
+  dplyr::mutate(pase_change = factor(pase_change, 
+                                     levels = c("Persistently high", "Decrease", "Increase", "Persistently low")),
+                pase_change = dplyr::recode(pase_change,
+                                            "Persistently high"="Consistently above lowest", 
+                                            "Decrease"="Decrease to lowest", 
+                                            "Increase"="Increase from lowest", 
+                                            "Persistently low"="Consistently lowest")
+                ) |>
+  cox_regression() |>
+  plot_survival_smooth(line.w = 1) +
+  ggplot2::labs(
+    fill = "PA level change group",
+    color = "PA level change group",
+    linetype = "PA level change group"
+  ) +
+  ggplot2::scale_x_continuous(limits = c(0, 9.5), breaks = c(0, 3, 6, 9))
+
+
+ggplot2::ggsave(here::here("out/smooth_surv.png"), 
+                p1, 
+                dpi = 600, 
+                units = "cm", 
+                height = 8, 
+                width = 15)
+p1
+surv.data <- targets::tar_read(df_event_data) |>
+  events_dataset(impute = FALSE) |>
+  cox_regression(all.vars = FALSE) |> # Minimal model to just give risk table
+  ggsurvfit::survfit2() |>
+  ggsurvfit::tidy_survfit(times = c(0, 3, 6, 9))
+
+
+risk_event <- c("n.risk", "cum.event") |>
+  purrr::map2(c("Numbers at risk", "Events"), \(.x, .y){
+    surv.data |>
+      tidyr::pivot_wider(id_cols = strata, names_from = time, values_from = {{ .x }}) |>
+      mask_micro_table(col.sel = -strata) |> # Masking columns
+      tidyr::pivot_longer(cols = -strata) |>
+      setNames(c("strata", "time", .x)) |>
+      dplyr::mutate(dplyr::across(time, ~ as.numeric(.x))) |>
+      dplyr::mutate(strata = factor(strata, levels = rev(c("Persistently high", "Decrease", "Increase", "Persistently low")))) |>
+      ggplot2::ggplot(ggplot2::aes(x = time, y = strata, label = get(.x))) +
+      ggplot2::geom_text() +
+      ggplot2::labs(y = NULL, title = .y) +
+      ggplot2::theme_minimal() +
+      ggsurvfit::theme_risktable_default()
+  })
+
+p2 <- ggsurvfit::ggsurvfit_align_plots(list(p1, risk_event[1]) |> purrr::list_flatten()) |>
+  patchwork::wrap_plots(ncol = 1, heights = c(2, 1), guides = "collect")
+
+ggplot2::ggsave(here::here("out/smooth_surv_tables.png"), 
+                p2, 
+                dpi = 600, 
+                units = "cm", 
+                height = 9, 
+                width = 15)
+p2
+#| include: false
+targets::tar_read(df_event_data) |>
+  events_dataset(impute = FALSE) |>
+  dplyr::mutate(pase_change = factor(pase_change, levels = c("Persistently high", "Decrease", "Increase", "Persistently low"))) |>
+  cox_regression(all.vars = FALSE) |> # Minimal model to just give risk table
+  ggsurvfit::survfit2() |>
+  ggsurvfit::ggsurvfit() +
+  ggplot2::scale_y_continuous(
+    limits = c(0, 1.02),
+    breaks = seq(0, 1, .25),
+    labels = scales::percent,
+    expand = c(0.01, 0)
+  ) +
+  ggplot2::scale_x_continuous(breaks = c(0, 4, 8.5), expand = c(0.02, 0)) +
+  ggsurvfit::add_risktable()
+#| include: false
+targets::tar_read(df_event_data_small) |>
+  events_dataset(impute = FALSE) |>
+  dplyr::mutate(pase_change = factor(pase_change, levels = c("Persistently high", "Decrease", "Increase", "Persistently low"))) |>
+  cox_regression() |>
+  plot_survival_smooth() +
+  ggplot2::labs(
+    fill = "PA change group",
+    color = "PA change group",
+    linetype = "PA change group"
+  )
+#| include: false
+targets::tar_read(df_event_data) |>
+  events_dataset(impute = FALSE) |>
+  dplyr::mutate(pase_change = factor(pase_change, levels = c("Persistently high", "Decrease", "Increase", "Persistently low"))) |>
+  cox_regression() |>
+  plot_survival_smooth() +
+  ggplot2::labs(
+    fill = "PA change group",
+    color = "PA change group",
+    linetype = "PA change group"
+  )
+
+
+
+# Code from: pa_events_analyses.qmd
+targets::tar_config_set(store = here::here("_targets"))
+source(here::here("R/functions.R"))
+source(here::here("R/glmnet-reg.R"))
+library(targets)
+library(tidyverse)
+#| include: false
+list("Univariate"=targets::tar_read(tbl_events_cox_regression_uv),
+"Multivariate"=targets::tar_read(tbl_events_cox_regression),
+"Imputed Multivariate"=targets::tar_read(tbl_events_mids_cox_regression)) |> 
+  # purrr::map(gtsummary::modify_table_styling,column=p.value,hide=TRUE) |> 
+  purrr::map(gtsummary::bold_p) |> 
+  tbl_merged_named()
+#| include: true
+list("Univariate"=targets::tar_read(tbl_events_cox_regression_uv),
+"Multivariate"=targets::tar_read(tbl_events_cox_regression),
+"Imputed Multivariate"=targets::tar_read(tbl_events_mids_cox_regression)) |> 
+  purrr::map(gtsummary::modify_table_styling,column=p.value,hide=TRUE) |> 
+  tbl_merged_named()
+#| echo: true
+targets::tar_read(df_event_data) |> 
+  # dplyr::select(-reg_bmi) |>
+  na.omit() |> 
+  nrow()
+#| include: false
+targets::tar_read(tbl_events_cox_regression_small)
+
+targets::tar_read(df_event_data_small)
+#| include: false
+targets::tar_read(tbl_events_mids_cox_regression)
+targets::tar_read("df_all_data_formatted") |> 
+  events_ready() |> 
+  dplyr::filter(!is.na(pase_0),!is.na(pase_4)) |> 
+  (\(data){
+    c("pase_0","pase_4") |> 
+      purrr::map(\(exp){
+        with(data,survival::coxph(as.formula(glue::glue("survival::Surv(time, status)~{exp}")))) |> 
+  gtsummary::tbl_regression(exponentiate=TRUE)|> 
+  fix_labels()
+      })
+    })()  |> 
+  gtsummary::tbl_stack()
+targets::tar_read("df_all_data_formatted") |> 
+  pase_cutter(drop.nas = TRUE) |> 
+  events_ready(v.groups=c("clin","lifestyle.events","ses", "assess.events","quartiles"))  |> 
+  dplyr::select(-dplyr::any_of(c("pase_0","pase_4","pase_change"))) |> 
+  (\(data){
+    c("pase_0_quartile","pase_4_quartile") |> 
+      purrr::map(\(exp){
+        list("Univariable"=cox_regression(data=data,all.vars = FALSE, use.strata = FALSE, outcome.var = exp),
+             "Multivariable"=cox_regression(data=data,all.vars = TRUE, use.strata = FALSE, outcome.var = exp)) |> 
+          purrr::map(\(.x){
+            .x |> gtsummary::tbl_regression(exponentiate=TRUE)|> 
+  fix_labels()
+          }) |> 
+          tbl_merged_named()
+      })
+    })()  |> 
+  gtsummary::tbl_stack()
+targets::tar_read("df_all_data_formatted") |> 
+  pase_cutter(drop.nas = TRUE) |>
+    get_vars(vars.groups = c("clin","lifestyle.events","ses", "assess.events","quartiles"),vars.vec = c("inc_time"))  |> 
+  dplyr::mutate(time=time+inc_time/365) |> 
+  dplyr::select(-dplyr::any_of(c("pase_0","pase_4","pase_change","inc_time","event.include","pase_4_quartile"))) |> 
+  (\(data){
+    list(
+        with(data,survival::coxph(as.formula(glue::glue("survival::Surv(time, status)~{exp}")))) |> 
+  gtsummary::tbl_regression(exponentiate=TRUE)|> 
+  fix_labels() |> gtsummary::add_glance_source_note()
+      )
+    })()  |> 
+  gtsummary::tbl_stack()
+
+
+
+# Code from: pa_events_summaries.qmd
+targets::tar_config_set(store = here::here("_targets"))
+source(here::here("R/functions.R"))
+source(here::here("R/glmnet-reg.R"))
+library(targets)
+library(tidyverse)
+#| include: false
+targets::tar_read(tbl_events_summary)
+#| include: true
+targets::tar_read(tbl_events_summary) |> mask_micro_summary(micro.n = 5)
+#| include: false
+ls <- targets::tar_read(df_event_data)|>
+    pase_cutter(drop.pase = TRUE) |>
+    dplyr::select(-tidyselect::all_of(c("status", "time"))) |>
+    dplyr::filter(!is.na(pase_change)) |> 
+    labelling_data() |>
+    gtsummary::tbl_summary(
+      missing = "ifany",
+      by = pase_change,
+      # value = list(where(is.logical) ~ TRUE),
+      missing_text = "Missing"
+    ) |>
+    gtsummary::add_overall() |>
+    gtsummary::add_n()
+
+ls |> add_missing_stats() |>  mask_micro_summary(micro.n = 5)
+targets::tar_read(df_event_data)|>
+    pase_cutter(drop.pase = TRUE) |>
+    dplyr::select(pase_change, time) |>
+    dplyr::filter(!is.na(pase_change)) |> 
+    labelling_data() |>
+    gtsummary::tbl_summary(
+      missing = "ifany",
+      by = pase_change,
+      type = gtsummary::all_continuous() ~ "continuous2",
+      statistic = list(gtsummary::all_continuous() ~ c("{median} ({p25}, {p75})","{mean} ({sd})")),
+      # value = list(where(is.logical) ~ TRUE),
+      
+      missing_text = "Missing"
+    ) |>
+    gtsummary::add_overall()
+#| include: true
+targets::tar_read(df_all_data_formatted) |>
+  (\(.x)summary(.x$pase_0))()
+
+# targets::tar_read(df_all_data_formatted) |>
+#    dplyr::filter(!is.na(pase_0),!is.na(pase_4))|>
+# (\(.x)summary(.x$pase_0))()
+#| include: false
+targets::tar_read(df_all_data_formatted) |>
+  pase_cutter(drop.pase = TRUE) |>
+  dplyr::select(mrs_4, pase_change) |>
+  dplyr::mutate(pase_change = forcats::fct_relevel(pase_change, c("Persistent high", "Increase", "Decrease", "Persistent low"))) |>
+  na.omit() |>
+  (\(.x){
+    table(mrs = .x$mrs_4, pase = .x$pase_change)
+  })() |>
+  rankinPlot::grottaBar(groupName = "pase", scoreName = "mrs")
+targets::tar_read(df_event_data)|>
+    pase_cutter(drop.pase = FALSE) |>
+    dplyr::filter(!is.na(pase_change))|>
+    dplyr::select(pase_0,pase_4)  |> 
+    labelling_data() |> 
+  gtsummary::tbl_summary()
+targets::tar_read(df_all_data_formatted)|>
+    pase_cutter(drop.pase = FALSE) |>
+    dplyr::filter(!is.na(pase_change))|>
+    dplyr::count(pase_0_quartile,pase_4_quartile) |> 
+  write_csv(here::here("out/event_sankey_data.csv"))
+ds <- targets::tar_read(df_all_data_formatted) |>
+  get_vars(vars.groups = c("clin", "lifestyle", "ses", "assess.events", "extra")) |>
+  dplyr::select(-time, -status, -soc_status) |>
+  pase_cutter(drop.pase = TRUE) |>
+  labelling_data()
+
+ls <- list(
+  pase_out = ds |>
+    dplyr::mutate(event.filter = factor(
+      dplyr::case_when(is.na(pase_change) ~ "pase_incomplete",
+        !event.include ~ "early_event",
+        .default = "included"
+      ),
+      levels = c("pase_incomplete", "early_event", "included")
+    )),
+  event_out = ds |>
+    dplyr::mutate(event.filter = factor(
+      dplyr::case_when(!event.include ~ "early_event",
+        is.na(pase_change) ~ "pase_incomplete",
+        .default = "included"
+      ),
+      levels = c("early_event", "pase_incomplete", "included")
+    ))
+) |>
+  purrr::map(dplyr::select, -event.include, -pase_change, -event)
+
+ls_tbl <- ls |>
+  purrr::map(\(.x){
+    .x |>
+      dplyr::filter(event.filter != "pase_incomplete") |>
+      dplyr::mutate(event.filter = factor(event.filter))
+  }) |>
+  (\(.x) list(.x, purrr::pluck(ls, 1) |> dplyr::mutate(event.filter = event.filter == "included")))() |>
+  purrr::list_flatten()
+#| include: false
+ls_tbl |>
+  purrr::map(\(.x){
+    .x |>
+      gtsummary::tbl_summary(
+        by = event.filter,
+        missing = "ifany"
+      ) |>
+      gtsummary::add_p()
+  }) |>
+  (\(.x)gtsummary::tbl_merge(.x, c(names(.x)[1:2], "all_out")))()
+targets::tar_read(df_all_data_formatted) |>
+  get_vars(vars.groups = c("clin", "lifestyle", "ses", "assess.events", "extra", "assess.pred")) |>
+  dplyr::select(-time, 
+                # -status, 
+                -soc_status) |>
+  pase_cutter(drop.pase = FALSE) |>
+  labelling_data() |>
+    dplyr::mutate(event.filter = factor(
+      dplyr::case_when(
+        !event.include | is.na(pase_change) ~ "excluded",
+        .default = "included"
+      )
+    )) |>
+  dplyr::select(-who_4, -mdi_4, -mrs_4_above1, -mfi_gen_4) |>
+      gtsummary::tbl_summary(
+        by = event.filter,
+        missing = "ifany"
+      ) |>
+      gtsummary::add_p()
+ds |>
+  dplyr::mutate(pase_incomplete=is.na(pase_change),
+                excluded=pase_incomplete | !event.include,
+                early_event=!event.include) |> 
+  dplyr::select(early_event,pase_incomplete,excluded) |> 
+  gtsummary::tbl_summary(by=excluded)
+#| include: true
+ls_tbl |>
+  purrr::pluck(3) |>
+  dplyr::select(-who_4, -mdi_4, -mrs_4_above1, -mfi_gen_4) |>
+  (\(.x){
+    .x |>
+      gtsummary::tbl_summary(
+        by = event.filter,
+        missing = "no"
+      ) |>
+      gtsummary::add_p()
+  })() |> mask_micro_summary(micro.n = 5)
+#| include: true
+targets::tar_read(df_event_data)|>
+    pase_cutter(drop.pase = FALSE)|>
+    dplyr::filter(!is.na(pase_change)) |>
+    dplyr::select(-time, -status, -pase_0_quartile, -pase_4_quartile, -pase_change)  |> 
+    labelling_data() |> 
+  dplyr::mutate(reg_female=ifelse(reg_female,"Female","Male")) |>
+    gtsummary::tbl_summary(
+      missing = "ifany",
+      by = reg_female,
+      value = list(where(is.logical) ~ TRUE)
+    )|> gtsummary::add_p() |> 
+  mask_micro_summary()
+#| include: false
+events <- targets::tar_read(ls_all_events) |>
+  dplyr::bind_rows() |>
+  dplyr::left_join(targets::tar_read(df_all_data_formatted) |>
+    dplyr::select(c("event.include", "rdate", "enddate", "PNR")), by = c("CPR" = "PNR")) |>
+  dplyr::mutate(
+    date.event = as.Date(date.event),
+    event.trial = !date.event > enddate,
+    event.itt = !date.event > (lubridate::dmonths(6) + rdate)
+  ) |>
+  dplyr::mutate(event.type = dplyr::if_else(grepl("^death", event.type), "death", event.type))
+
+ls <- list(
+  # Events during inclusion and during first 6 months after inclusion (Intention to treat)
+  events |>
+    dplyr::select(event.type, event.trial, event.itt) |>
+    tidyr::pivot_longer(cols = c("event.trial", "event.itt")) |>
+    dplyr::filter(value) |>
+    dplyr::select(-value) |>
+    gtsummary::tbl_summary(by = name),
+
+  # All registred events
+  events |>
+    dplyr::select(event.type) |>
+    gtsummary::tbl_summary(),
+
+  # All events in the selected group
+  events |>
+    dplyr::select(event.type, event.include) |>
+    # tidyr::pivot_longer(cols = c("event.trial","event.itt")) |>
+    dplyr::filter(event.include) |>
+    dplyr::select(-event.include) |>
+    gtsummary::tbl_summary(),
+
+  # All considered events (first event)
+  targets::tar_read(df_events_deaths)|>
+    dplyr::mutate(event.type = dplyr::if_else(grepl("^death", event.type), "death", event.type)) |>
+    dplyr::select(event.type) |>
+    gtsummary::tbl_summary(),
+  
+   # All included events (first event)
+  targets::tar_read(df_all_data_formatted)|> 
+  pase_cutter(drop.pase = TRUE) |>
+  dplyr::filter(!is.na(pase_change))|>
+    dplyr::filter(event.include) |>
+    # dplyr::select(-event.include)|>
+    dplyr::mutate(event = dplyr::if_else(grepl("^death", event), "death", event)) |>
+    dplyr::select(event) |>
+    dplyr::filter(!is.na(event)) |> 
+    gtsummary::tbl_summary()
+) |>
+  setNames(c("During trial", "All events", "Selected events", "Considered", "Included"))
+
+ls[4] |> 
+  purrr::map(\(.x) .x |>
+               mask_micro_summary(micro.n = 5)) |>
+  tbl_merged_named()
+targets::tar_read(df_all_data_formatted)|> 
+  pase_cutter(drop.pase = TRUE) |>
+  dplyr::filter(!is.na(pase_change))|>
+    dplyr::filter(event.include) |>
+    # dplyr::select(-event.include)|>
+    dplyr::mutate(event = dplyr::case_when(grepl("^death", event)~"Mors",
+                                           grepl("^DI6", event)~ "DI61-4",
+                                           .default = event)) |>
+    dplyr::select(event) |>
+    dplyr::filter(!is.na(event)) |> 
+    gtsummary::tbl_summary() |> mask_micro_summary(micro.n = 5)
+targets::tar_read(df_event_data) |>
+  pase_cutter(drop.pase = TRUE) |>
+  dplyr::filter(!is.na(pase_change)) |> 
+  events_table(by="pase_change")
+
+
+
+# Code from: sex_events.qmd
+targets::tar_config_set(store = here::here("_targets"))
+source(here::here("R/functions.R"))
+source(here::here("R/glmnet-reg.R"))
+library(targets)
+library(tidyverse)
+
+df <- targets::tar_read(df_all_data_formatted) |> 
+  get_vars(vars.groups = c("clin","lifestyle.events","ses", "ssri")) |> 
+  dplyr::rename(status=status.all,
+                time=time.all)
+df |>
+  pase_cutter(drop.nas = TRUE,drop.pase = TRUE) |>
+  dplyr::mutate(reg_female=factor(ifelse(reg_female,"Female","Male"))) |> 
+  (\(.x) {
+    split(.x, .x$reg_female)
+  })() |> lapply(\(.x) {
+    ls <- list("Univariate"=.x |> dplyr::select(-reg_female,-rtreat) |>
+      standard_multi_cox_table(all.vars = FALSE) |> gtsummary::add_nevent(),
+"Multivariate"=.x |> dplyr::select(-reg_female,-rtreat) |>
+      standard_multi_cox_table(all.vars = TRUE) |> gtsummary::add_nevent())|> 
+  purrr::map(gtsummary::bold_p) |> 
+  tbl_merged_named() 
+    ls |> 
+       gtsummary::modify_table_body(~filter(.x, variable == "pase_change"))
+  })   |> 
+  (\(.x) {
+    gtsummary::tbl_stack(.x,group_header=names(.x)) 
+  })()
+  
+
+
+
+
+
+# Code from: ssri_events.qmd
+targets::tar_config_set(store = here::here("_targets"))
+source(here::here("R/functions.R"))
+source(here::here("R/glmnet-reg.R"))
+library(targets)
+library(tidyverse)
+
+df <- targets::tar_read(df_all_data_formatted) |> 
+  get_vars(vars.groups = c("clin","lifestyle.events","ses", "ssri")) |> 
+  dplyr::rename(status=status.all,
+                time=time.all)
+df |> 
+  dplyr::select(#-event.include,
+                -rtreat_placebo)|>
+  labelling_data() |> 
+  gtsummary::tbl_summary(by=rtreat) |> 
+  gtsummary::add_overall() #|> 
+  # mask_micro_summary()
+df |> 
+  dplyr::select(
+    -rtreat_placebo,
+                -pase_4#,
+    # -reg_bmi
+                )  |> 
+  cox_regression(outcome.var = "rtreat",use.strata = FALSE) |> 
+  gtsummary::tbl_regression(exponentiate = TRUE, 
+                                    add_estimate_to_reference_rows = TRUE,
+                                    show_single_row = where(is.logical)) |> 
+  gtsummary::bold_p() |> 
+  fix_labels()
+df |> 
+  dplyr::select(-rtreat_placebo) |> 
+  cox_regression(outcome.var = "rtreat",all.vars = FALSE, use.strata = TRUE,include_formula = TRUE) |> 
+  plot_survival_smooth()
+df |>
+  pase_cutter(drop.nas = TRUE,drop.pase = TRUE) |>
+  (\(.x) {
+    split(.x, .x$rtreat)
+  })() |> lapply(\(.x) {
+    ls <- list("Univariate"=.x |> dplyr::select(-rtreat_placebo, -rtreat) |>
+      standard_multi_cox_table(all.vars = FALSE),
+"Multivariate"=.x |> dplyr::select(-rtreat_placebo, -rtreat) |>
+      standard_multi_cox_table(all.vars = TRUE))|> 
+  purrr::map(gtsummary::bold_p) |> 
+  tbl_merged_named() 
+    ls |> 
+       gtsummary::modify_table_body(~filter(.x, variable == "pase_change"))
+  })   |> tbl_stack_named()
+  # gtsummary::tbl_stack(group_header=levels(factor(df$rtreat)))
+
+
+

2 Longterm/260315/glmnet-reg.R

@@ -0,0 +1,340 @@
+## ItMLiHSmar2022
+## regular_fun.R, child script
+## Regularisation model building function
+## Andreas Gammelgaard Damsbo, agdamsbo@clin.au.dk
+##
+## Now modified to use in publication
+##
+
+regular_fun <- function(X, y, K, lambdas, alpha) {
+  n <- nrow(X)
+  set.seed(321)
+
+  # Using caret function to ensure both levels represented in all folds
+  c <- caret::createFolds(y = y, k = K, list = FALSE, returnTrain = TRUE)
+
+  B <- yhatTestProbKeep <- list()
+  accTrain <- accTest <- err_train <- err_test <- auc_train <- auc_test <- matrix(nrow = K, ncol = length(lambdas))
+
+  TrainProb <- TestProb <- list()
+  
+  catinfo <- levels(y)
+
+  cMatTrain <- cMatTest <- table(true = factor(c(0, 0), levels = catinfo), pred = factor(c(0, 0), levels = catinfo))
+
+
+  ## Iterate over partitions
+  for (idx1 in 1:K) {
+    # Status
+    cat("Processing fold", idx1, "of", K, "\n")
+
+    # idx1=1
+    # Get training- and test sets
+    I_train <- c != idx1 ## Creating selection vector of TRUE/FALSE
+    I_test <- !I_train
+
+    Xtrain <- X[I_train, ]
+    ytrain <- y[I_train]
+    Xtest <- X[I_test, ]
+    ytest <- y[I_test]
+
+
+    ## Model matrices for glmnet
+    ## Using the complicated approach not to include first level.
+    # Xmat.train<-model.matrix(~ .-1, data=Xtrain,
+    #              contrasts.arg = lapply(Xtrain[,sapply(Xtrain, is.factor)],
+    #                                     contrasts, contrasts=T))
+    # Xmat.test<-model.matrix(~ .-1, data=Xtest,
+    #                contrasts.arg = lapply(Xtest[,sapply(Xtest, is.factor)],
+    #                                       contrasts, contrasts=T))
+
+    # Xmat.train<-model.matrix(~.-1,Xtrain)
+    # Xmat.test<-model.matrix(~.-1,Xtest)
+
+    # Weights
+    ytrain_weight <- as.vector(1 - (table(ytrain)[ytrain] / length(ytrain)))
+    # ytest_weight<-as.vector(1 / (table(ytest)[ytest] / length(ytest)))
+
+    # Fit regularized linear regression model
+    mod <- glmnet::glmnet(Xtrain, ytrain,
+      alpha = alpha, ## Alpha = 1 for lasso
+      lambda = lambdas, ## Setting lambdas
+      standardize = TRUE, ## Scales and centers
+      weights = ytrain_weight,
+      family = "binomial"
+    )
+
+    # Keep coefficients for plot
+    B[[idx1]] <- as.matrix(coef(mod))
+
+    # TrainProb[[idx1]] <- list()
+    TestProb[[idx1]] <- list()
+    
+    # Iterate over regularization strengths to compute training- and test
+    # errors for individual regularization strengths.
+    for (idx2 in 1:length(lambdas)) {
+      # idx2=1
+
+      # Predict
+      yhatTrainProb <- predict(mod,
+        s = lambdas[idx2],
+        newx = data.matrix(Xtrain),
+        type = "response"
+      )
+
+      yhatTestProb <- predict(mod,
+        s = lambdas[idx2],
+        newx = data.matrix(Xtest),
+        type = "response"
+      )
+      
+      # Compute training and test error
+      yhatTrain <- round(yhatTrainProb)
+      yhatTest <- round(yhatTestProb)
+
+      TestProb[[idx1]][[idx2]] <- dplyr::bind_cols(data.matrix(Xtest),y=ytest,pred=yhatTestProb,.name_repair = "unique_quiet")
+      
+      # Make predictions categorical again (instead of 0/1 coding)
+      yhatTrainCat <- factor(round(yhatTrainProb), levels = c("0", "1"), labels = catinfo, ordered = TRUE)
+      yhatTestCat <- factor(round(yhatTestProb), levels = c("0", "1"), labels = catinfo, ordered = TRUE)
+
+      # Evaluate classifier performance
+      # Accuracy
+      # accTrain[idx1,idx2] <- sum(yhatTrainCat==ytrain)/length(ytrain)
+      # accTest [idx1,idx2] <- sum(yhatTestCat==ytest)/length(ytest)
+      # #
+      # # Error rate
+      # err_train[idx1,idx2] =  1 - accTrain[idx1,idx2]
+      # err_test [idx1,idx2] =   1 - accTest[idx1,idx2]
+
+      # AUROC
+      suppressMessages(
+        auc_train[idx1, idx2] <- pROC::auc(ytrain, yhatTrainCat)
+      )
+      suppressMessages(
+        auc_test[idx1, idx2] <- pROC::auc(ytest, yhatTestCat)
+      )
+
+      # Compute confusion matrices
+      cMatTrain <- cMatTrain + table(true = ytrain, pred = yhatTrainCat)
+      cMatTest <- cMatTest + table(true = ytest, pred = yhatTestCat)
+    }
+  }
+  list(mod = mod, B = B, auc_train = auc_train, auc_test = auc_test, cMatTrain = cMatTrain, cMatTest = cMatTest, 
+       TrainProb=TrainProb, 
+       TestProb=TestProb)
+}
+
+
+## ItMLiHSmar2022
+## regularisation_steps.R, child script
+## Regularised model building and analysation for assignment
+## Andreas Gammelgaard Damsbo, agdamsbo@clin.au.dk
+##
+## Now modified to use in publication
+##
+
+
+
+#' Title
+#'
+#' @param data
+#' @param outcome.var
+#' @param weighted
+#'
+#' @return
+#' @export
+#'
+#' @examples
+#' data <- targets::tar_read(df_pred_data) |> 
+#' pred_ls_split(excluded.vars = "reg_bmi")
+#' 
+#' data <- data[[1]]
+#' mod <- data |> regularisation_steps(auto.l=TRUE)
+regularisation_steps <- function(data, outcome.var = "pase_bin", weighted = FALSE, auto.l = FALSE) {
+  n <- nrow(data)
+
+  y <- data |> dplyr::select({{ outcome.var }})
+  X <- data |> dplyr::select(-{{ outcome.var }})
+
+  ## ====================================================================
+  ## Step 0: data import and wrangling
+  ## ====================================================================
+
+  # setwd("/Users/au301842/PhysicalActivityandStrokeOutcome/1 PA Decline/")
+
+  # source("data_format.R")
+  y1 <- factor(as.integer(y[[1]])) ## Outcome is required to be factor of 0 or 1.
+  # summary(y1)
+
+  ## ====================================================================
+  ## Step 1: settings
+  ## ====================================================================
+
+  ## Folds
+  K <- 10
+  set.seed(3)
+  c <- caret::createFolds(
+    y = y1,
+    k = K,
+    list = FALSE,
+    returnTrain = TRUE
+  ) # Fold IDs for tuning
+
+  ## Defining tuning parameters
+  if (auto.l){
+    lambdas <- NULL
+  } else {
+    lambdas <- 2^seq(-10, 20, 1)
+  }
+  
+  alphas <- seq(0, 1, .1)
+
+  ## Weights for models
+  if (weighted) {
+    wght <- as.vector(1 - (table(y1)[y1] / length(y1)))
+  } else {
+    wght <- rep(1, length(y1))
+  }
+
+
+  ## Standardise numeric
+  ## Centered and
+
+
+
+  ## ====================================================================
+  ## Step 2: all cross validations for each alpha
+  ## ====================================================================
+
+  # library(furrr)
+  # library(purrr)
+  # library(doMC)
+  # registerDoMC(cores=6)
+
+  future::plan(strategy = "multisession", workers = 2)
+
+  # Nested CVs with analysis for all lambdas for each alpha
+  #
+  set.seed(3)
+  cvs <- furrr::future_map(alphas, .options = furrr::furrr_options(seed = 3), function(a) {
+    glmnet::cv.glmnet(model.matrix(~ . - 1, X),
+      y1,
+      weights = wght,
+      lambda = lambdas,
+      type.measure = "deviance", # This is standard measure and recommended for tuning
+      foldid = c, # Per recommendation the folds are kept for alpha optimisation
+      alpha = a,
+      standardize = TRUE,
+      family = quasibinomial, # Same as binomial, but not as picky
+      keep = TRUE
+    )
+  })
+
+  ## ====================================================================
+  # Step 3: optimum lambda for each alpha
+  ## ====================================================================
+
+
+  # For each alpha, lambda is chosen for the lowest meassure (deviance)
+  each_alpha <- sapply(seq_along(alphas), function(id) {
+    each_cv <- cvs[[id]]
+    alpha_val <- alphas[id]
+    index_lmin <- match(
+      each_cv$lambda.min,
+      each_cv$lambda
+    )
+    c(
+      lamb = each_cv$lambda.min,
+      alph = alpha_val,
+      cvm = each_cv$cvm[index_lmin]
+    )
+  })
+
+  if (auto.l){
+    # Best (min) lambda
+    best_lamb <- min(each_alpha["lamb", ])
+    
+    # Alpha is chosen for best lambda with lowest model deviance, each_alpha["cvm",]
+    best_alph <- each_alpha["alph", ][each_alpha["cvm", ] == min(each_alpha["cvm", ]
+                                                                 [each_alpha["lamb", ] %in% best_lamb])]
+    
+    # BEst lamb is set to NULL to allow glm.net to use the optimal method, which is bult in.
+    # best_lamb <- NULL
+    
+  } else {
+    # Best (min) lambda
+    best_lamb <- min(each_alpha["lamb", ])
+    
+    # Alpha is chosen for best lambda with lowest model deviance, each_alpha["cvm",]
+    best_alph <- each_alpha["alph", ][each_alpha["cvm", ] == min(each_alpha["cvm", ]
+                                                                 [each_alpha["lamb", ] %in% best_lamb])]
+  }
+  
+
+  ## https://stackoverflow.com/questions/42007313/plot-an-roc-curve-in-r-with-ggplot2
+  # df_roc <- glmnet::roc.glmnet(cvs[[match(best_alph, alphas)]]$fit.preval, newy = y1)[match(best_lamb, lambdas)]# |> # Plots performance from model with best alpha
+  #
+  #   df_roc |> plot_roc_curve()
+
+  ## ====================================================================
+  # Step 4: Creating the final model
+  ## ====================================================================
+
+  # source(here::here("R/regular_fun.R")) # Custom function
+  optimised_model <- regular_fun(X = X, y = y1, K = K, lambdas = best_lamb, alpha = best_alph)
+  # With lambda and alpha specified, the function is just a k-fold cross-validation wrapper,
+  # but keeps model performance figures from each fold.
+  
+  # list2env(optimised_model, .GlobalEnv)
+  # Function outputs a list, which is unwrapped to Env.
+  # See source script for reference.
+
+  ## ====================================================================
+  # Step 5: creating table of coefficients for inference
+  ## ====================================================================
+
+  # reg_coef_tbl <- optimised_model$B |> purrr::reduce(cbind)
+
+  # Bmatrix <- optimised_model$B |> purrr::reduce(cbind)
+  # Bmedian <- apply(Bmatrix, 1, median)
+  # Bmean <- apply(Bmatrix, 1, mean)
+  #
+  # reg_coef_tbl <- dplyr::tibble(
+  #   name = rownames(Bmatrix),
+  #   medianX = round(Bmedian, 5),
+  #   ORmed = round(exp(Bmedian), 5),
+  #   meanX = round(Bmean, 5),
+  #   ORmea = round(exp(Bmean), 5)
+  # ) # |>
+  # arrange(desc(abs(medianX)))%>%
+  # gt::gt()
+
+  ## ====================================================================
+  # Step 6: plotting predictive performance
+  ## ====================================================================
+
+  # reg_cfm <- caret::confusionMatrix(optimised_model$cMatTest)
+  # reg_cfm <- optimised_model$cMatTest
+  # reg_auc_sum <- optimised_model$auc_test[, 1]
+
+  ## ====================================================================
+  # Step 7: Packing list to save in loop
+  ## ====================================================================
+
+  list(
+    "IncludedN" = n,
+    "model" = optimised_model,
+    "alphas" = alphas,
+    "bestA" = best_alph,
+    "lambdas" = lambdas,
+    "bestL" = best_lamb,
+    # "TestTable" = reg_cfm,
+    # "AUROC" = reg_auc_sum,
+    # "ROC curve" = df_roc,
+    "y1" = y1,
+    "X" = X,
+    "data" = data,
+    "cvs" = cvs
+  )
+}

2 Longterm/260315/last_sensitivity.R

@@ -0,0 +1,172 @@
+targets::tar_read("df_all_data_formatted") |>
+  events_ready() |>
+  dplyr::filter(!is.na(pase_0), !is.na(pase_4)) |>
+  (\(data){
+    c("pase_0", "pase_4") |>
+      purrr::map(\(exp){
+        list(
+          "Univariable" = cox_regression(data = data, all.vars = FALSE, use.strata = FALSE, outcome.var = exp),
+          "Multivariable" = cox_regression(data = data, all.vars = TRUE, use.strata = FALSE, outcome.var = exp)
+        ) |>
+          purrr::map(\(.x){
+            .x |>
+              gtsummary::tbl_regression(exponentiate = TRUE) |>
+              fix_labels()
+          }) |>
+          tbl_merged_named()
+      })
+  })() |>
+  gtsummary::tbl_stack()
+
+
+targets::tar_read("df_all_data_formatted") |>
+  pase_cutter(drop.nas = TRUE) |>
+  events_ready(v.groups = c("clin", "lifestyle.events", "ses", "assess.events", "quartiles")) |>
+  dplyr::select(-dplyr::any_of(c("pase_0", "pase_4", "pase_change"))) |>
+  (\(data){
+    c("pase_0_quartile", "pase_4_quartile") |>
+      purrr::map(\(exp){
+        list(
+          "Univariable" = cox_regression(data = data, all.vars = FALSE, use.strata = FALSE, outcome.var = exp),
+          "Multivariable" = cox_regression(data = data, all.vars = TRUE, use.strata = FALSE, outcome.var = exp)
+        ) |>
+          purrr::map(\(.x){
+            .x |>
+              gtsummary::tbl_regression(exponentiate = TRUE) |>
+              fix_labels()
+          }) |>
+          tbl_merged_named()
+      })
+  })() |>
+  gtsummary::tbl_stack()
+
+
+targets::tar_read("df_all_data_formatted") |>
+  pase_cutter(drop.nas = TRUE) |>
+  get_vars(vars.groups = c("clin", "lifestyle.events", "ses", "assess.events", "quartiles"), vars.vec = c("inc_time")) |>
+  dplyr::mutate(time = time + inc_time / 365) |>
+  dplyr::select(-dplyr::any_of(c("pase_0", "pase_4", "pase_change", "inc_time", "event.include", "pase_4_quartile"))) |>
+  (\(data){
+    list(
+      "Univariable" = cox_regression(data = data, all.vars = FALSE, use.strata = FALSE, outcome.var = "pase_0_quartile"),
+      "Multivariable" = cox_regression(data = data, all.vars = TRUE, use.strata = FALSE, outcome.var = "pase_0_quartile")
+    ) |>
+      purrr::map(\(.x){
+        .x |>
+          gtsummary::tbl_regression(exponentiate = TRUE) |>
+          fix_labels()
+      }) |>
+      tbl_merged_named()
+  })()
+
+ls_sens <- list(
+  pase_0_all_quartile = list(
+    data = targets::tar_read("df_all_data_formatted") |>
+      pase_cutter(drop.nas = FALSE) |>
+      get_vars(vars.groups = c("clin", "lifestyle.events", "ses", "assess.pred", "quartiles"), vars.vec = c("inc_time",
+                                                                                                            "time",
+                                                                                                            "status")) |>
+      dplyr::mutate(time = time + inc_time / 365) |>
+      dplyr::select(-dplyr::any_of(c("pase_0", "pase_4", "pase_change", "inc_time", "event.include", "pase_4_quartile"))),
+    main.exp = "pase_0_quartile"
+  ),
+  # pase_0_all_contin = list(
+  #   data = targets::tar_read("df_all_data_formatted") |>
+  #     get_vars(vars.groups = c("clin", "lifestyle.events", "ses", "assess.pred", "quartiles"), vars.vec = c("inc_time",
+  #                                                                                                           "time",
+  #                                                                                                           "status")) |>
+  #     dplyr::mutate(time = time + inc_time / 365) |>
+  #     dplyr::select(-dplyr::any_of(c("pase_4", "pase_change", "inc_time", "event.include", "pase_0_quartile", "pase_4_quartile"))),
+  #   main.exp = "pase_0"
+  # ),
+  pase_0_excl_quartile = list(
+    data = targets::tar_read("df_all_data_formatted") |>
+      pase_cutter(drop.nas = TRUE,drop.pase = FALSE) |>
+      events_ready(v.groups = c("clin", "lifestyle.events", "ses", "assess.pred", "quartiles"), vars.vec = c("inc_time",
+                                                                                                             "time",
+                                                                                                             "status")) |>
+      dplyr::select(-dplyr::any_of(c("pase_0","pase_4", "pase_change", "inc_time", "event.include", "pase_4_quartile"))),
+    main.exp = "pase_0_quartile"
+  ),
+  # pase_0_excl_contin = list(
+  #   data = targets::tar_read("df_all_data_formatted") |>
+  #     events_ready(v.groups = c("clin", "lifestyle.events", "ses", "assess.pred", "quartiles"), vars.vec = c("inc_time",
+  #                                                                                                            "time",
+  #                                                                                                            "status")) |>
+  #     dplyr::filter(!is.na(pase_0), !is.na(pase_4)) |>
+  #     dplyr::select(-pase_4),
+  #   main.exp = "pase_0"
+  # ),
+  pase_4_quartile = list(
+    data = targets::tar_read("df_all_data_formatted") |>
+      dplyr::mutate(pase_4_quartile=cut(x = pase_4, breaks = quantile(pase_4, na.rm = TRUE), labels = 1:4, include.lowest = TRUE))  |>
+      get_vars(vars.groups = c("clin", "lifestyle.events", "ses", "assess.events", "quartiles"))|>
+      dplyr::filter(!is.na(pase_4_quartile),event.include) |>
+      dplyr::select(-dplyr::any_of(c("pase_0","pase_4", "pase_change", "inc_time", "event.include", "pase_0_quartile"))),
+    main.exp = "pase_4_quartile"
+  ),
+  # pase_4_contin = list(
+  #   data = targets::tar_read("df_all_data_formatted") |>
+  #     events_ready() |>
+  #     dplyr::filter(!is.na(pase_0), !is.na(pase_4)) |>
+  #     dplyr::select(-pase_0),
+  #   main.exp = "pase_4"
+  # ),
+  pase_4_change_late_cut = list(
+    data = targets::tar_read("df_all_data_formatted") |>
+      events_ready() |>
+      dplyr::filter(!is.na(pase_0), !is.na(pase_4)) |>
+      pase_cutter(drop.pase = TRUE),
+    main.exp = "pase_change"
+  # ),
+  # pase_4_change_earliest_cut = list(
+  #   data = targets::tar_read("df_all_data_formatted") |>
+  #     pase_cutter(drop.pase = TRUE)|>
+  #     events_ready(vars.vec = c("pase_change")) |>
+  #     dplyr::filter(!is.na(pase_change)) ,
+  #   main.exp = "pase_change"
+  )
+)
+
+
+
+f <- function(data, main.exp, ...) {
+  set.seed(3023)
+  imp <- fun_impute(data = data, ignore = main.exp)
+
+  list(
+    "Univariable" = cox_regression(data = data, all.vars = FALSE, use.strata = FALSE, outcome.var = main.exp),
+    "Multivariable" = cox_regression(data = data, all.vars = TRUE, use.strata = FALSE, outcome.var = main.exp),
+    "Multivariable Imputed" = cox_regression(data = imp, all.vars = TRUE, use.strata = FALSE, outcome.var = main.exp)
+  )
+}
+
+
+ls_out <- purrr::map(ls_sens, \(.x){
+  do.call(f, .x)
+})
+
+ls_stack <- ls_out |>
+  purrr::imap(\(.x, .i){
+    list(
+      "Group counts" = ls_sens[[.i]][["data"]] |>
+        dplyr::select(ls_sens[[.i]][["main.exp"]]) |> 
+        gtsummary::tbl_summary(statistic =  list(gtsummary::all_continuous() ~ "{N_nonmiss} ({p_nonmiss}%)", gtsummary::all_categorical() ~ "{n} ({p}%)")) |> 
+        fix_labels(),
+      .x |>
+        lapply(\(.y){
+          .y |>
+            tbl_regression_standard() |>
+            # gtsummary::modify_table_styling(columns = tidyselect::starts_with("p.value"), hide = TRUE) |>
+            gtsummary::remove_row_type(variables = -dplyr::any_of(ls_sens[[.i]][["main.exp"]]), type = "all") |> 
+            gtsummary::bold_p()
+        })
+    ) |>
+      purrr::list_flatten() |>
+      tbl_merged_named()
+  }) |>
+  tbl_stack_named()
+
+ls_stack <- ls_stack|> gtsummary::as_gt() |> gt::tab_style(style = gt::cell_text(weight="bold"),locations = gt::cells_row_groups(dplyr::everything()))
+
+ls_stack |> gt::gtsave(filename = here::here("out/pase_extra_cox2.docx"))