get_background_text <- function(results_ls){
text_1L_chr <- results_ls$study_descs_ls$background_1L_chr
return(text_1L_chr)
}
get_conclusion_text <- function(results_ls){
text_1L_chr <- results_ls$study_descs_ls$conclusion_1L_chr
return(text_1L_chr)
}
get_cndts_for_mxd_mdls <- function(mdl_types_lup = NULL){
if(is.null(mdl_types_lup))
utils::data("mdl_types_lup", package = "TTU", envir = environment())
cndts_for_mxd_mdls_lup <- mdl_types_lup %>%
dplyr::filter(!tfmn_for_bnml_lgl,
short_name_chr != "BET_LOG" )
return(cndts_for_mxd_mdls_lup)
}
get_covars_by_ctg <- function(results_ls,
collapse_1L_lgl = F){
covars_by_ctg_ls <- results_ls$candidate_covars_ls %>%
purrr::map( ~ .x #%>% tolower()
) %>%
stats::setNames(get_covar_ctgs(results_ls,
collapse_1L_lgl = F))
if(collapse_1L_lgl){
covars_by_ctg_ls <- covars_by_ctg_ls %>%
purrr::map2(names(covars_by_ctg_ls),
~{
covars_1L_chr <- .x %>% paste0(collapse = ", ") %>%
stringi::stri_replace_last_fixed(","," and")
paste0(ifelse(length(.x)>1,.y %>% Hmisc::capitalize(),paste0("The ",.y)),
" covariate",
ifelse(length(.x)>1,"s were "," was "),
covars_1L_chr,".")
})
}
return(covars_by_ctg_ls)
}
get_covar_ctgs <- function(results_ls,
collapse_1L_lgl = T){
covar_ctgs_chr <- names(results_ls$candidate_covars_ls) %>% tolower()
if(collapse_1L_lgl){
covar_ctgs_chr <- covar_ctgs_chr %>% paste0(collapse = ", ") %>% stringi::stri_replace_last_fixed(","," and")
}
return(covar_ctgs_chr )
}
get_hlth_utl_nm <- function(results_ls,
short_nm_1L_lgl = T){
health_utl_nm_1L_chr <- ifelse(short_nm_1L_lgl,
results_ls$study_descs_ls$health_utl_nm_1L_chr,
results_ls$study_descs_ls$health_utl_long_nm_1L_chr)
return(health_utl_nm_1L_chr)
}
get_hlth_utl_stat <- function(results_ls,
stat_1L_chr = "bl_mean"){
hlth_utl_stat_1L_chr <- switch(stat_1L_chr,
"bl_mean" = results_ls$hlth_utl_and_predrs_ls$bl_hu_mean_1L_dbl,
"bl_sd" = results_ls$hlth_utl_and_predrs_ls$bl_hu_sd_1L_dbl,
"fup_mean" = results_ls$hlth_utl_and_predrs_ls$fup_hu_mean_1L_dbl,
"fup_sd" = results_ls$hlth_utl_and_predrs_ls$fup_hu_sd_1L_dbl)
return(hlth_utl_stat_1L_chr)
}
get_lngl_ttu_types <- function(results_ls,
collapse_1L_lgl = T){
mdl_types_chr <- results_ls$ttu_lngl_ls$best_mdls_tb$model_type
if(collapse_1L_lgl){
mdl_types_chr <- mdl_types_chr %>%
paste0(collapse = ", ") %>%
stringi::stri_replace_last(fixed = ",", " and")
}
return(mdl_types_chr)
}
get_link_from_tfmn <- function(tfmn_1L_chr,
is_OLS_1L_lgl = F){
link_1L_chr <- ifelse(is_OLS_1L_lgl,
"identity",
ifelse(tfmn_1L_chr == "LOG",
"log",
ifelse(tfmn_1L_chr == "LGT",
"logit",
ifelse(tfmn_1L_chr == "CLL",
"cloglog",
ifelse(tfmn_1L_chr == "LOGLOG",
"loglog",
ifelse(tfmn_1L_chr == "NTF",
"identity",
"ERROR"))))))
if(link_1L_chr=="ERROR")
stop("Link cannot be identified - incorrect transformation argument tfmn_1L_chr")
return(link_1L_chr)
}
get_mdl_cmprsns <- function(results_ls,
describe_1L_lgl = T,
mixed_1L_lgl = F,
as_list_1L_lgl = F){
if(as_list_1L_lgl){
mdl_types_chr <- c("OLS", "GLM")[c("OLS", "GLM") %in%
results_ls$tables_ls$tenf_sngl_predr_tb$Model]
mdl_cmprsns_ls <- mdl_types_chr %>%
purrr::map(~{
if(.x == "OLS"){
mdls_chr <- results_ls$tables_ls$tenf_sngl_predr_tb$Model[(which(results_ls$tables_ls$tenf_sngl_predr_tb$Model=="OLS")+1):(which(results_ls$tables_ls$tenf_sngl_predr_tb$Model=="GLM")-1)] %>% unique()
}
if(.x == "GLM"){
mdls_chr <-results_ls$tables_ls$tenf_sngl_predr_tb$Model[(which(results_ls$tables_ls$tenf_sngl_predr_tb$Model=="GLM")+1):length(results_ls$tables_ls$tenf_sngl_predr_tb$Model)] %>%
unique()
}
mdls_chr
}) %>%
stats::setNames(mdl_types_chr)
mdl_cmprsns_xx <- mdl_cmprsns_ls
}else{
mdl_cmprsns_1L_chr <- paste0(
ifelse(!"OLS" %in%
results_ls$tables_ls$tenf_sngl_predr_tb$Model,
"",
ifelse(describe_1L_lgl,
paste0("OLS regression models used ", results_ls$tables_ls$tenf_sngl_predr_tb$Model[(which(results_ls$tables_ls$tenf_sngl_predr_tb$Model=="OLS")+1):(which(results_ls$tables_ls$tenf_sngl_predr_tb$Model=="GLM")-1)] %>% unique() %>% purrr::map_chr(~ .x %>% stringi::stri_replace_last_fixed("(","(measured on a scale of ")) %>% paste0(collapse = ", ") %>% stringi::stri_replace_last_fixed(","," and") %>% tolower(),"."),
ifelse(mixed_1L_lgl,"linear mixed effect models (LMMs)","ordinary least squares (OLS) regression models"))
),
ifelse(!describe_1L_lgl & length(intersect(c("OLS","GLM"),
results_ls$tables_ls$tenf_sngl_predr_tb$Model))==2," and ",ifelse(describe_1L_lgl," ","")),
ifelse(!"GLM" %in%
results_ls$tables_ls$tenf_sngl_predr_tb$Model,
"",
ifelse(describe_1L_lgl,
paste0("GLMs used ",
results_ls$tables_ls$tenf_sngl_predr_tb$Model[(which(results_ls$tables_ls$tenf_sngl_predr_tb$Model=="GLM")+1):length(results_ls$tables_ls$tenf_sngl_predr_tb$Model)] %>%
unique() %>%
purrr::map_chr(~ .x %>%
stringi::stri_replace_last_fixed("(","(measured on a scale of ")) %>% paste0(collapse = ", ") %>% stringi::stri_replace_last_fixed(","," and") %>% tolower()),
ifelse(mixed_1L_lgl,"generalised linear mixed effect models (GLMMs)","generalised linear models (GLMs)"))
))
mdl_cmprsns_xx <- mdl_cmprsns_1L_chr
}
return(mdl_cmprsns_xx)
}
get_mdls_with_signft_covars <- function(outp_smry_ls,
params_ls_ls){
signft_covars_chr <- outp_smry_ls$mdls_with_covars_smry_tb %>%
get_signft_covars(covar_var_nms_chr = params_ls_ls$params_ls$candidate_covar_nms_chr)
signft_vars_ls <- outp_smry_ls[["mdls_with_covars_smry_tb"]]$Significant %>%
purrr::map(~strsplit(.x, " ")) %>% purrr::flatten()
mdls_with_signft_covars_ls <- signft_covars_chr %>%
purrr::map(~{
covar_nm_1L_chr <- .x
mdls_chr <- outp_smry_ls$mdls_with_covars_smry_tb %>%
dplyr::filter(purrr::map_lgl(signft_vars_ls,
~ any(.x == covar_nm_1L_chr))) %>%
dplyr::pull(variable)
mdls_chr
}) %>%
stats::setNames(signft_covars_chr)
return(mdls_with_signft_covars_ls)
}
get_mdl_type_from_nm <- function(mdl_nm_1L_chr,
mdl_types_lup = NULL){
if(is.null(mdl_types_lup))
utils::data("mdl_types_lup", package = "TTU", envir = environment())
mdl_type_1L_chr <- (mdl_types_lup %>%
dplyr::pull(short_name_chr))[mdl_types_lup %>%
dplyr::pull(short_name_chr) %>%
purrr::map_lgl(~endsWith(mdl_nm_1L_chr,.x))]
return(mdl_type_1L_chr)
}
get_nbr_of_predrs <- function(results_ls,
as_words_1L_lgl = T){
nbr_of_predrs_xx <- results_ls$study_descs_ls$predr_ctgs_ls %>% purrr::map_int(~length(.x[.x %in% results_ls$candidate_predrs_chr])) %>% sum()
if(as_words_1L_lgl)
nbr_of_predrs_xx <- nbr_of_predrs_xx %>% xfun::numbers_to_words()
return(nbr_of_predrs_xx)
}
get_nbr_of_predrs_by_ctg <- function(results_ls){
multiple_1L_lgl <- length(get_predr_ctgs(results_ls,
collapse_1L_lgl = F)>1)
predrs_by_ctg_1L_chr <- results_ls$study_descs_ls$predr_ctgs_ls[names(results_ls$study_descs_ls$predr_ctgs_ls) %>%
tolower() %>%
purrr::map_lgl(~.x %in% get_predr_ctgs(results_ls,
collapse_1L_lgl = F))] %>%
purrr::map2_chr(get_predr_ctgs(results_ls,
collapse_1L_lgl = F),
~ paste0(.y,
ifelse(multiple_1L_lgl,
paste0(" (",
length(.x[.x %in% results_ls$candidate_predrs_chr]) %>%
xfun::numbers_to_words(),
" measure",
ifelse(length(.x[.x %in%
results_ls$candidate_predrs_chr])>1,
"s",
""),
")"),
""))) %>%
paste0(collapse = ", ") %>%
stringi::stri_replace_last_fixed(","," and") %>%
tolower()
return(predrs_by_ctg_1L_chr )
}
get_nbr_of_scndry_analyses <- function(results_ls,
as_words_1L_lgl = T,
capitalise_1L_lgl = T){
nbr_of_scndry_analyses_1L_xx <- names(results_ls$mdl_ingredients_ls) %>%
startsWith("secondary") %>% sum()
if(as_words_1L_lgl){
nbr_of_scndry_analyses_1L_xx <- nbr_of_scndry_analyses_1L_xx %>% xfun::numbers_to_words()
if(capitalise_1L_lgl){
nbr_of_scndry_analyses_1L_xx <- nbr_of_scndry_analyses_1L_xx %>% Hmisc::capitalize()
}
}
return(nbr_of_scndry_analyses_1L_xx)
}
get_ordered_sngl_csnl_mdls <- function(results_ls,
select_int = NULL,
collapse_1L_lgl = F){
ordered_sngl_csnl_mdls_chr <- results_ls$ttu_cs_ls$cs_mdls_predrs_seq_dscdng_chr
if(!is.null(select_int)){
ordered_sngl_csnl_mdls_chr <- ordered_sngl_csnl_mdls_chr[select_int]
}
if(collapse_1L_lgl){
ordered_sngl_csnl_mdls_chr <- ordered_sngl_csnl_mdls_chr %>%
paste0(collapse = ", ") %>%
stringi::stri_replace_last(fixed = ",", " and")
}
return(ordered_sngl_csnl_mdls_chr)
}
get_popl_descvs <- function(results_ls){
popl_descvs_1L_chr <- results_ls$tables_ls$participant_descs$variable %>%
unique() %>%
# tolower() %>%
paste0(collapse = ", ") %>%
stringi::stri_replace_last_fixed(","," and")
return(popl_descvs_1L_chr)
}
get_predrs_by_ctg <- function(results_ls,
long_desc_1L_lgl = F,
transform_1L_lgl = F,
collapse_1L_lgl = F){
predrs_by_ctg_ls <- results_ls$study_descs_ls$predr_ctgs_ls[names(results_ls$study_descs_ls$predr_ctgs_ls) %>%
tolower() %>%
purrr::map_lgl(~.x %in% get_predr_ctgs(results_ls,
collapse_1L_lgl = F))] %>%
purrr::map( ~ .x[.x %in% results_ls$candidate_predrs_chr]) %>%
stats::setNames(get_predr_ctgs(results_ls,
collapse_1L_lgl = F))
if(long_desc_1L_lgl){
predrs_by_ctg_ls <- predrs_by_ctg_ls %>%
purrr::map2(names(predrs_by_ctg_ls) %>% Hmisc::capitalize(),
~{
predr_descs_1L_chr <- .x %>% purrr::map_chr(~ paste0(ready4::get_from_lup_obj(results_ls$mdl_ingredients_ls$dictionary_tb,
match_value_xx = .x,
match_var_nm_1L_chr = "var_nm_chr",
target_var_nm_1L_chr = "var_desc_chr",
evaluate_1L_lgl = F),
" (",
.x %>% transform_names(rename_lup = results_ls$var_nm_change_lup),
" - measured on a scale of ",
ready4::get_from_lup_obj(results_ls$mdl_ingredients_ls$predictors_lup,
match_value_xx = .x,
match_var_nm_1L_chr = "short_name_chr",
target_var_nm_1L_chr = "min_val_dbl",
evaluate_1L_lgl = F),
"-",
ready4::get_from_lup_obj(results_ls$mdl_ingredients_ls$predictors_lup,
match_value_xx = .x,
match_var_nm_1L_chr = "short_name_chr",
target_var_nm_1L_chr = "max_val_dbl",
evaluate_1L_lgl = F),
")")
) %>% paste0(collapse = ", ") %>%
stringi::stri_replace_last_fixed(","," and")
paste0(.y," was measured by ", predr_descs_1L_chr,".")
})
}else{
if(transform_1L_lgl){
predrs_by_ctg_ls <- predrs_by_ctg_ls %>%
purrr::map(~{
purrr::map_chr(.x,
~ transform_names(.x,
rename_lup = results_ls$var_nm_change_lup))
}) %>% purrr::flatten_chr()
if(collapse_1L_lgl){
predrs_by_ctg_ls <- predrs_by_ctg_ls %>%
paste0(collapse = ", ") %>%
stringi::stri_replace_last(fixed = ",", " and")
}
}
}
return(predrs_by_ctg_ls)
}
get_predr_ctgs <- function(results_ls,
collapse_1L_lgl = T){
predr_ctgs_chr <- (results_ls$study_descs_ls$predr_ctgs_ls %>% names())[(results_ls$study_descs_ls$predr_ctgs_ls %>% purrr::map_int(~length(.x[.x %in% results_ls$candidate_predrs_chr]))) > 0] %>% tolower()
if(collapse_1L_lgl){
predr_ctgs_chr <- predr_ctgs_chr %>% paste0(collapse = ", ") %>% stringi::stri_replace_last_fixed(","," and")
}
return(predr_ctgs_chr)
}
get_prefd_mdl_predrs <- function(results_ls){
predrs_1L_chr <- results_ls$predr_var_nms_chr %>%
paste0(collapse = ", ") %>%
stringi::stri_replace_last(fixed = ",", " and")
return(predrs_1L_chr)
}
get_random_intercept <- function(mdls_smry_tb,
mdl_nm_1L_chr,
deterministic_1L_lgl = T){
mdl_smry_tb <- mdls_smry_tb %>%
dplyr::filter(Model == mdl_nm_1L_chr)
sd_dbl <- c(mdl_smry_tb %>%
ready4::get_from_lup_obj(match_value_xx = "SD (Intercept)",
match_var_nm_1L_chr = "Parameter",
target_var_nm_1L_chr = "Estimate",
evaluate_1L_lgl = F),
ifelse(deterministic_1L_lgl,
0,
mdl_smry_tb %>%
ready4::get_from_lup_obj(match_value_xx = "SD (Intercept)",
match_var_nm_1L_chr = "Parameter",
target_var_nm_1L_chr = "SE",
evaluate_1L_lgl = F)))
return(sd_dbl)
}
get_scndry_anlys_descs <- function(results_ls){
nbr_of_scndry_analyses_1L_int <- get_nbr_of_scndry_analyses(results_ls, as_words_1L_lgl = F)
if(nbr_of_scndry_analyses_1L_int > 0){
scndry_anlys_descs_chr <- 1:nbr_of_scndry_analyses_1L_int %>%
purrr::map_chr(~{
secondary_ls <- results_ls$mdl_ingredients_ls %>% purrr::pluck(paste0("secondary_",.x))
mdls_lup <- secondary_ls$mdls_lup
predictors_chr <- mdls_lup$predrs_ls %>%
unique() %>%
purrr::map_chr(~{
.x %>%
purrr::map_chr(~ready4::get_from_lup_obj(secondary_ls$dictionary_tb %>% ready4use::remove_labels_from_ds(),
match_value_xx =.x,
match_var_nm_1L_chr = "var_nm_chr",
target_var_nm_1L_chr = "var_desc_chr",
evaluate_1L_lgl = F)) %>%
paste0(collapse = ", ") %>%
stringi::stri_replace_last_fixed(","," and")
})
paste0(ifelse(nbr_of_scndry_analyses_1L_int ==1,
"The secondary analysis used ",
paste0("Secondary Analysis ",LETTERS[.x], " used ")),
ifelse(length(predictors_chr)==1,
paste0(predictors_chr, " as a predictor."),
paste0(predictors_chr, " as predictors.")))
})
}
return(scndry_anlys_descs_chr)
}
get_selected_mixed_mdls <- function(results_ls,
collapse_1L_lgl = T){
mixed_mdls_xx <- results_ls$ttu_lngl_ls$best_mdls_tb %>% purrr::pmap_chr(~paste0(..1," (",..2,")"))
if(collapse_1L_lgl){
mixed_mdls_xx <- mixed_mdls_xx %>%
paste0(collapse = ", ") %>%
stringi::stri_replace_last(fixed = ",", " and")
}
return(mixed_mdls_xx)
}
get_signft_covars <- function (mdls_with_covars_smry_tb, covar_var_nms_chr)
{
signif_vars_chr <- mdls_with_covars_smry_tb$Significant %>%
purrr::map(~strsplit(.x, " ")) %>% purrr::flatten() %>%
purrr::flatten_chr() %>% unique()
signt_covars_chr <- covar_var_nms_chr[covar_var_nms_chr %in%
signif_vars_chr]
if(identical(signt_covars_chr, character(0)))
signt_covars_chr <- NA_character_
return(signt_covars_chr)
}
get_table_predn_mdl <- function(mdl_nm_1L_chr,
ingredients_ls,
analysis_1L_chr = NULL){
mdl_type_1L_chr <- get_mdl_type_from_nm(mdl_nm_1L_chr,
mdl_types_lup = ingredients_ls$mdl_types_lup)
tfmn_1L_chr <- ready4::get_from_lup_obj(ingredients_ls$mdl_types_lup,
match_value_xx = mdl_type_1L_chr,
match_var_nm_1L_chr = "short_name_chr",
target_var_nm_1L_chr = "tfmn_chr",
evaluate_1L_lgl = F)
if(is.null(analysis_1L_chr)){
fake_ds_tb <- ingredients_ls$fake_ds_tb
}else{
reference_1L_chr <- ifelse(analysis_1L_chr == "Primary Analysis",
"Primary",
paste0("secondary_",which(LETTERS == stringr::str_sub(analysis_1L_chr,start=-1))))
fake_ds_tb <- ingredients_ls %>% purrr::pluck(reference_1L_chr) %>% purrr::pluck("fake_ds_tb")
}
fake_ds_tb <- fake_ds_tb %>%
add_tfd_var_to_ds(depnt_var_nm_1L_chr = ingredients_ls$depnt_var_nm_1L_chr,
tfmn_1L_chr = tfmn_1L_chr)
table_predn_mdl <- make_shareable_mdl(fake_ds_tb = fake_ds_tb,
mdl_smry_tb = ingredients_ls$mdls_smry_tb %>% dplyr::filter(Model == mdl_nm_1L_chr),
depnt_var_nm_1L_chr = ingredients_ls$depnt_var_nm_1L_chr,
id_var_nm_1L_chr = ingredients_ls$id_var_nm_1L_chr,
tfmn_1L_chr = tfmn_1L_chr,
mdl_type_1L_chr = mdl_type_1L_chr,
mdl_types_lup = ingredients_ls$mdl_types_lup,
control_1L_chr = ready4::get_from_lup_obj(ingredients_ls$mdl_types_lup,
match_value_xx = mdl_type_1L_chr,
match_var_nm_1L_chr = "short_name_chr",
target_var_nm_1L_chr = "control_chr",
evaluate_1L_lgl = F),
start_1L_chr = NA_character_,
seed_1L_int = ingredients_ls$seed_1L_int)
return(table_predn_mdl)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.