R/fn_make.R

In ready4-dev/specific: Specify Models to Solve Inverse Problems

#' Make abstract arguments list
#' @description make_abstract_args_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make abstract arguments list. The function returns Abstract arguments (a list).
#' @param results_ls Results (a list)
#' @param fl_nm_1L_chr File name (a character vector of length one), Default: 'abstract.txt'
#' @return Abstract arguments (a list)
#' @rdname make_abstract_args_ls
#' @export 
#' @importFrom xfun numbers_to_words
#' @importFrom Hmisc capitalize
make_abstract_args_ls <- function (results_ls, fl_nm_1L_chr = "abstract.txt") 
{
    mdl_cmprsns_ls <- get_mdl_cmprsns(results_ls, as_list_1L_lgl = T)
    abstract_args_ls <- list(abstract_ls = list(Background = get_background_text(results_ls), 
        Objectives = paste0("We aimed to identify the best regression models to predict ", 
            get_hlth_utl_nm(results_ls, short_nm_1L_lgl = F), 
            " (", get_hlth_utl_nm(results_ls), ") utility and evaluate the predictive ability of ", 
            get_nbr_of_predrs(results_ls), " candidate measure", 
            ifelse(get_nbr_of_predrs(results_ls, as_words_1L_lgl = F) > 
                1, "s", ""), " of ", get_predr_ctgs(results_ls), 
            "."), Methods = paste0(results_ls$study_descs_ls$sample_desc_1L_chr, 
            ifelse(is.na(results_ls$study_descs_ls$time_btwn_bl_and_fup_1L_chr), 
                "", paste0(" Follow-up measurements were ", results_ls$study_descs_ls$time_btwn_bl_and_fup_1L_chr, 
                  " after baseline. ")), paste0(length(mdl_cmprsns_ls$OLS) %>% 
                xfun::numbers_to_words() %>% Hmisc::capitalize()), 
            " ordinary least squares (OLS) and ", length(mdl_cmprsns_ls$GLM) %>% 
                xfun::numbers_to_words(), " generalised linear models (GLMs) were explored to identify the best algorithm. ", 
            " Predictive ability of ", get_nbr_of_predrs(results_ls), 
            " candidate measure", ifelse(get_nbr_of_predrs(results_ls, 
                as_words_1L_lgl = F) > 1, "s", ""), " of ", get_predr_ctgs(results_ls), 
            " were assessed using ten fold cross validation", 
            ifelse(get_nbr_of_predrs(results_ls, as_words_1L_lgl = F) > 
                1, " and forest models", ""), ifelse(is.na(results_ls$study_descs_ls$time_btwn_bl_and_fup_1L_chr), 
                ". ", paste0(". Linear / generalised linear mixed effect models were then used to construct longitudinal predictive models for ", 
                  get_hlth_utl_nm(results_ls), " change."))), 
        Results = paste0(make_ten_fold_text(results_ls, for_abstract_1L_lgl = T), 
            ". ", make_selected_mdl_text(results_ls, for_abstract_1L_lgl = T), 
            ifelse(is.na(results_ls$study_descs_ls$time_btwn_bl_and_fup_1L_chr), 
                "", paste0(" The mean ratio between the within-person and between-person associated coefficients was ", 
                  make_within_between_ratios_text(results_ls, 
                    exclude_covars_1L_lgl = T), "."))), Conclusions = get_conclusion_text(results_ls), 
        Data = make_data_availability_text(results_ls)), fl_nm_1L_chr = fl_nm_1L_chr)
    return(abstract_args_ls)
}
#' Make all model types summary table
#' @description make_all_mdl_types_smry_tbl() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make all model types summary table. The function returns All model types summary table (a tibble).
#' @param outp_smry_ls Output summary (a list)
#' @param mdls_tb Models (a tibble)
#' @return All model types summary table (a tibble)
#' @rdname make_all_mdl_types_smry_tbl
#' @export 
#' @importFrom purrr map_dfc
#' @importFrom dplyr select rename_with
#' @keywords internal
make_all_mdl_types_smry_tbl <- function (outp_smry_ls, mdls_tb) 
{
    mdls_ls <- make_mdls_ls(outp_smry_ls, mdls_tb = mdls_tb)
    all_mdl_types_smry_tbl_tb <- 1:length(mdls_ls) %>% purrr::map_dfc(~{
        make_mdl_type_smry_tbl(mdls_tb = mdls_tb, mdl_nms_chr = mdls_ls[[.x]], 
            mdl_type_1L_chr = outp_smry_ls$prefd_mdl_types_chr[.x], 
            add_mdl_nm_sfx_1L_lgl = T)
    }) %>% dplyr::select(-paste0("Parameter_", outp_smry_ls$prefd_mdl_types_chr[-1])) %>% 
        dplyr::rename_with(~"Parameter", .cols = paste0("Parameter_", 
            outp_smry_ls$prefd_mdl_types_chr[1]))
    return(all_mdl_types_smry_tbl_tb)
}
#' Make analysis core parameters list
#' @description make_analysis_core_params_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make analysis core parameters list. The function returns Analysis core parameters (a list).
#' @param ds_descvs_ls Dataset descriptives (a list)
#' @param mdl_smry_ls Model summary (a list), Default: make_mdl_smry_ls()
#' @param output_format_ls Output format (a list), Default: make_output_format_ls()
#' @param predictors_lup Predictors (a lookup table)
#' @param control_ls Control (a list), Default: NULL
#' @param iters_1L_int Iterations (an integer vector of length one), Default: 4000
#' @param prefd_covars_chr Preferred covariates (a character vector), Default: NULL
#' @param prefd_mdl_types_chr Preferred model types (a character vector), Default: NULL
#' @param prior_ls Prior (a list), Default: NULL
#' @param seed_1L_int Seed (an integer vector of length one), Default: 12345
#' @return Analysis core parameters (a list)
#' @rdname make_analysis_core_params_ls
#' @export 
#' @keywords internal
make_analysis_core_params_ls <- function (ds_descvs_ls, mdl_smry_ls = make_mdl_smry_ls(), output_format_ls = make_output_format_ls(), 
    predictors_lup, control_ls = NULL, iters_1L_int = 4000L, 
    prefd_covars_chr = NULL, prefd_mdl_types_chr = NULL, prior_ls = NULL, 
    seed_1L_int = 12345) 
{
    candidate_covar_nms_chr <- ds_descvs_ls$candidate_covar_nms_chr
    use_fake_data_1L_lgl <- ds_descvs_ls$is_fake_1L_lgl
    analysis_core_params_ls <- list(candidate_covar_nms_chr = candidate_covar_nms_chr, 
        ds_descvs_ls = ds_descvs_ls, iters_1L_int = iters_1L_int, 
        mdl_smry_ls = mdl_smry_ls, nbr_of_digits_1L_int = output_format_ls$supplementary_digits_1L_int, 
        output_type_1L_chr = output_format_ls$supplementary_outp_1L_chr, 
        predictors_lup = predictors_lup, prefd_covars_chr = prefd_covars_chr, 
        prefd_mdl_types_chr = prefd_mdl_types_chr, seed_1L_int = seed_1L_int, 
        use_fake_data_1L_lgl = use_fake_data_1L_lgl, prior_ls = prior_ls, 
        control_ls = control_ls)
    return(analysis_core_params_ls)
}
#' Make analysis dataset summary list
#' @description make_analysis_ds_smry_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make analysis dataset summary list. The function returns Analysis dataset summary (a list).
#' @param ds_descvs_ls Dataset descriptives (a list)
#' @param candidate_covar_nms_chr Candidate covariate names (a character vector)
#' @param predictors_lup Predictors (a lookup table)
#' @return Analysis dataset summary (a list)
#' @rdname make_analysis_ds_smry_ls
#' @export 
make_analysis_ds_smry_ls <- function (ds_descvs_ls, candidate_covar_nms_chr, predictors_lup) 
{
    analysis_ds_smry_ls <- list(candidate_predrs_chr = ds_descvs_ls$candidate_predrs_chr, 
        candidate_covar_nms_chr = candidate_covar_nms_chr, depnt_var_nm_1L_chr = ds_descvs_ls$utl_wtd_var_nm_1L_chr, 
        id_var_nm_1L_chr = ds_descvs_ls$id_var_nm_1L_chr, predictors_lup = predictors_lup, 
        round_var_nm_1L_chr = ds_descvs_ls$round_var_nm_1L_chr, 
        round_bl_val_1L_chr = ds_descvs_ls$round_vals_chr[1], 
        dictionary_tb = ds_descvs_ls$dictionary_tb)
    return(analysis_ds_smry_ls)
}
#' Make baseline follow-up add to row list
#' @description make_bl_fup_add_to_row_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make baseline follow-up add to row list. The function returns Add to row (a list).
#' @param df Data.frame (a data.frame)
#' @param n_at_bl_1L_int N at baseline (an integer vector of length one)
#' @param n_at_fup_1L_int N at follow-up (an integer vector of length one)
#' @return Add to row (a list)
#' @rdname make_bl_fup_add_to_row_ls
#' @export 
#' @keywords internal
make_bl_fup_add_to_row_ls <- function (df, n_at_bl_1L_int, n_at_fup_1L_int) 
{
    if (is.na(n_at_fup_1L_int)) {
        fup_1L_chr <- character(0)
    }
    else {
        fup_1L_chr <- paste0(" & \\multicolumn{2}{c}{\\textbf{Follow-up (N=", 
            n_at_fup_1L_int, ")}}")
    }
    add_to_row_ls <- list(pos = list(-1, nrow(df)), command = c(paste("\\toprule \n", 
        paste0("\\multicolumn{2}{c}{} & \\multicolumn{2}{c}{\\textbf{Baseline (N=", 
            n_at_bl_1L_int, ")}}", fup_1L_chr, " \\\\\n")), paste("\\bottomrule \n")))
    return(add_to_row_ls)
}
#' Make bayesian regression models model plot
#' @description make_brms_mdl_plt() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make bayesian regression models model plot. The function returns Plot (a plot).
#' @param outp_smry_ls Output summary (a list)
#' @param depnt_var_min_val_1L_dbl Dependent variable minimum value (a double vector of length one), Default: numeric(0)
#' @param depnt_var_desc_1L_chr Dependent variable description (a character vector of length one)
#' @param mdl_nm_1L_chr Model name (a character vector of length one)
#' @param type_1L_chr Type (a character vector of length one)
#' @param base_size_1L_dbl Base size (a double vector of length one), Default: 8
#' @param brms_mdl Bayesian regression models (a model), Default: NULL
#' @param correspondences_lup Correspondences (a lookup table), Default: NULL
#' @param new_var_nm_1L_chr New variable name (a character vector of length one), Default: 'Predicted'
#' @param predn_type_1L_chr Prediction type (a character vector of length one), Default: NULL
#' @param x_lbl_1L_chr X label (a character vector of length one), Default: 'NA'
#' @param y_lbl_1L_chr Y label (a character vector of length one), Default: 'NA'
#' @return Plot (a plot)
#' @rdname make_brms_mdl_plt
#' @export 
#' @importFrom ready4 get_from_lup_obj
#' @importFrom purrr flatten_chr
#' @importFrom rlang exec
#' @keywords internal
make_brms_mdl_plt <- function (outp_smry_ls, depnt_var_min_val_1L_dbl = numeric(0), 
    depnt_var_desc_1L_chr, mdl_nm_1L_chr, type_1L_chr, base_size_1L_dbl = 8, 
    brms_mdl = NULL, correspondences_lup = NULL, new_var_nm_1L_chr = "Predicted", 
    predn_type_1L_chr = NULL, x_lbl_1L_chr = NA_character_, y_lbl_1L_chr = NA_character_) 
{
    sfx_1L_chr <- " from brmsfit"
    mdl_types_lup <- outp_smry_ls$mdl_types_lup
    if (is.null(brms_mdl)) {
        incld_mdl_paths_chr <- make_incld_mdl_paths(outp_smry_ls)
        brms_mdl <- readRDS(paste0(outp_smry_ls$path_to_write_to_1L_chr, 
            "/", incld_mdl_paths_chr[incld_mdl_paths_chr %>% 
                endsWith(paste0(mdl_nm_1L_chr, ".RDS"))]))
    }
    mdl_type_1L_chr <- get_mdl_type_from_nm(mdl_nm_1L_chr, mdl_types_lup = mdl_types_lup)
    tfmn_1L_chr <- ready4::get_from_lup_obj(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)
    plot_fn_and_args_ls <- make_plot_fn_and_args_ls(brms_mdl = brms_mdl, 
        tfd_data_tb = outp_smry_ls$scored_data_tb %>% transform_tb_to_mdl_inp(depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, 
            depnt_var_nm_1L_chr = outp_smry_ls$depnt_var_nm_1L_chr, 
            predr_vars_nms_chr = outp_smry_ls$predr_vars_nms_ls %>% 
                purrr::flatten_chr() %>% unique(), id_var_nm_1L_chr = outp_smry_ls$id_var_nm_1L_chr, 
            round_var_nm_1L_chr = outp_smry_ls$round_var_nm_1L_chr, 
            round_bl_val_1L_chr = outp_smry_ls$round_bl_val_1L_chr, 
            scaling_fctr_dbl = make_scaling_fctr_dbl(outp_smry_ls)), 
        base_size_1L_dbl = base_size_1L_dbl, correspondences_lup = correspondences_lup, 
        depnt_var_nm_1L_chr = outp_smry_ls$depnt_var_nm_1L_chr, 
        depnt_var_desc_1L_chr = depnt_var_desc_1L_chr, new_var_nm_1L_chr = new_var_nm_1L_chr, 
        predn_type_1L_chr = predn_type_1L_chr, round_var_nm_1L_chr = outp_smry_ls$round_var_nm_1L_chr, 
        sd_dbl = NA_real_, sfx_1L_chr = sfx_1L_chr, tfmn_1L_chr = tfmn_1L_chr, 
        type_1L_chr = type_1L_chr, utl_min_val_1L_dbl = ifelse(!is.null(outp_smry_ls$utl_min_val_1L_dbl), 
            outp_smry_ls$utl_min_val_1L_dbl, -1), x_lbl_1L_chr = x_lbl_1L_chr, 
        y_lbl_1L_chr = y_lbl_1L_chr)
    plt <- rlang::exec(plot_fn_and_args_ls$plt_fn, !!!plot_fn_and_args_ls$fn_args_ls)
    return(plt)
}
#' Make bayesian regression models model print list
#' @description make_brms_mdl_print_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make bayesian regression models model print list. The function returns Bayesian regression models model print (a list).
#' @param mdl_ls Model list (a list of models)
#' @param label_stub_1L_chr Label stub (a character vector of length one)
#' @param caption_1L_chr Caption (a character vector of length one)
#' @param output_type_1L_chr Output type (a character vector of length one), Default: 'PDF'
#' @param digits_1L_dbl Digits (a double vector of length one), Default: 2
#' @param big_mark_1L_chr Big mark (a character vector of length one), Default: ' '
#' @return Bayesian regression models model print (a list)
#' @rdname make_brms_mdl_print_ls
#' @export 
#' @importFrom utils capture.output
#' @importFrom purrr map_dbl map_chr map2_chr discard map
#' @importFrom dplyr mutate all_of across case_when
#' @importFrom Hmisc latexTranslate
#' @importFrom stringr str_replace
#' @keywords internal
make_brms_mdl_print_ls <- function (mdl_ls, label_stub_1L_chr, caption_1L_chr, output_type_1L_chr = "PDF", 
    digits_1L_dbl = 2, big_mark_1L_chr = " ") 
{
    smry_mdl_ls <- summary(mdl_ls, digits = 4)
    mdl_smry_chr <- smry_mdl_ls %>% utils::capture.output()
    idx_dbl <- c("Formula: ", "  Draws:", "Group-Level Effects: ", 
        "Population-Level Effects: ", "Family Specific Parameters: ", 
        "Draws were sampled using ") %>% purrr::map_dbl(~mdl_smry_chr %>% 
        startsWith(.x) %>% which())
    data_tb <- make_brms_mdl_smry_tbl(smry_mdl_ls, grp_1L_chr = mdl_smry_chr[idx_dbl[3]], 
        popl_1L_chr = mdl_smry_chr[idx_dbl[4]], fam_1L_chr = mdl_smry_chr[idx_dbl[5]])
    bold_lgl <- data_tb$Parameter %in% c(mdl_smry_chr[idx_dbl[3]], 
        mdl_smry_chr[idx_dbl[4]], mdl_smry_chr[idx_dbl[5]])
    if (output_type_1L_chr == "PDF") {
        data_tb <- data_tb %>% dplyr::mutate(Parameter = purrr::map_chr(Parameter, 
            ~.x %>% Hmisc::latexTranslate()))
    }
    data_tb <- data_tb %>% dplyr::mutate(Parameter = Parameter %>% 
        purrr::map2_chr(dplyr::all_of(bold_lgl), ~ifelse(.y & 
            output_type_1L_chr == "PDF", paste0("\\textbf{", 
            .x, "}"), .x)))
    if (output_type_1L_chr != "PDF") {
        data_tb <- data_tb %>% dplyr::mutate(dplyr::across(c(Bulk_ESS, 
            Tail_ESS), ~format(., big.mark = big_mark_1L_chr)))
    }
    if (output_type_1L_chr == "HTML") {
        data_tb <- data_tb %>% dplyr::mutate(dplyr::across(where(is.numeric), 
            ~format(round(., digits = digits_1L_dbl), digits = digits_1L_dbl, 
                nsmall = digits_1L_dbl)))
    }
    data_tb <- data_tb %>% dplyr::mutate(dplyr::across(where(is.character), 
        ~dplyr::case_when(is.na(.) ~ "", . == "NA" ~ "", endsWith(., 
            " NA") ~ "", TRUE ~ .)))
    end_matter_1L_chr <- trimws(mdl_smry_chr[idx_dbl[6]:length(mdl_smry_chr)]) %>% 
        paste0(collapse = " ")
    brms_mdl_print_ls <- list(part_1 = mdl_smry_chr[idx_dbl[1]], 
        part_2 = "\n\n", part_3 = c(trimws(mdl_smry_chr[1:(idx_dbl[2] - 
            1)][-idx_dbl[1]]), paste0(trimws(mdl_smry_chr[idx_dbl[2]]), 
            " ", trimws(mdl_smry_chr[idx_dbl[2] + 1]), collapse = " ")) %>% 
            paste0(collapse = ifelse(output_type_1L_chr == "PDF", 
                "\n\n", "\n")), part_4 = "\n\n", part_5 = list(data_tb = data_tb, 
            output_type_1L_chr = output_type_1L_chr, caption_1L_chr = caption_1L_chr, 
            mkdn_tbl_ref_1L_chr = paste0("tab:", label_stub_1L_chr), 
            merge_row_idx_int = as.integer(which(bold_lgl)), 
            digits_dbl = c(ifelse(output_type_1L_chr == "PDF", 
                0, NA_real_) %>% purrr::discard(is.na), names(data_tb) %>% 
                purrr::map_dbl(~ifelse(.x %in% c("Bulk_ESS", 
                  "Tail_ESS"), 0, digits_1L_dbl))), big_mark_1L_chr = big_mark_1L_chr, 
            hline_after_ls = c(-1, 0), sanitize_fn = force, footnotes_chr = NA_character_), 
        part_6 = end_matter_1L_chr)
    if (output_type_1L_chr != "PDF") {
        brms_mdl_print_ls$part_5$footnotes_chr <- c(paste0(brms_mdl_print_ls$part_1, 
            ifelse(output_type_1L_chr == "Word", "", "\n")), 
            brms_mdl_print_ls$part_3, brms_mdl_print_ls$part_6)
        brms_mdl_print_ls$part_6 <- NULL
    }
    else {
        footnotes_chr <- c(mdl_smry_chr[idx_dbl[1]], trimws(mdl_smry_chr[1:(idx_dbl[2] - 
            1)][-idx_dbl[1]]), trimws(mdl_smry_chr[idx_dbl[2]]), 
            trimws(mdl_smry_chr[idx_dbl[2] + 1]), trimws(mdl_smry_chr[idx_dbl[6]:length(mdl_smry_chr)])) %>% 
            Hmisc::latexTranslate()
        footnotes_chr[1] <- footnotes_chr[1] %>% stringr::str_replace("~", 
            "\\\\textasciitilde")
        brms_mdl_print_ls$part_5$add_to_row_ls <- list(pos = purrr::map(c(0, 
            rep(nrow(data_tb), length(footnotes_chr) + 1)), ~.x), 
            command = c(names(data_tb) %>% Hmisc::latexTranslate() %>% 
                paste0(collapse = " & ") %>% paste0("\\\\\n"), 
                c("\\toprule\n"), footnotes_chr %>% purrr::map_chr(~paste0("\\multicolumn{", 
                  ncol(data_tb), "}{l}{", paste0("{\\footnotesize ", 
                    .x, "}\n", collapse = ","), "}\\\\\n"))))
    }
    return(brms_mdl_print_ls)
}
#' Make bayesian regression models model summary table
#' @description make_brms_mdl_smry_tbl() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make bayesian regression models model summary table. The function returns Bayesian regression models model summary (a tibble).
#' @param smry_mdl_ls Summary (a list of models)
#' @param grp_1L_chr Group (a character vector of length one)
#' @param popl_1L_chr Population (a character vector of length one)
#' @param fam_1L_chr Family (a character vector of length one)
#' @return Bayesian regression models model summary (a tibble)
#' @rdname make_brms_mdl_smry_tbl
#' @export 
#' @importFrom purrr map
#' @importFrom dplyr bind_rows
#' @keywords internal
make_brms_mdl_smry_tbl <- function (smry_mdl_ls, grp_1L_chr, popl_1L_chr, fam_1L_chr) 
{
    brms_mdl_smry_tb <- purrr::map(1:length(smry_mdl_ls$random), 
        ~make_mdl_smry_elmt_tbl(ctg_chr = c(ifelse(.x == 1, grp_1L_chr, 
            character(0)), paste0(names(smry_mdl_ls$ngrps)[.x], 
            " (Number of levels: ", smry_mdl_ls$ngrps[.x][[1]], 
            ")")), mat = smry_mdl_ls$random[.x][[1]])) %>% dplyr::bind_rows(make_mdl_smry_elmt_tbl(mat = smry_mdl_ls$fixed, 
        ctg_chr = popl_1L_chr), make_mdl_smry_elmt_tbl(mat = smry_mdl_ls$spec_pars, 
        ctg_chr = fam_1L_chr))
    return(brms_mdl_smry_tb)
}
#' Make composite scatter and density plot
#' @description make_cmpst_sctr_and_dnst_plt() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make composite scatter and density plot. The function returns Composite (a plot).
#' @param outp_smry_ls Output summary (a list)
#' @param output_data_dir_1L_chr Output data directory (a character vector of length one), Default: 'NA'
#' @param predr_var_nms_chr Predictor variable names (a character vector), Default: 'NA'
#' @param base_size_1L_dbl Base size (a double vector of length one), Default: 16
#' @param correspondences_lup Correspondences (a lookup table), Default: NULL
#' @param depnt_var_min_val_1L_dbl Dependent variable minimum value (a double vector of length one), Default: numeric(0)
#' @param depnt_var_desc_1L_chr Dependent variable description (a character vector of length one), Default: 'NA'
#' @param labels_chr Labels (a character vector), Default: c("A", "B", "C", "D")
#' @param label_x_1L_dbl Label x (a double vector of length one), Default: 0.1
#' @param label_y_1L_dbl Label y (a double vector of length one), Default: 0.9
#' @param label_size_1L_dbl Label size (a double vector of length one), Default: 22
#' @param mdl_indcs_int Model indices (an integer vector), Default: 1:2
#' @param use_png_fls_1L_lgl Use png files (a logical vector of length one), Default: T
#' @return Composite (a plot)
#' @rdname make_cmpst_sctr_and_dnst_plt
#' @export 
#' @importFrom purrr discard map_lgl map_chr map flatten_chr flatten
#' @importFrom stringr str_detect str_remove
#' @importFrom DescTools SplitPath
#' @importFrom cowplot ggdraw draw_image plot_grid
make_cmpst_sctr_and_dnst_plt <- function (outp_smry_ls, output_data_dir_1L_chr = NA_character_, 
    predr_var_nms_chr = NA_character_, base_size_1L_dbl = 16, 
    correspondences_lup = NULL, depnt_var_min_val_1L_dbl = numeric(0), 
    depnt_var_desc_1L_chr = NA_character_, labels_chr = c("A", 
        "B", "C", "D"), label_x_1L_dbl = 0.1, label_y_1L_dbl = 0.9, 
    label_size_1L_dbl = 22, mdl_indcs_int = 1:2, use_png_fls_1L_lgl = T) 
{
    if (use_png_fls_1L_lgl) {
        filtered_paths_chr <- outp_smry_ls$file_paths_chr %>% 
            purrr::discard(~endsWith(.x, "_sim_sctr.png") | endsWith(.x, 
                "_sim_dnst.png") | endsWith(.x, "_cnstrd_sctr_plt.png") | 
                endsWith(.x, "_cnstrd_dnst.png"))
        filtered_paths_chr <- paste0(output_data_dir_1L_chr, 
            "/", filtered_paths_chr[filtered_paths_chr %>% purrr::map_lgl(~stringr::str_detect(.x, 
                paste0(predr_var_nms_chr, "_1")) & (stringr::str_detect(.x, 
                "_dnst.png") | stringr::str_detect(.x, "_sctr_plt.png")))])
        mdl_types_chr <- filtered_paths_chr %>% purrr::map_chr(~DescTools::SplitPath(.x)$filename %>% 
            stringr::str_remove("_dnst") %>% stringr::str_remove("_sctr_plt") %>% 
            get_mdl_type_from_nm())
        ordered_paths_chr <- outp_smry_ls$prefd_mdl_types_chr %>% 
            purrr::map(~filtered_paths_chr[which(mdl_types_chr == 
                .x)]) %>% purrr::flatten_chr()
        plot_ls <- ordered_paths_chr %>% purrr::map(~cowplot::ggdraw() + 
            cowplot::draw_image(.x))
    }
    else {
        plots_chr <- outp_smry_ls$mdl_nms_ls %>% purrr::flatten_chr()
        plots_chr <- plots_chr[mdl_indcs_int]
        plot_ls <- plots_chr %>% purrr::map(~{
            mdl_nm_1L_chr <- .x
            brms_mdl <- get_brms_mdl(outp_smry_ls, mdl_nm_1L_chr = mdl_nm_1L_chr)
            if (is.na(depnt_var_desc_1L_chr)) {
                depnt_var_desc_1L_chr <- get_hlth_utl_nm(outp_smry_ls$results_ls, 
                  short_nm_1L_lgl = T)
            }
            purrr::map(c("dnst", "sctr_plt"), ~{
                make_brms_mdl_plt(outp_smry_ls, base_size_1L_dbl = base_size_1L_dbl, 
                  brms_mdl = brms_mdl, correspondences_lup = correspondences_lup, 
                  depnt_var_desc_1L_chr = depnt_var_desc_1L_chr, 
                  depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, 
                  mdl_nm_1L_chr = mdl_nm_1L_chr, type_1L_chr = .x, 
                  predn_type_1L_chr = NULL, x_lbl_1L_chr = paste0("Observed ", 
                    depnt_var_desc_1L_chr), y_lbl_1L_chr = paste0("Predicted ", 
                    depnt_var_desc_1L_chr))
            })
        }) %>% purrr::flatten()
    }
    composite_plt <- cowplot::plot_grid(plot_ls[[1]], plot_ls[[2]], 
        plot_ls[[3]], plot_ls[[4]], nrow = 2, labels = labels_chr, 
        label_x = label_x_1L_dbl, label_y = label_y_1L_dbl, label_size = label_size_1L_dbl)
    return(composite_plt)
}
#' Make candidate predictor text
#' @description make_cndt_predr_text() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make candidate predictor text. The function returns Text (a character vector of length one).
#' @param results_ls Results (a list)
#' @param type_1L_chr Type (a character vector of length one), Default: 'description'
#' @return Text (a character vector of length one)
#' @rdname make_cndt_predr_text
#' @export 
#' @importFrom Hmisc capitalize
make_cndt_predr_text <- function (results_ls, type_1L_chr = "description") 
{
    nbr_of_predrs_1L_int <- get_nbr_of_predrs(results_ls, as_words_1L_lgl = F)
    if (type_1L_chr == "description") {
        text_1L_chr <- paste0(get_nbr_of_predrs(results_ls) %>% 
            Hmisc::capitalize(), " measure", ifelse(nbr_of_predrs_1L_int > 
            1, "s", ""), " of ", get_nbr_of_predrs_by_ctg(results_ls), 
            ifelse(nbr_of_predrs_1L_int > 1, " were", " was"), 
            " used as ", ifelse(nbr_of_predrs_1L_int > 1, "", 
                "a "), "candidate predictor", ifelse(nbr_of_predrs_1L_int > 
                1, "s", ""), " to construct models.")
    }
    if (type_1L_chr == "comparison") {
        text_1L_chr <- paste0(ifelse(nbr_of_predrs_1L_int > 1, 
            paste0("We ", "evaluated", " the independent predictive ability of different candidate predictors using 10-fold cross-validation."), 
            ""))
    }
    return(text_1L_chr)
}
#' Make cohort list
#' @description make_cohort_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make cohort list. The function returns Cohort (a list).
#' @param descv_tbls_ls Descriptive tables (a list)
#' @param ctgl_vars_regrouping_ls Categorical variables regrouping (a list), Default: NULL
#' @param nbr_of_digits_1L_int Number of digits (an integer vector of length one), Default: 2
#' @return Cohort (a list)
#' @rdname make_cohort_ls
#' @export 
#' @importFrom dplyr filter pull
#' @importFrom purrr map_dbl discard map map2
#' @importFrom rlang sym
#' @importFrom stringr str_remove
#' @importFrom stats setNames
#' @keywords internal
make_cohort_ls <- function (descv_tbls_ls, ctgl_vars_regrouping_ls = NULL, nbr_of_digits_1L_int = 2L) 
{
    numeric_vars_chr <- descv_tbls_ls$cohort_desc_tb %>% dplyr::filter(label == 
        "Median (Q1, Q3)") %>% dplyr::pull(variable)
    ctgl_vars_chr <- unique(descv_tbls_ls$cohort_desc_tb$variable[!descv_tbls_ls$cohort_desc_tb$variable %in% 
        numeric_vars_chr])
    nbr_by_round_dbl <- paste0(descv_tbls_ls$ds_descvs_ls$round_vals_chr, 
        "_val_1_dbl") %>% purrr::map_dbl(~descv_tbls_ls$cohort_desc_tb %>% 
        dplyr::filter(variable == ctgl_vars_chr[1]) %>% dplyr::pull(.x) %>% 
        purrr::discard(~.x == "") %>% as.numeric() %>% purrr::map_dbl(~.x[[1]]) %>% 
        sum())
    numeric_vars_smry_ls <- numeric_vars_chr %>% purrr::map(~{
        var_smry_tb <- descv_tbls_ls$cohort_desc_tb %>% dplyr::filter(variable == 
            .x)
        list(bl_min_1L_dbl = var_smry_tb %>% dplyr::filter(label == 
            "Min - Max") %>% dplyr::pull(!!rlang::sym(paste0(descv_tbls_ls$ds_descvs_ls$round_vals_chr[1], 
            "_val_1_dbl"))) %>% as.numeric(), bl_max_1L_dbl = var_smry_tb %>% 
            dplyr::filter(label == "Min - Max") %>% dplyr::pull(!!rlang::sym(paste0(descv_tbls_ls$ds_descvs_ls$round_vals_chr[1], 
            "_val_2_ls"))) %>% as.numeric(), bl_mean_1L_dbl = round(var_smry_tb %>% 
            dplyr::filter(label == "Mean (SD)") %>% dplyr::pull(!!rlang::sym(paste0(descv_tbls_ls$ds_descvs_ls$round_vals_chr[1], 
            "_val_1_dbl"))) %>% as.numeric(), nbr_of_digits_1L_int), 
            bl_sd_1L_dbl = round(var_smry_tb %>% dplyr::filter(label == 
                "Mean (SD)") %>% dplyr::pull(!!rlang::sym(paste0(descv_tbls_ls$ds_descvs_ls$round_vals_chr[1], 
                "_val_2_ls"))) %>% stringr::str_remove("\\(") %>% 
                stringr::str_remove("\\)") %>% as.numeric(), 
                nbr_of_digits_1L_int))
    }) %>% stats::setNames(numeric_vars_chr)
    cohort_ls <- list(n_all_1l_dbl = descv_tbls_ls$ds_descvs_ls$nbr_participants_1L_int, 
        n_inc_1L_dbl = nbr_by_round_dbl[1], n_fup_1L_dbl = nbr_by_round_dbl[2], 
        numeric_vars_smry_ls = numeric_vars_smry_ls)
    if (!is.null(ctgl_vars_regrouping_ls)) {
        append_ls <- ctgl_vars_regrouping_ls %>% purrr::map2(names(ctgl_vars_regrouping_ls), 
            ~{
                var_nm_1L_chr <- .y
                .x %>% purrr::map(~{
                  list(name_1L_chr = .x$name_1L_chr, n_in_group_1L_dbl = descv_tbls_ls$cohort_desc_tb %>% 
                    dplyr::filter(variable == var_nm_1L_chr) %>% 
                    dplyr::filter(label %in% .x$ctgs_chr) %>% 
                    dplyr::pull(Baseline_val_1_dbl) %>% as.numeric() %>% 
                    purrr::map_dbl(~.x) %>% sum(), n_msng_1L_dbl = descv_tbls_ls$cohort_desc_tb %>% 
                    dplyr::filter(variable == var_nm_1L_chr) %>% 
                    dplyr::filter(label == "Missing") %>% dplyr::pull(Baseline_val_1_dbl) %>% 
                    as.numeric())
                })
            })
        cohort_ls <- append(cohort_ls, append_ls)
    }
    return(cohort_ls)
}
#' Make conflict of interest text
#' @description make_coi_text() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make conflict of interest text. The function returns Text (a character vector of length one).
#' @param results_ls Results (a list)
#' @return Text (a character vector of length one)
#' @rdname make_coi_text
#' @export 
make_coi_text <- function (results_ls) 
{
    text_1L_chr <- ifelse(is.null(results_ls$study_descs_ls$coi_1L_chr), 
        "", results_ls$study_descs_ls$coi_1L_chr)
    return(text_1L_chr)
}
#' Make correlation text
#' @description make_correlation_text() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make correlation text. The function returns Correlation text (a character vector of length one).
#' @param results_ls Results (a list)
#' @return Correlation text (a character vector of length one)
#' @rdname make_correlation_text
#' @export 
make_correlation_text <- function (results_ls) 
{
    correlation_text_1L_chr <- ifelse(length(results_ls$hlth_utl_and_predrs_ls$cor_seq_dscdng_chr) < 
        2, "", paste0(results_ls$hlth_utl_and_predrs_ls$cor_seq_dscdng_chr[1], 
        " was found to have the highest correlation with utility score both at baseline and follow-up followed by ", 
        results_ls$hlth_utl_and_predrs_ls$cor_seq_dscdng_chr[2], 
        ifelse(length(results_ls$hlth_utl_and_predrs_ls$cor_seq_dscdng_chr) < 
            3, "", paste0(" and ", results_ls$hlth_utl_and_predrs_ls$cor_seq_dscdng_chr[3])), 
        ifelse(length(results_ls$hlth_utl_and_predrs_ls$cor_seq_dscdng_chr) < 
            4, "", paste0("; baseline and follow-up ", results_ls$hlth_utl_and_predrs_ls$cor_seq_dscdng_chr[length(results_ls$hlth_utl_and_predrs_ls$cor_seq_dscdng_chr)], 
            " was found to have the lowest correlation coefficients with utility score")), 
        "."))
    return(correlation_text_1L_chr)
}
#' Make covariate transfer to utility algorithm table references
#' @description make_covar_ttu_tbl_refs() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make covariate transfer to utility algorithm table references. The function returns Text (a character vector of length one).
#' @param params_ls Parameters (a list)
#' @return Text (a character vector of length one)
#' @rdname make_covar_ttu_tbl_refs
#' @export 
#' @importFrom purrr discard
#' @importFrom stringi stri_replace_last
#' @keywords internal
make_covar_ttu_tbl_refs <- function (params_ls) 
{
    results_ls <- params_ls$results_ls
    n_mdls_1L_int <- length(results_ls$ttu_lngl_ls$best_mdls_tb$model_type)
    n_covars_1L_int <- length(results_ls$ttu_lngl_ls$incld_covars_chr %>% 
        purrr::discard(is.na))
    text_1L_chr <- paste0(ifelse(n_covars_1L_int < 1, "", paste0(" (see ", 
        ifelse(params_ls$output_type_1L_chr == "Word", "", "Table"), 
        "s ", paste0("\\@ref(tab:coefscovarstype", 1:n_mdls_1L_int, 
            ")", collapse = ", ") %>% stringi::stri_replace_last(fixed = ",", 
            " and"), ").")))
    return(text_1L_chr)
}
#' Make covariate transfer to utility algorithm table title
#' @description make_covar_ttu_tbl_title() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make covariate transfer to utility algorithm table title. The function returns Title (a character vector of length one).
#' @param results_ls Results (a list)
#' @param ref_1L_int Reference (an integer vector of length one), Default: 1
#' @return Title (a character vector of length one)
#' @rdname make_covar_ttu_tbl_title
#' @export 
#' @importFrom purrr map_chr
#' @importFrom ready4 get_from_lup_obj make_list_phrase
#' @importFrom stringi stri_replace_last
#' @keywords internal
make_covar_ttu_tbl_title <- function (results_ls, ref_1L_int = 1) 
{
    title_1L_chr <- paste0("Estimated coefficients from utility mapping models based on individual candidate predictors with ", 
        results_ls$ttu_lngl_ls$incld_covars_chr %>% purrr::map_chr(~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")) %>% ready4::make_list_phrase() %>% 
            paste0(collapse = ", ") %>% stringi::stri_replace_last(fixed = ",", 
            " and"), " using ", results_ls$ttu_lngl_ls$best_mdls_tb[[ref_1L_int, 
            "model_type"]], " (", results_ls$ttu_lngl_ls$best_mdls_tb[[ref_1L_int, 
            "link_and_tfmn_chr"]], ")")
    return(title_1L_chr)
}
#' Make covariates text
#' @description make_covariates_text() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make covariates text. The function returns Text (a character vector of length one).
#' @param results_ls Results (a list)
#' @return Text (a character vector of length one)
#' @rdname make_covariates_text
#' @export 
#' @importFrom Hmisc capitalize
#' @importFrom purrr map_chr map map_lgl flatten_chr map2_chr
#' @importFrom ready4 get_from_lup_obj
#' @importFrom stringi stri_replace_last
#' @importFrom stringr str_detect
make_covariates_text <- function (results_ls) 
{
    if (!is.null(results_ls$candidate_covars_ls)) {
        if (length(results_ls$candidate_covars_ls) < 1) {
            text_1L_chr <- ""
        }
        else {
            n_predrs_1L_int <- get_nbr_of_predrs(results_ls, 
                as_words_1L_lgl = F)
            tfmn_fn <- function(x, results_ls) {
                ifelse(is.na(results_ls$cohort_ls$n_fup_1L_dbl), 
                  Hmisc::capitalize(x), x)
            }
            text_1L_chr <- paste0("The confounding effect of other participant characteristics when using the candidate predictors in predicting utility score were also evaluated. ", 
                ifelse(is.na(results_ls$cohort_ls$n_fup_1L_dbl), 
                  "", "Using the baseline data, "), ifelse(is.na(results_ls$ttu_cs_ls$sig_covars_all_predrs_mdls_chr[1]), 
                  "no confounding factor", results_ls$ttu_cs_ls$sig_covars_all_predrs_mdls_chr %>% 
                    purrr::map_chr(~ready4::get_from_lup_obj(data_lookup_tb = results_ls$mdl_ingredients_ls$dictionary_tb, 
                      match_var_nm_1L_chr = "var_nm_chr", match_value_xx = .x, 
                      target_var_nm_1L_chr = "var_desc_chr")) %>% 
                    paste0(collapse = ", ") %>% stringi::stri_replace_last(fixed = ",", 
                    " and") %>% tfmn_fn(results_ls)), " ", ifelse(is.na(results_ls$ttu_cs_ls$sig_covars_all_predrs_mdls_chr[1]), 
                  "was", ifelse(length(results_ls$ttu_cs_ls$sig_covars_all_predrs_mdls_chr) == 
                    1, "was", "were")), " found to independently predict utility scores in models for ", 
                ifelse(n_predrs_1L_int == 1, "the ", ifelse(n_predrs_1L_int == 
                  2, "both ", paste0("all ", get_nbr_of_predrs(results_ls), 
                  " "))), "candidate predictor", ifelse(n_predrs_1L_int == 
                  1, " ", "s "), "*(p<0.01)*.")
            mdls_with_signft_covars_ls <- results_ls$mdls_with_signft_covars_ls
            duplicates_int <- which(duplicated(mdls_with_signft_covars_ls))
            if (!identical(integer(0), duplicates_int)) {
                unduplicated_ls <- mdls_with_signft_covars_ls[!duplicated(mdls_with_signft_covars_ls)]
                duplicated_ls <- mdls_with_signft_covars_ls[duplicates_int]
                add_to_chr <- duplicates_int %>% purrr::map(~{
                  match_chr <- mdls_with_signft_covars_ls[[.x]]
                  mdls_with_signft_covars_ls[1:(.x - 1)] %>% 
                    purrr::map_lgl(~identical(.x, match_chr)) %>% 
                    names()
                }) %>% purrr::flatten_chr() %>% unique()
                signft_covars_chr <- names(unduplicated_ls) %>% 
                  purrr::map(~{
                    vars_chr <- c(.x, names(duplicated_ls)[which(.x == 
                      add_to_chr)])
                    paste0(vars_chr %>% purrr::map_chr(~transform_names(.x, 
                      rename_lup = results_ls$var_nm_change_lup)) %>% 
                      paste0(collapse = ", ") %>% stringi::stri_replace_last(fixed = ",", 
                      " and"), ifelse(length(vars_chr) > 1, " were significant covariates *(p<0.01)*", 
                      " was a significant covariate *(p<0.01)*"), 
                      " in the ")
                  }) %>% purrr::flatten_chr()
                mdls_ls <- unduplicated_ls
            }
            else {
                if (!is.na(names(mdls_with_signft_covars_ls)[1])) {
                  signft_covars_chr <- names(mdls_with_signft_covars_ls) %>% 
                    purrr::map_chr(~paste0(transform_names(.x, 
                      rename_lup = results_ls$var_nm_change_lup), 
                      " was a significant covariate *(p<0.01)* in the "))
                  mdls_ls <- mdls_with_signft_covars_ls
                }
                else {
                  signft_covars_chr <- ""
                  mdls_ls <- NULL
                }
            }
            if (!is.null(mdls_ls)) {
                nbr_predrs_1L_int <- get_nbr_of_predrs(results_ls, 
                  as_words_1L_lgl = F)
                sig_for_some_int <- which(mdls_ls %>% purrr::map_lgl(~length(.x) != 
                  nbr_predrs_1L_int)) %>% unname()
                if (!identical(sig_for_some_int, integer(0))) {
                  mdls_ls <- mdls_ls[sig_for_some_int]
                  signft_covars_chr <- signft_covars_chr[sig_for_some_int]
                  text_1L_chr <- paste0(text_1L_chr, " ", mdls_ls %>% 
                    purrr::map_chr(~.x %>% purrr::map_chr(~transform_names(.x, 
                      rename_lup = results_ls$var_nm_change_lup)) %>% 
                      paste0(collapse = ", ") %>% stringi::stri_replace_last(fixed = ",", 
                      " and")) %>% purrr::map2_chr(signft_covars_chr, 
                    ~paste0(.y, .x, " model", ifelse(stringr::str_detect(.x, 
                      " and "), "s. ", ". "))) %>% paste0(collapse = ""))
                }
            }
        }
    }
    else {
        text_1L_chr <- ""
    }
    return(text_1L_chr)
}
#' Make cross-section time series ratios tibble
#' @description make_cs_ts_ratios_tb() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make cross-section time series ratios tibble. The function returns Cross-section time series ratios (a tibble).
#' @param predr_ctgs_ls Predictor categories (a list)
#' @param mdl_coef_ratios_ls Model coefficient ratios (a list)
#' @param candidate_predrs_chr Candidate predictors (a character vector), Default: NULL
#' @param nbr_of_digits_1L_int Number of digits (an integer vector of length one), Default: 2
#' @param fn_ls Function list (a list of functions), Default: NULL
#' @return Cross-section time series ratios (a tibble)
#' @rdname make_cs_ts_ratios_tb
#' @export 
#' @importFrom purrr map flatten_chr map_dfr pluck map_lgl
#' @importFrom tibble tibble
#' @importFrom rlang exec
#' @importFrom dplyr distinct
#' @keywords internal
make_cs_ts_ratios_tb <- function (predr_ctgs_ls, mdl_coef_ratios_ls, candidate_predrs_chr = NULL, 
    nbr_of_digits_1L_int = 2L, fn_ls = NULL) 
{
    if (is.null(fn_ls)) 
        fn_ls <- purrr::map(1:length(predr_ctgs_ls), ~make_mdl_coef_range_text)
    if (is.null(candidate_predrs_chr)) {
        candidate_predrs_chr <- predr_ctgs_ls %>% purrr::flatten_chr()
    }
    cs_ts_ratios_tb <- 1:length(predr_ctgs_ls) %>% purrr::map_dfr(~{
        if (length(predr_ctgs_ls %>% purrr::pluck(.x)) > 1) {
            predr_nm_1L_chr <- paste0(names(predr_ctgs_ls)[.x] %>% 
                tolower(), " measurements")
        }
        else {
            predr_nm_1L_chr <- predr_ctgs_ls %>% purrr::pluck(.x)
        }
        tibble::tibble(predr_nm_chr = predr_nm_1L_chr, ratios_chr = ifelse(identical(make_mdl_coef_range_text, 
            fn_ls %>% purrr::pluck(.x)), make_mdl_coef_range_text(mdl_coef_ratios_ls %>% 
            purrr::pluck(names(predr_ctgs_ls)[.x]), nbr_of_digits_1L_int = nbr_of_digits_1L_int), 
            paste0(round(rlang::exec(fn_ls %>% purrr::pluck(.x), 
                mdl_coef_ratios_ls %>% purrr::pluck(names(predr_ctgs_ls)[.x])), 
                nbr_of_digits_1L_int), ifelse(identical(min, 
                fn_ls %>% purrr::pluck(.x)), " or over", ifelse(identical(max, 
                fn_ls %>% purrr::pluck(.x)), " or under", "")))), 
            contains_cndt_predr_lgl = predr_ctgs_ls[[.x]] %>% 
                purrr::map_lgl(~!identical(intersect(.x, candidate_predrs_chr), 
                  character(0))) %>% unname())
    })
    cs_ts_ratios_tb <- dplyr::distinct(cs_ts_ratios_tb)
    return(cs_ts_ratios_tb)
}
#' Make cross-sectional example predictors
#' @description make_csnl_example_predrs() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make cross-sectional example predictors. The function returns Predictors (a ready4 S3).

#' @return Predictors (a ready4 S3)
#' @rdname make_csnl_example_predrs
#' @export 
#' @importFrom dplyr mutate case_when
#' @keywords internal
make_csnl_example_predrs <- function () 
{
    predictors_r3 <- Ready4useRepos(dv_nm_1L_chr = "TTU", dv_ds_nm_1L_chr = "https://doi.org/10.7910/DVN/DKDIB0", 
        dv_server_1L_chr = "dataverse.harvard.edu") %>% ingest(fls_to_ingest_chr = c("predictors_r3"), 
        metadata_1L_lgl = F)
    predictors_r3 <- renew.specific_predictors(predictors_r3, 
        filter_cdn_1L_chr = "short_name_chr == 'SOFAS'") %>% 
        renew.specific_predictors(short_name_chr = c("K10", "MLT", 
            "CHU9D", "AQOL6D"), long_name_chr = c("K10 total score", 
            "MLT total score", "CHU9D health utility", "AQOL6D health utility"), 
            min_val_dbl = c(10, 0, -0.1059, 0.03), max_val_dbl = c(50, 
                100, 1, 1), class_chr = c("integer", "numeric", 
                "numeric", "numeric"), increment_dbl = 1, class_fn_chr = c("youthvars::youthvars_k10_aus", 
                "as.double", "youthvars::youthvars_chu9d_adolaus", 
                "youthvars::youthvars_aqol6d_adol"), mdl_scaling_dbl = c(0.01, 
                0.01, 1, 1), covariate_lgl = F) %>% dplyr::mutate(covariate_lgl = dplyr::case_when(short_name_chr == 
        "SOFAS" ~ F, T ~ covariate_lgl))
    return(predictors_r3)
}
#' Make data availability text
#' @description make_data_availability_text() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make data availability text. The function returns Text (a character vector of length one).
#' @param results_ls Results (a list)
#' @return Text (a character vector of length one)
#' @rdname make_data_availability_text
#' @export 
make_data_availability_text <- function (results_ls) 
{
    text_1L_chr <- ifelse(is.null(results_ls$dv_ds_nm_and_url_chr), 
        "None available", paste0("Detailed results in the form of catalogues of the models produced by this study and other supporting information are available in the online repository: ", 
            results_ls$dv_ds_nm_and_url_chr[2]))
    return(text_1L_chr)
}
#' Make density and scatter plot title
#' @description make_dnst_and_sctr_plt_title() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make density and scatter plot title. The function returns Title (a character vector of length one).
#' @param results_ls Results (a list)
#' @return Title (a character vector of length one)
#' @rdname make_dnst_and_sctr_plt_title
#' @export 
#' @importFrom stringi stri_replace_last
#' @importFrom purrr pmap_chr pluck
make_dnst_and_sctr_plt_title <- function (results_ls) 
{
    title_1L_chr <- paste0("Comparison of observed and predicted ", 
        results_ls$study_descs_ls$health_utl_nm_1L_chr, " score from longitudinal model using ", 
        results_ls$predr_var_nms_chr %>% paste0(collapse = ", ") %>% 
            stringi::stri_replace_last(fixed = ",", " and"), 
        " (A) Density plots of observed and predicted utility scores (", 
        results_ls$ttu_lngl_ls$best_mdls_tb %>% purrr::pmap_chr(~paste0(..1, 
            " (", ..2, ")")) %>% purrr::pluck(1), ") (B) Scatter plots of observed and predicted utility scores by timepoint (", 
        results_ls$ttu_lngl_ls$best_mdls_tb %>% purrr::pmap_chr(~paste0(..1, 
            " (", ..2, ")")) %>% purrr::pluck(1), ") (C) Density plots of observed and predicted results (", 
        ifelse(nrow(results_ls$ttu_lngl_ls$best_mdls_tb) > 1, 
            paste0(results_ls$ttu_lngl_ls$best_mdls_tb %>% purrr::pmap_chr(~paste0(..1, 
                " (", ..2, ")")) %>% purrr::pluck(2), ") (D) Scatter plots of observed and predicted results by timepoint (", 
                results_ls$ttu_lngl_ls$best_mdls_tb %>% purrr::pmap_chr(~paste0(..1, 
                  " (", ..2, ")")) %>% purrr::pluck(2), ")"), 
            ""))
    return(title_1L_chr)
}
#' Make dataset descriptives list
#' @description make_ds_descvs_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make dataset descriptives list. The function returns Dataset descriptives (a list).
#' @param candidate_predrs_chr Candidate predictors (a character vector)
#' @param cohort_descv_var_nms_chr Cohort descriptive variable names (a character vector)
#' @param dictionary_tb Dictionary (a tibble)
#' @param id_var_nm_1L_chr Identity variable name (a character vector of length one)
#' @param msrmnt_date_var_nm_1L_chr Measurement date variable name (a character vector of length one)
#' @param round_var_nm_1L_chr Round variable name (a character vector of length one)
#' @param round_vals_chr Round values (a character vector)
#' @param maui_item_pfx_1L_chr Multi-attribute utility instrument item prefix (a character vector of length one)
#' @param utl_wtd_var_nm_1L_chr Utility weighted variable name (a character vector of length one), Default: 'wtd_utl_dbl'
#' @param utl_unwtd_var_nm_1L_chr Utility unweighted variable name (a character vector of length one), Default: 'unwtd_utl_dbl'
#' @param candidate_covar_nms_chr Candidate covariate names (a character vector), Default: NULL
#' @param is_fake_1L_lgl Is fake (a logical vector of length one), Default: NULL
#' @return Dataset descriptives (a list)
#' @rdname make_ds_descvs_ls
#' @export 
make_ds_descvs_ls <- function (candidate_predrs_chr, cohort_descv_var_nms_chr, dictionary_tb, 
    id_var_nm_1L_chr, msrmnt_date_var_nm_1L_chr, round_var_nm_1L_chr, 
    round_vals_chr, maui_item_pfx_1L_chr, utl_wtd_var_nm_1L_chr = "wtd_utl_dbl", 
    utl_unwtd_var_nm_1L_chr = "unwtd_utl_dbl", candidate_covar_nms_chr = NULL, 
    is_fake_1L_lgl = NULL) 
{
    ds_descvs_ls <- list(candidate_covar_nms_chr = candidate_covar_nms_chr, 
        candidate_predrs_chr = candidate_predrs_chr, cohort_descv_var_nms_chr = cohort_descv_var_nms_chr, 
        dictionary_tb = dictionary_tb, id_var_nm_1L_chr = id_var_nm_1L_chr, 
        is_fake_1L_lgl = is_fake_1L_lgl, msrmnt_date_var_nm_1L_chr = msrmnt_date_var_nm_1L_chr, 
        round_var_nm_1L_chr = round_var_nm_1L_chr, round_vals_chr = round_vals_chr, 
        maui_item_pfx_1L_chr = maui_item_pfx_1L_chr, utl_wtd_var_nm_1L_chr = utl_wtd_var_nm_1L_chr, 
        utl_unwtd_var_nm_1L_chr = utl_unwtd_var_nm_1L_chr)
    return(ds_descvs_ls)
}
#' Make dataset summary list
#' @description make_ds_smry_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make dataset summary list. The function returns Dataset summary (a list).
#' @param candidate_predrs_chr Candidate predictors (a character vector)
#' @param candidate_covar_nms_chr Candidate covariate names (a character vector)
#' @param depnt_var_nm_1L_chr Dependent variable name (a character vector of length one)
#' @param dictionary_tb Dictionary (a tibble)
#' @param id_var_nm_1L_chr Identity variable name (a character vector of length one)
#' @param round_var_nm_1L_chr Round variable name (a character vector of length one)
#' @param round_bl_val_1L_chr Round baseline value (a character vector of length one)
#' @param predictors_lup Predictors (a lookup table)
#' @return Dataset summary (a list)
#' @rdname make_ds_smry_ls
#' @export 
make_ds_smry_ls <- function (candidate_predrs_chr, candidate_covar_nms_chr, depnt_var_nm_1L_chr, 
    dictionary_tb, id_var_nm_1L_chr, round_var_nm_1L_chr, round_bl_val_1L_chr, 
    predictors_lup) 
{
    ds_smry_ls <- list(candidate_predrs_chr = candidate_predrs_chr, 
        candidate_covar_nms_chr = candidate_covar_nms_chr, depnt_var_nm_1L_chr = depnt_var_nm_1L_chr, 
        dictionary_tb = dictionary_tb, id_var_nm_1L_chr = id_var_nm_1L_chr, 
        round_var_nm_1L_chr = round_var_nm_1L_chr, round_bl_val_1L_chr = round_bl_val_1L_chr, 
        predictors_lup = predictors_lup)
    return(ds_smry_ls)
}
#' Make ethics text
#' @description make_ethics_text() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make ethics text. The function returns Text (a character vector of length one).
#' @param results_ls Results (a list)
#' @return Text (a character vector of length one)
#' @rdname make_ethics_text
#' @export 
make_ethics_text <- function (results_ls) 
{
    text_1L_chr <- ifelse(is.null(results_ls$study_descs_ls$ethics_1L_chr), 
        "", results_ls$study_descs_ls$ethics_1L_chr)
    return(text_1L_chr)
}
#' Make fake time series data
#' @description make_fake_ts_data() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make fake time series data. The function returns Fk data (a tibble).
#' @param outp_smry_ls Output summary (a list)
#' @param depnt_var_min_val_1L_dbl Dependent variable minimum value (a double vector of length one), Default: numeric(0)
#' @param depnt_vars_are_NA_1L_lgl Dependent variables are NA (a logical vector of length one), Default: T
#' @return Fk data (a tibble)
#' @rdname make_fake_ts_data
#' @export 
#' @importFrom purrr flatten_chr map_dbl map_lgl
#' @importFrom ready4 get_from_lup_obj
#' @importFrom synthpop syn
#' @importFrom dplyr ungroup mutate group_by pull across all_of
#' @importFrom rlang sym
make_fake_ts_data <- function (outp_smry_ls, depnt_var_min_val_1L_dbl = numeric(0), 
    depnt_vars_are_NA_1L_lgl = T) 
{
    data_tb <- outp_smry_ls$scored_data_tb %>% transform_tb_to_mdl_inp(depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, 
        depnt_var_nm_1L_chr = outp_smry_ls$depnt_var_nm_1L_chr, 
        predr_vars_nms_chr = outp_smry_ls$predr_vars_nms_ls %>% 
            purrr::flatten_chr() %>% unique(), id_var_nm_1L_chr = outp_smry_ls$id_var_nm_1L_chr, 
        round_var_nm_1L_chr = outp_smry_ls$round_var_nm_1L_chr, 
        round_bl_val_1L_chr = outp_smry_ls$round_bl_val_1L_chr, 
        scaling_fctr_dbl = outp_smry_ls$predr_vars_nms_ls %>% 
            purrr::flatten_chr() %>% unique() %>% purrr::map_dbl(~ifelse(.x %in% 
            outp_smry_ls$predictors_lup$short_name_chr, ready4::get_from_lup_obj(outp_smry_ls$predictors_lup, 
            match_var_nm_1L_chr = "short_name_chr", match_value_xx = .x, 
            target_var_nm_1L_chr = "mdl_scaling_dbl"), 1)), tidy_1L_lgl = T)
    fk_data_ls <- synthpop::syn(data_tb, visit.sequence = names(data_tb)[names(data_tb) != 
        outp_smry_ls$id_var_nm_1L_chr], seed = outp_smry_ls$seed_1L_int)
    fk_data_tb <- fk_data_ls$syn
    if (identical(outp_smry_ls$round_var_nm_1L_chr, character(0)) | 
        ifelse(identical(outp_smry_ls$round_var_nm_1L_chr, character(0)), 
            T, is.na(outp_smry_ls$round_var_nm_1L_chr))) {
        fk_data_tb <- fk_data_tb %>% dplyr::ungroup()
    }
    else {
        fk_data_tb <- fk_data_tb %>% dplyr::mutate(`:=`(!!rlang::sym(outp_smry_ls$round_var_nm_1L_chr), 
            as.character(!!rlang::sym(outp_smry_ls$round_var_nm_1L_chr)))) %>% 
            dplyr::group_by(!!rlang::sym(outp_smry_ls$id_var_nm_1L_chr)) %>% 
            dplyr::mutate(`:=`(!!rlang::sym(outp_smry_ls$round_var_nm_1L_chr), 
                !!rlang::sym(outp_smry_ls$round_var_nm_1L_chr) %>% 
                  transform_timepoint_vals(timepoint_levels_chr = outp_smry_ls$scored_data_tb %>% 
                    dplyr::pull(!!rlang::sym(outp_smry_ls$round_var_nm_1L_chr)) %>% 
                    unique(), bl_val_1L_chr = outp_smry_ls$round_bl_val_1L_chr))) %>% 
            dplyr::ungroup()
    }
    if (depnt_vars_are_NA_1L_lgl) {
        depnt_vars_chr <- names(fk_data_tb)[names(fk_data_tb) %>% 
            purrr::map_lgl(~startsWith(.x, outp_smry_ls$depnt_var_nm_1L_chr))]
        fk_data_tb <- fk_data_tb %>% dplyr::mutate(dplyr::across(dplyr::all_of(depnt_vars_chr), 
            ~NA_real_))
    }
    return(fk_data_tb)
}
#' Make folds list
#' @description make_folds_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make folds list. The function returns Folds (a list).
#' @param data_tb Data (a tibble)
#' @param depnt_var_nm_1L_chr Dependent variable name (a character vector of length one), Default: 'utl_total_w'
#' @param folds_1L_int Folds (an integer vector of length one), Default: 10
#' @return Folds (a list)
#' @rdname make_folds_ls
#' @export 
#' @importFrom caret createFolds
#' @importFrom dplyr pull
#' @importFrom rlang sym
#' @keywords internal
make_folds_ls <- function (data_tb, depnt_var_nm_1L_chr = "utl_total_w", folds_1L_int = 10L) 
{
    folds_ls <- caret::createFolds(data_tb %>% dplyr::pull(!!rlang::sym(depnt_var_nm_1L_chr)), 
        k = folds_1L_int, list = TRUE, returnTrain = FALSE)
    return(folds_ls)
}
#' Make funding text
#' @description make_funding_text() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make funding text. The function returns Text (a character vector of length one).
#' @param results_ls Results (a list)
#' @return Text (a character vector of length one)
#' @rdname make_funding_text
#' @export 
make_funding_text <- function (results_ls) 
{
    text_1L_chr <- ifelse(is.null(results_ls$study_descs_ls$funding_1L_chr), 
        "", results_ls$study_descs_ls$funding_1L_chr)
    return(text_1L_chr)
}
#' Make health utility and predictors list
#' @description make_hlth_utl_and_predrs_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make health utility and predictors list. The function returns Health utility and predictors (a list).
#' @param outp_smry_ls Output summary (a list)
#' @param descv_tbls_ls Descriptive tables (a list)
#' @param nbr_of_digits_1L_int Number of digits (an integer vector of length one), Default: 2
#' @param old_nms_chr Old names (a character vector), Default: NULL
#' @param new_nms_chr New names (a character vector), Default: NULL
#' @return Health utility and predictors (a list)
#' @rdname make_hlth_utl_and_predrs_ls
#' @export 
#' @importFrom ready4 get_from_lup_obj
#' @importFrom dplyr filter
#' @importFrom stringr str_remove
#' @keywords internal
make_hlth_utl_and_predrs_ls <- function (outp_smry_ls, descv_tbls_ls, nbr_of_digits_1L_int = 2L, 
    old_nms_chr = NULL, new_nms_chr = NULL) 
{
    ranked_predrs_ls <- make_ranked_predrs_ls(descv_tbls_ls, 
        old_nms_chr = old_nms_chr, new_nms_chr = new_nms_chr)
    var_nm_1L_chr <- descv_tbls_ls$ds_descvs_ls$dictionary_tb %>% 
        ready4::get_from_lup_obj(match_var_nm_1L_chr = "var_nm_chr", 
            match_value_xx = outp_smry_ls$depnt_var_nm_1L_chr, 
            target_var_nm_1L_chr = "var_desc_chr", evaluate_1L_lgl = F) %>% 
        as.vector()
    hlth_utl_and_predrs_ls = list(bl_hu_mean_1L_dbl = descv_tbls_ls$main_outc_tbl_tb %>% 
        dplyr::filter(label == "Mean (SD)") %>% ready4::get_from_lup_obj(match_var_nm_1L_chr = "variable", 
        match_value_xx = var_nm_1L_chr, target_var_nm_1L_chr = paste0(descv_tbls_ls$ds_descvs_ls$round_vals_chr[1], 
            "_val_1_dbl"), evaluate_1L_lgl = F) %>% as.numeric() %>% 
        round(nbr_of_digits_1L_int), bl_hu_sd_1L_dbl = descv_tbls_ls$main_outc_tbl_tb %>% 
        dplyr::filter(label == "Mean (SD)") %>% ready4::get_from_lup_obj(match_var_nm_1L_chr = "variable", 
        match_value_xx = var_nm_1L_chr, target_var_nm_1L_chr = paste0(descv_tbls_ls$ds_descvs_ls$round_vals_chr[1], 
            "_val_2_ls"), evaluate_1L_lgl = F) %>% stringr::str_remove("\\(") %>% 
        stringr::str_remove("\\)") %>% as.numeric() %>% round(nbr_of_digits_1L_int), 
        fup_hu_mean_1L_dbl = ifelse(length(descv_tbls_ls$ds_descvs_ls$round_vals_chr) < 
            2, NA_real_, descv_tbls_ls$main_outc_tbl_tb %>% dplyr::filter(label == 
            "Mean (SD)") %>% ready4::get_from_lup_obj(match_var_nm_1L_chr = "variable", 
            match_value_xx = var_nm_1L_chr, target_var_nm_1L_chr = paste0(descv_tbls_ls$ds_descvs_ls$round_vals_chr[2], 
                "_val_1_dbl"), evaluate_1L_lgl = F) %>% as.numeric() %>% 
            round(nbr_of_digits_1L_int)), fup_hu_sd_1L_dbl = ifelse(length(descv_tbls_ls$ds_descvs_ls$round_vals_chr) < 
            2, NA_real_, descv_tbls_ls$main_outc_tbl_tb %>% dplyr::filter(label == 
            "Mean (SD)") %>% ready4::get_from_lup_obj(match_var_nm_1L_chr = "variable", 
            match_value_xx = var_nm_1L_chr, target_var_nm_1L_chr = paste0(descv_tbls_ls$ds_descvs_ls$round_vals_chr[2], 
                "_val_2_ls"), evaluate_1L_lgl = F) %>% stringr::str_remove("\\(") %>% 
            stringr::str_remove("\\)") %>% as.numeric() %>% round(nbr_of_digits_1L_int)), 
        predrs_nartv_seq_chr = ranked_predrs_ls$unranked_predrs_chr, 
        cor_seq_dscdng_chr = ranked_predrs_ls$ranked_predrs_chr)
    return(hlth_utl_and_predrs_ls)
}
#' Make included model paths
#' @description make_incld_mdl_paths() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make included model paths. The function returns Included model paths (a character vector).
#' @param outp_smry_ls Output summary (a list)
#' @return Included model paths (a character vector)
#' @rdname make_incld_mdl_paths
#' @export 
#' @importFrom purrr map_chr flatten_chr map map_lgl map_int
#' @importFrom stringr str_locate
#' @keywords internal
make_incld_mdl_paths <- function (outp_smry_ls) 
{
    incld_mdl_paths_chr <- outp_smry_ls$file_paths_chr %>% purrr::map_chr(~{
        file_path_1L_chr <- .x
        mdl_fl_nms_chr <- paste0(outp_smry_ls$mdl_nms_ls %>% 
            purrr::flatten_chr(), ".RDS")
        mdl_fl_nms_locn_ls <- mdl_fl_nms_chr %>% purrr::map(~stringr::str_locate(file_path_1L_chr, 
            .x))
        match_lgl <- mdl_fl_nms_locn_ls %>% purrr::map_lgl(~!(is.na(.x[[1, 
            1]]) | is.na(.x[[1, 2]])))
        if (any(match_lgl)) {
            file_path_1L_chr
        }
        else {
            NA_character_
        }
    })
    incld_mdl_paths_chr <- incld_mdl_paths_chr[!is.na(incld_mdl_paths_chr)]
    ranked_mdl_nms_chr <- outp_smry_ls$mdl_nms_ls %>% purrr::flatten_chr()
    sorted_mdl_nms_chr <- sort(ranked_mdl_nms_chr)
    rank_indcs_int <- purrr::map_int(sorted_mdl_nms_chr, ~which(ranked_mdl_nms_chr == 
        .x))
    incld_mdl_paths_chr <- incld_mdl_paths_chr[order(rank_indcs_int)]
    return(incld_mdl_paths_chr)
}
#' Make independent predictors longitudinal table title
#' @description make_indpnt_predrs_lngl_tbl_title() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make independent predictors longitudinal table title. The function returns Title (a character vector of length one).
#' @param results_ls Results (a list)
#' @param ref_1L_int Reference (an integer vector of length one), Default: 1
#' @return Title (a character vector of length one)
#' @rdname make_indpnt_predrs_lngl_tbl_title
#' @export 
make_indpnt_predrs_lngl_tbl_title <- function (results_ls, ref_1L_int = 1) 
{
    title_1L_chr <- paste0("Estimated coefficients for single predictor longitudinal models using ", 
        results_ls$ttu_lngl_ls$best_mdls_tb[[ref_1L_int, "model_type"]], 
        " (", results_ls$ttu_lngl_ls$best_mdls_tb[[ref_1L_int, 
            "link_and_tfmn_chr"]], ")")
    return(title_1L_chr)
}
#' Make independent predictors longitudinal tables reference
#' @description make_indpnt_predrs_lngl_tbls_ref() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make independent predictors longitudinal tables reference. The function returns Text (a character vector of length one).
#' @param params_ls Parameters (a list)
#' @return Text (a character vector of length one)
#' @rdname make_indpnt_predrs_lngl_tbls_ref
#' @export 
#' @importFrom stringi stri_replace_last
make_indpnt_predrs_lngl_tbls_ref <- function (params_ls) 
{
    results_ls <- params_ls$results_ls
    n_mdls_1L_int <- length(results_ls$ttu_lngl_ls$best_mdls_tb$model_type)
    text_1L_chr <- paste0(ifelse(params_ls$output_type_1L_chr == 
        "Word", "", "Table"), ifelse(n_mdls_1L_int < 3, " \\@ref(tab:cfscl)", 
        paste0("s ", paste0("\\@ref(tab:cfscl", 1:n_mdls_1L_int, 
            ")", collapse = ", ") %>% stringi::stri_replace_last(fixed = ",", 
            " and"))))
    return(text_1L_chr)
}
#' Make inner loop model summary
#' @description make_inner_loop_mdl_smry() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make inner loop model summary. The function returns Models summary (a tibble).
#' @param idx_1L_int Index (an integer vector of length one)
#' @param data_tb Data (a tibble)
#' @param mdl_nms_ls Model names (a list)
#' @param mdl_smry_dir_1L_chr Model summary directory (a character vector of length one)
#' @param mdl_types_lup Model types (a lookup table)
#' @param predictors_lup Predictors (a lookup table)
#' @param predr_vars_nms_ls Predictor variables names (a list)
#' @param backend_1L_chr Backend (a character vector of length one), Default: getOption("brms.backend", "rstan")
#' @param consent_1L_chr Consent (a character vector of length one), Default: ''
#' @param consent_indcs_int Consent indices (an integer vector), Default: 1
#' @param control_ls Control (a list), Default: NULL
#' @param depnt_var_min_val_1L_dbl Dependent variable minimum value (a double vector of length one), Default: numeric(0)
#' @param depnt_var_nm_1L_chr Dependent variable name (a character vector of length one), Default: 'utl_total_w'
#' @param id_var_nm_1L_chr Identity variable name (a character vector of length one), Default: 'fkClientID'
#' @param iters_1L_int Iterations (an integer vector of length one), Default: 4000
#' @param options_chr Options (a character vector), Default: c("Y", "N")
#' @param prior_ls Prior (a list), Default: NULL
#' @param round_var_nm_1L_chr Round variable name (a character vector of length one), Default: 'round'
#' @param round_bl_val_1L_chr Round baseline value (a character vector of length one), Default: 'Baseline'
#' @param seed_1L_int Seed (an integer vector of length one), Default: 1000
#' @param utl_min_val_1L_dbl Utility minimum value (a double vector of length one), Default: -1
#' @return Models summary (a tibble)
#' @rdname make_inner_loop_mdl_smry
#' @export 
#' @importFrom purrr map_dfr
#' @keywords internal
make_inner_loop_mdl_smry <- function (idx_1L_int, data_tb, mdl_nms_ls, mdl_smry_dir_1L_chr, 
    mdl_types_lup, predictors_lup, predr_vars_nms_ls, backend_1L_chr = getOption("brms.backend", 
        "rstan"), consent_1L_chr = "", consent_indcs_int = 1L, 
    control_ls = NULL, depnt_var_min_val_1L_dbl = numeric(0), 
    depnt_var_nm_1L_chr = "utl_total_w", id_var_nm_1L_chr = "fkClientID", 
    iters_1L_int = 4000L, options_chr = c("Y", "N"), prior_ls = NULL, 
    round_var_nm_1L_chr = "round", round_bl_val_1L_chr = "Baseline", 
    seed_1L_int = 1000L, utl_min_val_1L_dbl = -1) 
{
    mdls_smry_tb <- purrr::map_dfr(mdl_nms_ls[[idx_1L_int]], 
        ~{
            smry_ls <- make_smry_of_ts_mdl_outp(backend_1L_chr = backend_1L_chr, 
                consent_1L_chr = consent_1L_chr, consent_indcs_int = consent_indcs_int, 
                control_ls = control_ls, data_tb = data_tb, depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, 
                depnt_var_nm_1L_chr = depnt_var_nm_1L_chr, id_var_nm_1L_chr = id_var_nm_1L_chr, 
                iters_1L_int = iters_1L_int, predr_vars_nms_chr = predr_vars_nms_ls[[idx_1L_int]], 
                mdl_nm_1L_chr = .x, mdl_types_lup = mdl_types_lup, 
                options_chr = options_chr, path_to_write_to_1L_chr = mdl_smry_dir_1L_chr, 
                predictors_lup = predictors_lup, prior_ls = prior_ls, 
                round_bl_val_1L_chr = round_bl_val_1L_chr, round_var_nm_1L_chr = round_var_nm_1L_chr, 
                utl_min_val_1L_dbl = utl_min_val_1L_dbl, seed_1L_int = seed_1L_int)
            Sys.sleep(5)
            smry_ls$smry_of_ts_mdl_tb
        })
    return(mdls_smry_tb)
}
#' Make input parameters
#' @description make_input_params() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make input parameters. The function returns Parameters (a list of lists).
#' @param ds_tb Dataset (a tibble)
#' @param ds_descvs_ls Dataset descriptives (a list)
#' @param header_yaml_args_ls Header yaml arguments (a list)
#' @param maui_params_ls Multi-attribute utility instrument parameters (a list)
#' @param predictors_lup Predictors (a lookup table)
#' @param consent_1L_chr Consent (a character vector of length one), Default: ''
#' @param consent_indcs_int Consent indices (an integer vector), Default: 1
#' @param control_ls Control (a list), Default: NULL
#' @param dv_ds_nm_and_url_chr Dataverse dataset name and url (a character vector), Default: NULL
#' @param iters_1L_int Iterations (an integer vector of length one), Default: 4000
#' @param mdl_smry_ls Model summary (a list), Default: make_mdl_smry_ls()
#' @param options_chr Options (a character vector), Default: c("Y", "N")
#' @param output_format_ls Output format (a list), Default: make_output_format_ls()
#' @param path_params_ls Path parameters (a list), Default: NULL
#' @param prefd_covars_chr Preferred covariates (a character vector), Default: NULL
#' @param prefd_mdl_types_chr Preferred model types (a character vector), Default: NULL
#' @param prior_ls Prior (a list), Default: NULL
#' @param seed_1L_int Seed (an integer vector of length one), Default: 12345
#' @param scndry_anlys_params_ls Secondary analysis parameters (a list), Default: NULL
#' @param write_new_dir_1L_lgl Write new directory (a logical vector of length one), Default: T
#' @return Parameters (a list of lists)
#' @rdname make_input_params
#' @export 
#' @importFrom ready4show make_path_params_ls
make_input_params <- function (ds_tb, ds_descvs_ls, header_yaml_args_ls, maui_params_ls, 
    predictors_lup, consent_1L_chr = "", consent_indcs_int = 1L, 
    control_ls = NULL, dv_ds_nm_and_url_chr = NULL, iters_1L_int = 4000L, 
    mdl_smry_ls = make_mdl_smry_ls(), options_chr = c("Y", "N"), 
    output_format_ls = make_output_format_ls(), path_params_ls = NULL, 
    prefd_covars_chr = NULL, prefd_mdl_types_chr = NULL, prior_ls = NULL, 
    seed_1L_int = 12345, scndry_anlys_params_ls = NULL, write_new_dir_1L_lgl = T) 
{
    path_params_ls <- ready4show::make_path_params_ls(use_fake_data_1L_lgl = ds_descvs_ls$is_fake_1L_lgl, 
        consent_1L_chr = consent_1L_chr, consent_indcs_int = consent_indcs_int, 
        dv_ds_nm_and_url_chr = dv_ds_nm_and_url_chr, options_chr = options_chr, 
        write_new_dir_1L_lgl = write_new_dir_1L_lgl)
    params_ls_ls <- make_analysis_core_params_ls(ds_descvs_ls = ds_descvs_ls, 
        output_format_ls = output_format_ls, predictors_lup = predictors_lup, 
        prefd_covars_chr = prefd_covars_chr, prefd_mdl_types_chr = prefd_mdl_types_chr, 
        mdl_smry_ls = mdl_smry_ls, control_ls = control_ls, iters_1L_int = iters_1L_int, 
        prior_ls = prior_ls, seed_1L_int = seed_1L_int) %>% make_valid_params_ls_ls(ds_tb = ds_tb, 
        maui_params_ls = maui_params_ls, path_params_ls = path_params_ls)
    params_ls_ls$header_yaml_args_ls <- header_yaml_args_ls
    params_ls_ls$output_format_ls <- output_format_ls
    params_ls_ls$scndry_anlys_params_ls <- scndry_anlys_params_ls
    return(params_ls_ls)
}
#' Make knit pars list
#' @description make_knit_pars_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make knit pars list. The function returns Knit pars (a list).
#' @param rltv_path_to_data_dir_1L_chr Relative path to data directory (a character vector of length one)
#' @param mdl_types_chr Model types (a character vector)
#' @param predr_vars_nms_ls Predictor variables names (a list)
#' @param output_type_1L_chr Output type (a character vector of length one), Default: 'HTML'
#' @param mdl_types_lup Model types (a lookup table), Default: NULL
#' @param plt_types_lup Plot types (a lookup table), Default: NULL
#' @param plt_types_chr Plot types (a character vector), Default: 'NA'
#' @param section_type_1L_chr Section type (a character vector of length one), Default: '#'
#' @return Knit pars (a list)
#' @rdname make_knit_pars_ls
#' @export 
#' @importFrom utils data
#' @importFrom purrr pmap map map_chr map_lgl flatten_chr map2
#' @importFrom stringr str_detect
#' @importFrom stats setNames
#' @importFrom ready4 get_from_lup_obj
make_knit_pars_ls <- function (rltv_path_to_data_dir_1L_chr, mdl_types_chr, predr_vars_nms_ls, 
    output_type_1L_chr = "HTML", mdl_types_lup = NULL, plt_types_lup = NULL, 
    plt_types_chr = NA_character_, section_type_1L_chr = "#") 
{
    if (is.null(mdl_types_lup)) 
        utils::data(mdl_types_lup, envir = environment())
    if (is.null(plt_types_lup)) 
        utils::data(plt_types_lup, envir = environment())
    if (is.na(plt_types_chr)) {
        plt_types_chr <- plt_types_lup$short_name_chr
    }
    paths_to_all_data_fls_chr <- list.files(rltv_path_to_data_dir_1L_chr, 
        full.names = T)
    lab_idx_dbl <- 1:(length(mdl_types_chr) * length(predr_vars_nms_ls))
    knit_pars_ls <- purrr::pmap(list(predr_vars_nms_ls, split(lab_idx_dbl, 
        ceiling(seq_along(lab_idx_dbl)/length(mdl_types_chr))), 
        make_mdl_nms_ls(predr_vars_nms_ls, mdl_types_chr = mdl_types_chr)), 
        ~{
            mdl_nms_chr <- ..3
            mdl_data_paths_ls <- mdl_nms_chr %>% purrr::map(~paths_to_all_data_fls_chr[stringr::str_detect(paths_to_all_data_fls_chr, 
                .x)]) %>% stats::setNames(mdl_nms_chr)
            paths_to_mdls_chr <- mdl_data_paths_ls %>% purrr::map_chr(~ifelse(identical(.x[endsWith(.x, 
                ".RDS")], character(0)), NA_character_, .x[endsWith(.x, 
                ".RDS")])) %>% unname()
            paths_to_mdl_plts_ls <- mdl_data_paths_ls %>% purrr::map(~{
                paths_to_all_plots_chr <- .x[endsWith(.x, ".png")]
                plt_types_chr %>% purrr::map(~{
                  sfx_1L_chr <- paste0(.x, ".png")
                  paths_to_all_plots_chr[paths_to_all_plots_chr %>% 
                    purrr::map_lgl(~endsWith(.x, sfx_1L_chr))][paths_to_all_plots_chr[paths_to_all_plots_chr %>% 
                    purrr::map_lgl(~endsWith(.x, sfx_1L_chr))] %>% 
                    nchar() %>% which.min()]
                }) %>% purrr::flatten_chr() %>% unique()
            })
            mdl_tots_chr <- paste0(..1[1], ifelse(is.na(..1[2]), 
                "", paste(" with ", ..1[2])), " ", mdl_types_chr %>% 
                purrr::map_chr(~paste0(ready4::get_from_lup_obj(mdl_types_lup, 
                  match_var_nm_1L_chr = "short_name_chr", match_value_xx = .x, 
                  target_var_nm_1L_chr = "mixed_type_chr", evaluate_1L_lgl = F), 
                  " with ", ready4::get_from_lup_obj(mdl_types_lup, 
                    match_var_nm_1L_chr = "short_name_chr", match_value_xx = .x, 
                    target_var_nm_1L_chr = "with_chr", evaluate_1L_lgl = F))))
            section_tots_chr <- paste0(section_type_1L_chr, " ", 
                mdl_tots_chr)
            plt_nms_ls <- paths_to_mdl_plts_ls %>% purrr::map2(mdl_tots_chr, 
                ~{
                  paths_to_mdl_plts_chr <- .x
                  mdl_tot_1L_chr <- .y
                  transform_1L_lgl <- paths_to_mdl_plts_chr %>% 
                    endsWith("_coefs.png") %>% any()
                  if (paths_to_mdl_plts_chr %>% endsWith("_hetg.png") %>% 
                    any()) 
                    transform_1L_lgl <- F
                  plt_types_chr %>% purrr::map(~{
                    if (endsWith(paths_to_mdl_plts_chr, paste0("_", 
                      .x, ".png")) %>% any()) {
                      paste0(mdl_tot_1L_chr, " ", ifelse(transform_1L_lgl & 
                        .x == "coefs", "population and group level effects", 
                        ready4::get_from_lup_obj(plt_types_lup, 
                          match_var_nm_1L_chr = "short_name_chr", 
                          match_value_xx = .x, target_var_nm_1L_chr = "long_name_chr", 
                          evaluate_1L_lgl = F)))
                    }
                    else {
                      character(0)
                    }
                  }) %>% purrr::flatten_chr()
                })
            list(plt_nms_ls = plt_nms_ls, paths_to_mdls_chr = paths_to_mdls_chr, 
                tbl_captions_chr = mdl_tots_chr, label_stubs_chr = paste0("lab", 
                  ..2), output_type_1L_chr = output_type_1L_chr, 
                section_tots_chr = section_tots_chr, paths_to_mdl_plts_ls = paths_to_mdl_plts_ls)
        }) %>% stats::setNames(predr_vars_nms_ls %>% purrr::map_chr(~paste(.x, 
        collapse = "_")))
    return(knit_pars_ls)
}
#' Make longitudinal transfer to utility algorithm squared text
#' @description make_lngl_ttu_r2_text() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make longitudinal transfer to utility algorithm squared text. The function returns Text (a character vector of length one).
#' @param results_ls Results (a list)
#' @param part_int Part (an integer vector), Default: 1
#' @return Text (a character vector of length one)
#' @rdname make_lngl_ttu_r2_text
#' @export 
#' @importFrom stringi stri_replace_last
#' @importFrom stringr str_squish
#' @importFrom purrr map_dbl pmap_chr
#' @importFrom dplyr filter pull
#' @importFrom rlang sym
#' @keywords internal
make_lngl_ttu_r2_text <- function (results_ls, part_int = 1) 
{
    if (1 %in% part_int) {
        text_1L_chr <- ifelse(length(results_ls$candidate_predrs_chr) == 
            1, "", paste0("In ", ifelse(length(results_ls$ttu_lngl_ls$best_mdls_tb$name_chr %>% 
            unique()) > 1, "", ifelse(nrow(results_ls$ttu_lngl_ls$best_mdls_tb) == 
            2, "both ", "all ")), results_ls$ttu_lngl_ls$best_mdls_tb$model_type %>% 
            paste0(collapse = ", ") %>% stringi::stri_replace_last(fixed = ",", 
            " and"), " models, the prediction models using ", 
            ifelse(length(results_ls$ttu_lngl_ls$best_mdls_tb$name_chr %>% 
                unique()) == 1, results_ls$ttu_lngl_ls$best_mdls_tb$name_chr %>% 
                unique(), results_ls$ttu_lngl_ls$best_mdls_tb$name_chr %>% 
                paste0(collapse = ", ") %>% stringi::stri_replace_last(fixed = ",", 
                " and") %>% paste0(" respectively")), " had the highest R^2^ (", 
            results_ls$ttu_lngl_ls$best_mdls_tb$r2_dbl %>% stringr::str_squish() %>% 
                paste0(collapse = ", ") %>% stringi::stri_replace_last(fixed = ",", 
                " and"), ")"))
    }
    else {
        text_1L_chr <- ""
    }
    if (2 %in% part_int) {
        mdl_types_chr <- results_ls$ttu_lngl_ls$best_mdls_tb$model_type
        mdl_r2_var_nms_chr <- intersect(results_ls$tables_ls$ind_preds_coefs_tbl %>% 
            names(), c("R2_OLS_CLL", "R2_GLM_GSN_LOG"))
        mdl_r2_mins_dbl <- mdl_r2_var_nms_chr %>% purrr::map_dbl(~results_ls$tables_ls$ind_preds_coefs_tbl %>% 
            dplyr::filter(!is.na(!!rlang::sym(.x))) %>% dplyr::pull(!!rlang::sym(.x)) %>% 
            as.numeric() %>% min())
        mdl_r2_maxs_dbl <- mdl_r2_var_nms_chr %>% purrr::map_dbl(~results_ls$tables_ls$ind_preds_coefs_tbl %>% 
            dplyr::filter(!is.na(!!rlang::sym(.x))) %>% dplyr::pull(!!rlang::sym(.x)) %>% 
            as.numeric() %>% max())
        part_2_main_1L_chr <- list(mdl_types_chr, mdl_r2_mins_dbl, 
            mdl_r2_maxs_dbl, 1:length(mdl_types_chr)) %>% purrr::pmap_chr(~paste0(ifelse(..4 == 
            1, "R^2^ was ", ""), ifelse(length(results_ls$candidate_predrs_chr) == 
            1, paste0(, ..2, " for the "), paste0(ifelse(..2 == 
            ..3, paste0("", ..2), paste0("between ", ..2, " and ", 
            ..3, " for all ")))), ..1, ifelse(length(results_ls$candidate_predrs_chr) == 
            1, paste0(""), paste0("s")))) %>% paste0(collapse = ", ") %>% 
            stringi::stri_replace_last(fixed = ",", " and")
        text_1L_chr <- paste0(text_1L_chr, ifelse(1 %in% part_int, 
            ". ", ""), part_2_main_1L_chr, ifelse(part_2_main_1L_chr == 
            "", "", "."))
    }
    return(text_1L_chr)
}
#' Make longitudinal transfer to utility algorithm with covariates text
#' @description make_lngl_ttu_with_covars_text() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make longitudinal transfer to utility algorithm with covariates text. The function returns Text (a character vector of length one).
#' @param results_ls Results (a list)
#' @return Text (a character vector of length one)
#' @rdname make_lngl_ttu_with_covars_text
#' @export 
#' @importFrom stringi stri_replace_last
#' @keywords internal
make_lngl_ttu_with_covars_text <- function (results_ls) 
{
    text_1L_chr <- ifelse((is.na(results_ls$ttu_lngl_ls$incld_covars_chr[1]) | 
        length(results_ls$ttu_lngl_ls$incld_covars_chr) == 0), 
        "", paste0("We also evaluated models with ", results_ls$ttu_lngl_ls$incld_covars_chr %>% 
            paste0(collapse = ", ") %>% stringi::stri_replace_last(fixed = ",", 
            " and") %>% paste0(" at baseline"), " and ", results_ls$ttu_lngl_ls$incld_covars_chr %>% 
            paste0(collapse = ", ") %>% stringi::stri_replace_last(fixed = ",", 
            " and") %>% paste0(" change from baseline"), " added to ", 
            names(results_ls$study_descs_ls$predr_ctgs_ls) %>% 
                tolower() %>% paste0(collapse = ", ") %>% stringi::stri_replace_last(fixed = ",", 
                " and"), " predictors"))
    return(text_1L_chr)
}
#' Make multi-attribute utility instrument parameters list
#' @description make_maui_params_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make multi-attribute utility instrument parameters list. The function returns Multi-attribute utility instrument parameters (a list).
#' @param maui_itm_short_nms_chr Multi-attribute utility instrument item short names (a character vector)
#' @param maui_domains_pfxs_1L_chr Multi-attribute utility instrument domains prefixes (a character vector of length one), Default: NULL
#' @param maui_scoring_fn Multi-attribute utility instrument scoring (a function), Default: NULL
#' @param short_and_long_nm PARAM_DESCRIPTION, Default: NULL
#' @param utl_min_val_1L_dbl Utility minimum value (a double vector of length one), Default: -1
#' @return Multi-attribute utility instrument parameters (a list)
#' @rdname make_maui_params_ls
#' @export 
#' @importFrom dplyr mutate across starts_with filter
#' @importFrom rlang sym
make_maui_params_ls <- function (maui_itm_short_nms_chr, maui_domains_pfxs_1L_chr = NULL, 
    maui_scoring_fn = NULL, short_and_long_nm = NULL, utl_min_val_1L_dbl = -1) 
{
    if (is.null(maui_scoring_fn)) {
        maui_scoring_fn <- function(data_tb, maui_item_pfx_1L_chr, 
            id_var_nm_1L_chr, utl_wtd_var_nm_1L_chr, utl_unwtd_var_nm_1L_chr) {
            data_tb %>% dplyr::mutate(`:=`(!!rlang::sym(utl_unwtd_var_nm_1L_chr), 
                rowSums(dplyr::across(dplyr::starts_with(maui_item_pfx_1L_chr))))) %>% 
                dplyr::filter(!is.na(!!rlang::sym(utl_unwtd_var_nm_1L_chr)))
        }
    }
    maui_params_ls <- list(maui_domains_pfxs_1L_chr = maui_domains_pfxs_1L_chr, 
        maui_itm_short_nms_chr = maui_itm_short_nms_chr, maui_scoring_fn = maui_scoring_fn, 
        short_and_long_nm = short_and_long_nm, utl_min_val_1L_dbl = utl_min_val_1L_dbl)
    return(maui_params_ls)
}
#' Make model
#' @description make_mdl() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make model. The function returns Model (a model).
#' @param data_tb Data (a tibble)
#' @param depnt_var_min_val_1L_dbl Dependent variable minimum value (a double vector of length one), Default: numeric(0)
#' @param depnt_var_nm_1L_chr Dependent variable name (a character vector of length one), Default: 'utl_total_w'
#' @param tfmn_1L_chr Transformation (a character vector of length one), Default: 'NTF'
#' @param predr_var_nm_1L_chr Predictor variable name (a character vector of length one)
#' @param covar_var_nms_chr Covariate variable names (a character vector), Default: 'NA'
#' @param mdl_type_1L_chr Model type (a character vector of length one), Default: 'OLS_NTF'
#' @param mdl_types_lup Model types (a lookup table), Default: NULL
#' @param control_1L_chr Control (a character vector of length one), Default: 'NA'
#' @param start_1L_chr Start (a character vector of length one), Default: NULL
#' @return Model (a model)
#' @rdname make_mdl
#' @export 
#' @importFrom utils data
#' @importFrom ready4 get_from_lup_obj
#' @importFrom stringi stri_locate_last_fixed
#' @importFrom stringr str_sub
make_mdl <- function (data_tb, depnt_var_min_val_1L_dbl = numeric(0), depnt_var_nm_1L_chr = "utl_total_w", 
    tfmn_1L_chr = "NTF", predr_var_nm_1L_chr, covar_var_nms_chr = NA_character_, 
    mdl_type_1L_chr = "OLS_NTF", mdl_types_lup = NULL, control_1L_chr = NA_character_, 
    start_1L_chr = NULL) 
{
    if (is.null(mdl_types_lup)) 
        utils::data("mdl_types_lup", envir = environment())
    data_tb <- transform_ds_for_mdlng(data_tb, depnt_var_nm_1L_chr = depnt_var_nm_1L_chr, 
        depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, 
        predr_var_nm_1L_chr = predr_var_nm_1L_chr, covar_var_nms_chr = covar_var_nms_chr)
    if (is.null(start_1L_chr)) {
        start_1L_chr <- ready4::get_from_lup_obj(mdl_types_lup, 
            match_var_nm_1L_chr = "short_name_chr", match_value_xx = mdl_type_1L_chr, 
            target_var_nm_1L_chr = "start_chr", evaluate_1L_lgl = F)
    }
    if (!is.na(control_1L_chr)) {
        idx_1L_int <- 1 + stringi::stri_locate_last_fixed(mdl_type_1L_chr, 
            "_")[1, 1] %>% as.vector()
        link_1L_chr <- get_link_from_tfmn(stringr::str_sub(mdl_type_1L_chr, 
            start = idx_1L_int))
    }
    mdl_1L_chr <- paste0(ready4::get_from_lup_obj(mdl_types_lup, 
        match_var_nm_1L_chr = "short_name_chr", match_value_xx = mdl_type_1L_chr, 
        target_var_nm_1L_chr = "fn_chr", evaluate_1L_lgl = F), 
        "(", transform_depnt_var_nm(depnt_var_nm_1L_chr, tfmn_1L_chr = tfmn_1L_chr), 
        " ~ ", predr_var_nm_1L_chr, ifelse(is.na(covar_var_nms_chr[1]), 
            "", paste0(" + ", paste0(covar_var_nms_chr, collapse = " + "))), 
        ", data = data_tb", ifelse(!is.na(ready4::get_from_lup_obj(mdl_types_lup, 
            match_var_nm_1L_chr = "short_name_chr", match_value_xx = mdl_type_1L_chr, 
            target_var_nm_1L_chr = "family_chr", evaluate_1L_lgl = F)), 
            paste0(", family = ", ready4::get_from_lup_obj(mdl_types_lup, 
                match_var_nm_1L_chr = "short_name_chr", match_value_xx = mdl_type_1L_chr, 
                target_var_nm_1L_chr = "family_chr", evaluate_1L_lgl = F)), 
            ""), ifelse((!is.na(start_1L_chr) | (is.na(start_1L_chr) & 
            !is.na(control_1L_chr))), ", ", ""), ifelse(!is.na(control_1L_chr), 
            paste0("link=\"", link_1L_chr, "\",control=", control_1L_chr, 
                "("), ""), ifelse(!is.na(start_1L_chr), paste0("start=c(", 
            start_1L_chr, ")"), ""), ifelse(!is.na(control_1L_chr), 
            ")", ""), ")")
    model_mdl <- eval(parse(text = mdl_1L_chr))
    return(model_mdl)
}
#' Make model coefficient range text
#' @description make_mdl_coef_range_text() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make model coefficient range text. The function returns Coefficient range text (a character vector).
#' @param coef_ratios_dbl Coefficient ratios (a double vector)
#' @param nbr_of_digits_1L_int Number of digits (an integer vector of length one), Default: 2
#' @return Coefficient range text (a character vector)
#' @rdname make_mdl_coef_range_text
#' @export 
make_mdl_coef_range_text <- function (coef_ratios_dbl, nbr_of_digits_1L_int = 2L) 
{
    if (length(coef_ratios_dbl) == 1) {
        coef_range_text_chr <- as.character(round(coef_ratios_dbl, 
            nbr_of_digits_1L_int))
    }
    else {
        min_1L_dbl <- round(min(coef_ratios_dbl), nbr_of_digits_1L_int)
        max_1L_dbl <- round(max(coef_ratios_dbl), nbr_of_digits_1L_int)
        coef_range_text_chr <- paste0("between ", min_1L_dbl, 
            " and ", max_1L_dbl)
    }
    return(coef_range_text_chr)
}
#' Make model coefficient ratio list
#' @description make_mdl_coef_ratio_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make model coefficient ratio list. The function returns Model coefficient ratios (a list).
#' @param mdl_ingredients_ls Model ingredients (a list)
#' @param predr_ctgs_ls Predictor categories (a list), Default: NULL
#' @return Model coefficient ratios (a list)
#' @rdname make_mdl_coef_ratio_ls
#' @export 
#' @importFrom purrr map_chr map map2 map_dbl
#' @importFrom dplyr filter pull
#' @importFrom stats setNames
#' @keywords internal
make_mdl_coef_ratio_ls <- function (mdl_ingredients_ls, predr_ctgs_ls = NULL) 
{
    predrs_chr <- mdl_ingredients_ls$predictors_lup$short_name_chr
    mdl_type_chr <- mdl_ingredients_ls$mdls_smry_tb$Model %>% 
        unique() %>% purrr::map_chr(~get_mdl_type_from_nm(.x, 
        mdl_types_lup = mdl_ingredients_ls$mdl_types_lup)) %>% 
        unique()
    main_mdls_ls <- predrs_chr %>% purrr::map(~paste0(paste0(.x, 
        "_1_"), mdl_type_chr))
    ratios_ls <- main_mdls_ls %>% purrr::map2(predrs_chr, ~{
        mdls_chr <- .x
        predr_1L_chr <- .y
        mdls_chr %>% purrr::map_dbl(~{
            coefs_dbl <- mdl_ingredients_ls$mdls_smry_tb %>% 
                dplyr::filter(Model %in% .x) %>% dplyr::filter(Parameter %in% 
                paste0(predr_1L_chr, (c(" baseline", " scaled", 
                  " unscaled", " change")))) %>% dplyr::pull(Estimate)
            coefs_dbl[2]/coefs_dbl[1]
        })
    }) %>% stats::setNames(predrs_chr)
    mdl_coef_ratios_ls = list(mean_ratios_dbl = ratios_ls %>% 
        purrr::map_dbl(~mean(.x)))
    if (!is.null(predr_ctgs_ls)) {
        append_ls <- purrr::map(predr_ctgs_ls, ~mdl_coef_ratios_ls$mean_ratios_dbl[predrs_chr %in% 
            .x]) %>% stats::setNames(names(predr_ctgs_ls))
        mdl_coef_ratios_ls <- append(mdl_coef_ratios_ls, append_ls)
    }
    return(mdl_coef_ratios_ls)
}
#' Make model description lines
#' @description make_mdl_desc_lines() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make model description lines. The function returns Model description lines (a character vector).
#' @param outp_smry_ls Output summary (a list)
#' @param mdl_nm_1L_chr Model name (a character vector of length one)
#' @param output_type_1L_chr Output type (a character vector of length one), Default: 'PDF'
#' @return Model description lines (a character vector)
#' @rdname make_mdl_desc_lines
#' @export 
#' @importFrom dplyr filter
#' @importFrom purrr map_chr
#' @importFrom stringr str_remove
#' @importFrom ready4 get_from_lup_obj
make_mdl_desc_lines <- function (outp_smry_ls, mdl_nm_1L_chr, output_type_1L_chr = "PDF") 
{
    mdl_smry_tb <- outp_smry_ls$mdls_smry_tb %>% dplyr::filter(Model == 
        mdl_nm_1L_chr)
    predictors_chr <- mdl_smry_tb$Parameter[!mdl_smry_tb$Parameter %in% 
        c("SD (Intercept)", "Intercept", "R2", "RMSE", "Sigma")] %>% 
        purrr::map_chr(~stringr::str_remove(.x, " baseline") %>% 
            stringr::str_remove(" change") %>% stringr::str_remove(" scaled") %>% 
            stringr::str_remove(" unscaled")) %>% unique()
    predictors_desc_chr <- predictors_chr %>% purrr::map_chr(~{
        scaling_1L_dbl <- ready4::get_from_lup_obj(outp_smry_ls$predictors_lup, 
            match_value_xx = .x, match_var_nm_1L_chr = "short_name_chr", 
            target_var_nm_1L_chr = "mdl_scaling_dbl", evaluate_1L_lgl = F)
        paste0(.x, " (", ready4::get_from_lup_obj(outp_smry_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), 
            ifelse(scaling_1L_dbl == 1, "", paste0(" (multiplied by ", 
                scaling_1L_dbl, ")")), ")")
    })
    if (length(predictors_desc_chr) > 1) 
        predictors_desc_chr <- paste0(c(paste0("\n - ", predictors_desc_chr[-length(predictors_desc_chr)], 
            collapse = ";"), paste0("\n - ", predictors_desc_chr[length(predictors_desc_chr)])), 
            collapse = "; and")
    mdl_desc_lines_chr <- paste0(paste0("This model predicts values at two timepoints for ", 
        ready4::get_from_lup_obj(outp_smry_ls$dictionary_tb, 
            match_value_xx = outp_smry_ls$depnt_var_nm_1L_chr, 
            match_var_nm_1L_chr = "var_nm_chr", target_var_nm_1L_chr = "var_desc_chr", 
            evaluate_1L_lgl = F), ". The predictor variables are ", 
        "baseline values and subsequent changes in ", collapse = ""), 
        predictors_desc_chr, ". ", "The catalogue reference for this model is ", 
        ifelse(output_type_1L_chr == "PDF", paste0("\\texttt{\\detokenize{", 
            mdl_nm_1L_chr, "}}"), mdl_nm_1L_chr), ".")
    return(mdl_desc_lines_chr)
}
#' Make model names list
#' @description make_mdl_nms_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make model names list. The function returns Model names (a list).
#' @param predr_vars_nms_ls Predictor variables names (a list)
#' @param mdl_types_chr Model types (a character vector)
#' @return Model names (a list)
#' @rdname make_mdl_nms_ls
#' @export 
#' @importFrom purrr map2
#' @keywords internal
make_mdl_nms_ls <- function (predr_vars_nms_ls, mdl_types_chr) 
{
    mdl_nms_ls <- purrr::map2(predr_vars_nms_ls, make_unique_ls_elmt_idx_int(predr_vars_nms_ls), 
        ~paste0(.x[1], "_", ifelse(is.na(.x[2]), "", paste0(.x[2], 
            "_")), .y, "_", mdl_types_chr))
    return(mdl_nms_ls)
}
#' Make model summary element table
#' @description make_mdl_smry_elmt_tbl() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make model summary element table. The function returns Model element sum (a tibble).
#' @param mat Matrix (a matrix)
#' @param ctg_chr Category (a character vector)
#' @return Model element sum (a tibble)
#' @rdname make_mdl_smry_elmt_tbl
#' @export 
#' @importFrom tibble as_tibble add_case
#' @importFrom dplyr mutate select everything filter bind_rows
#' @keywords internal
make_mdl_smry_elmt_tbl <- function (mat, ctg_chr) 
{
    tb <- mat %>% tibble::as_tibble() %>% dplyr::mutate(Parameter = rownames(mat)) %>% 
        dplyr::select(Parameter, dplyr::everything())
    mdl_elmt_sum_tb <- tb %>% dplyr::filter(F) %>% tibble::add_case(Parameter = ctg_chr) %>% 
        dplyr::bind_rows(tb)
    return(mdl_elmt_sum_tb)
}
#' Make model summary list
#' @description make_mdl_smry_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make model summary list. The function returns Model summary (a list).
#' @param mdl_types_lup Model types (a lookup table), Default: get_cndts_for_mxd_mdls()
#' @param mdl_types_chr Model types (a character vector), Default: NULL
#' @param choose_from_pfx_chr Choose from prefix (a character vector), Default: NULL
#' @param folds_1L_int Folds (an integer vector of length one), Default: 10
#' @param max_nbr_of_boruta_mdl_runs_int Maximum number of boruta model runs (an integer vector), Default: 300
#' @return Model summary (a list)
#' @rdname make_mdl_smry_ls
#' @export 
#' @importFrom stringr word
#' @keywords internal
make_mdl_smry_ls <- function (mdl_types_lup = get_cndts_for_mxd_mdls(), mdl_types_chr = NULL, 
    choose_from_pfx_chr = NULL, folds_1L_int = 10L, max_nbr_of_boruta_mdl_runs_int = 300L) 
{
    if (is.null(mdl_types_lup)) 
        data("mdl_types_lup", package = "specific", envir = environment())
    if (is.null(mdl_types_chr)) 
        mdl_types_chr <- mdl_types_lup$short_name_chr
    if (is.null(choose_from_pfx_chr)) 
        choose_from_pfx_chr <- stringr::word(mdl_types_lup$short_name_chr, 
            1, sep = "\\_") %>% unique()
    mdl_smry_ls <- list(mdl_types_lup = mdl_types_lup, mdl_types_chr = mdl_types_chr, 
        choose_from_pfx_chr = choose_from_pfx_chr, folds_1L_int = folds_1L_int, 
        max_nbr_of_boruta_mdl_runs_int = max_nbr_of_boruta_mdl_runs_int)
    return(mdl_smry_ls)
}
#' Make model type summary table
#' @description make_mdl_type_smry_tbl() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make model type summary table. The function returns Model type summary table (a tibble).
#' @param mdls_tb Models (a tibble)
#' @param mdl_nms_chr Model names (a character vector)
#' @param mdl_type_1L_chr Model type (a character vector of length one)
#' @param add_mdl_nm_sfx_1L_lgl Add model name suffix (a logical vector of length one), Default: T
#' @return Model type summary table (a tibble)
#' @rdname make_mdl_type_smry_tbl
#' @export 
#' @importFrom purrr map_dfr
#' @keywords internal
make_mdl_type_smry_tbl <- function (mdls_tb, mdl_nms_chr, mdl_type_1L_chr, add_mdl_nm_sfx_1L_lgl = T) 
{
    mdl_type_smry_tbl_tb <- mdl_nms_chr %>% purrr::map_dfr(~make_sngl_mdl_smry_tb(mdls_tb, 
        mdl_nm_1L_chr = .x, mdl_type_1L_chr = mdl_type_1L_chr, 
        add_mdl_nm_sfx_1L_lgl = add_mdl_nm_sfx_1L_lgl))
    return(mdl_type_smry_tbl_tb)
}
#' Make models list
#' @description make_mdls_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make models list. The function returns Models (a list).
#' @param outp_smry_ls Output summary (a list)
#' @param mdls_tb Models (a tibble)
#' @return Models (a list)
#' @rdname make_mdls_ls
#' @export 
#' @importFrom purrr map
#' @keywords internal
make_mdls_ls <- function (outp_smry_ls, mdls_tb) 
{
    mdls_chr <- mdls_tb$Model %>% unique()
    mdls_ls <- outp_smry_ls$prefd_mdl_types_chr %>% purrr::map(~mdls_chr[mdls_chr %>% 
        endsWith(.x)])
    return(mdls_ls)
}
#' Make models summary tables list
#' @description make_mdls_smry_tbls_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make models summary tables list. The function returns Models summary tables (a list).
#' @param outp_smry_ls Output summary (a list)
#' @param nbr_of_digits_1L_int Number of digits (an integer vector of length one), Default: 2
#' @return Models summary tables (a list)
#' @rdname make_mdls_smry_tbls_ls
#' @export 
#' @importFrom dplyr mutate across filter pull
#' @importFrom purrr map flatten_chr map_chr map_dfr map_lgl pluck
#' @keywords internal
make_mdls_smry_tbls_ls <- function (outp_smry_ls, nbr_of_digits_1L_int = 2L) 
{
    mdls_smry_tb <- outp_smry_ls$mdls_smry_tb %>% dplyr::mutate(dplyr::across(c("Estimate", 
        "SE"), ~round(.x, nbr_of_digits_1L_int) %>% format(nsmall = nbr_of_digits_1L_int))) %>% 
        dplyr::mutate(`95% CI` = `95% CI` %>% transform_chr_digit_pairs(nbr_of_digits_1L_int = nbr_of_digits_1L_int))
    rownames(mdls_smry_tb) <- NULL
    indpt_predrs_mdls_tb <- mdls_smry_tb %>% dplyr::filter(Model %in% 
        (paste0(outp_smry_ls$predr_cmprsn_tb$predr_chr, "_1_") %>% 
            purrr::map(~paste0(.x, outp_smry_ls$prefd_mdl_types_chr)) %>% 
            purrr::flatten_chr()))
    covar_mdls_tb <- mdls_smry_tb %>% dplyr::filter(!Model %in% 
        indpt_predrs_mdls_tb$Model)
    mdl_types_chr <- indpt_predrs_mdls_tb$Model %>% purrr::map_chr(~get_mdl_type_from_nm(.x, 
        mdl_types_lup = outp_smry_ls$mdl_types_lup)) %>% unique()
    prefd_predr_mdl_smry_tb <- mdl_types_chr %>% purrr::map_dfr(~{
        mdl_type_1L_chr <- .x
        mdl_type_smry_tb <- indpt_predrs_mdls_tb %>% dplyr::filter(Model %>% 
            purrr::map_lgl(~endsWith(.x, mdl_type_1L_chr)))
        max_r2_dbl <- mdl_type_smry_tb %>% dplyr::filter(Parameter == 
            "R2") %>% dplyr::pull(Estimate) %>% as.numeric() %>% 
            abs() %>% max()
        prefd_mdl_1L_chr <- mdl_type_smry_tb %>% dplyr::filter(Parameter == 
            "R2") %>% dplyr::filter(as.numeric(Estimate) == max_r2_dbl) %>% 
            dplyr::pull(Model) %>% purrr::pluck(1)
        mdl_type_smry_tb %>% dplyr::filter(Model == prefd_mdl_1L_chr)
    })
    mdls_smry_tbls_ls <- list(indpt_predrs_mdls_tb = indpt_predrs_mdls_tb, 
        covar_mdls_tb = covar_mdls_tb, prefd_predr_mdl_smry_tb = prefd_predr_mdl_smry_tb)
    return(mdls_smry_tbls_ls)
}
#' Make manuscript summary tables list
#' @description make_ms_smry_tbls_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make manuscript summary tables list. The function returns Manuscript summary tables (a list).
#' @param outp_smry_ls Output summary (a list)
#' @param mdls_smry_tbls_ls Models summary tables (a list)
#' @param covars_mdls_ls Covariates models (a list)
#' @param descv_tbls_ls Descriptive tables (a list)
#' @param nbr_of_digits_1L_int Number of digits (an integer vector of length one), Default: 2
#' @return Manuscript summary tables (a list)
#' @rdname make_ms_smry_tbls_ls
#' @export 
#' @importFrom purrr map map_chr map_dbl
#' @importFrom stats setNames
#' @importFrom tibble as_tibble
#' @importFrom dplyr mutate across everything
#' @importFrom stringr str_replace_all
#' @keywords internal
make_ms_smry_tbls_ls <- function (outp_smry_ls, mdls_smry_tbls_ls, covars_mdls_ls, descv_tbls_ls, 
    nbr_of_digits_1L_int = 2L) 
{
    mdl_types_tables_ls <- purrr::map(1:length(outp_smry_ls$prefd_mdl_types_chr), 
        ~make_mdl_type_smry_tbl(mdls_tb = mdls_smry_tbls_ls$covar_mdls_tb, 
            mdl_nms_chr = covars_mdls_ls[[.x]], mdl_type_1L_chr = outp_smry_ls$prefd_mdl_types_chr[.x], 
            add_mdl_nm_sfx_1L_lgl = F)) %>% stats::setNames(1:length(outp_smry_ls$prefd_mdl_types_chr) %>% 
        purrr::map_chr(~paste0("mdl_type_", .x, "_covar_mdls_tb")))
    ms_smry_tbls_ls <- append(mdl_types_tables_ls, list(ind_preds_coefs_tbl = make_all_mdl_types_smry_tbl(outp_smry_ls, 
        mdls_tb = mdls_smry_tbls_ls$indpt_predrs_mdls_tb), participant_descs = descv_tbls_ls$cohort_desc_tb, 
        predd_dist_and_cors = descv_tbls_ls$predr_pars_and_cors_tb, 
        tenf_prefd_mdl_tb = outp_smry_ls[["smry_of_mdl_sngl_predrs_tb"]] %>% 
            tibble::as_tibble() %>% dplyr::mutate(dplyr::across(where(is.numeric), 
            ~.x %>% purrr::map_dbl(~min(max(.x, -1.1), 1.1)))) %>% 
            transform_tbl_to_rnd_vars(nbr_of_digits_1L_int = nbr_of_digits_1L_int) %>% 
            dplyr::mutate(dplyr::across(.cols = dplyr::everything(), 
                ~.x %>% stringr::str_replace_all("-1.10", "< -1.00") %>% 
                  stringr::str_replace_all("1.10", "> 1.00"))), 
        tenf_sngl_predr_tb = make_tfd_sngl_predr_mdls_tb(outp_smry_ls, 
            nbr_of_digits_1L_int = nbr_of_digits_1L_int)))
    return(ms_smry_tbls_ls)
}
#' Make number at follow-up text
#' @description make_nbr_at_fup_text() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make number at follow-up text. The function returns Number at follow-up (a character vector of length one).
#' @param results_ls Results (a list)
#' @return Number at follow-up (a character vector of length one)
#' @rdname make_nbr_at_fup_text
#' @export 
make_nbr_at_fup_text <- function (results_ls) 
{
    nbr_at_fup_1L_chr <- paste0("There were ", results_ls$cohort_ls$n_fup_1L_dbl, 
        " participants (", (results_ls$cohort_ls$n_fup_1L_dbl/results_ls$cohort_ls$n_inc_1L_dbl * 
            100) %>% round(1), "%) who completed ", results_ls$study_descs_ls$health_utl_nm_1L_chr, 
        " questions at the follow-up survey ", results_ls$study_descs_ls$time_btwn_bl_and_fup_1L_chr, 
        " after baseline assessment.")
    return(nbr_at_fup_1L_chr)
}
#' Make number included text
#' @description make_nbr_included_text() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make number included text. The function is called for its side effects and does not return a value.
#' @param results_ls Results (a list)
#' @return NULL
#' @rdname make_nbr_included_text
#' @export 
make_nbr_included_text <- function (results_ls) 
{
    paste0(ifelse(results_ls$cohort_ls$n_inc_1L_dbl == results_ls$cohort_ls$n_all_1l_dbl, 
        "all ", paste0(results_ls$cohort_ls$n_inc_1L_dbl, " out of the ")), 
        results_ls$cohort_ls$n_all_1l_dbl, " participants with complete ", 
        results_ls$study_descs_ls$health_utl_nm_1L_chr, " data")
}
#' Make paths to manuscript summary plots list
#' @description make_paths_to_ms_smry_plts_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make paths to manuscript summary plots list. The function returns Paths to manuscript summary plots (a list).
#' @param output_data_dir_1L_chr Output data directory (a character vector of length one)
#' @param outp_smry_ls Output summary (a list)
#' @param additional_paths_chr Additional paths (a character vector), Default: '/dens_and_sctr.png'
#' @return Paths to manuscript summary plots (a list)
#' @rdname make_paths_to_ms_smry_plts_ls
#' @export 
#' @importFrom purrr map_lgl
#' @importFrom stringr str_detect
#' @keywords internal
make_paths_to_ms_smry_plts_ls <- function (output_data_dir_1L_chr, outp_smry_ls, additional_paths_chr = "/dens_and_sctr.png") 
{
    paths_to_ms_smry_plts_ls = list(combined_utl = paste0(output_data_dir_1L_chr, 
        "/_Descriptives/combined_utl.png"), composite = paste0(output_data_dir_1L_chr, 
        additional_paths_chr[1]), items = paste0(output_data_dir_1L_chr, 
        "/_Descriptives/qstn_rspns.png"), density = paste0(output_data_dir_1L_chr, 
        "/", outp_smry_ls$file_paths_chr[outp_smry_ls$file_paths_chr %>% 
            purrr::map_lgl(~stringr::str_detect(.x, "A_TFMN_CMPRSN_DNSTY"))]), 
        importance = paste0(output_data_dir_1L_chr, "/", outp_smry_ls$file_paths_chr[outp_smry_ls$file_paths_chr %>% 
            purrr::map_lgl(~stringr::str_detect(.x, "B_PRED_CMPRSN_BORUTA_VAR_IMP"))]))
    return(paths_to_ms_smry_plts_ls)
}
#' Make plot function and arguments list
#' @description make_plot_fn_and_args_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make plot function and arguments list. The function returns Plot function and arguments (a list).
#' @param type_1L_chr Type (a character vector of length one)
#' @param depnt_var_desc_1L_chr Dependent variable description (a character vector of length one)
#' @param args_ls Arguments (a list), Default: NULL
#' @param base_size_1L_dbl Base size (a double vector of length one), Default: 11
#' @param brms_mdl Bayesian regression models (a model), Default: NULL
#' @param correspondences_lup Correspondences (a lookup table), Default: NULL
#' @param depnt_var_nm_1L_chr Dependent variable name (a character vector of length one), Default: NULL
#' @param new_var_nm_1L_chr New variable name (a character vector of length one), Default: 'NA'
#' @param predn_type_1L_chr Prediction type (a character vector of length one), Default: NULL
#' @param round_var_nm_1L_chr Round variable name (a character vector of length one), Default: NULL
#' @param sd_dbl Standard deviation (a double vector), Default: NA
#' @param seed_1L_dbl Seed (a double vector of length one), Default: 23456
#' @param sfx_1L_chr Suffix (a character vector of length one), Default: ' from table'
#' @param table_predn_mdl Table prediction (a model), Default: NULL
#' @param tfmn_1L_chr Transformation (a character vector of length one), Default: 'NTF'
#' @param tfd_data_tb Transformed data (a tibble), Default: NULL
#' @param utl_min_val_1L_dbl Utility minimum value (a double vector of length one), Default: -1
#' @param x_lbl_1L_chr X label (a character vector of length one), Default: 'NA'
#' @param y_lbl_1L_chr Y label (a character vector of length one), Default: 'NA'
#' @return Plot function and arguments (a list)
#' @rdname make_plot_fn_and_args_ls
#' @export 
#' @keywords internal
make_plot_fn_and_args_ls <- function (type_1L_chr, depnt_var_desc_1L_chr, args_ls = NULL, 
    base_size_1L_dbl = 11, brms_mdl = NULL, correspondences_lup = NULL, 
    depnt_var_nm_1L_chr = NULL, new_var_nm_1L_chr = NA_character_, 
    predn_type_1L_chr = NULL, round_var_nm_1L_chr = NULL, sd_dbl = NA_real_, 
    seed_1L_dbl = 23456, sfx_1L_chr = " from table", table_predn_mdl = NULL, 
    tfmn_1L_chr = "NTF", tfd_data_tb = NULL, utl_min_val_1L_dbl = -1, 
    x_lbl_1L_chr = NA_character_, y_lbl_1L_chr = NA_character_) 
{
    if (!is.null(brms_mdl)) {
        set.seed(seed_1L_dbl)
        tfd_data_tb <- transform_ds_for_all_cmprsn_plts(tfd_data_tb = tfd_data_tb, 
            model_mdl = brms_mdl, depnt_var_nm_1L_chr = depnt_var_nm_1L_chr, 
            is_brms_mdl_1L_lgl = inherits(brms_mdl, "brmsfit"), 
            predn_type_1L_chr = predn_type_1L_chr, sd_dbl = NA_real_, 
            sfx_1L_chr = ifelse(is.null(table_predn_mdl), " from brmsfit", 
                sfx_1L_chr), tfmn_1L_chr = tfmn_1L_chr, utl_min_val_1L_dbl = utl_min_val_1L_dbl)
        if (!is.null(table_predn_mdl)) {
            tfd_data_tb <- transform_ds_for_all_cmprsn_plts(tfd_data_tb = tfd_data_tb, 
                model_mdl = table_predn_mdl, depnt_var_nm_1L_chr = depnt_var_nm_1L_chr, 
                is_brms_mdl_1L_lgl = F, predn_type_1L_chr = predn_type_1L_chr, 
                sd_dbl = sd_dbl, sfx_1L_chr = ifelse(!is.null(brms_mdl), 
                  " from table", sfx_1L_chr), tfmn_1L_chr = tfmn_1L_chr, 
                utl_min_val_1L_dbl = utl_min_val_1L_dbl)
        }
    }
    ref_idx_1L_int <- which(type_1L_chr == c("coefs", "hetg", 
        "dnst", "sctr_plt", "sim_dnst", "sim_sctr", "cnstrd_dnst", 
        "cnstrd_sctr_plt", "cnstrd_sim_dnst", "cnstrd_sim_sctr"))
    if (ref_idx_1L_int %in% c(3, 5, 7, 9)) {
        plt_fn <- plot_obsd_predd_dnst
        fn_args_ls <- list(tfd_data_tb = tfd_data_tb, base_size_1L_dbl = base_size_1L_dbl, 
            depnt_var_nm_1L_chr = depnt_var_nm_1L_chr, depnt_var_desc_1L_chr = depnt_var_desc_1L_chr, 
            new_var_nm_1L_chr = new_var_nm_1L_chr, predd_val_var_nm_1L_chr = ifelse(ref_idx_1L_int %in% 
                c(3, 7), transform_predd_var_nm("Predicted", 
                sfx_1L_chr = ifelse(!is.null(table_predn_mdl), 
                  " from brmsfit", sfx_1L_chr), utl_min_val_1L_dbl = ifelse(ref_idx_1L_int == 
                  3, NA_real_, utl_min_val_1L_dbl)), transform_predd_var_nm("Simulated", 
                sfx_1L_chr = ifelse(!is.null(table_predn_mdl), 
                  " from brmsfit", sfx_1L_chr), utl_min_val_1L_dbl = ifelse(ref_idx_1L_int == 
                  5, NA_real_, utl_min_val_1L_dbl))), cmprsn_predd_var_nm_1L_chr = ifelse(is.null(table_predn_mdl), 
                NA_character_, ifelse(ref_idx_1L_int %in% c(3, 
                  7), transform_predd_var_nm("Predicted", sfx_1L_chr = " from table", 
                  utl_min_val_1L_dbl = ifelse(ref_idx_1L_int == 
                    3, NA_real_, utl_min_val_1L_dbl)), transform_predd_var_nm("Simulated", 
                  sfx_1L_chr = " from table", utl_min_val_1L_dbl = ifelse(ref_idx_1L_int == 
                    5, NA_real_, utl_min_val_1L_dbl)))))
    }
    else {
        plt_fn <- plot_obsd_predd_sctr_cmprsn
        fn_args_ls <- list(tfd_data_tb = tfd_data_tb, base_size_1L_dbl = base_size_1L_dbl, 
            correspondences_lup = correspondences_lup, depnt_var_nm_1L_chr = depnt_var_nm_1L_chr, 
            depnt_var_desc_1L_chr = depnt_var_desc_1L_chr, round_var_nm_1L_chr = round_var_nm_1L_chr, 
            predd_val_var_nm_1L_chr = ifelse(ref_idx_1L_int %in% 
                c(4, 8), transform_predd_var_nm("Predicted", 
                sfx_1L_chr = ifelse(!is.null(table_predn_mdl), 
                  " from brmsfit", sfx_1L_chr), utl_min_val_1L_dbl = ifelse(ref_idx_1L_int == 
                  4, NA_real_, utl_min_val_1L_dbl)), transform_predd_var_nm("Simulated", 
                sfx_1L_chr = ifelse(!is.null(table_predn_mdl), 
                  " from brmsfit", sfx_1L_chr), utl_min_val_1L_dbl = ifelse(ref_idx_1L_int == 
                  6, NA_real_, utl_min_val_1L_dbl))), args_ls = args_ls, 
            x_lbl_1L_chr = x_lbl_1L_chr, y_lbl_1L_chr = y_lbl_1L_chr)
    }
    plot_fn_and_args_ls <- list(plt_fn = plt_fn, fn_args_ls = fn_args_ls)
    return(plot_fn_and_args_ls)
}
#' Make prediction dataset with one predictor
#' @description make_predn_ds_with_one_predr() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make prediction dataset with one predictor. The function returns Prediction dataset (a tibble).
#' @param model_mdl Model (a model)
#' @param depnt_var_nm_1L_chr Dependent variable name (a character vector of length one), Default: 'utl_total_w'
#' @param tfmn_1L_chr Transformation (a character vector of length one), Default: 'NTF'
#' @param predr_var_nm_1L_chr Predictor variable name (a character vector of length one)
#' @param predr_vals_dbl Predictor values (a double vector)
#' @param predn_type_1L_chr Prediction type (a character vector of length one), Default: NULL
#' @return Prediction dataset (a tibble)
#' @rdname make_predn_ds_with_one_predr
#' @export 
#' @importFrom tibble tibble
#' @importFrom rlang sym
#' @importFrom dplyr mutate
#' @importFrom stats predict
#' @keywords internal
make_predn_ds_with_one_predr <- function (model_mdl, depnt_var_nm_1L_chr = "utl_total_w", tfmn_1L_chr = "NTF", 
    predr_var_nm_1L_chr, predr_vals_dbl, predn_type_1L_chr = NULL) 
{
    predn_ds_tb <- tibble::tibble(`:=`(!!rlang::sym(predr_var_nm_1L_chr), 
        predr_vals_dbl))
    predn_ds_tb <- predn_ds_tb %>% dplyr::mutate(`:=`(!!rlang::sym(depnt_var_nm_1L_chr), 
        stats::predict(model_mdl, newdata = predn_ds_tb, type = predn_type_1L_chr) %>% 
            calculate_depnt_var_tfmn(tfmn_1L_chr = tfmn_1L_chr, 
                tfmn_is_outp_1L_lgl = T)))
    return(predn_ds_tb)
}
#' Make predictor categories list
#' @description make_predr_ctgs_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make predictor categories list. The function returns Predictor categories (a list).
#' @param outp_smry_ls Output summary (a list)
#' @param include_idx_int Include index (an integer vector), Default: NULL
#' @return Predictor categories (a list)
#' @rdname make_predr_ctgs_ls
#' @export 
#' @importFrom purrr flatten_chr map_chr map pluck
#' @importFrom ready4 get_from_lup_obj
#' @importFrom ready4use remove_labels_from_ds
#' @importFrom dplyr filter pull
#' @importFrom stats setNames
#' @keywords internal
make_predr_ctgs_ls <- function (outp_smry_ls, include_idx_int = NULL) 
{
    predictors_chr <- outp_smry_ls$predr_vars_nms_ls %>% purrr::flatten_chr() %>% 
        unique()
    categories_chr <- predictors_chr %>% purrr::map_chr(~outp_smry_ls$dictionary_tb %>% 
        ready4::get_from_lup_obj(match_value_xx = .x, match_var_nm_1L_chr = "var_nm_chr", 
            target_var_nm_1L_chr = "var_ctg_chr", evaluate_1L_lgl = F)) %>% 
        unique()
    predr_ctgs_ls <- categories_chr %>% purrr::map(~outp_smry_ls$dictionary_tb %>% 
        ready4use::remove_labels_from_ds() %>% dplyr::filter(var_ctg_chr == 
        .x) %>% dplyr::pull(var_nm_chr) %>% intersect(predictors_chr)) %>% 
        stats::setNames(categories_chr)
    if (!is.null(include_idx_int)) {
        predr_ctgs_ls <- include_idx_int %>% purrr::map(~predr_ctgs_ls %>% 
            purrr::pluck(.x)) %>% stats::setNames(categories_chr[include_idx_int])
    }
    return(predr_ctgs_ls)
}
#' Make predictor values
#' @description make_predr_vals() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make predictor values. The function returns Predictor values (a double vector).
#' @param predr_var_nm_1L_chr Predictor variable name (a character vector of length one)
#' @param candidate_predrs_lup Candidate predictors (a lookup table), Default: NULL
#' @return Predictor values (a double vector)
#' @rdname make_predr_vals
#' @export 
#' @importFrom utils data
#' @importFrom purrr map_dbl
#' @importFrom ready4 get_from_lup_obj
#' @importFrom rlang exec
make_predr_vals <- function (predr_var_nm_1L_chr, candidate_predrs_lup = NULL) 
{
    if (is.null(candidate_predrs_lup)) {
        utils::data("candidate_predrs_lup", envir = environment())
    }
    args_ls <- purrr::map_dbl(names(candidate_predrs_lup)[3:4], 
        ~candidate_predrs_lup %>% ready4::get_from_lup_obj(match_value_xx = predr_var_nm_1L_chr, 
            match_var_nm_1L_chr = "short_name_chr", target_var_nm_1L_chr = .x, 
            evaluate_1L_lgl = F)) %>% as.list()
    predr_vals_dbl <- rlang::exec(.fn = seq, !!!args_ls)
    return(predr_vals_dbl)
}
#' Make predictor variables names list
#' @description make_predr_vars_nms_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make predictor variables names list. The function returns Predictor variables names (a list).
#' @param main_predrs_chr Main predictors (a character vector)
#' @param covars_ls Covariates (a list)
#' @param combinations_1L_lgl Combinations (a logical vector of length one), Default: F
#' @param existing_predrs_ls Existing predictors (a list), Default: NULL
#' @param max_nbr_of_covars_1L_int Maximum number of covariates (an integer vector of length one), Default: integer(0)
#' @return Predictor variables names (a list)
#' @rdname make_predr_vars_nms_ls
#' @export 
#' @importFrom purrr map discard flatten map_lgl flatten_chr
#' @importFrom gtools combinations
make_predr_vars_nms_ls <- function (main_predrs_chr, covars_ls, combinations_1L_lgl = F, 
    existing_predrs_ls = NULL, max_nbr_of_covars_1L_int = integer(0)) 
{
    predr_vars_nms_ls <- covars_ls %>% purrr::map(~{
        covars_chr <- .x
        purrr::map(main_predrs_chr, ~list(c(.x), c(.x, covars_chr) %>% 
            purrr::discard(is.na))) %>% purrr::flatten()
    }) %>% purrr::flatten() %>% unique()
    predr_vars_nms_ls <- predr_vars_nms_ls[order(sapply(predr_vars_nms_ls, 
        length))]
    if (combinations_1L_lgl) {
        main_predrs_ls <- predr_vars_nms_ls[predr_vars_nms_ls %>% 
            purrr::map_lgl(~length(.x) == 1)]
        combinations_from_chr <- setdiff(predr_vars_nms_ls[predr_vars_nms_ls %>% 
            purrr::map_lgl(~length(.x) > 1)] %>% purrr::flatten_chr(), 
            main_predrs_chr)
        combinations_ls <- 1:(ifelse(identical(max_nbr_of_covars_1L_int, 
            integer(0)), length(combinations_from_chr), min(max_nbr_of_covars_1L_int, 
            length(combinations_from_chr)))) %>% purrr::map(~gtools::combinations(length(combinations_from_chr), 
            .x, combinations_from_chr) %>% t() %>% as.data.frame() %>% 
            as.list() %>% unname()) %>% purrr::flatten()
        combinations_ls <- main_predrs_ls %>% purrr::map(~{
            main_1L_chr <- .x
            combinations_ls %>% purrr::map(~c(main_1L_chr, .x))
        }) %>% purrr::flatten()
        predr_vars_nms_ls <- append(main_predrs_ls, combinations_ls)
    }
    if (!is.null(existing_predrs_ls)) {
        predr_vars_nms_ls <- predr_vars_nms_ls[predr_vars_nms_ls %>% 
            purrr::map_lgl(~{
                test_chr <- .x
                !any(existing_predrs_ls %>% purrr::map_lgl(~identical(.x, 
                  test_chr)))
            })]
    }
    return(predr_vars_nms_ls)
}
#' Make predictors for best models
#' @description make_predrs_for_best_mdls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make predictors for best models. The function returns Predictors for best models (a character vector).
#' @param outp_smry_ls Output summary (a list)
#' @param old_nms_chr Old names (a character vector), Default: NULL
#' @param new_nms_chr New names (a character vector), Default: NULL
#' @return Predictors for best models (a character vector)
#' @rdname make_predrs_for_best_mdls
#' @export 
#' @importFrom dplyr filter arrange desc pull
#' @importFrom purrr map flatten_chr map_lgl map2_chr
#' @importFrom stringr str_remove
make_predrs_for_best_mdls <- function (outp_smry_ls, old_nms_chr = NULL, new_nms_chr = NULL) 
{
    ordered_mdl_nms_chr <- outp_smry_ls$mdls_smry_tb %>% dplyr::filter(Parameter == 
        "R2") %>% dplyr::arrange(dplyr::desc(Estimate)) %>% dplyr::pull(Model)
    ind_predr_mdls_by_mdl_type_ls <- outp_smry_ls$prefd_mdl_types_chr %>% 
        purrr::map(~{
            mdl_type_1L_chr <- .x
            paste0(outp_smry_ls$predr_cmprsn_tb$predr_chr, "_1_") %>% 
                purrr::map(~paste0(.x, mdl_type_1L_chr)) %>% 
                purrr::flatten_chr()
        })
    ordered_mdls_by_type_ls <- ind_predr_mdls_by_mdl_type_ls %>% 
        purrr::map(~{
            ind_predr_mdls_chr <- .x
            ordered_mdl_nms_chr[ordered_mdl_nms_chr %>% purrr::map_lgl(~.x %in% 
                ind_predr_mdls_chr)]
        })
    predrs_for_best_mdls_chr <- ordered_mdls_by_type_ls %>% purrr::map2_chr(outp_smry_ls$prefd_mdl_types_chr, 
        ~{
            .x[1] %>% stringr::str_remove(paste0("_1_", .y))
        })
    if (!is.null(old_nms_chr)) {
        predrs_for_best_mdls_chr <- transform_predr_nm_part_of_phrases(predrs_for_best_mdls_chr, 
            old_nms_chr = old_nms_chr, new_nms_chr = new_nms_chr)
    }
    return(predrs_for_best_mdls_chr)
}
#' Make preferred models vector
#' @description make_prefd_mdls_vec() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make preferred models vector. The function returns Preferred models (a character vector).
#' @param smry_of_sngl_predr_mdls_tb Summary of single predictor models (a tibble)
#' @param choose_from_pfx_chr Choose from prefix (a character vector), Default: c("BET", "GLM", "OLS")
#' @param mdl_types_lup Model types (a lookup table), Default: NULL
#' @return Preferred models (a character vector)
#' @rdname make_prefd_mdls_vec
#' @export 
#' @importFrom utils data
#' @importFrom dplyr inner_join select rename pull
#' @importFrom purrr map_chr map_int
make_prefd_mdls_vec <- function (smry_of_sngl_predr_mdls_tb, choose_from_pfx_chr = c("BET", 
    "GLM", "OLS"), mdl_types_lup = NULL) 
{
    if (is.null(mdl_types_lup)) 
        utils::data("mdl_types_lup", envir = environment(), package = "specific")
    ordered_mdl_types_chr <- dplyr::inner_join(smry_of_sngl_predr_mdls_tb %>% 
        dplyr::select(Model) %>% dplyr::rename(long_name_chr = Model), 
        mdl_types_lup, by = "long_name_chr") %>% dplyr::pull(short_name_chr)
    prefd_mdls_chr <- purrr::map_chr(choose_from_pfx_chr, ~ordered_mdl_types_chr[startsWith(ordered_mdl_types_chr, 
        .x)][1])
    prefd_mdls_chr <- prefd_mdls_chr[order(prefd_mdls_chr %>% 
        purrr::map_int(~which(ordered_mdl_types_chr == .x)))]
    return(prefd_mdls_chr)
}
#' Make primary analysis parameters list
#' @description make_prmry_analysis_params_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make primary analysis parameters list. The function returns Primary analysis parameters (a list).
#' @param analysis_core_params_ls Analysis core parameters (a list)
#' @param candidate_covar_nms_chr Candidate covariate names (a character vector), Default: 'NA'
#' @param ds_tb Dataset (a tibble)
#' @param path_params_ls Path parameters (a list)
#' @param maui_params_ls Multi-attribute utility instrument parameters (a list)
#' @param prefd_covars_chr Preferred covariates (a character vector), Default: NULL
#' @param prefd_mdl_types_chr Preferred model types (a character vector), Default: NULL
#' @param raw_ds_tfmn_fn Raw dataset transformation (a function), Default: NULL
#' @param subtitle_1L_chr Subtitle (a character vector of length one), Default: 'Methods Report 1: Analysis Program (Primary Analysis)'
#' @param utl_class_fn_1L_chr Utility class function (a character vector of length one), Default: 'as.numeric'
#' @return Primary analysis parameters (a list)
#' @rdname make_prmry_analysis_params_ls
#' @export 
#' @keywords internal
make_prmry_analysis_params_ls <- function (analysis_core_params_ls, candidate_covar_nms_chr = NA_character_, 
    ds_tb, path_params_ls, maui_params_ls, prefd_covars_chr = NULL, 
    prefd_mdl_types_chr = NULL, raw_ds_tfmn_fn = NULL, subtitle_1L_chr = "Methods Report 1: Analysis Program (Primary Analysis)", 
    utl_class_fn_1L_chr = "as.numeric") 
{
    if (is.na(analysis_core_params_ls$candidate_covar_nms_chr[1]) & 
        !is.na(candidate_covar_nms_chr[1])) {
        analysis_core_params_ls$candidate_covar_nms_chr <- candidate_covar_nms_chr
    }
    if (is.null(analysis_core_params_ls$prefd_covars_chr) & !is.null(prefd_covars_chr)) {
        analysis_core_params_ls$prefd_covars_chr <- prefd_covars_chr
    }
    if (is.null(analysis_core_params_ls$prefd_mdl_types_chr) & 
        !is.null(prefd_mdl_types_chr)) {
        analysis_core_params_ls$prefd_mdl_types_chr <- prefd_mdl_types_chr
    }
    prmry_analysis_params_ls <- list(ds_tb = ds_tb, raw_ds_tfmn_fn = raw_ds_tfmn_fn, 
        subtitle_1L_chr = subtitle_1L_chr, utl_class_fn_1L_chr = utl_class_fn_1L_chr) %>% 
        append(analysis_core_params_ls) %>% append(path_params_ls[1:2]) %>% 
        append(maui_params_ls)
    return(prmry_analysis_params_ls)
}
#' Make psych predictors lookup table
#' @description make_psych_predrs_lup() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make psych predictors lookup table. The function returns Predictors (a lookup table).

#' @return Predictors (a lookup table)
#' @rdname make_psych_predrs_lup
#' @export 
#' @keywords internal
make_psych_predrs_lup <- function () 
{
    predictors_lup <- TTU_predictors_lup(make_pt_TTU_predictors_lup(short_name_chr = c("K10_int", 
        "Psych_well_int"), long_name_chr = c("Kessler Psychological Distress - 10 Item Total Score", 
        "Overall Wellbeing Measure (Winefield et al. 2012)"), 
        min_val_dbl = c(10, 18), max_val_dbl = c(50, 90), class_chr = "integer", 
        increment_dbl = 1, class_fn_chr = "integer", mdl_scaling_dbl = 0.01, 
        covariate_lgl = F))
    return(predictors_lup)
}
#' Make random forest text
#' @description make_random_forest_text() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make random forest text. The function returns Text (a character vector of length one).
#' @param results_ls Results (a list)
#' @param for_abstract_1L_lgl For abstract (a logical vector of length one), Default: F
#' @return Text (a character vector of length one)
#' @rdname make_random_forest_text
#' @export 
make_random_forest_text <- function (results_ls, for_abstract_1L_lgl = F) 
{
    if (for_abstract_1L_lgl) {
        text_1L_chr <- ifelse(length(results_ls$ttu_cs_ls$rf_seq_dscdng_chr) > 
            1, paste0(ifelse(results_ls$ttu_cs_ls$mdl_predrs_and_rf_seqs_cmprsn_1L_chr == 
            "is consistent", " and the random forest model", 
            paste0(", while ", results_ls$ttu_cs_ls$rf_seq_dscdng_chr[1], 
                " was the most 'important' predictor in the random forest model"))), 
            "")
    }
    else {
        text_1L_chr <- ifelse(length(results_ls$ttu_cs_ls$rf_seq_dscdng_chr) > 
            1, paste0("This ", results_ls$ttu_cs_ls$mdl_predrs_and_rf_seqs_cmprsn_1L_chr, 
            " with the random forest model in which ", results_ls$ttu_cs_ls$rf_seq_dscdng_chr[1], 
            " was found to be the most 'important' predictor"), 
            "")
    }
    return(text_1L_chr)
}
#' Make ranked predictors list
#' @description make_ranked_predrs_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make ranked predictors list. The function returns Ranked predictors (a list).
#' @param descv_tbls_ls Descriptive tables (a list)
#' @param old_nms_chr Old names (a character vector), Default: NULL
#' @param new_nms_chr New names (a character vector), Default: NULL
#' @return Ranked predictors (a list)
#' @rdname make_ranked_predrs_ls
#' @export 
#' @importFrom purrr map_dbl map flatten_chr
#' @keywords internal
make_ranked_predrs_ls <- function (descv_tbls_ls, old_nms_chr = NULL, new_nms_chr = NULL) 
{
    unranked_predrs_chr <- rownames(descv_tbls_ls[["bl_cors_tb"]])[-1]
    if (!is.null(old_nms_chr)) 
        unranked_predrs_chr <- unranked_predrs_chr %>% transform_predr_nm_part_of_phrases(old_nms_chr = old_nms_chr, 
            new_nms_chr = new_nms_chr)
    ranks_dbl <- descv_tbls_ls[["bl_cors_tb"]][2:nrow(descv_tbls_ls[["bl_cors_tb"]]), 
        1] %>% purrr::map_dbl(~{
        vec_dbl <- regmatches(.x, gregexpr("[[:digit:]]+", .x)) %>% 
            unlist() %>% as.numeric()
        vec_dbl[1] + vec_dbl[2]/100
    }) %>% rank()
    unique_ranks_dbl <- unique(ranks_dbl) %>% sort(decreasing = T)
    ranked_predrs_chr <- purrr::map(unique_ranks_dbl, ~unranked_predrs_chr[ranks_dbl == 
        .x]) %>% purrr::flatten_chr()
    ranked_predrs_ls <- list(unranked_predrs_chr = unranked_predrs_chr, 
        ranked_predrs_chr = ranked_predrs_chr)
    return(ranked_predrs_ls)
}
#' Make results list
#' @description make_results_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make results list. The function returns Results (a list).
#' @param spine_of_results_ls Spine of results (a list), Default: NULL
#' @param abstract_args_ls Abstract arguments (a list), Default: NULL
#' @param consent_1L_chr Consent (a character vector of length one), Default: ''
#' @param consent_indcs_int Consent indices (an integer vector), Default: 1
#' @param depnt_var_min_val_1L_dbl Dependent variable minimum value (a double vector of length one), Default: numeric(0)
#' @param dv_ds_nm_and_url_chr Dataverse dataset name and url (a character vector), Default: NULL
#' @param options_chr Options (a character vector), Default: c("Y", "N")
#' @param output_format_ls Output format (a list), Default: NULL
#' @param params_ls_ls Parameters (a list of lists), Default: NULL
#' @param path_params_ls Path parameters (a list), Default: NULL
#' @param study_descs_ls Study descriptions (a list), Default: NULL
#' @param fn_ls Function list (a list of functions), Default: NULL
#' @param include_idx_int Include index (an integer vector), Default: NULL
#' @param var_nm_change_lup Variable name change (a lookup table), Default: NULL
#' @param ctgl_vars_regrouping_ls Categorical variables regrouping (a list), Default: NULL
#' @param make_cmpst_plt_1L_lgl Make composite plot (a logical vector of length one), Default: T
#' @param outp_smry_ls Output summary (a list), Default: NULL
#' @param sig_covars_some_predrs_mdls_tb Sig covariates some predictors models (a tibble), Default: NULL
#' @param sig_thresh_covars_1L_chr Sig thresh covariates (a character vector of length one), Default: NULL
#' @param version_1L_chr Version (a character vector of length one), Default: NULL
#' @return Results (a list)
#' @rdname make_results_ls
#' @export 
#' @importFrom purrr map_lgl map_chr
#' @importFrom stringr str_detect
#' @importFrom ready4 write_with_consent get_from_lup_obj
#' @importFrom cowplot save_plot
#' @importFrom tibble tibble
#' @importFrom dplyr filter pull
make_results_ls <- function (spine_of_results_ls = NULL, abstract_args_ls = NULL, 
    consent_1L_chr = "", consent_indcs_int = 1L, depnt_var_min_val_1L_dbl = numeric(0), 
    dv_ds_nm_and_url_chr = NULL, options_chr = c("Y", "N"), output_format_ls = NULL, 
    params_ls_ls = NULL, path_params_ls = NULL, study_descs_ls = NULL, 
    fn_ls = NULL, include_idx_int = NULL, var_nm_change_lup = NULL, 
    ctgl_vars_regrouping_ls = NULL, make_cmpst_plt_1L_lgl = T, 
    outp_smry_ls = NULL, sig_covars_some_predrs_mdls_tb = NULL, 
    sig_thresh_covars_1L_chr = NULL, version_1L_chr = NULL) 
{
    if (is.null(spine_of_results_ls)) {
        spine_of_results_ls <- make_results_ls_spine(output_format_ls = output_format_ls, 
            params_ls_ls = params_ls_ls, path_params_ls = path_params_ls, 
            study_descs_ls = study_descs_ls, fn_ls = fn_ls, include_idx_int = include_idx_int, 
            outp_smry_ls = outp_smry_ls, var_nm_change_lup = var_nm_change_lup)
    }
    mdls_smry_tbls_ls <- make_mdls_smry_tbls_ls(spine_of_results_ls$outp_smry_ls, 
        nbr_of_digits_1L_int = spine_of_results_ls$nbr_of_digits_1L_int)
    covars_mdls_ls <- make_mdls_ls(spine_of_results_ls$outp_smry_ls, 
        mdls_tb = mdls_smry_tbls_ls$covar_mdls_tb)
    descv_tbls_ls <- paste0(spine_of_results_ls$output_data_dir_1L_chr, 
        "/", spine_of_results_ls$outp_smry_ls$file_paths_chr[spine_of_results_ls$outp_smry_ls$file_paths_chr %>% 
            purrr::map_lgl(~stringr::str_detect(.x, "descv_tbls_ls.RDS"))]) %>% 
        readRDS()
    if (make_cmpst_plt_1L_lgl) {
        composite_plt <- make_cmpst_sctr_and_dnst_plt(spine_of_results_ls$outp_smry_ls, 
            depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, 
            output_data_dir_1L_chr = spine_of_results_ls$output_data_dir_1L_chr, 
            predr_var_nms_chr = spine_of_results_ls$outp_smry_ls$predr_vars_nms_ls[[1]])
        ready4::write_with_consent(consented_fn = cowplot::save_plot, 
            prompt_1L_chr = paste0("Do you confirm that you want to write the file ", 
                paste0(spine_of_results_ls$output_data_dir_1L_chr, 
                  "/dens_and_sctr.png"), "?"), consent_1L_chr = consent_1L_chr, 
            consent_indcs_int = consent_indcs_int, consented_args_ls = list(filename = paste0(spine_of_results_ls$output_data_dir_1L_chr, 
                "/dens_and_sctr.png"), plot = composite_plt, 
                base_height = 20), consented_msg_1L_chr = paste0("File ", 
                paste0(spine_of_results_ls$output_data_dir_1L_chr, 
                  "/dens_and_sctr.png"), " has been written."), 
            declined_msg_1L_chr = "Write request cancelled - no new files have been written.", 
            options_chr = options_chr)
    }
    ttu_cs_ls <- make_ttu_cs_ls(spine_of_results_ls$outp_smry_ls, 
        sig_covars_some_predrs_mdls_tb = sig_covars_some_predrs_mdls_tb, 
        sig_thresh_covars_1L_chr = sig_thresh_covars_1L_chr)
    mdl_types_chr <- mdls_smry_tbls_ls$prefd_predr_mdl_smry_tb$Model %>% 
        purrr::map_chr(~get_mdl_type_from_nm(.x)) %>% unique()
    ttu_cs_ls$rf_seq_dscdng_chr <- ttu_cs_ls$rf_seq_dscdng_chr %>% 
        purrr::map_chr(~ifelse(.x %in% spine_of_results_ls$var_nm_change_lup$old_nms_chr, 
            .x %>% ready4::get_from_lup_obj(data_lookup_tb = spine_of_results_ls$var_nm_change_lup, 
                match_var_nm_1L_chr = "old_nms_chr", target_var_nm_1L_chr = "new_nms_chr", 
                evaluate_1L_lgl = F), .x))
    ttu_cs_ls$cs_mdls_predrs_seq_dscdng_chr <- ttu_cs_ls$cs_mdls_predrs_seq_dscdng_chr %>% 
        purrr::map_chr(~ifelse(.x %in% spine_of_results_ls$var_nm_change_lup$old_nms_chr, 
            .x %>% ready4::get_from_lup_obj(data_lookup_tb = spine_of_results_ls$var_nm_change_lup, 
                match_var_nm_1L_chr = "old_nms_chr", target_var_nm_1L_chr = "new_nms_chr", 
                evaluate_1L_lgl = F), .x))
    ttu_lngl_ls = list(best_mdls_tb = tibble::tibble(model_type = mdl_types_chr %>% 
        purrr::map_chr(~ready4::get_from_lup_obj(spine_of_results_ls$outp_smry_ls$mdl_types_lup, 
            match_value_xx = .x, match_var_nm_1L_chr = "short_name_chr", 
            target_var_nm_1L_chr = "mixed_acronym_chr", evaluate_1L_lgl = F)), 
        link_and_tfmn_chr = mdl_types_chr %>% purrr::map_chr(~ready4::get_from_lup_obj(spine_of_results_ls$outp_smry_ls$mdl_types_lup, 
            match_value_xx = .x, match_var_nm_1L_chr = "short_name_chr", 
            target_var_nm_1L_chr = "with_chr", evaluate_1L_lgl = F)), 
        name_chr = make_predrs_for_best_mdls(spine_of_results_ls$outp_smry_ls, 
            old_nms_chr = spine_of_results_ls$var_nm_change_lup$old_nms_chr, 
            new_nms_chr = spine_of_results_ls$var_nm_change_lup$new_nms_chr), 
        r2_dbl = mdls_smry_tbls_ls$prefd_predr_mdl_smry_tb %>% 
            dplyr::filter(Parameter == "R2") %>% dplyr::pull(Estimate)), 
        cs_ts_ratios_tb = spine_of_results_ls$cs_ts_ratios_tb, 
        incld_covars_chr = spine_of_results_ls$outp_smry_ls$prefd_covars_chr)
    results_ls <- list(abstract_args_ls = abstract_args_ls, candidate_covars_ls = spine_of_results_ls$candidate_covars_ls, 
        candidate_predrs_chr = spine_of_results_ls$candidate_predrs_chr, 
        cohort_ls = make_cohort_ls(descv_tbls_ls, ctgl_vars_regrouping_ls = ctgl_vars_regrouping_ls, 
            nbr_of_digits_1L_int = spine_of_results_ls$nbr_of_digits_1L_int), 
        dv_ds_nm_and_url_chr = dv_ds_nm_and_url_chr, header_yaml_args_ls = params_ls_ls$header_yaml_args_ls, 
        hlth_utl_and_predrs_ls = make_hlth_utl_and_predrs_ls(spine_of_results_ls$outp_smry_ls, 
            descv_tbls_ls = descv_tbls_ls, nbr_of_digits_1L_int = spine_of_results_ls$nbr_of_digits_1L_int, 
            old_nms_chr = spine_of_results_ls$var_nm_change_lup$old_nms_chr, 
            new_nms_chr = spine_of_results_ls$var_nm_change_lup$new_nms_chr), 
        mdl_coef_ratios_ls = spine_of_results_ls$mdl_coef_ratios_ls, 
        mdl_ingredients_ls = spine_of_results_ls$mdl_ingredients_ls, 
        mdls_with_signft_covars_ls = spine_of_results_ls$mdls_with_signft_covars_ls, 
        output_format_ls = params_ls_ls$output_format_ls, path_params_ls = params_ls_ls$path_params_ls, 
        paths_to_figs_ls = make_paths_to_ms_smry_plts_ls(spine_of_results_ls$output_data_dir_1L_chr, 
            outp_smry_ls = spine_of_results_ls$outp_smry_ls), 
        predr_var_nms_chr = spine_of_results_ls$outp_smry_ls$predr_vars_nms_ls[[1]] %>% 
            purrr::map_chr(~ifelse(.x %in% spine_of_results_ls$var_nm_change_lup$old_nms_chr, 
                .x %>% ready4::get_from_lup_obj(data_lookup_tb = spine_of_results_ls$var_nm_change_lup, 
                  match_var_nm_1L_chr = "old_nms_chr", target_var_nm_1L_chr = "new_nms_chr", 
                  evaluate_1L_lgl = F), .x)), r_version_1L_chr = paste0(spine_of_results_ls$outp_smry_ls$session_ls$R.version$major, 
            ".", spine_of_results_ls$outp_smry_ls$session_ls$R.version$minor), 
        study_descs_ls = spine_of_results_ls$study_descs_ls, 
        tables_ls = make_ms_smry_tbls_ls(spine_of_results_ls$outp_smry_ls, 
            mdls_smry_tbls_ls = mdls_smry_tbls_ls, covars_mdls_ls = covars_mdls_ls, 
            descv_tbls_ls = descv_tbls_ls, nbr_of_digits_1L_int = spine_of_results_ls$nbr_of_digits_1L_int), 
        ttu_cs_ls = ttu_cs_ls, ttu_lngl_ls = ttu_lngl_ls, ttu_version_1L_chr = spine_of_results_ls$outp_smry_ls$session_ls$otherPkgs$TTU$Version, 
        var_nm_change_lup = spine_of_results_ls$var_nm_change_lup, 
        version_1L_chr = version_1L_chr)
    results_ls <- transform_tbls_for_covar_nms(results_ls) %>% 
        transform_tbls_for_csnl_mdls()
    return(results_ls)
}
#' Make results list spine
#' @description make_results_ls_spine() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make results list spine. The function returns Spine of results (a list).
#' @param output_format_ls Output format (a list), Default: NULL
#' @param params_ls_ls Parameters (a list of lists), Default: NULL
#' @param path_params_ls Path parameters (a list), Default: NULL
#' @param study_descs_ls Study descriptions (a list)
#' @param fn_ls Function list (a list of functions), Default: NULL
#' @param include_idx_int Include index (an integer vector), Default: NULL
#' @param outp_smry_ls Output summary (a list), Default: NULL
#' @param var_nm_change_lup Variable name change (a lookup table), Default: NULL
#' @return Spine of results (a list)
#' @rdname make_results_ls_spine
#' @export 
#' @importFrom purrr map_chr map
#' @importFrom ready4 get_from_lup_obj
#' @importFrom stats setNames
#' @keywords internal
make_results_ls_spine <- function (output_format_ls = NULL, params_ls_ls = NULL, path_params_ls = NULL, 
    study_descs_ls, fn_ls = NULL, include_idx_int = NULL, outp_smry_ls = NULL, 
    var_nm_change_lup = NULL) 
{
    output_data_dir_1L_chr <- path_params_ls$paths_ls$output_data_dir_1L_chr
    nbr_of_digits_1L_int <- output_format_ls$manuscript_digits_1L_int
    if (is.null(var_nm_change_lup)) {
        var_nm_change_lup <- list(old_nms_chr = NULL, new_nms_chr = NULL)
    }
    if (is.null(outp_smry_ls)) 
        outp_smry_ls <- readRDS(paste0(output_data_dir_1L_chr, 
            "/I_ALL_OUTPUT_.RDS"))
    mdl_ingredients_ls <- readRDS(paste0(output_data_dir_1L_chr, 
        "/G_Shareable/Ingredients/mdl_ingredients.RDS"))
    if (!is.null(params_ls_ls)) {
        if (is.null(params_ls_ls$params_ls$candidate_covar_nms_chr) | 
            is.na(params_ls_ls$params_ls$candidate_covar_nms_chr[1])) {
            candidate_covars_ls <- NULL
        }
        else {
            covar_ctgs_chr <- params_ls_ls$params_ls$candidate_covar_nms_chr %>% 
                purrr::map_chr(~ready4::get_from_lup_obj(params_ls_ls$params_ls$ds_descvs_ls$dictionary_tb, 
                  match_value_xx = .x, match_var_nm_1L_chr = "var_nm_chr", 
                  target_var_nm_1L_chr = "var_ctg_chr", evaluate_1L_lgl = F)) %>% 
                unique()
            candidate_covars_ls <- covar_ctgs_chr %>% purrr::map(~{
                var_desc_chr <- ready4::get_from_lup_obj(params_ls_ls$params_ls$ds_descvs_ls$dictionary_tb, 
                  match_value_xx = .x, match_var_nm_1L_chr = "var_ctg_chr", 
                  target_var_nm_1L_chr = "var_desc_chr", evaluate_1L_lgl = F)
                class(var_desc_chr) <- setdiff(class(var_desc_chr), 
                  "labelled")
                attr(var_desc_chr, "label") <- NULL
                var_nm_chr <- ready4::get_from_lup_obj(params_ls_ls$params_ls$ds_descvs_ls$dictionary_tb, 
                  match_value_xx = .x, match_var_nm_1L_chr = "var_ctg_chr", 
                  target_var_nm_1L_chr = "var_nm_chr", evaluate_1L_lgl = F)
                var_desc_chr[var_nm_chr %in% params_ls_ls$params_ls$candidate_covar_nms_chr]
            }) %>% stats::setNames(covar_ctgs_chr)
        }
    }
    else {
        candidate_covars_ls <- NULL
    }
    study_descs_ls$predr_ctgs_ls <- make_predr_ctgs_ls(outp_smry_ls, 
        include_idx_int = include_idx_int)
    mdl_coef_ratios_ls <- make_mdl_coef_ratio_ls(mdl_ingredients_ls, 
        predr_ctgs_ls = study_descs_ls$predr_ctgs_ls)
    mdls_smry_tbls_ls <- make_mdls_smry_tbls_ls(outp_smry_ls, 
        nbr_of_digits_1L_int = nbr_of_digits_1L_int)
    covars_mdls_ls <- make_mdls_ls(outp_smry_ls, mdls_tb = mdls_smry_tbls_ls$covar_mdls_tb)
    cs_ts_ratios_tb <- make_cs_ts_ratios_tb(predr_ctgs_ls = study_descs_ls$predr_ctgs_ls, 
        mdl_coef_ratios_ls = mdl_coef_ratios_ls, candidate_predrs_chr = params_ls_ls$params_ls$ds_descvs_ls$candidate_predrs_chr, 
        fn_ls = fn_ls, nbr_of_digits_1L_int = nbr_of_digits_1L_int)
    spine_of_results_ls <- list(candidate_covars_ls = candidate_covars_ls, 
        candidate_predrs_chr = params_ls_ls$params_ls$ds_descvs_ls$candidate_predrs_chr, 
        cs_ts_ratios_tb = cs_ts_ratios_tb, mdls_with_signft_covars_ls = get_mdls_with_signft_covars(outp_smry_ls, 
            params_ls_ls = params_ls_ls), outp_smry_ls = outp_smry_ls, 
        output_data_dir_1L_chr = output_data_dir_1L_chr, mdl_coef_ratios_ls = mdl_coef_ratios_ls, 
        mdl_ingredients_ls = mdl_ingredients_ls, nbr_of_digits_1L_int = nbr_of_digits_1L_int, 
        study_descs_ls = study_descs_ls, var_nm_change_lup = var_nm_change_lup)
    return(spine_of_results_ls)
}
#' Make scaling factor double vector
#' @description make_scaling_fctr_dbl() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make scaling factor double vector. The function returns Scaling factor (a double vector).
#' @param outp_smry_ls Output summary (a list)
#' @return Scaling factor (a double vector)
#' @rdname make_scaling_fctr_dbl
#' @export 
#' @importFrom purrr flatten_chr map_dbl
#' @importFrom ready4 get_from_lup_obj
#' @keywords internal
make_scaling_fctr_dbl <- function (outp_smry_ls) 
{
    scaling_fctr_dbl <- outp_smry_ls$predr_vars_nms_ls %>% purrr::flatten_chr() %>% 
        unique() %>% purrr::map_dbl(~ifelse(.x %in% outp_smry_ls$predictors_lup$short_name_chr, 
        ready4::get_from_lup_obj(outp_smry_ls$predictors_lup, 
            target_var_nm_1L_chr = "mdl_scaling_dbl", match_value_xx = .x, 
            match_var_nm_1L_chr = "short_name_chr", evaluate_1L_lgl = F), 
        1))
    return(scaling_fctr_dbl)
}
#' Make scaling text
#' @description make_scaling_text() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make scaling text. The function returns Text (a character vector of length one).
#' @param results_ls Results (a list)
#' @param table_1L_chr Table (a character vector of length one), Default: 'cfscl'
#' @return Text (a character vector of length one)
#' @rdname make_scaling_text
#' @export 
#' @importFrom purrr pluck map_chr
#' @importFrom stringr str_remove str_replace_all
#' @importFrom dplyr filter pull
#' @importFrom stringi stri_replace_last
make_scaling_text <- function (results_ls, table_1L_chr = "cfscl") 
{
    if (startsWith(table_1L_chr, "cfscl")) {
        table_df <- results_ls$tables_ls$ind_preds_coefs_tbl
    }
    else {
        if (startsWith(table_1L_chr, "coefscovarstype")) {
            table_df <- results_ls$tables_ls %>% purrr::pluck(paste0("mdl_type_", 
                table_1L_chr %>% stringr::str_remove("coefscovarstype"), 
                "_covar_mdls_tb"))
        }
    }
    predrs_chr <- table_df$Parameter %>% setdiff(c("SD (Intercept)", 
        "Intercept")) %>% stringr::str_replace_all(" model", 
        "") %>% stringr::str_replace_all(" baseline", "") %>% 
        stringr::str_replace_all(" change", "") %>% stringr::str_replace_all(" scaled", 
        "") %>% stringr::str_replace_all(" unscaled", "") %>% 
        unique()
    predrs_lup <- results_ls$mdl_ingredients_ls$predictors_lup %>% 
        dplyr::filter(short_name_chr %in% predrs_chr)
    scaling_dbl <- predrs_lup$mdl_scaling_dbl %>% unique()
    text_1L_chr <- ifelse(all(scaling_dbl == 1), "", paste0("Note: ", 
        scaling_dbl %>% purrr::map_chr(~{
            scaled_predrs_chr <- predrs_lup %>% dplyr::filter(mdl_scaling_dbl == 
                .x) %>% dplyr::pull(short_name_chr) %>% sort() %>% 
                transform_names(rename_lup = results_ls$var_nm_change_lup)
            ifelse(.x == 1, "", paste0("The ", scaled_predrs_chr %>% 
                paste0(collapse = ", ") %>% stringi::stri_replace_last(fixed = ",", 
                " and"), " parameter", ifelse(length(scaled_predrs_chr) == 
                1, " was", "s were"), " first multiplied by ", 
                .x, "."))
        }) %>% paste0(collapse = " ")))
    return(text_1L_chr)
}
#' Make secondary analysis parameters
#' @description make_scndry_anlys_params() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make secondary analysis parameters. The function returns New parameters (a list).
#' @param scndry_anlys_params_ls Secondary analysis parameters (a list), Default: NULL
#' @param candidate_covar_nms_chr Candidate covariate names (a character vector), Default: NULL
#' @param candidate_predrs_chr Candidate predictors (a character vector), Default: NULL
#' @param predictors_lup Predictors (a lookup table), Default: NULL
#' @param prefd_covars_chr Preferred covariates (a character vector), Default: 'NA'
#' @return New parameters (a list)
#' @rdname make_scndry_anlys_params
#' @export 
#' @importFrom stats setNames
make_scndry_anlys_params <- function (scndry_anlys_params_ls = NULL, candidate_covar_nms_chr = NULL, 
    candidate_predrs_chr = NULL, predictors_lup = NULL, prefd_covars_chr = NA_character_) 
{
    new_params_ls <- list(candidate_covar_nms_chr = candidate_covar_nms_chr, 
        candidate_predrs_chr = candidate_predrs_chr, predictors_lup = predictors_lup, 
        prefd_covars_chr = prefd_covars_chr)
    if (!is.null(scndry_anlys_params_ls)) {
        new_params_ls <- append(scndry_anlys_params_ls, list(new_params_ls)) %>% 
            stats::setNames(paste0("secondary_", 1:(length(scndry_anlys_params_ls) + 
                1)))
    }
    else {
        new_params_ls <- list(secondary_1 = new_params_ls)
    }
    return(new_params_ls)
}
#' Make secondary analysis text
#' @description make_scndry_anlys_text() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make secondary analysis text. The function returns Text (a character vector of length one).
#' @param results_ls Results (a list)
#' @return Text (a character vector of length one)
#' @rdname make_scndry_anlys_text
#' @export 
make_scndry_anlys_text <- function (results_ls) 
{
    text_1L_chr <- ifelse(get_nbr_of_scndry_analyses(results_ls, 
        as_words_1L_lgl = F) == 0, "", paste0(get_nbr_of_scndry_analyses(results_ls), 
        " secondary analys", ifelse(get_nbr_of_scndry_analyses(results_ls, 
            as_words_1L_lgl = F) == 1, "is was ", "es were "), 
        "undertaken. ", get_scndry_anlys_descs(results_ls)))
    return(text_1L_chr)
}
#' Make selected model text
#' @description make_selected_mdl_text() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make selected model text. The function returns Text (a character vector of length one).
#' @param results_ls Results (a list)
#' @param for_abstract_1L_lgl For abstract (a logical vector of length one), Default: F
#' @return Text (a character vector of length one)
#' @rdname make_selected_mdl_text
#' @export 
#' @importFrom stringi stri_replace_last
make_selected_mdl_text <- function (results_ls, for_abstract_1L_lgl = F) 
{
    length_1L_int <- length(results_ls$ttu_cs_ls$selected_mdls_chr)
    text_1L_chr <- paste0(ifelse((length_1L_int == 2 & !for_abstract_1L_lgl), 
        "Both ", ""), results_ls$ttu_cs_ls$selected_mdls_chr %>% 
        paste0(collapse = ", ") %>% stringi::stri_replace_last(fixed = ",", 
        " and"), ifelse(length_1L_int > 1, " were", " was"), 
        ifelse(for_abstract_1L_lgl, paste0(" the best peforming model", 
            ifelse(length_1L_int > 1, "s.", ".")), " selected for further evaluation."))
    return(text_1L_chr)
}
#' Make shareable model
#' @description make_shareable_mdl() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make shareable model. The function returns Model (a model).
#' @param fake_ds_tb Fake dataset (a tibble)
#' @param mdl_smry_tb Model summary (a tibble)
#' @param x_ready4use_dictionary PARAM_DESCRIPTION
#' @param control_1L_chr Control (a character vector of length one), Default: 'NA'
#' @param depnt_var_nm_1L_chr Dependent variable name (a character vector of length one), Default: 'utl_total_w'
#' @param id_var_nm_1L_chr Identity variable name (a character vector of length one), Default: 'fkClientID'
#' @param mdl_type_1L_chr Model type (a character vector of length one), Default: 'OLS_CLL'
#' @param mdl_types_lup Model types (a lookup table), Default: NULL
#' @param seed_1L_int Seed (an integer vector of length one), Default: 12345
#' @param start_1L_chr Start (a character vector of length one), Default: 'NA'
#' @param tfmn_1L_chr Transformation (a character vector of length one), Default: 'CLL'
#' @return Model (a model)
#' @rdname make_shareable_mdl
#' @export 
#' @importFrom utils data
#' @importFrom ready4 get_from_lup_obj
#' @importFrom stringi stri_replace_last_fixed
#' @importFrom ready4use Ready4useDyad
#' @importFrom dplyr select mutate case_when filter slice
#' @importFrom purrr map_chr
#' @importFrom tidyselect all_of
#' @importFrom stringr str_replace_all
#' @importFrom assertthat assert_that
make_shareable_mdl <- function (fake_ds_tb, mdl_smry_tb, x_ready4use_dictionary, control_1L_chr = NA_character_, 
    depnt_var_nm_1L_chr = "utl_total_w", id_var_nm_1L_chr = "fkClientID", 
    mdl_type_1L_chr = "OLS_CLL", mdl_types_lup = NULL, seed_1L_int = 12345L, 
    start_1L_chr = NA_character_, tfmn_1L_chr = "CLL") 
{
    if (is.null(mdl_types_lup)) 
        utils::data(mdl_types_lup, envir = environment())
    if (is.na(tfmn_1L_chr)) 
        tfmn_1L_chr <- ready4::get_from_lup_obj(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)
    predr_var_nms_chr <- mdl_smry_tb$Parameter[!mdl_smry_tb$Parameter %in% 
        c("SD (Intercept)", "Intercept", "R2", "RMSE", "Sigma")] %>% 
        stringi::stri_replace_last_fixed(" baseline", "_baseline") %>% 
        stringi::stri_replace_last_fixed(" change", "_change") %>% 
        stringi::stri_replace_last_fixed(" scaled", "_scaled") %>% 
        stringi::stri_replace_last_fixed(" unscaled", "_unscaled")
    X <- ready4use::Ready4useDyad(ds_tb = fake_ds_tb %>% dplyr::select(intersect(names(fake_ds_tb), 
        x_ready4use_dictionary$var_nm_chr)), dictionary_r3 = x_ready4use_dictionary)
    dummys_chr <- manufacture(X, flatten_1L_lgl = T)
    predr_var_nms_chr <- predr_var_nms_chr %>% purrr::map_chr(~ifelse(.x %in% 
        dummys_chr, manufacture(X, flatten_1L_lgl = T, what_1L_chr = "factors-d", 
        match_1L_chr = .x), .x)) %>% unique()
    tfd_depnt_var_nm_1L_chr <- transform_depnt_var_nm(depnt_var_nm_1L_chr, 
        tfmn_1L_chr = tfmn_1L_chr)
    if (length(predr_var_nms_chr) > 1) {
        covar_var_nms_chr <- predr_var_nms_chr[2:length(predr_var_nms_chr)]
    }
    else {
        covar_var_nms_chr <- NA_character_
    }
    model_mdl <- make_mdl(fake_ds_tb %>% dplyr::select(tidyselect::all_of(c(id_var_nm_1L_chr, 
        tfd_depnt_var_nm_1L_chr, predr_var_nms_chr))), depnt_var_nm_1L_chr = depnt_var_nm_1L_chr, 
        predr_var_nm_1L_chr = predr_var_nms_chr[1], covar_var_nms_chr = covar_var_nms_chr, 
        tfmn_1L_chr = tfmn_1L_chr, mdl_type_1L_chr = mdl_type_1L_chr, 
        mdl_types_lup = mdl_types_lup, control_1L_chr = control_1L_chr, 
        start_1L_chr = start_1L_chr)
    if (ready4::get_from_lup_obj(mdl_types_lup, match_value_xx = mdl_type_1L_chr, 
        match_var_nm_1L_chr = "short_name_chr", target_var_nm_1L_chr = "fn_chr", 
        evaluate_1L_lgl = F) == "betareg::betareg") {
        model_coeffs_dbl <- model_mdl$coefficients$mean
    }
    else {
        model_coeffs_dbl <- model_mdl$coefficients
    }
    param_nms_chr <- model_coeffs_dbl %>% names()
    mdl_smry_tb <- mdl_smry_tb %>% dplyr::mutate(Parameter = dplyr::case_when(Parameter == 
        "Intercept" ~ "(Intercept)", TRUE ~ purrr::map_chr(Parameter, 
        ~stringr::str_replace_all(.x, " ", "_")))) %>% dplyr::filter(Parameter %in% 
        param_nms_chr) %>% dplyr::slice(match(param_nms_chr, 
        Parameter))
    assertthat::assert_that(all(param_nms_chr == mdl_smry_tb$Parameter), 
        msg = "Parameter names mismatch between data and model summary table")
    model_coeffs_dbl <- mdl_smry_tb$Estimate
    names(model_coeffs_dbl) <- param_nms_chr
    if (ready4::get_from_lup_obj(mdl_types_lup, match_value_xx = mdl_type_1L_chr, 
        match_var_nm_1L_chr = "short_name_chr", target_var_nm_1L_chr = "fn_chr", 
        evaluate_1L_lgl = F) == "betareg::betareg") {
        model_mdl$coefficients$mean <- model_coeffs_dbl
    }
    else {
        model_mdl$coefficients <- model_coeffs_dbl
    }
    return(model_mdl)
}
#' Make summary of bayesian regression model model
#' @description make_smry_of_brm_mdl() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make summary of bayesian regression model model. The function returns Summary of bayesian regression model model (a tibble).
#' @param mdl_ls Model list (a list of models)
#' @param data_tb Data (a tibble)
#' @param depnt_var_nm_1L_chr Dependent variable name (a character vector of length one), Default: 'utl_total_w'
#' @param predr_vars_nms_chr Predictor variables names (a character vector)
#' @param mdl_nm_1L_chr Model name (a character vector of length one), Default: 'NA'
#' @param seed_1L_dbl Seed (a double vector of length one), Default: 23456
#' @param tfmn_1L_chr Transformation (a character vector of length one)
#' @return Summary of bayesian regression model model (a tibble)
#' @rdname make_smry_of_brm_mdl
#' @export 
#' @importFrom stats predict
#' @importFrom dplyr mutate across everything pull rename select
#' @importFrom brms bayes_R2
#' @importFrom psych describe
#' @importFrom rlang sym
#' @importFrom purrr map flatten_chr
#' @importFrom stringi stri_replace_last_fixed
#' @keywords internal
make_smry_of_brm_mdl <- function (mdl_ls, data_tb, depnt_var_nm_1L_chr = "utl_total_w", 
    predr_vars_nms_chr, mdl_nm_1L_chr = NA_character_, seed_1L_dbl = 23456, 
    tfmn_1L_chr) 
{
    if (is.na(mdl_nm_1L_chr)) 
        mdl_nm_1L_chr <- predr_vars_nms_chr[1]
    set.seed(seed_1L_dbl)
    predictions <- stats::predict(mdl_ls, summary = F) %>% calculate_depnt_var_tfmn(tfmn_1L_chr = tfmn_1L_chr, 
        tfmn_is_outp_1L_lgl = T)
    sd_intcpt_df <- summary(mdl_ls, digits = 4)$random[[1]]
    sd_intcpt_df <- sd_intcpt_df[1:nrow(sd_intcpt_df), 1:4] %>% 
        dplyr::mutate(dplyr::across(dplyr::everything(), as.numeric))
    coef <- summary(mdl_ls, digits = 4)$fixed
    coef <- coef[1:nrow(coef), 1:4] %>% dplyr::mutate(dplyr::across(dplyr::everything(), 
        as.numeric))
    R2 <- brms::bayes_R2(mdl_ls) %>% as.vector()
    RMSE <- psych::describe(apply(predictions, 1, calculate_rmse, 
        y_dbl = data_tb %>% dplyr::pull(!!rlang::sym(depnt_var_nm_1L_chr))), 
        quant = c(0.25, 0.75), skew = F, ranges = F)
    RMSE <- cbind(RMSE$mean, RMSE$sd, RMSE$Q0.25, RMSE$Q0.75) %>% 
        as.vector()
    Sigma <- summary(mdl_ls, digits = 4)$spec_par[1:4]
    smry_of_brm_mdl_tb <- data.frame(round(rbind(sd_intcpt_df, 
        coef, R2, RMSE, Sigma), 3)) %>% dplyr::mutate(Parameter = c("SD (Intercept)", 
        "Intercept", purrr::map(predr_vars_nms_chr, ~{
            possibilities_chr <- paste0(.x, c("", " baseline", 
                " change", " scaled", " unscaled"))
            if (possibilities_chr[1] %in% names(mdl_ls$data)) {
                values_xx <- mdl_ls$data %>% dplyr::pull(.x)
                if (is.factor(values_xx)) {
                  possibilities_chr <- c(possibilities_chr[1], 
                    paste0(.x, levels(values_xx)[2:length(levels(values_xx))]))
                }
            }
            possibilities_chr
        }) %>% purrr::flatten_chr() %>% intersect(purrr::map(names(mdl_ls$data), 
            ~{
                values_xx <- mdl_ls$data %>% dplyr::pull(.x)
                if (is.factor(values_xx)) {
                  paste0(.x, levels(values_xx)[2:length(levels(values_xx))])
                } else {
                  stringi::stri_replace_last_fixed(.x, "_baseline", 
                    " baseline") %>% stringi::stri_replace_last_fixed("_change", 
                    " change") %>% stringi::stri_replace_last_fixed("_scaled", 
                    " scaled") %>% stringi::stri_replace_last_fixed("_unscaled", 
                    " unscaled")
                }
            }) %>% purrr::flatten_chr()), "R2", "RMSE", "Sigma"), 
        Model = mdl_nm_1L_chr) %>% dplyr::mutate(`95% CI` = paste(l.95..CI, 
        ",", u.95..CI)) %>% dplyr::rename(SE = Est.Error) %>% 
        dplyr::select(Model, Parameter, Estimate, SE, `95% CI`)
    rownames(smry_of_brm_mdl_tb) <- NULL
    return(smry_of_brm_mdl_tb)
}
#' Make summary of model output
#' @description make_smry_of_mdl_outp() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make summary of model output. The function returns Summary of one predictor model (a tibble).
#' @param data_tb Data (a tibble)
#' @param folds_1L_int Folds (an integer vector of length one), Default: 10
#' @param depnt_var_min_val_1L_dbl Dependent variable minimum value (a double vector of length one), Default: numeric(0)
#' @param depnt_var_nm_1L_chr Dependent variable name (a character vector of length one), Default: 'utl_total_w'
#' @param start_1L_chr Start (a character vector of length one), Default: NULL
#' @param tfmn_1L_chr Transformation (a character vector of length one), Default: 'NTF'
#' @param predr_var_nm_1L_chr Predictor variable name (a character vector of length one)
#' @param covar_var_nms_chr Covariate variable names (a character vector), Default: 'NA'
#' @param mdl_type_1L_chr Model type (a character vector of length one), Default: 'OLS_NTF'
#' @param mdl_types_lup Model types (a lookup table), Default: NULL
#' @param predn_type_1L_chr Prediction type (a character vector of length one), Default: NULL
#' @return Summary of one predictor model (a tibble)
#' @rdname make_smry_of_mdl_outp
#' @export 
#' @importFrom utils data
#' @importFrom dplyr filter pull summarise_all mutate select everything
#' @importFrom rlang sym
#' @importFrom ready4 get_from_lup_obj
#' @importFrom purrr map_dfr
#' @importFrom stats predict
#' @importFrom tibble tibble
#' @importFrom caret R2 RMSE MAE
#' @keywords internal
make_smry_of_mdl_outp <- function (data_tb, folds_1L_int = 10, depnt_var_min_val_1L_dbl = numeric(0), 
    depnt_var_nm_1L_chr = "utl_total_w", start_1L_chr = NULL, 
    tfmn_1L_chr = "NTF", predr_var_nm_1L_chr, covar_var_nms_chr = NA_character_, 
    mdl_type_1L_chr = "OLS_NTF", mdl_types_lup = NULL, predn_type_1L_chr = NULL) 
{
    if (is.null(mdl_types_lup)) 
        utils::data("mdl_types_lup", envir = environment())
    data_tb <- data_tb %>% dplyr::filter(!is.na(!!rlang::sym(predr_var_nm_1L_chr)))
    data_tb <- transform_ds_for_mdlng(data_tb, depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, 
        depnt_var_nm_1L_chr = depnt_var_nm_1L_chr, predr_var_nm_1L_chr = predr_var_nm_1L_chr, 
        covar_var_nms_chr = covar_var_nms_chr)
    mdl_desc_1L_chr <- ready4::get_from_lup_obj(mdl_types_lup, 
        match_var_nm_1L_chr = "short_name_chr", match_value_xx = mdl_type_1L_chr, 
        target_var_nm_1L_chr = "long_name_chr", evaluate_1L_lgl = F)
    folds_ls <- make_folds_ls(data_tb, depnt_var_nm_1L_chr = depnt_var_nm_1L_chr, 
        folds_1L_int = folds_1L_int)
    control_1L_chr <- ready4::get_from_lup_obj(mdl_types_lup, 
        match_var_nm_1L_chr = "short_name_chr", match_value_xx = mdl_type_1L_chr, 
        target_var_nm_1L_chr = "control_chr", evaluate_1L_lgl = F)
    smry_of_one_predr_mdl_tb <- purrr::map_dfr(folds_ls, ~{
        model_mdl <- make_mdl(data_tb[-.x, ], depnt_var_nm_1L_chr = depnt_var_nm_1L_chr, 
            depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, 
            start_1L_chr = start_1L_chr, tfmn_1L_chr = tfmn_1L_chr, 
            predr_var_nm_1L_chr = predr_var_nm_1L_chr, covar_var_nms_chr = covar_var_nms_chr, 
            mdl_type_1L_chr = mdl_type_1L_chr, mdl_types_lup = mdl_types_lup, 
            control_1L_chr = control_1L_chr)
        predd_old_dbl <- stats::predict(model_mdl, type = predn_type_1L_chr) %>% 
            calculate_depnt_var_tfmn(tfmn_1L_chr = tfmn_1L_chr, 
                tfmn_is_outp_1L_lgl = T)
        predd_new_dbl <- stats::predict(model_mdl, newdata = data_tb[.x, 
            ], type = predn_type_1L_chr) %>% calculate_depnt_var_tfmn(tfmn_1L_chr = tfmn_1L_chr, 
            tfmn_is_outp_1L_lgl = T)
        tibble::tibble(Rsquared = caret::R2(predd_old_dbl, data_tb[-.x, 
            ] %>% dplyr::pull(!!rlang::sym(depnt_var_nm_1L_chr)), 
            form = "traditional"), RMSE = caret::RMSE(predd_old_dbl, 
            data_tb[-.x, ] %>% dplyr::pull(!!rlang::sym(depnt_var_nm_1L_chr))), 
            MAE = caret::MAE(predd_old_dbl, data_tb[-.x, ] %>% 
                dplyr::pull(!!rlang::sym(depnt_var_nm_1L_chr))), 
            RsquaredP = caret::R2(predd_new_dbl, data_tb[.x, 
                ] %>% dplyr::pull(!!rlang::sym(depnt_var_nm_1L_chr)), 
                form = "traditional"), RMSEP = caret::RMSE(predd_new_dbl, 
                data_tb[.x, ] %>% dplyr::pull(!!rlang::sym(depnt_var_nm_1L_chr))), 
            MAEP = caret::MAE(predd_new_dbl, data_tb[.x, ] %>% 
                dplyr::pull(!!rlang::sym(depnt_var_nm_1L_chr))))
    }) %>% dplyr::summarise_all(mean) %>% dplyr::mutate(Model = mdl_desc_1L_chr) %>% 
        dplyr::select(Model, dplyr::everything())
    return(smry_of_one_predr_mdl_tb)
}
#' Make summary of time series model output
#' @description make_smry_of_ts_mdl_outp() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make summary of time series model output. The function returns Summary of time series (a list of models).
#' @param data_tb Data (a tibble)
#' @param mdl_nm_1L_chr Model name (a character vector of length one)
#' @param mdl_types_lup Model types (a lookup table)
#' @param predr_vars_nms_chr Predictor variables names (a character vector)
#' @param predictors_lup Predictors (a lookup table)
#' @param backend_1L_chr Backend (a character vector of length one), Default: getOption("brms.backend", "rstan")
#' @param consent_1L_chr Consent (a character vector of length one), Default: ''
#' @param consent_indcs_int Consent indices (an integer vector), Default: 1
#' @param control_ls Control (a list), Default: NULL
#' @param depnt_var_min_val_1L_dbl Dependent variable minimum value (a double vector of length one), Default: numeric(0)
#' @param depnt_var_nm_1L_chr Dependent variable name (a character vector of length one), Default: 'utl_total_w'
#' @param id_var_nm_1L_chr Identity variable name (a character vector of length one), Default: 'fkClientID'
#' @param iters_1L_int Iterations (an integer vector of length one), Default: 4000
#' @param options_chr Options (a character vector), Default: c("Y", "N")
#' @param path_to_write_to_1L_chr Path to write to (a character vector of length one), Default: 'NA'
#' @param prior_ls Prior (a list), Default: NULL
#' @param round_bl_val_1L_chr Round baseline value (a character vector of length one), Default: 'Baseline'
#' @param round_var_nm_1L_chr Round variable name (a character vector of length one), Default: 'round'
#' @param seed_1L_int Seed (an integer vector of length one), Default: 1000
#' @param utl_min_val_1L_dbl Utility minimum value (a double vector of length one), Default: -1
#' @return Summary of time series (a list of models)
#' @rdname make_smry_of_ts_mdl_outp
#' @export 
#' @importFrom purrr map_dbl
#' @importFrom ready4 get_from_lup_obj write_to_delete_fls write_with_consent
#' @importFrom stringr str_remove str_sub
#' @importFrom stringi stri_locate_first_fixed
#' @importFrom rlang exec
#' @keywords internal
make_smry_of_ts_mdl_outp <- function (data_tb, mdl_nm_1L_chr, mdl_types_lup, predr_vars_nms_chr, 
    predictors_lup, backend_1L_chr = getOption("brms.backend", 
        "rstan"), consent_1L_chr = "", consent_indcs_int = 1L, 
    control_ls = NULL, depnt_var_min_val_1L_dbl = numeric(0), 
    depnt_var_nm_1L_chr = "utl_total_w", id_var_nm_1L_chr = "fkClientID", 
    iters_1L_int = 4000L, options_chr = c("Y", "N"), path_to_write_to_1L_chr = NA_character_, 
    prior_ls = NULL, round_bl_val_1L_chr = "Baseline", round_var_nm_1L_chr = "round", 
    seed_1L_int = 1000L, utl_min_val_1L_dbl = -1) 
{
    scaling_fctr_dbl <- predr_vars_nms_chr %>% purrr::map_dbl(~ifelse(.x %in% 
        predictors_lup$short_name_chr, ready4::get_from_lup_obj(predictors_lup, 
        target_var_nm_1L_chr = "mdl_scaling_dbl", match_value_xx = .x, 
        match_var_nm_1L_chr = "short_name_chr", evaluate_1L_lgl = F), 
        1))
    mdl_type_1L_chr <- mdl_nm_1L_chr %>% stringr::str_remove(paste0(predr_vars_nms_chr[1], 
        "_", ifelse(is.na(predr_vars_nms_chr[2]), "", paste0(predr_vars_nms_chr[2], 
            "_"))))
    mdl_type_1L_chr <- stringr::str_sub(mdl_type_1L_chr, start = 1 + 
        (mdl_type_1L_chr %>% stringi::stri_locate_first_fixed("_"))[1, 
            2] %>% as.vector())
    tfmn_1L_chr <- ready4::get_from_lup_obj(mdl_types_lup, target_var_nm_1L_chr = "tfmn_chr", 
        match_value_xx = mdl_type_1L_chr, match_var_nm_1L_chr = "short_name_chr", 
        evaluate_1L_lgl = F)
    tfd_data_tb <- transform_tb_to_mdl_inp(data_tb, depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, 
        depnt_var_nm_1L_chr = depnt_var_nm_1L_chr, predr_vars_nms_chr = predr_vars_nms_chr, 
        id_var_nm_1L_chr = id_var_nm_1L_chr, round_var_nm_1L_chr = round_var_nm_1L_chr, 
        round_bl_val_1L_chr = round_bl_val_1L_chr, scaling_fctr_dbl = scaling_fctr_dbl, 
        tfmn_1L_chr = tfmn_1L_chr)
    tfd_depnt_var_nm_1L_chr <- transform_depnt_var_nm(depnt_var_nm_1L_chr, 
        tfmn_1L_chr = tfmn_1L_chr)
    family_fn_1L_chr <- ready4::get_from_lup_obj(mdl_types_lup, 
        match_var_nm_1L_chr = "short_name_chr", match_value_xx = mdl_type_1L_chr, 
        target_var_nm_1L_chr = "family_chr", evaluate_1L_lgl = F)
    family_fn_1L_chr <- ifelse(is.na(family_fn_1L_chr), ifelse(startsWith(mdl_type_1L_chr, 
        "BET"), paste0("brms::Beta(link = \"", get_link_from_tfmn(stringr::str_sub(mdl_type_1L_chr, 
        start = -3)), "\")"), "gaussian(identity)"), family_fn_1L_chr)
    args_ls <- list(data_tb = tfd_data_tb, depnt_var_nm_1L_chr = tfd_depnt_var_nm_1L_chr, 
        predr_vars_nms_chr = predr_vars_nms_chr, id_var_nm_1L_chr = id_var_nm_1L_chr, 
        is_csnl_1L_lgl = !(!identical(round_var_nm_1L_chr, character(0)) && 
            ifelse(identical(round_var_nm_1L_chr, character(0)), 
                T, !is.na(round_var_nm_1L_chr))), iters_1L_int = iters_1L_int, 
        backend_1L_chr = backend_1L_chr, family_fn_1L_chr = family_fn_1L_chr, 
        seed_1L_int = seed_1L_int, prior_ls = prior_ls, control_ls = control_ls)
    mdl_ls <- rlang::exec(fit_ts_model_with_brm, !!!args_ls)
    smry_of_ts_mdl_ls <- list(smry_of_ts_mdl_tb = make_smry_of_brm_mdl(mdl_ls, 
        data_tb = tfd_data_tb, depnt_var_nm_1L_chr = tfd_depnt_var_nm_1L_chr, 
        predr_vars_nms_chr = predr_vars_nms_chr, mdl_nm_1L_chr = mdl_nm_1L_chr, 
        tfmn_1L_chr = tfmn_1L_chr))
    if (!is.na(path_to_write_to_1L_chr)) {
        smry_of_ts_mdl_ls$path_to_mdl_ls_1L_chr <- paste0(path_to_write_to_1L_chr, 
            "/", mdl_nm_1L_chr, ".RDS")
        capture_xx <- ready4::write_to_delete_fls(smry_of_ts_mdl_ls$path_to_mdl_ls_1L_chr, 
            consent_1L_chr = consent_1L_chr, consent_indcs_int = consent_indcs_int, 
            options_chr = options_chr)
        ready4::write_with_consent(consented_fn = saveRDS, consent_1L_chr = consent_1L_chr, 
            consent_indcs_int = consent_indcs_int, consented_args_ls = list(object = mdl_ls, 
                file = smry_of_ts_mdl_ls$path_to_mdl_ls_1L_chr), 
            consented_msg_1L_chr = paste0("File ", smry_of_ts_mdl_ls$path_to_mdl_ls_1L_chr, 
                " has been written"), declined_msg_1L_chr = "Write request cancelled - no new files have been written.", 
            options_chr = options_chr, prompt_1L_chr = paste0("Do you confirm that you want to write the file ", 
                smry_of_ts_mdl_ls$path_to_mdl_ls_1L_chr, "?"))
        smry_of_ts_mdl_ls$paths_to_mdl_plts_chr <- write_ts_mdl_plts(mdl_ls, 
            consent_1L_chr = consent_1L_chr, consent_indcs_int = consent_indcs_int, 
            depnt_var_nm_1L_chr = depnt_var_nm_1L_chr, mdl_nm_1L_chr = mdl_nm_1L_chr, 
            options_chr = options_chr, path_to_write_to_1L_chr = path_to_write_to_1L_chr, 
            round_var_nm_1L_chr = round_var_nm_1L_chr, tfd_data_tb = tfd_data_tb, 
            tfmn_1L_chr = tfmn_1L_chr, utl_min_val_1L_dbl = utl_min_val_1L_dbl)
    }
    return(smry_of_ts_mdl_ls)
}
#' Make single model summary tibble
#' @description make_sngl_mdl_smry_tb() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make single model summary tibble. The function returns New (a tibble).
#' @param mdls_tb Models (a tibble)
#' @param mdl_nm_1L_chr Model name (a character vector of length one)
#' @param mdl_type_1L_chr Model type (a character vector of length one)
#' @param add_mdl_nm_sfx_1L_lgl Add model name suffix (a logical vector of length one), Default: T
#' @return New (a tibble)
#' @rdname make_sngl_mdl_smry_tb
#' @export 
#' @importFrom dplyr filter select mutate case_when rename_with
#' @importFrom tibble add_case
#' @importFrom rlang sym
#' @importFrom ready4 get_from_lup_obj
#' @importFrom purrr map_chr
#' @importFrom stringr str_replace
#' @keywords internal
make_sngl_mdl_smry_tb <- function (mdls_tb, mdl_nm_1L_chr, mdl_type_1L_chr, add_mdl_nm_sfx_1L_lgl = T) 
{
    new_tb <- mdls_tb %>% dplyr::filter(Model == mdl_nm_1L_chr) %>% 
        tibble::add_case(Parameter = mdl_nm_1L_chr, .before = 1) %>% 
        dplyr::select(-Model)
    mdl_nm_sfx_1L_chr <- ifelse(add_mdl_nm_sfx_1L_lgl, paste0("_", 
        mdl_type_1L_chr), "")
    new_tb <- new_tb %>% dplyr::mutate(`:=`(!!rlang::sym(paste0("R2", 
        mdl_nm_sfx_1L_chr)), dplyr::case_when(Parameter == mdl_nm_1L_chr ~ 
        ready4::get_from_lup_obj(new_tb, match_value_xx = "R2", 
            match_var_nm_1L_chr = "Parameter", target_var_nm_1L_chr = "Estimate", 
            evaluate_1L_lgl = F), T ~ NA_character_)), `:=`(!!rlang::sym(paste0("Sigma", 
        mdl_nm_sfx_1L_chr)), dplyr::case_when(Parameter == mdl_nm_1L_chr ~ 
        ready4::get_from_lup_obj(new_tb, match_value_xx = "Sigma", 
            match_var_nm_1L_chr = "Parameter", target_var_nm_1L_chr = "Estimate", 
            evaluate_1L_lgl = F), T ~ NA_character_))) %>% dplyr::filter(!Parameter %in% 
        c("R2", "RMSE", "Sigma")) %>% dplyr::rename_with(~paste0(.x, 
        mdl_nm_sfx_1L_chr), .cols = c("Parameter", "Estimate", 
        "SE")) %>% dplyr::rename_with(~paste0("CI", mdl_nm_sfx_1L_chr), 
        .cols = c("95% CI")) %>% dplyr::mutate(`:=`(!!rlang::sym(paste0("Parameter", 
        mdl_nm_sfx_1L_chr)), !!rlang::sym(paste0("Parameter", 
        mdl_nm_sfx_1L_chr)) %>% purrr::map_chr(~stringr::str_replace(.x, 
        paste0("_1_", mdl_type_1L_chr), " model"))))
    rownames(new_tb) <- NULL
    return(new_tb)
}
#' Make study descriptions list
#' @description make_study_descs_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make study descriptions list. The function returns Input parameters (a list).
#' @param input_params_ls Input parameters (a list), Default: NULL
#' @param time_btwn_bl_and_fup_1L_chr Time between baseline and follow-up (a character vector of length one)
#' @param background_1L_chr Background (a character vector of length one), Default: ''
#' @param coi_1L_chr Conflict of interest (a character vector of length one), Default: 'None declared.'
#' @param conclusion_1L_chr Conclusion (a character vector of length one), Default: ''
#' @param ethics_1L_chr Ethics (a character vector of length one), Default: NULL
#' @param funding_1L_chr Funding (a character vector of length one), Default: NULL
#' @param predr_ctgs_ls Predictor categories (a list), Default: NULL
#' @param sample_desc_1L_chr Sample description (a character vector of length one), Default: NULL
#' @param var_nm_change_lup Variable name change (a lookup table), Default: NULL
#' @return Input parameters (a list)
#' @rdname make_study_descs_ls
#' @export 
make_study_descs_ls <- function (input_params_ls = NULL, time_btwn_bl_and_fup_1L_chr, 
    background_1L_chr = "", coi_1L_chr = "None declared.", conclusion_1L_chr = "", 
    ethics_1L_chr = NULL, funding_1L_chr = NULL, predr_ctgs_ls = NULL, 
    sample_desc_1L_chr = NULL, var_nm_change_lup = NULL) 
{
    health_utl_nm_1L_chr <- input_params_ls$short_and_long_nm[1]
    params_ls_ls <- input_params_ls
    health_utl_long_nm_1L_chr <- ifelse(!is.null(params_ls_ls$short_and_long_nm), 
        params_ls_ls$short_and_long_nm[2], NA_character_)
    study_descs_ls <- list(background_1L_chr = background_1L_chr, 
        coi_1L_chr = coi_1L_chr, conclusion_1L_chr = conclusion_1L_chr, 
        ethics_1L_chr = ethics_1L_chr, funding_1L_chr = funding_1L_chr, 
        health_utl_nm_1L_chr = health_utl_nm_1L_chr, health_utl_long_nm_1L_chr = health_utl_long_nm_1L_chr, 
        time_btwn_bl_and_fup_1L_chr = time_btwn_bl_and_fup_1L_chr, 
        predr_ctgs_ls = predr_ctgs_ls, sample_desc_1L_chr = sample_desc_1L_chr, 
        var_nm_change_lup = var_nm_change_lup)
    if (!is.null(input_params_ls)) {
        input_params_ls$study_descs_ls <- study_descs_ls
    }
    else {
        input_params_ls <- study_descs_ls
    }
    return(input_params_ls)
}
#' Make ten fold text
#' @description make_ten_fold_text() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make ten fold text. The function returns Text (a character vector of length one).
#' @param results_ls Results (a list)
#' @param for_abstract_1L_lgl For abstract (a logical vector of length one), Default: F
#' @return Text (a character vector of length one)
#' @rdname make_ten_fold_text
#' @export 
make_ten_fold_text <- function (results_ls, for_abstract_1L_lgl = F) 
{
    mdls_chr <- get_ordered_sngl_csnl_mdls(results_ls)
    if (for_abstract_1L_lgl) {
        text_1L_chr <- ifelse(length(mdls_chr) > 1, paste0(mdls_chr[1], 
            " had the highest predictive ability in ten fold cross validation"), 
            "")
    }
    else {
        text_1L_chr <- ifelse(length(mdls_chr) > 1, paste0(mdls_chr[1], 
            " had the highest predictive ability followed by ", 
            get_ordered_sngl_csnl_mdls(results_ls, select_int = -1, 
                collapse_1L_lgl = T), ". ", ifelse(length(mdls_chr) > 
                2, paste0(mdls_chr[length(mdls_chr)], " had the least predictive capability."), 
                "")), paste0("the predictive ability of ", mdls_chr[1]))
    }
    return(text_1L_chr)
}
#' Make ten folds table title
#' @description make_ten_folds_tbl_title() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make ten folds table title. The function returns Title (a character vector of length one).
#' @param results_ls Results (a list)
#' @param ref_1L_int Reference (an integer vector of length one), Default: 1
#' @return Title (a character vector of length one)
#' @rdname make_ten_folds_tbl_title
#' @export 
#' @importFrom stringi stri_replace_last
make_ten_folds_tbl_title <- function (results_ls, ref_1L_int = 1) 
{
    title_1L_chr <- ifelse(ref_1L_int == 1, paste0("10-fold cross-validated model fitting index for different ", 
        results_ls$ttu_cs_ls$best_mdl_types_ls %>% names() %>% 
            paste0(collapse = ", ") %>% stringi::stri_replace_last(fixed = ",", 
            " and"), " models using ", results_ls$ttu_cs_ls$cs_mdls_predrs_seq_dscdng_chr[1], 
        " as predictor with the baseline data"), paste0("10-fold cross-validated model fitting index for different candidate predictors estimated using ", 
        results_ls$ttu_cs_ls$selected_mdls_chr[1], " with the baseline data"))
    return(title_1L_chr)
}
#' Make transformed single predictor models tibble
#' @description make_tfd_sngl_predr_mdls_tb() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make transformed single predictor models tibble. The function returns Transformed single predictor models (a tibble).
#' @param outp_smry_ls Output summary (a list)
#' @param nbr_of_digits_1L_int Number of digits (an integer vector of length one), Default: 2
#' @param mdl_pfx_ls Model prefix (a list), Default: list(OLS = "Ordinary Least Squares ", GLM = c("Generalised Linear Model with ", 
#'    "Beta Regression Model with Binomial "))
#' @return Transformed single predictor models (a tibble)
#' @rdname make_tfd_sngl_predr_mdls_tb
#' @export 
#' @importFrom purrr map2 map_lgl map_dfr
#' @importFrom dplyr filter mutate case_when
#' @importFrom stringr str_replace_all str_remove_all
#' @importFrom tibble add_case
#' @keywords internal
make_tfd_sngl_predr_mdls_tb <- function (outp_smry_ls, nbr_of_digits_1L_int = 2L, mdl_pfx_ls = list(OLS = "Ordinary Least Squares ", 
    GLM = c("Generalised Linear Model with ", "Beta Regression Model with Binomial "))) 
{
    tfd_sngl_predr_mdls_tb <- mdl_pfx_ls %>% purrr::map2(names(mdl_pfx_ls), 
        ~{
            pfx_chr <- .x
            mdls_tb <- outp_smry_ls$smry_of_sngl_predr_mdls_tb %>% 
                dplyr::filter(Model %>% purrr::map_lgl(~{
                  term_1L_chr <- .x
                  pfx_chr %>% purrr::map_lgl(~startsWith(term_1L_chr, 
                    .x)) %>% any()
                }))
            pfx_chr %>% purrr::map_dfr(~{
                pfx_1L_chr <- .x
                mdls_tb %>% dplyr::filter(startsWith(Model, pfx_1L_chr)) %>% 
                  dplyr::mutate(Model = dplyr::case_when(Model %>% 
                    startsWith(mdl_pfx_ls[[2]][2]) ~ stringr::str_replace_all(Model, 
                    pfx_1L_chr, "Beta "), T ~ stringr::str_remove_all(Model, 
                    pfx_1L_chr))) %>% dplyr::mutate(Model = Model %>% 
                  stringr::str_remove_all("\\(|\\)"))
            }) %>% tibble::add_case(Model = .y, .before = 1)
        }) %>% purrr::map_dfr(~.x) %>% transform_tbl_to_rnd_vars(nbr_of_digits_1L_int = nbr_of_digits_1L_int)
    return(tfd_sngl_predr_mdls_tb)
}
#' Make transformation comparison plot
#' @description make_tfmn_cmprsn_plt() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make transformation comparison plot. The function returns Transformation comparison (a plot).
#' @param data_tb Data (a tibble)
#' @param depnt_var_nm_1L_chr Dependent variable name (a character vector of length one)
#' @param dictionary_tb Dictionary (a tibble)
#' @return Transformation comparison (a plot)
#' @rdname make_tfmn_cmprsn_plt
#' @export 
#' @importFrom tidyr gather
#' @importFrom dplyr mutate
#' @importFrom rlang sym
#' @importFrom psych logit
#' @importFrom ggplot2 ggplot aes geom_rug facet_wrap theme_bw labs
#' @importFrom ggalt geom_bkde
#' @importFrom viridis scale_fill_viridis
#' @importFrom ready4 get_from_lup_obj
make_tfmn_cmprsn_plt <- function (data_tb, depnt_var_nm_1L_chr, dictionary_tb) 
{
    tfmn_cmprsn_plt <- tidyr::gather(data_tb %>% dplyr::mutate(`:=`(!!rlang::sym(paste0(depnt_var_nm_1L_chr, 
        "_log")), log(!!rlang::sym(depnt_var_nm_1L_chr))), `:=`(!!rlang::sym(paste0(depnt_var_nm_1L_chr, 
        "_logit")), psych::logit(!!rlang::sym(depnt_var_nm_1L_chr))), 
        `:=`(!!rlang::sym(paste0(depnt_var_nm_1L_chr, "_loglog")), 
            -log(-log(!!rlang::sym(depnt_var_nm_1L_chr)))), `:=`(!!rlang::sym(paste0(depnt_var_nm_1L_chr, 
            "_cloglog")), log(-log(1 - !!rlang::sym(depnt_var_nm_1L_chr))))), 
        variable, value, !!rlang::sym(depnt_var_nm_1L_chr), !!rlang::sym(paste0(depnt_var_nm_1L_chr, 
            "_log")), !!rlang::sym(paste0(depnt_var_nm_1L_chr, 
            "_logit")), !!rlang::sym(paste0(depnt_var_nm_1L_chr, 
            "_loglog")), !!rlang::sym(paste0(depnt_var_nm_1L_chr, 
            "_cloglog"))) %>% dplyr::mutate(variable = factor(variable, 
        levels = paste0(depnt_var_nm_1L_chr, c("", "_log", "_logit", 
            "_loglog", "_cloglog")), labels = c("No transformation", 
            "Log", "Logit", "Log-log", "Complementary log-log"))) %>% 
        ggplot2::ggplot(ggplot2::aes(x = value, fill = variable)) + 
        ggalt::geom_bkde() + ggplot2::geom_rug() + viridis::scale_fill_viridis(guide = "none", 
        discrete = TRUE) + ggplot2::facet_wrap(~variable, scales = "free") + 
        ggplot2::theme_bw() + ggplot2::labs(x = paste0("Transformed ", 
        dictionary_tb %>% ready4::get_from_lup_obj(match_var_nm_1L_chr = "var_nm_chr", 
            match_value_xx = depnt_var_nm_1L_chr, target_var_nm_1L_chr = "var_desc_chr", 
            evaluate_1L_lgl = F)))
    return(tfmn_cmprsn_plt)
}
#' Make transfer to utility algorithm cross-section list
#' @description make_ttu_cs_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make transfer to utility algorithm cross-section list. The function returns Transfer to utility algorithm cross-section (a list).
#' @param outp_smry_ls Output summary (a list)
#' @param sig_covars_some_predrs_mdls_tb Sig covariates some predictors models (a tibble)
#' @param sig_thresh_covars_1L_chr Sig thresh covariates (a character vector of length one)
#' @return Transfer to utility algorithm cross-section (a list)
#' @rdname make_ttu_cs_ls
#' @export 
#' @importFrom purrr map_chr
#' @importFrom ready4 get_from_lup_obj
#' @keywords internal
make_ttu_cs_ls <- function (outp_smry_ls, sig_covars_some_predrs_mdls_tb, sig_thresh_covars_1L_chr) 
{
    ttu_cs_ls <- list(best_mdl_types_ls = list(GLM = c("Gaussian distribution and log link"), 
        OLS = c("no transformation", "log transformation", "clog-log transformation")), 
        selected_mdls_chr = outp_smry_ls$prefd_mdl_types_chr %>% 
            purrr::map_chr(~paste0(ready4::get_from_lup_obj(outp_smry_ls$mdl_types_lup, 
                match_var_nm_1L_chr = "short_name_chr", match_value_xx = .x, 
                target_var_nm_1L_chr = "fixed_acronym_chr", evaluate_1L_lgl = F), 
                " with ", ready4::get_from_lup_obj(outp_smry_ls$mdl_types_lup, 
                  match_var_nm_1L_chr = "short_name_chr", match_value_xx = .x, 
                  target_var_nm_1L_chr = "with_chr", evaluate_1L_lgl = F))), 
        cs_mdls_predrs_seq_dscdng_chr = outp_smry_ls$smry_of_mdl_sngl_predrs_tb$Predictor, 
        sig_covars_all_predrs_mdls_chr = outp_smry_ls$signt_covars_chr, 
        sig_thresh_covars_1L_chr = sig_thresh_covars_1L_chr, 
        sig_covars_some_predrs_mdls_tb = sig_covars_some_predrs_mdls_tb, 
        rf_seq_dscdng_chr = outp_smry_ls$predr_cmprsn_tb$predr_chr, 
        mdl_predrs_and_rf_seqs_cmprsn_1L_chr = ifelse(outp_smry_ls$smry_of_mdl_sngl_predrs_tb$Predictor[1] == 
            outp_smry_ls$predr_cmprsn_tb$predr_chr[1], "is consistent", 
            "contrasts"))
    return(ttu_cs_ls)
}
#' Make unique identifier rename lookup table
#' @description make_uid_rename_lup() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make unique identifier rename lookup table. The function returns Unique identifier rename lookup table (a tibble).
#' @param data_tb Data (a tibble)
#' @param id_var_nm_1L_chr Identity variable name (a character vector of length one), Default: 'UID'
#' @return Unique identifier rename lookup table (a tibble)
#' @rdname make_uid_rename_lup
#' @export 
#' @importFrom tibble tibble
#' @importFrom dplyr pull
#' @keywords internal
make_uid_rename_lup <- function (data_tb, id_var_nm_1L_chr = "UID") 
{
    uid_rename_lup_tb <- tibble::tibble(old_id_xx = data_tb %>% 
        dplyr::pull(id_var_nm_1L_chr) %>% unique(), new_id_int = 1:length(data_tb %>% 
        dplyr::pull(id_var_nm_1L_chr) %>% unique()))
    return(uid_rename_lup_tb)
}
#' Make unique list element index integer vector
#' @description make_unique_ls_elmt_idx_int() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make unique list element index integer vector. The function returns Unique list element index (an integer vector).
#' @param data_ls Data (a list)
#' @return Unique list element index (an integer vector)
#' @rdname make_unique_ls_elmt_idx_int
#' @export 
#' @importFrom tibble tibble
#' @importFrom purrr map_chr
#' @importFrom dplyr group_by mutate row_number
#' @keywords internal
make_unique_ls_elmt_idx_int <- function (data_ls) 
{
    combos_tb <- tibble::tibble(names_chr = data_ls %>% purrr::map_chr(~paste0(.x[1], 
        ifelse(length(.x) > 1, .x[2], ""))), indices_int = NA_integer_)
    combos_tb <- combos_tb %>% dplyr::group_by(names_chr) %>% 
        dplyr::mutate(indices_int = dplyr::row_number())
    unique_ls_elmt_idx_int <- combos_tb$indices_int
    return(unique_ls_elmt_idx_int)
}
#' Make valid parameters list list
#' @description make_valid_params_ls_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make valid parameters list list. The function returns Valid parameters (a list of lists).
#' @param analysis_core_params_ls Analysis core parameters (a list)
#' @param ds_tb Dataset (a tibble)
#' @param path_params_ls Path parameters (a list)
#' @param maui_params_ls Multi-attribute utility instrument parameters (a list)
#' @param candidate_covar_nms_chr Candidate covariate names (a character vector), Default: 'NA'
#' @param prefd_covars_chr Preferred covariates (a character vector), Default: NULL
#' @param prefd_mdl_types_chr Preferred model types (a character vector), Default: NULL
#' @param raw_ds_tfmn_fn Raw dataset transformation (a function), Default: NULL
#' @param scndry_analysis_extra_vars_chr Secondary analysis extra variables (a character vector), Default: 'NA'
#' @param subtitle_1L_chr Subtitle (a character vector of length one), Default: 'Methods Report 1: Analysis Program (Primary Analysis)'
#' @param utl_class_fn_1L_chr Utility class function (a character vector of length one), Default: 'as.numeric'
#' @return Valid parameters (a list of lists)
#' @rdname make_valid_params_ls_ls
#' @export 
#' @keywords internal
make_valid_params_ls_ls <- function (analysis_core_params_ls, ds_tb, path_params_ls, maui_params_ls, 
    candidate_covar_nms_chr = NA_character_, prefd_covars_chr = NULL, 
    prefd_mdl_types_chr = NULL, raw_ds_tfmn_fn = NULL, scndry_analysis_extra_vars_chr = NA_character_, 
    subtitle_1L_chr = "Methods Report 1: Analysis Program (Primary Analysis)", 
    utl_class_fn_1L_chr = "as.numeric") 
{
    valid_params_ls_ls <- make_prmry_analysis_params_ls(analysis_core_params_ls = analysis_core_params_ls, 
        candidate_covar_nms_chr = candidate_covar_nms_chr, ds_tb = ds_tb, 
        path_params_ls = path_params_ls, maui_params_ls = maui_params_ls, 
        prefd_covars_chr = prefd_covars_chr, prefd_mdl_types_chr = prefd_mdl_types_chr, 
        raw_ds_tfmn_fn = raw_ds_tfmn_fn, subtitle_1L_chr = subtitle_1L_chr, 
        utl_class_fn_1L_chr = utl_class_fn_1L_chr) %>% transform_params_ls_to_valid(scndry_analysis_extra_vars_chr = scndry_analysis_extra_vars_chr)
    valid_params_ls_ls$params_ls$short_and_long_nm <- NULL
    valid_params_ls_ls$short_and_long_nm <- maui_params_ls$short_and_long_nm
    valid_params_ls_ls$path_params_ls <- path_params_ls
    return(valid_params_ls_ls)
}
#' Make within between ratios text
#' @description make_within_between_ratios_text() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make within between ratios text. The function returns Text (a character vector of length one).
#' @param results_ls Results (a list)
#' @param exclude_covars_1L_lgl Exclude covariates (a logical vector of length one), Default: F
#' @return Text (a character vector of length one)
#' @rdname make_within_between_ratios_text
#' @export 
#' @importFrom dplyr distinct filter
#' @importFrom purrr pmap_chr
#' @importFrom stringi stri_replace_last
make_within_between_ratios_text <- function (results_ls, exclude_covars_1L_lgl = F) 
{
    tb <- results_ls$ttu_lngl_ls$cs_ts_ratios_tb %>% dplyr::distinct()
    if (exclude_covars_1L_lgl) 
        tb <- tb %>% dplyr::filter(contains_cndt_predr_lgl)
    text_1L_chr <- tb %>% purrr::pmap_chr(~paste0(..2, " for ", 
        ..1)) %>% paste0(collapse = ", ") %>% stringi::stri_replace_last(fixed = ",", 
        " and")
    return(text_1L_chr)
}