279 lines
7.8 KiB
R
279 lines
7.8 KiB
R
|
ready_clin <- function(data) {
|
||
|
|
data |>
|
||
|
|
correct_na() |>
|
||
|
|
dplyr::mutate(
|
||
|
|
reg_smoker = dplyr::case_match(
|
||
|
|
reg_rygning, "1" ~ TRUE,
|
||
|
|
c("2", "3", "4") ~ FALSE,
|
||
|
|
"9" ~ NA
|
||
|
|
),
|
||
|
|
reg_cohabiting = dplyr::case_match(
|
||
|
|
reg_civil, "1" ~ TRUE,
|
||
|
|
c("2", "3") ~ FALSE,
|
||
|
|
"9" ~ NA
|
||
|
|
),
|
||
|
|
# Living alone defined as not together with somebody
|
||
|
|
reg_alone = dplyr::case_match(
|
||
|
|
reg_civil, "1" ~ FALSE,
|
||
|
|
c("2", "3") ~ TRUE,
|
||
|
|
"9" ~ NA
|
||
|
|
),
|
||
|
|
reg_more_alc = dplyr::case_match(
|
||
|
|
reg_alkohol, "1" ~ FALSE,
|
||
|
|
"2" ~ TRUE,
|
||
|
|
"9" ~ NA
|
||
|
|
),
|
||
|
|
reg_female = sex == "Kvinde",
|
||
|
|
dplyr::across(
|
||
|
|
.cols = c(
|
||
|
|
"reg_hyperten",
|
||
|
|
"reg_diabetes",
|
||
|
|
"reg_atriefli",
|
||
|
|
"reg_perifer_arteriel",
|
||
|
|
"reg_tidl_tci",
|
||
|
|
"reg_ami"
|
||
|
|
),
|
||
|
|
~ dplyr::case_match(
|
||
|
|
.x, "1" ~ TRUE,
|
||
|
|
"2" ~ FALSE,
|
||
|
|
"9" ~ NA
|
||
|
|
)
|
||
|
|
),
|
||
|
|
dplyr::across(
|
||
|
|
.cols = c(
|
||
|
|
"reg_trombolyse",
|
||
|
|
"reg_trombektomi"
|
||
|
|
),
|
||
|
|
~ dplyr::case_match(
|
||
|
|
.x, "1" ~ TRUE,
|
||
|
|
c("3", "4") ~ FALSE,
|
||
|
|
"9" ~ NA
|
||
|
|
)
|
||
|
|
),
|
||
|
|
reg_any_perf = reg_trombolyse | reg_trombektomi
|
||
|
|
) |>
|
||
|
|
bmi_calc()
|
||
|
|
}
|
||
|
|
|
||
|
|
#' Formatting the complete data set
|
||
|
|
#'
|
||
|
|
#' @param data the merged raw data set
|
||
|
|
#'
|
||
|
|
#' @return tibble
|
||
|
|
#' @examples
|
||
|
|
#' ds <- targets::tar_read(df_all_data) |>
|
||
|
|
#' data_formatting() |>
|
||
|
|
#' subset_df("mdi")
|
||
|
|
#' ds |> skimr::skim()
|
||
|
|
#' ds |> View()
|
||
|
|
data_formatting <- function(data) {
|
||
|
|
to_logical <- grep(match_str_grepl(c("missings", "incompletes")), names(data))
|
||
|
|
|
||
|
|
suppressWarnings(
|
||
|
|
data |>
|
||
|
|
correct_na() |>
|
||
|
|
dplyr::mutate(dplyr::across(all_of(to_logical), ~ .x == "TRUE")) |>
|
||
|
|
dplyr::mutate(
|
||
|
|
# This uses the work-corrected score
|
||
|
|
# pase_0 = dplyr::if_else(pase_score_missings_w_0 | is.na(talos_pase10_0), NA, pase_score_sum_w_0),
|
||
|
|
# pase_4 = dplyr::if_else(pase_score_missings_w_4 | is.na(talos_pase10_4), NA, pase_score_sum_w_4),
|
||
|
|
# Below is the plain PASE scor used according to the manual used with TALOS
|
||
|
|
pase_0 = dplyr::if_else(pase_score_missings_0, NA, pase_score_sum_0),
|
||
|
|
pase_4 = dplyr::if_else(pase_score_missings_4, NA, pase_score_sum_4),
|
||
|
|
who_0 = as.numeric(talos_who07_0),
|
||
|
|
who_4 = as.numeric(talos_who07_4),
|
||
|
|
mrs_0 = factor(substr(talos_mrs01_0, 1, 1), ordered = FALSE),
|
||
|
|
mrs_0_above0 = (as.numeric(mrs_0) - 1) > 0,
|
||
|
|
mrs_4 = factor(substr(talos_mrs01_4, 1, 1), ordered = FALSE),
|
||
|
|
mrs_4_above1 = (as.numeric(mrs_4) - 1) > 1,
|
||
|
|
mdi_4 = as.numeric(talos_mdi12_4),
|
||
|
|
mfi_gen_4 = as.numeric(talos_mfi_gen_4),
|
||
|
|
nihss_0 = as.numeric(talos_nihss16_0),
|
||
|
|
# soc_status = dst_SOC_STATUS_KODE.latest,
|
||
|
|
# fam_indk = cut(dst_FAMAEKVIVADISP_13.5.mean,
|
||
|
|
# breaks = quantile(dst_FAMAEKVIVADISP_13.5.mean, probs = seq(0, 1, 1 / 3), na.rm = TRUE),
|
||
|
|
# ordered_results = FALSE,
|
||
|
|
# labels = c("low", "medium", "high"),
|
||
|
|
# include.lowest = TRUE
|
||
|
|
# ),
|
||
|
|
# fam_indk_bin = cut(dst_FAMAEKVIVADISP_13.5.mean,
|
||
|
|
# breaks = quantile(dst_FAMAEKVIVADISP_13.5.mean, probs = seq(0, 1, 1 / 2), na.rm = TRUE),
|
||
|
|
# ordered_results = FALSE,
|
||
|
|
# labels = c("low", "high"),
|
||
|
|
# include.lowest = TRUE
|
||
|
|
# ),
|
||
|
|
# fam_indk_hl=forcats::fct_rev(fam_indk),
|
||
|
|
# fam_indk_high = dplyr::if_else(fam_indk_bin=="high",TRUE,FALSE),
|
||
|
|
# fam_indk_low = dplyr::if_else(fam_indk_bin=="low",TRUE,FALSE),
|
||
|
|
# edu_level = factor(dst_ISCED_lvl, ordered = FALSE, levels = c("low", "medium", "high")),
|
||
|
|
# edu_high = dplyr::if_else(dst_ISCED_bin=="high",TRUE,FALSE),
|
||
|
|
# edu_low = dplyr::if_else(dst_ISCED_lvl=="low",TRUE,FALSE),
|
||
|
|
# edu_level_hl=forcats::fct_rev(edu_level),
|
||
|
|
rtreat_placebo = rtreat == "Placebo"
|
||
|
|
) #|>
|
||
|
|
# group_soc_status() |>
|
||
|
|
# define_status_time()
|
||
|
|
)
|
||
|
|
}
|
||
|
|
|
||
|
|
#' Store of variable names for data sub-setting
|
||
|
|
#'
|
||
|
|
#' @return list
|
||
|
|
#' @examples
|
||
|
|
#' define_variables()
|
||
|
|
define_variables <- function() {
|
||
|
|
list(
|
||
|
|
clin = c(
|
||
|
|
"age",
|
||
|
|
"reg_female",
|
||
|
|
"nihss_0",
|
||
|
|
"reg_trombolyse",
|
||
|
|
"reg_trombektomi",
|
||
|
|
# "rtreat",
|
||
|
|
"rtreat_placebo"
|
||
|
|
),
|
||
|
|
lifestyle = c(
|
||
|
|
"pase_0",
|
||
|
|
"pase_4",
|
||
|
|
"reg_alone",
|
||
|
|
"reg_bmi",
|
||
|
|
# "reg_hojde",
|
||
|
|
# "reg_vaegt_alt",
|
||
|
|
"reg_smoker",
|
||
|
|
"reg_more_alc",
|
||
|
|
"reg_hyperten",
|
||
|
|
"reg_diabetes",
|
||
|
|
"reg_tidl_tci",
|
||
|
|
"reg_atriefli",
|
||
|
|
"reg_ami",
|
||
|
|
"reg_perifer_arteriel"
|
||
|
|
),
|
||
|
|
ses = c(
|
||
|
|
# "soc_status",
|
||
|
|
# "soc_status_work",
|
||
|
|
# "soc_status_nowork",
|
||
|
|
# "fam_indk",
|
||
|
|
# "fam_indk_hl",
|
||
|
|
# "fam_indk_high",
|
||
|
|
# "fam_indk_low",
|
||
|
|
# "edu_level",
|
||
|
|
# "edu_high",
|
||
|
|
# "edu_low",
|
||
|
|
# "edu_level_hl"
|
||
|
|
),
|
||
|
|
assess.events = c(
|
||
|
|
"who_4",
|
||
|
|
"mdi_4",
|
||
|
|
"mrs_4_above1",
|
||
|
|
"mfi_gen_4",
|
||
|
|
"time",
|
||
|
|
"status",
|
||
|
|
"event.include"
|
||
|
|
),
|
||
|
|
assess.pred = c(
|
||
|
|
"who_0",
|
||
|
|
"mrs_0_above0"
|
||
|
|
),
|
||
|
|
extra = c(
|
||
|
|
"soc_status",
|
||
|
|
"pase_0",
|
||
|
|
"pase_4"
|
||
|
|
)
|
||
|
|
)
|
||
|
|
}
|
||
|
|
|
||
|
|
|
||
|
|
#' Wrapper to print summary table with extended info
|
||
|
|
#'
|
||
|
|
#' @param data formatted and subset data set
|
||
|
|
#' @param by.var stratify by
|
||
|
|
#'
|
||
|
|
#' @return
|
||
|
|
#' @examples
|
||
|
|
print_table_summary <- function(data, by.var = "pase_change", adds = TRUE, missing="ifany") {
|
||
|
|
out <- data |>
|
||
|
|
pragmatic_imputation(vec=c("reg_trombolyse", "reg_trombektomi","reg_any_perf")) |>
|
||
|
|
# pase_cutter(drop.pase = TRUE) |>
|
||
|
|
gtsummary::tbl_summary(
|
||
|
|
missing = missing,
|
||
|
|
by = tidyselect::all_of(by.var) # ,
|
||
|
|
# value = list(where(is.logical) ~ TRUE),
|
||
|
|
# type = list(gtsummary::all_continuous() ~ "continuous2"),
|
||
|
|
# statistic = list(gtsummary::all_continuous() ~ c(
|
||
|
|
# # "{N_nonmiss} ({p_nonmiss}%)",
|
||
|
|
# "{median} ({p25}, {p75})",
|
||
|
|
# # "{min}, {max}",
|
||
|
|
# "{mean} ({sd})"#,
|
||
|
|
# # "{N_miss} ({p_miss}%)"
|
||
|
|
# )#,
|
||
|
|
# # gtsummary::all_categorical() ~ c(
|
||
|
|
# # "{N_obs} ({p_nonmiss}%)"#,
|
||
|
|
# # # "{N_miss} ({p_miss})"
|
||
|
|
# # )
|
||
|
|
# )
|
||
|
|
) #|>
|
||
|
|
# gtsummary::add_n()
|
||
|
|
|
||
|
|
if (adds) {
|
||
|
|
out |>
|
||
|
|
gtsummary::add_overall() #|>
|
||
|
|
# gtsummary::add_p()
|
||
|
|
} else {
|
||
|
|
out
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
#' Title
|
||
|
|
#'
|
||
|
|
#' @param data
|
||
|
|
#'
|
||
|
|
#' @return
|
||
|
|
#' @export
|
||
|
|
#'
|
||
|
|
#' @examples
|
||
|
|
#' targets::tar_read(df_all_data_formatted) |> View()
|
||
|
|
#' targets::tar_read(df_pred_data) |>
|
||
|
|
#' dplyr::transmute(stRoke::quantile_cut(pase_0, 4, group.names = 1:4), soc_status_work, fam_indk, edu_level) |>
|
||
|
|
#' summary_tblone()
|
||
|
|
summary_tblone <- function(data, by = names(data)[1], adds = FALSE, missing="ifany") {
|
||
|
|
# data <- targets::tar_read(df_pred_data)
|
||
|
|
data |>
|
||
|
|
labelling_data() |>
|
||
|
|
# prediction_ready() |>
|
||
|
|
# dplyr::select(-reg_bmi) |>
|
||
|
|
# pase_cutter(drop.pase = TRUE) |>
|
||
|
|
# dplyr::filter(!is.na(pase_change)) |>
|
||
|
|
# dplyr::mutate(pase_change=forcats::fct_rev(pase_change)) |>
|
||
|
|
print_table_summary(by.var = by, adds = adds, missing=missing)
|
||
|
|
}
|
||
|
|
|
||
|
|
#' Creating a truthful stratified table for predictions
|
||
|
|
#'
|
||
|
|
#' @param data data frame
|
||
|
|
#'
|
||
|
|
#' @return list
|
||
|
|
#' @export
|
||
|
|
#'
|
||
|
|
#' @examples
|
||
|
|
#' targets::tar_read(df_pred_data) |> true_pred_sum_plot()
|
||
|
|
#' data <- pred_data
|
||
|
|
true_pred_sum_plot <- function(data,by="pase_change") {
|
||
|
|
true_sum <- data |>
|
||
|
|
pase_cutter(drop.pase = TRUE) |>
|
||
|
|
dplyr::mutate(pase_change = forcats::fct_rev(pase_change))
|
||
|
|
|
||
|
|
|
||
|
|
list( # true_sum,
|
||
|
|
true_sum |>
|
||
|
|
(function(.x) {
|
||
|
|
split(.x, .x$pase_change %in% c("Persistently low", "Increase"))
|
||
|
|
})() |>
|
||
|
|
purrr::map(function(.y) {
|
||
|
|
.y |> dplyr::mutate(pase_change = factor(pase_change))
|
||
|
|
})
|
||
|
|
) |>
|
||
|
|
purrr::list_flatten() |>
|
||
|
|
purrr::map(summary_tblone, by = by) |>
|
||
|
|
purrr::map(micRo::mask_micro_summary) |>
|
||
|
|
gtsummary::tbl_merge()
|
||
|
|
}
|