268 lines
7.9 KiB
R
Executable file
268 lines
7.9 KiB
R
Executable file
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()
|