PAaSO/2 Longterm/260315/alternative_grouping.R

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()