R/fn_make.R

In ready4-dev/youthvars: Describe and Validate Youth Mental Health Economic Datasets

#' Make adolescent Assessment of Quality of Life Six Dimension disvalue lookup table
#' @description make_adol_aqol6d_disv_lup() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make adolescent assessment of quality of life six dimension disvalue lookup table. The function returns Adolescent Assessment of Quality of Life Six Dimension disvalue (a lookup table).
#' @param aqol6d_scrg_dss_ls Assessment of Quality of Life Six Dimension scoring datasets (a list), Default: NULL
#' @return Adolescent Assessment of Quality of Life Six Dimension disvalue (a lookup table)
#' @rdname make_adol_aqol6d_disv_lup
#' @export 
#' @importFrom lifecycle deprecate_soft
#' @importFrom dplyr mutate case_when
#' @keywords internal
make_adol_aqol6d_disv_lup <- function (aqol6d_scrg_dss_ls = NULL) 
{
    lifecycle::deprecate_soft("0.0.0.9078", "youthvars::make_adol_aqol6d_disv_lup()", 
        "scorz::make_adol_aqol6d_disv_lup()")
    if (is.null(aqol6d_scrg_dss_ls)) 
        aqol6d_scrg_dss_ls <- get_aqol6d_scrg_dss()
    aqol6d_adult_disv_lup_tb <- aqol6d_scrg_dss_ls$aqol6d_adult_disv_lup_tb
    adol_aqol6d_disv_lup <- aqol6d_adult_disv_lup_tb %>% dplyr::mutate(Answer_4_dbl = dplyr::case_when(Question_chr == 
        "Q18" ~ 0.622, TRUE ~ Answer_4_dbl), Answer_5_dbl = dplyr::case_when(Question_chr == 
        "Q3" ~ 0.827, TRUE ~ Answer_5_dbl), Answer_6_dbl = dplyr::case_when(Question_chr == 
        "Q1" ~ 0.073, TRUE ~ Answer_5_dbl))
    return(adol_aqol6d_disv_lup)
}
#' Make Assessment of Quality of Life Six Dimension adolescent pop tibbles list
#' @description make_aqol6d_adol_pop_tbs_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make assessment of quality of life six dimension adolescent pop tibbles list. The function returns Assessment of Quality of Life Six Dimension adolescent pop tibbles (a list).
#' @param aqol_items_prpns_tbs_ls Assessment of Quality of Life items proportions tibbles (a list)
#' @param aqol_scores_pars_ls Assessment of Quality of Life scores pars (a list)
#' @param series_names_chr Series names (a character vector)
#' @param synth_data_spine_ls Synthetic data spine (a list)
#' @param temporal_cors_ls Temporal correlations (a list)
#' @param aqol6d_scrg_dss_ls Assessment of Quality of Life Six Dimension scoring datasets (a list), Default: NULL
#' @param id_var_nm_1L_chr Identity variable name (a character vector of length one), Default: 'fkClientID'
#' @param prefix_chr Prefix (a character vector), Default: c(uid = "Participant_", aqol_item = "aqol6d_q", domain_unwtd_pfx_1L_chr = "aqol6d_subtotal_c_", 
#'    domain_wtd_pfx_1L_chr = "aqol6d_subtotal_w_")
#' @return Assessment of Quality of Life Six Dimension adolescent pop tibbles (a list)
#' @rdname make_aqol6d_adol_pop_tbs_ls
#' @export 
#' @importFrom lifecycle deprecate_soft
#' @importFrom purrr map
#' @importFrom dplyr select starts_with everything
#' @importFrom rlang sym
#' @keywords internal
make_aqol6d_adol_pop_tbs_ls <- function (aqol_items_prpns_tbs_ls, aqol_scores_pars_ls, series_names_chr, 
    synth_data_spine_ls, temporal_cors_ls, aqol6d_scrg_dss_ls = NULL, 
    id_var_nm_1L_chr = "fkClientID", prefix_chr = c(uid = "Participant_", 
        aqol_item = "aqol6d_q", domain_unwtd_pfx_1L_chr = "aqol6d_subtotal_c_", 
        domain_wtd_pfx_1L_chr = "aqol6d_subtotal_w_")) 
{
    lifecycle::deprecate_soft("0.0.0.9078", "youthvars::make_aqol6d_adol_pop_tbs_ls()", 
        "scorz::make_aqol6d_adol_pop_tbs_ls()")
    if (is.null(aqol6d_scrg_dss_ls)) {
        aqol6d_scrg_dss_ls <- get_aqol6d_scrg_dss()
    }
    domain_qs_lup_tb <- aqol6d_scrg_dss_ls$aqol6d_domain_qs_lup_tb
    item_pfx_1L_chr <- prefix_chr[["aqol_item"]]
    uid_pfx_1L_chr <- prefix_chr[["uid"]]
    aqol6d_adol_pop_tbs_ls <- make_synth_series_tbs_ls(synth_data_spine_ls, 
        series_names_chr = series_names_chr) %>% add_cors_and_utls_to_aqol6d_tbs_ls(aqol_scores_pars_ls = aqol_scores_pars_ls, 
        aqol_items_prpns_tbs_ls = aqol_items_prpns_tbs_ls, temporal_cors_ls = temporal_cors_ls, 
        prefix_chr = prefix_chr, aqol_tots_var_nms_chr = synth_data_spine_ls$aqol_tots_var_nms_chr, 
        aqol6d_scrg_dss_ls = aqol6d_scrg_dss_ls, id_var_nm_1L_chr = id_var_nm_1L_chr) %>% 
        purrr::map(~{
            domain_items_ls <- make_domain_items_ls(domain_qs_lup_tb = domain_qs_lup_tb, 
                item_pfx_1L_chr = item_pfx_1L_chr)
            domain_items_ls %>% add_unwtd_dim_tots(items_tb = .x, 
                domain_pfx_1L_chr = prefix_chr[["domain_unwtd_pfx_1L_chr"]]) %>% 
                add_wtd_dim_tots(domain_items_ls = domain_items_ls, 
                  domain_unwtd_pfx_1L_chr = prefix_chr[["domain_unwtd_pfx_1L_chr"]], 
                  domain_wtd_pfx_1L_chr = prefix_chr[["domain_wtd_pfx_1L_chr"]], 
                  aqol6d_scrg_dss_ls = aqol6d_scrg_dss_ls) %>% 
                add_labels_to_aqol6d_tb()
        }) %>% purrr::map(~.x %>% dplyr::select(!!rlang::sym(id_var_nm_1L_chr), 
        dplyr::starts_with(item_pfx_1L_chr), dplyr::starts_with(prefix_chr[["domain_unwtd_pfx_1L_chr"]]), 
        dplyr::starts_with(prefix_chr[["domain_wtd_pfx_1L_chr"]]), 
        dplyr::everything()))
    return(aqol6d_adol_pop_tbs_ls)
}
#' Make Assessment of Quality of Life Six Dimension functions list
#' @description make_aqol6d_fns_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make assessment of quality of life six dimension functions list. The function returns Assessment of Quality of Life Six Dimension disu (a list of functions).
#' @param domain_items_ls Domain items (a list)
#' @return Assessment of Quality of Life Six Dimension disu (a list of functions)
#' @rdname make_aqol6d_fns_ls
#' @export 
#' @importFrom lifecycle deprecate_soft
#' @importFrom purrr map
#' @importFrom rlang sym
#' @keywords internal
make_aqol6d_fns_ls <- function (domain_items_ls) 
{
    lifecycle::deprecate_soft("0.0.0.9078", "youthvars::make_aqol6d_fns_ls()", 
        "scorz::make_aqol6d_fns_ls()")
    aqol6d_disu_fn_ls <- paste0("calculate_aqol6d_dim_", 1:length(domain_items_ls), 
        "_disv") %>% purrr::map(~rlang::sym(.x))
    return(aqol6d_disu_fn_ls)
}
#' Make Assessment of Quality of Life Six Dimension items tibble
#' @description make_aqol6d_items_tb() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make assessment of quality of life six dimension items tibble. The function returns Assessment of Quality of Life Six Dimension items (a tibble).
#' @param aqol_tb Assessment of Quality of Life (a tibble)
#' @param old_pfx_1L_chr Old prefix (a character vector of length one)
#' @param new_pfx_1L_chr New prefix (a character vector of length one)
#' @return Assessment of Quality of Life Six Dimension items (a tibble)
#' @rdname make_aqol6d_items_tb
#' @export 
#' @importFrom lifecycle deprecate_soft
#' @importFrom dplyr select starts_with rename_all
#' @importFrom stringr str_replace
#' @keywords internal
make_aqol6d_items_tb <- function (aqol_tb, old_pfx_1L_chr, new_pfx_1L_chr) 
{
    lifecycle::deprecate_soft("0.0.0.9078", "youthvars::make_aqol6d_items_tb()", 
        "scorz::make_aqol6d_items_tb()")
    aqol6d_items_tb <- aqol_tb %>% dplyr::select(dplyr::starts_with(old_pfx_1L_chr)) %>% 
        dplyr::rename_all(~{
            stringr::str_replace(., old_pfx_1L_chr, new_pfx_1L_chr)
        })
    return(aqol6d_items_tb)
}
#' Make complete proportions tibbles list
#' @description make_complete_prpns_tbs_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make complete proportions tibbles list. The function returns Complete proportions tibbles (a list).
#' @param raw_prpns_tbs_ls Raw proportions tibbles (a list)
#' @param question_var_nm_1L_chr Question variable name (a character vector of length one), Default: 'Question'
#' @return Complete proportions tibbles (a list)
#' @rdname make_complete_prpns_tbs_ls
#' @export 
#' @importFrom purrr map map2_dbl
#' @importFrom dplyr mutate select mutate_if
#' @importFrom rlang sym
#' @keywords internal
make_complete_prpns_tbs_ls <- function (raw_prpns_tbs_ls, question_var_nm_1L_chr = "Question") 
{
    complete_prpns_tbs_ls <- raw_prpns_tbs_ls %>% purrr::map(~{
        .x %>% dplyr::mutate(total_prop_dbl = rowSums(dplyr::select(., 
            -!!rlang::sym(question_var_nm_1L_chr)), na.rm = T) - 
            100) %>% dplyr::mutate_if(is.numeric, ~purrr::map2_dbl(., 
            total_prop_dbl, ~ifelse(.x == 100, 1 - .y, .x))) %>% 
            dplyr::select(-total_prop_dbl)
    })
    return(complete_prpns_tbs_ls)
}
#' Make correlated data tibble
#' @description make_correlated_data_tb() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make correlated data tibble. The function returns Correlated data (a tibble).
#' @param synth_data_spine_ls Synthetic data spine (a list)
#' @param synth_data_idx_1L_dbl Synthetic data index (a double vector of length one), Default: 1
#' @return Correlated data (a tibble)
#' @rdname make_correlated_data_tb
#' @export 
#' @importFrom simstudy genCorData
#' @keywords internal
make_correlated_data_tb <- function (synth_data_spine_ls, synth_data_idx_1L_dbl = 1) 
{
    correlated_data_tb <- simstudy::genCorData(synth_data_spine_ls$nbr_obs_dbl[synth_data_idx_1L_dbl], 
        mu = synth_data_spine_ls$means_ls[[synth_data_idx_1L_dbl]], 
        sigma = synth_data_spine_ls$sds_ls[[synth_data_idx_1L_dbl]], 
        corMatrix = make_pdef_cor_mat_mat(synth_data_spine_ls$cor_mat_ls[[synth_data_idx_1L_dbl]]), 
        cnames = synth_data_spine_ls$var_names_chr) %>% force_min_max_and_int_cnstrs(var_names_chr = synth_data_spine_ls$var_names_chr, 
        min_max_ls = synth_data_spine_ls$min_max_ls, discrete_lgl = synth_data_spine_ls$discrete_lgl)
    return(correlated_data_tb)
}
#' Make correlations with utility table
#' @description make_cors_with_utl_tbl() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make correlations with utility table. The function returns Correlations with utility (a tibble).
#' @param data_tb Data (a tibble)
#' @param ds_descvs_ls Dataset descriptives (a list)
#' @param dictionary_tb Dictionary (a tibble), Default: NULL
#' @param cor_type_1L_chr Correlation type (a character vector of length one), Default: 'pearson'
#' @return Correlations with utility (a tibble)
#' @rdname make_cors_with_utl_tbl
#' @export 
#' @importFrom purrr map map2_dfc map_chr
#' @importFrom dplyr filter select mutate everything
#' @importFrom rlang sym syms
#' @importFrom Hmisc rcorr
#' @importFrom tibble tibble
#' @importFrom ready4 get_from_lup_obj
#' @keywords internal
make_cors_with_utl_tbl <- function (data_tb, ds_descvs_ls, dictionary_tb = NULL, cor_type_1L_chr = "pearson") 
{
    cors_with_utl_tb <- purrr::map(ds_descvs_ls$round_vals_chr, 
        ~data_tb %>% dplyr::filter(!!rlang::sym(ds_descvs_ls$round_var_nm_1L_chr) == 
            .x) %>% dplyr::select(!!!rlang::syms(c(ds_descvs_ls$utl_wtd_var_nm_1L_chr, 
            ds_descvs_ls$candidate_predrs_chr))) %>% as.matrix() %>% 
            Hmisc::rcorr(type = cor_type_1L_chr)) %>% purrr::map2_dfc(ds_descvs_ls$round_vals_chr, 
        ~tibble::tibble(`:=`(!!rlang::sym(paste0(.y, "_cor_dbl")), 
            .x[[1]][2:(length(ds_descvs_ls$candidate_predrs_chr) + 
                1)]), `:=`(!!rlang::sym(paste0(.y, "_sig_dbl")), 
            .x[[3]][2:(length(ds_descvs_ls$candidate_predrs_chr) + 
                1)]))) %>% dplyr::mutate(variable_chr = ds_descvs_ls$candidate_predrs_chr) %>% 
        dplyr::select(variable_chr, dplyr::everything())
    if (!is.null(dictionary_tb)) {
        cors_with_utl_tb <- cors_with_utl_tb %>% dplyr::mutate(variable_chr = variable_chr %>% 
            purrr::map_chr(~ready4::get_from_lup_obj(dictionary_tb, 
                target_var_nm_1L_chr = "var_desc_chr", match_var_nm_1L_chr = "var_nm_chr", 
                match_value_xx = .x, evaluate_1L_lgl = F)))
    }
    return(cors_with_utl_tb)
}
#' Make starred correlations table output object of multiple potential types
#' @description make_corstars_tbl_xx() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make starred correlations table output object of multiple potential types. The function is called for its side effects and does not return a value.
#' @param x An object
#' @param caption_1L_chr Caption (a character vector of length one), Default: NULL
#' @param mkdn_tbl_ref_1L_chr Markdown table reference (a character vector of length one), Default: NULL
#' @param method_chr Method (a character vector), Default: c("pearson", "spearman")
#' @param removeTriangle_chr RemoveTriangle (a character vector), Default: c("upper", "lower")
#' @param result_chr Result (a character vector), Default: 'none'
#' @return No return value, called for side effects.
#' @rdname make_corstars_tbl_xx
#' @export 
#' @importFrom Hmisc rcorr
#' @importFrom purrr discard map_int map_chr
#' @importFrom stringr str_trim
#' @importFrom stringi stri_replace_last
#' @importFrom knitr opts_current
#' @importFrom ready4show print_table
make_corstars_tbl_xx <- function (x, caption_1L_chr = NULL, mkdn_tbl_ref_1L_chr = NULL, 
    method_chr = c("pearson", "spearman"), removeTriangle_chr = c("upper", 
        "lower"), result_chr = "none") 
{
    x <- as.matrix(x)
    correlation_matrix <- Hmisc::rcorr(x, type = method_chr[1])
    R <- correlation_matrix$r
    p <- correlation_matrix$P
    mystars <- ifelse(p < 1e-04, "****", ifelse(p < 0.001, "*** ", 
        ifelse(p < 0.01, "**  ", ifelse(p < 0.05, "*   ", "    "))))
    R <- format(round(cbind(rep(-1.11, ncol(x)), R), 2))[, -1]
    Rnew <- matrix(paste(R, mystars, sep = ""), ncol = ncol(x))
    diag(Rnew) <- paste(diag(R), " ", sep = "")
    rownames(Rnew) <- colnames(x)
    colnames(Rnew) <- paste(colnames(x), "", sep = "")
    if (removeTriangle_chr[1] == "upper") {
        Rnew <- as.matrix(Rnew)
        Rnew[upper.tri(Rnew, diag = TRUE)] <- ""
        Rnew <- as.data.frame(Rnew)
    }
    else {
        if (removeTriangle_chr[1] == "lower") {
            Rnew <- as.matrix(Rnew)
            Rnew[lower.tri(Rnew, diag = TRUE)] <- ""
            Rnew <- as.data.frame(Rnew)
        }
    }
    Rnew <- cbind(Rnew[1:length(Rnew) - 1])
    stars_chr <- mystars %>% as.vector() %>% unique() %>% purrr::discard(is.na) %>% 
        stringr::str_trim()
    stars_chr <- stars_chr[order(stars_chr, purrr::map_int(stars_chr, 
        ~nchar(.x)))]
    footnotes_chr <- stars_chr %>% purrr::map_chr(~{
        paste0(.x, " p<", switch(nchar(.x), "0.05", "0.01", "0.001", 
            "0.0001"))
    })
    footnotes_chr <- paste0("Note: ", footnotes_chr %>% paste0(collapse = ", ") %>% 
        stringi::stri_replace_last(fixed = ",", " and"))
    if (result_chr[1] == "none") 
        return(Rnew)
    else {
        if (is.null(caption_1L_chr)) 
            caption_1L_chr <- knitr::opts_current$get("tab.cap")
        if (is.null(mkdn_tbl_ref_1L_chr)) 
            mkdn_tbl_ref_1L_chr <- paste0("tab:", knitr::opts_current$get("tab.id"))
        add_to_row_ls <- list()
        add_to_row_ls$pos <- list(nrow(Rnew))
        add_to_row_ls$command <- c(paste0("\\hline\n", "{\\footnotesize ", 
            footnotes_chr, "}\n"))
        Rnew %>% ready4show::print_table(output_type_1L_chr = result_chr[1], 
            add_to_row_ls = add_to_row_ls, caption_1L_chr = caption_1L_chr, 
            footnotes_chr = footnotes_chr, inc_col_nms_1L_lgl = T, 
            inc_row_nms_1L_lgl = T, mkdn_tbl_ref_1L_chr = mkdn_tbl_ref_1L_chr, 
            use_rdocx_1L_lgl = ifelse(result_chr[1] == "Word", 
                T, F))
    }
}
#' Make cross-sectional example dictionary
#' @description make_csnl_example_dict() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make cross-sectional example dictionary. The function is called for its side effects and does not return a value.
#' @param ds_tb Dataset (a tibble)
#' @return No return value, called for side effects.
#' @rdname make_csnl_example_dict
#' @export 
#' @importFrom dplyr filter arrange
#' @importFrom ready4use renew.ready4use_dictionary
#' @importFrom purrr map_chr
#' @keywords internal
make_csnl_example_dict <- function (ds_tb) 
{
    dictionary_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("dictionary_r3"), 
        metadata_1L_lgl = F)
    dictionary_r3 <- dictionary_r3 %>% dplyr::filter(var_nm_chr %in% 
        names(ds_tb)) %>% dplyr::filter(!var_nm_chr %in% c("CALD", 
        "c_p_diag_s", "d_ATSI", "d_gender", "d_studying_working")) %>% 
        ready4use::renew.ready4use_dictionary(var_nm_chr = c(setdiff(names(ds_tb), 
            dictionary_r3$var_nm_chr), "c_p_diag_s", "d_ATSI", 
            "d_gender", "d_studying_working") %>% sort(), var_ctg_chr = c(rep("clinical symptom", 
            5), rep("multi-attribute utility instrument question", 
            9), "health_utility", rep("demographic", 7), rep("difference", 
            2), "psychological distress", "quality of life", 
            rep("spatial", 2), rep("validation", 2)), var_desc_chr = c("days unable to perform usual activities", 
            "days out of role", "days cut back on usual activities", 
            "primary diagnosis group", "primary diagnosis", paste0("Child Health Utility (9 Dimension) question ", 
                1:9), "Child Health Utility (9 Dimension) total score", 
            "Aboriginal and Torres Strait Islander", "culturally and linguistically diverse", 
            "in employment", "employment type", "gender", "in education", 
            "education and employment", "Difference between AQoL-6D and CHU-9D total scores", 
            "Difference between AQoL-6D total scores and validation values", 
            "Kessler Psychological Distress Scale (10 Item)", 
            "My Life Tracker", "area index of relative social disadvantage", 
            "area remoteness", "validation unweighted aqol total", 
            "validation weighted aqol total"), var_type_chr = c(setdiff(names(ds_tb), 
            dictionary_r3$var_nm_chr), "c_p_diag_s", "d_ATSI", 
            "d_gender", "d_studying_working") %>% sort() %>% 
            purrr::map_chr(~{
                classes_chr <- ds_tb[, .x][[1]] %>% class()
                ifelse("numeric" %in% classes_chr, ifelse(is.integer(ds_tb[, 
                  .x][[1]]), "integer", "double"), classes_chr[1])
            })) %>% dplyr::arrange(var_ctg_chr, var_nm_chr)
    dictionary_r3
}
#' Make descriptive statistics table
#' @description make_descv_stats_tbl() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make descriptive statistics table. The function returns Descriptive statistics table (a tibble).
#' @param data_tb Data (a tibble)
#' @param key_var_nm_1L_chr Key variable name (a character vector of length one), Default: 'round'
#' @param key_var_vals_chr Key variable values (a character vector), Default: NULL
#' @param variable_nms_chr Variable names (a character vector)
#' @param dictionary_tb Dictionary (a tibble), Default: NULL
#' @param test_1L_lgl Test (a logical vector of length one), Default: F
#' @param sections_as_row_1L_lgl Sections as row (a logical vector of length one), Default: F
#' @param nbr_of_digits_1L_int Number of digits (an integer vector of length one), Default: NA
#' @return Descriptive statistics table (a tibble)
#' @rdname make_descv_stats_tbl
#' @export 
#' @importFrom dplyr pull select mutate filter across
#' @importFrom purrr discard map_chr pmap_dbl pmap map flatten_chr reduce map2_chr
#' @importFrom ready4 get_from_lup_obj
#' @importFrom tidyselect all_of
#' @importFrom rlang sym
make_descv_stats_tbl <- function (data_tb, key_var_nm_1L_chr = "round", key_var_vals_chr = NULL, 
    variable_nms_chr, dictionary_tb = NULL, test_1L_lgl = F, 
    sections_as_row_1L_lgl = F, nbr_of_digits_1L_int = NA_integer_) 
{
    if (is.null(key_var_vals_chr)) {
        key_var_vals_chr <- data_tb %>% dplyr::pull(key_var_nm_1L_chr) %>% 
            unique() %>% as.character()
    }
    if (length(key_var_vals_chr) < 2 & test_1L_lgl) {
        descv_stats_tbl_tb <- NULL
    }
    else {
        descv_stats_tbl_tb <- make_tableby_ls(data_tb, key_var_nm_1L_chr = key_var_nm_1L_chr, 
            variable_nms_chr = variable_nms_chr, test_1L_lgl = test_1L_lgl) %>% 
            as.data.frame() %>% dplyr::select(c("variable", "label", 
            key_var_vals_chr, ifelse(test_1L_lgl, "p.value", 
                character(0))) %>% purrr::discard(is.na))
        if (!is.null(dictionary_tb)) {
            descv_stats_tbl_tb <- descv_stats_tbl_tb %>% dplyr::mutate(variable = variable %>% 
                purrr::map_chr(~ready4::get_from_lup_obj(dictionary_tb, 
                  target_var_nm_1L_chr = "var_desc_chr", match_var_nm_1L_chr = "var_nm_chr", 
                  match_value_xx = .x, evaluate_1L_lgl = F) %>% 
                  as.vector()))
        }
        vars_with_mdns_chr <- descv_stats_tbl_tb %>% dplyr::filter(label == 
            "Median (Q1, Q3)") %>% dplyr::pull(variable)
        descv_stats_tbl_tb <- descv_stats_tbl_tb %>% dplyr::mutate(dplyr::across(tidyselect::all_of(key_var_vals_chr), 
            ~list(.x) %>% purrr::pmap_dbl(~{
                ifelse(..1[[1]][[1]] == "", NA_real_, ..1[[1]][[1]])
            }), .names = "{col}_val_1_dbl"), dplyr::across(tidyselect::all_of(key_var_vals_chr), 
            ~list(.x, variable, label) %>% purrr::pmap(~{
                if (..2 %in% vars_with_mdns_chr) {
                  if (..3 == "Median (Q1, Q3)") {
                    return_dbl <- c(..1[[2]], ..1[[3]])
                  }
                  else {
                    return_dbl <- ifelse(length(..1) == 1, NA_real_, 
                      ..1[[2]])
                  }
                }
                else {
                  return_dbl <- ifelse(length(..1) == 1, NA_real_, 
                    ifelse(..1[[2]] == "", NA_real_, ..1[[2]]))
                }
            }), .names = "{col}_val_2_ls")) %>% dplyr::select(variable, 
            label, key_var_vals_chr %>% purrr::map(~c(paste0(.x, 
                c("_val_1_dbl", "_val_2_ls")))) %>% purrr::flatten_chr(), 
            ifelse(test_1L_lgl, "p.value", character(0)) %>% 
                purrr::discard(is.na))
        if (sections_as_row_1L_lgl) {
            descv_stats_tbl_tb <- descv_stats_tbl_tb %>% dplyr::select(-variable)
        }
        else {
            descv_stats_tbl_tb <- descv_stats_tbl_tb %>% dplyr::filter(label != 
                variable)
        }
        if (!is.na(nbr_of_digits_1L_int)) {
            descv_stats_tbl_tb <- c(key_var_vals_chr %>% purrr::map(~c(paste0(.x, 
                c("_val_1_dbl", "_val_2_ls")))) %>% purrr::flatten_chr(), 
                ifelse(test_1L_lgl, "p.value", character(0)) %>% 
                  purrr::discard(is.na)) %>% purrr::reduce(.init = descv_stats_tbl_tb, 
                ~.x %>% dplyr::mutate(`:=`(!!rlang::sym(.y), 
                  !!rlang::sym(.y) %>% purrr::map_chr(~{
                    ifelse(length(.x) == 1, ifelse(is.na(.x), 
                      "", paste0("", format(round(.x, nbr_of_digits_1L_int), 
                        nsmall = nbr_of_digits_1L_int), "")), 
                      paste0("", .x %>% purrr::map_chr(~format(round(.x, 
                        nbr_of_digits_1L_int), nsmall = nbr_of_digits_1L_int)) %>% 
                        paste0(collapse = ", "), ""))
                  }))))
            descv_stats_tbl_tb <- paste0(key_var_vals_chr, "_val_2_ls") %>% 
                purrr::reduce(.init = descv_stats_tbl_tb, ~.x %>% 
                  dplyr::mutate(`:=`(!!rlang::sym(.y), !!rlang::sym(.y) %>% 
                    purrr::map2_chr(label, ~ifelse(.x == "" | 
                      .y == "Min - Max", .x, paste0("(", .x, 
                      ifelse(.y %in% c("Mean (SD)", "Median (Q1, Q3)", 
                        "Missing"), "", "%"), ")"))))))
        }
    }
    return(descv_stats_tbl_tb)
}
#' Make dimension scaling constants double vector
#' @description make_dim_sclg_cons_dbl() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make dimension scaling constants double vector. The function returns Dimension scaling constants (a double vector).
#' @param domains_chr Domains (a character vector)
#' @param dim_sclg_con_lup_tb Dimension scaling constant lookup table (a tibble)
#' @return Dimension scaling constants (a double vector)
#' @rdname make_dim_sclg_cons_dbl
#' @export 
#' @importFrom lifecycle deprecate_soft
#' @importFrom purrr map_dbl
#' @importFrom ready4 get_from_lup_obj
#' @keywords internal
make_dim_sclg_cons_dbl <- function (domains_chr, dim_sclg_con_lup_tb) 
{
    lifecycle::deprecate_soft("0.0.0.9078", "youthvars::make_dim_sclg_cons_dbl()", 
        "scorz::make_dim_sclg_cons_dbl()")
    dim_sclg_cons_dbl <- purrr::map_dbl(domains_chr, ~ready4::get_from_lup_obj(dim_sclg_con_lup_tb, 
        match_var_nm_1L_chr = "Dimension_chr", match_value_xx = .x, 
        target_var_nm_1L_chr = "Constant_dbl", evaluate_1L_lgl = F))
    return(dim_sclg_cons_dbl)
}
#' Make domain items list
#' @description make_domain_items_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make domain items list. The function returns Domain items (a list).
#' @param domain_qs_lup_tb Domain questions lookup table (a tibble)
#' @param item_pfx_1L_chr Item prefix (a character vector of length one)
#' @return Domain items (a list)
#' @rdname make_domain_items_ls
#' @export 
#' @importFrom lifecycle deprecate_soft
#' @importFrom purrr map
#' @importFrom dplyr filter pull
#' @importFrom stats setNames
#' @keywords internal
make_domain_items_ls <- function (domain_qs_lup_tb, item_pfx_1L_chr) 
{
    lifecycle::deprecate_soft("0.0.0.9078", "youthvars::get_aqol6d_scrg_dss()", 
        "scorz::get_aqol6d_scrg_dss()")
    domains_chr <- domain_qs_lup_tb$Domain_chr %>% unique()
    q_nbrs_ls <- purrr::map(domains_chr, ~domain_qs_lup_tb %>% 
        dplyr::filter(Domain_chr == .x) %>% dplyr::pull(Question_dbl))
    domain_items_ls <- purrr::map(q_nbrs_ls, ~paste0(item_pfx_1L_chr, 
        .x)) %>% stats::setNames(domains_chr)
    return(domain_items_ls)
}
#' Make final replication dataset dictionary
#' @description make_final_repln_ds_dict() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make final replication dataset dictionary. The function returns Dictionary (a tibble).
#' @param seed_dictionary_tb Seed dictionary (a tibble), Default: NULL
#' @param additions_tb Additions (a tibble), Default: NULL
#' @param utl_unwtd_var_nm_1L_chr Utility unweighted variable name (a character vector of length one), Default: 'aqol6d_total_c'
#' @return Dictionary (a tibble)
#' @rdname make_final_repln_ds_dict
#' @export 
#' @importFrom utils data
#' @importFrom ready4 renew
#' @importFrom ready4use make_pt_ready4use_dictionary ready4use_dictionary
#' @importFrom Hmisc label
make_final_repln_ds_dict <- function (seed_dictionary_tb = NULL, additions_tb = NULL, utl_unwtd_var_nm_1L_chr = "aqol6d_total_c") 
{
    if (is.null(seed_dictionary_tb)) {
        utils::data("aqol_scrg_dict_r3", package = "youthvars", 
            envir = environment())
        dictionary_tb <- ready4::renew(make_tfd_repln_ds_dict_r3(), 
            new_cases_r3 = aqol_scrg_dict_r3)
    }
    else {
        dictionary_tb <- seed_dictionary_tb
    }
    if (is.null(additions_tb)) {
        additions_tb <- ready4use::make_pt_ready4use_dictionary(var_nm_chr = c("bl_date_dtm", 
            "interval_dbl", "participation"), var_ctg_chr = c("Temporal", 
            "Temporal", "Temporal"), var_desc_chr = c("Date of baseline assessment", 
            "Interval between baseline and follow-up assessments", 
            "Rounds participated in"), var_type_chr = c("date", 
            "interval", "character")) %>% ready4use::ready4use_dictionary()
    }
    Hmisc::label(additions_tb) <- as.list(Hmisc::label(dictionary_tb) %>% 
        unname())
    dictionary_tb <- dictionary_tb %>% ready4::renew(new_cases_r3 = additions_tb)
    return(dictionary_tb)
}
#' Make formula
#' @description make_formula() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make formula. The function is called for its side effects and does not return a value.
#' @param depnt_var_nm_1L_chr Dependent variable name (a character vector of length one)
#' @param predictors_chr Predictors (a character vector)
#' @param environment_env Environment (an environment), Default: parent.frame()
#' @return Formula (formula)
#' @rdname make_formula
#' @export 
#' @importFrom stats formula
make_formula <- function (depnt_var_nm_1L_chr, predictors_chr, environment_env = parent.frame()) 
{
    formula_fml <- stats::formula(paste0(depnt_var_nm_1L_chr, 
        " ~ ", paste0(predictors_chr, collapse = " + ")), env = environment_env)
    return(formula_fml)
}
#' Make item plot
#' @description make_item_plt() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make item plot. The function returns Item (a plot).
#' @param tfd_data_tb Transformed data (a tibble)
#' @param var_nm_1L_chr Variable name (a character vector of length one)
#' @param x_label_1L_chr X label (a character vector of length one)
#' @param fill_label_1L_chr Fill label (a character vector of length one), Default: 'Data collection'
#' @param legend_position_1L_chr Legend position (a character vector of length one), Default: 'none'
#' @param round_var_nm_1L_chr Round variable name (a character vector of length one), Default: 'round'
#' @param sngl_round_lbl_1L_chr Single round label (a character vector of length one), Default: 'n'
#' @param sngl_round_var_nm_1L_chr Single round variable name (a character vector of length one), Default: 'n'
#' @param use_bw_theme_1L_lgl Use black and white theme (a logical vector of length one), Default: F
#' @param y_label_1L_chr Y label (a character vector of length one), Default: 'Percentage'
#' @param y_scale_scl_fn Y scale scale (a function), Default: NULL
#' @return Item (a plot)
#' @rdname make_item_plt
#' @export 
#' @importFrom ggplot2 ggplot aes_string geom_bar aes scale_y_continuous labs theme_bw theme scale_fill_manual
#' @importFrom dplyr with_groups
#' @importFrom ready4use remove_labels_from_ds
#' @importFrom rlang sym
#' @keywords internal
make_item_plt <- function (tfd_data_tb, var_nm_1L_chr, x_label_1L_chr, fill_label_1L_chr = "Data collection", 
    legend_position_1L_chr = "none", round_var_nm_1L_chr = "round", 
    sngl_round_lbl_1L_chr = "n", sngl_round_var_nm_1L_chr = "n", 
    use_bw_theme_1L_lgl = F, y_label_1L_chr = "Percentage", y_scale_scl_fn = NULL) 
{
    item_plt <- ggplot2::ggplot(tfd_data_tb %>% dplyr::with_groups(NULL, 
        ready4use::remove_labels_from_ds), ggplot2::aes_string(var_nm_1L_chr)) + 
        ggplot2::geom_bar(ggplot2::aes(y = y, fill = !!rlang::sym(ifelse(identical(round_var_nm_1L_chr, 
            character(0)), sngl_round_var_nm_1L_chr, round_var_nm_1L_chr))), 
            stat = "identity", na.rm = TRUE, position = "dodge", 
            colour = "white", alpha = 0.7)
    if (!is.null(y_scale_scl_fn)) {
        item_plt <- item_plt + ggplot2::scale_y_continuous(labels = y_scale_scl_fn)
    }
    item_plt <- item_plt + ggplot2::labs(x = x_label_1L_chr, 
        y = y_label_1L_chr, fill = ifelse(identical(round_var_nm_1L_chr, 
            character(0)), sngl_round_lbl_1L_chr, fill_label_1L_chr))
    if (use_bw_theme_1L_lgl) {
        item_plt <- item_plt + ggplot2::theme_bw()
    }
    item_plt <- item_plt + ggplot2::theme(legend.position = legend_position_1L_chr)
    if (!identical(round_var_nm_1L_chr, character(0))) {
        item_plt <- item_plt + ggplot2::scale_fill_manual(values = c("#de2d26", 
            "#fc9272"))
    }
    return(item_plt)
}
#' Make item response plots
#' @description make_itm_resp_plts() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make item response plots. The function returns Composite (a plot).
#' @param data_tb Data (a tibble)
#' @param col_nms_chr Column names (a character vector)
#' @param lbl_nms_chr Label names (a character vector)
#' @param plot_rows_cols_pair_int Plot rows columns pair (an integer vector)
#' @param heights_int Heights (an integer vector)
#' @param round_var_nm_1L_chr Round variable name (a character vector of length one), Default: 'round'
#' @param y_label_1L_chr Y label (a character vector of length one), Default: 'Percentage'
#' @return Composite (a plot)
#' @rdname make_itm_resp_plts
#' @export 
#' @importFrom scales percent_format
#' @importFrom gridExtra grid.arrange
#' @importFrom ggpubr ggarrange
#' @importFrom purrr discard
make_itm_resp_plts <- function (data_tb, col_nms_chr, lbl_nms_chr, plot_rows_cols_pair_int, 
    heights_int, round_var_nm_1L_chr = "round", y_label_1L_chr = "Percentage") 
{
    plots_ls <- list()
    j = 1
    for (i in col_nms_chr) {
        tfd_data_tb <- data_tb %>% transform_ds_for_item_plt(var_nm_1L_chr = i, 
            round_var_nm_1L_chr = round_var_nm_1L_chr)
        labelx <- lbl_nms_chr[j]
        j = j + 1
        plots_ls[[i]] <- make_item_plt(tfd_data_tb, var_nm_1L_chr = i, 
            round_var_nm_1L_chr = round_var_nm_1L_chr, x_label_1L_chr = labelx, 
            y_label_1L_chr = y_label_1L_chr, y_scale_scl_fn = scales::percent_format(), 
            use_bw_theme_1L_lgl = T, legend_position_1L_chr = "none")
    }
    if (!identical(round_var_nm_1L_chr, character(0))) {
        plot_plt <- make_item_plt(tfd_data_tb, var_nm_1L_chr = i, 
            round_var_nm_1L_chr = round_var_nm_1L_chr, x_label_1L_chr = labelx, 
            y_label_1L_chr = y_label_1L_chr, y_scale_scl_fn = NULL, 
            use_bw_theme_1L_lgl = F, legend_position_1L_chr = "bottom")
        legend_ls <- get_guide_box_lgd(plot_plt)
    }
    else {
        legend_ls <- NULL
    }
    composite_plt <- gridExtra::grid.arrange(ggpubr::ggarrange(plotlist = plots_ls, 
        nrow = plot_rows_cols_pair_int[1], ncol = plot_rows_cols_pair_int[2]), 
        legend_ls, nrow = length(heights_int), heights = heights_int)
    composite_plt$grobs <- composite_plt$grobs %>% purrr::discard(is.null)
    return(composite_plt)
}
#' Make make item worst weights list list
#' @description make_make_item_wrst_wts_ls_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make make item worst weights list list. The function returns Make item worst weights (a list of lists).
#' @param domain_items_ls Domain items (a list)
#' @param itm_wrst_wts_lup_tb Item worst weights lookup table (a tibble)
#' @return Make item worst weights (a list of lists)
#' @rdname make_make_item_wrst_wts_ls_ls
#' @export 
#' @importFrom purrr map map_dbl
#' @importFrom ready4 get_from_lup_obj
#' @keywords internal
make_make_item_wrst_wts_ls_ls <- function (domain_items_ls, itm_wrst_wts_lup_tb) 
{
    make_item_wrst_wts_ls_ls <- domain_items_ls %>% purrr::map(~{
        purrr::map_dbl(.x, ~{
            ready4::get_from_lup_obj(itm_wrst_wts_lup_tb, match_var_nm_1L_chr = "Question_chr", 
                match_value_xx = .x, target_var_nm_1L_chr = "Worst_Weight_dbl", 
                evaluate_1L_lgl = F)
        })
    })
    return(make_item_wrst_wts_ls_ls)
}
#' Make positive definite correlation matrix matrix
#' @description make_pdef_cor_mat_mat() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make positive definite correlation matrix matrix. The function returns Positive definite correlation (a matrix).
#' @param lower_diag_mat Lower diagonal (a matrix)
#' @return Positive definite correlation (a matrix)
#' @rdname make_pdef_cor_mat_mat
#' @export 
#' @importFrom Matrix forceSymmetric
#' @importFrom matrixcalc is.positive.definite
#' @importFrom psych cor.smooth
#' @keywords internal
make_pdef_cor_mat_mat <- function (lower_diag_mat) 
{
    pdef_cor_mat <- lower_diag_mat %>% Matrix::forceSymmetric(uplo = "L") %>% 
        as.matrix()
    if (!matrixcalc::is.positive.definite(pdef_cor_mat)) {
        pdef_cor_mat <- psych::cor.smooth(pdef_cor_mat)
    }
    return(pdef_cor_mat)
}
#' Make predictor pars and correlations table
#' @description make_predr_pars_and_cors_tbl() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make predictor pars and correlations table. The function returns Predictor pars and correlations (a tibble).
#' @param data_tb Data (a tibble)
#' @param ds_descvs_ls Dataset descriptives (a list)
#' @param descv_tbl_ls Descriptive table (a list)
#' @param dictionary_tb Dictionary (a tibble)
#' @param nbr_of_digits_1L_int Number of digits (an integer vector of length one), Default: 2
#' @param predictors_lup Predictors (a lookup table), Default: NULL
#' @return Predictor pars and correlations (a tibble)
#' @rdname make_predr_pars_and_cors_tbl
#' @export 
#' @importFrom dplyr mutate slice across rename_with select everything filter
#' @importFrom ready4 get_from_lup_obj
#' @importFrom purrr map_dfr map_chr
#' @importFrom rlang syms
#' @importFrom stringr str_replace
#' @importFrom tibble add_case
#' @keywords internal
make_predr_pars_and_cors_tbl <- function (data_tb, ds_descvs_ls, descv_tbl_ls, dictionary_tb, 
    nbr_of_digits_1L_int = 2L, predictors_lup = NULL) 
{
    predr_pars_and_cors_tb <- make_cors_with_utl_tbl(data_tb, 
        ds_descvs_ls = ds_descvs_ls, dictionary_tb = dictionary_tb) %>% 
        dplyr::mutate(label = paste0("Correlation with ", ready4::get_from_lup_obj(dictionary_tb, 
            match_var_nm_1L_chr = "var_nm_chr", match_value_xx = ds_descvs_ls$utl_wtd_var_nm_1L_chr, 
            target_var_nm_1L_chr = "var_desc_chr", evaluate_1L_lgl = F)))
    predr_pars_and_cors_tb <- purrr::map_dfr(1:nrow(predr_pars_and_cors_tb), 
        ~predr_pars_and_cors_tb %>% dplyr::slice(.x) %>% dplyr::mutate(dplyr::across(paste0(ds_descvs_ls$round_vals_chr, 
            "_sig_dbl"), ~format(round(.x, nbr_of_digits_1L_int), 
            nsmall = nbr_of_digits_1L_int))) %>% dplyr::mutate(p.value = paste0(c(!!!rlang::syms(paste0(ds_descvs_ls$round_vals_chr, 
            "_sig_dbl"))), collapse = ", "))) %>% dplyr::mutate(dplyr::across(paste0(ds_descvs_ls$round_vals_chr, 
        "_sig_dbl"), ~"")) %>% dplyr::mutate(dplyr::across(paste0(ds_descvs_ls$round_vals_chr, 
        "_cor_dbl"), ~format(round(.x, nbr_of_digits_1L_int), 
        nsmall = nbr_of_digits_1L_int))) %>% dplyr::rename_with(~stringr::str_replace(.x, 
        "_cor_dbl", "_val_1_chr") %>% stringr::str_replace("_sig_dbl", 
        "_val_2_chr")) %>% dplyr::select(variable_chr, label, 
        dplyr::everything())
    main_outc_tbl_tb <- descv_tbl_ls$main_outc_tbl_tb %>% dplyr::filter(label %in% 
        c("Mean (SD)", "Missing")) %>% dplyr::rename_with(~stringr::str_replace(.x, 
        "_val_1_dbl", "_val_1_chr") %>% stringr::str_replace("_val_2_ls", 
        "_val_2_chr") %>% stringr::str_replace("variable", "variable_chr")) %>% 
        dplyr::filter(variable_chr %in% purrr::map_chr(ds_descvs_ls$candidate_predrs_chr, 
            ~ready4::get_from_lup_obj(dictionary_tb, match_var_nm_1L_chr = "var_nm_chr", 
                match_value_xx = .x, target_var_nm_1L_chr = "var_desc_chr", 
                evaluate_1L_lgl = F)))
    if ("p.value" %in% names(predr_pars_and_cors_tb) & !"p.value" %in% 
        names(main_outc_tbl_tb)) 
        main_outc_tbl_tb <- main_outc_tbl_tb %>% dplyr::mutate(p.value = "")
    predr_pars_and_cors_tb <- main_outc_tbl_tb$variable_chr %>% 
        unique() %>% purrr::map_dfr(~tibble::add_case(main_outc_tbl_tb %>% 
        dplyr::filter(variable_chr == .x), predr_pars_and_cors_tb %>% 
        dplyr::filter(variable_chr == .x)))
    if (!is.null(predictors_lup)) {
        predr_pars_and_cors_tb <- predr_pars_and_cors_tb %>% 
            dplyr::mutate(variable_chr = purrr::map_chr(variable_chr, 
                ~{
                  var_nm_1L_chr <- ready4::get_from_lup_obj(dictionary_tb, 
                    match_var_nm_1L_chr = "var_desc_chr", match_value_xx = .x, 
                    target_var_nm_1L_chr = "var_nm_chr", evaluate_1L_lgl = F)
                  paste0(.x, " (", ready4::get_from_lup_obj(predictors_lup, 
                    match_var_nm_1L_chr = "short_name_chr", match_value_xx = var_nm_1L_chr, 
                    target_var_nm_1L_chr = "min_val_dbl", evaluate_1L_lgl = F), 
                    "-", ready4::get_from_lup_obj(predictors_lup, 
                      match_var_nm_1L_chr = "short_name_chr", 
                      match_value_xx = var_nm_1L_chr, target_var_nm_1L_chr = "max_val_dbl", 
                      evaluate_1L_lgl = F), ")")
                }))
    }
    return(predr_pars_and_cors_tb)
}
#' Make sub total plots
#' @description make_sub_tot_plts() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make sub total plots. The function returns Composite (a plot).
#' @param data_tb Data (a tibble)
#' @param col_nms_chr Column names (a character vector)
#' @param heights_int Heights (an integer vector)
#' @param plot_rows_cols_pair_int Plot rows columns pair (an integer vector)
#' @param add_legend_1L_lgl Add legend (a logical vector of length one), Default: T
#' @param axis_text_sclg_1L_dbl Axis text scaling (a double vector of length one), Default: 1
#' @param axis_title_sclg_1L_dbl Axis title scaling (a double vector of length one), Default: 1
#' @param legend_sclg_1L_dbl Legend scaling (a double vector of length one), Default: 1
#' @param make_log_log_tfmn_1L_lgl Make log log transformation (a logical vector of length one), Default: F
#' @param round_var_nm_1L_chr Round variable name (a character vector of length one), Default: 'round'
#' @param x_labels_chr X labels (a character vector), Default: character(0)
#' @param y_label_1L_chr Y label (a character vector of length one), Default: 'Percentage'
#' @return Composite (a plot)
#' @rdname make_sub_tot_plts
#' @export 
#' @importFrom dplyr mutate
#' @importFrom stringr str_sub
#' @importFrom stringi stri_locate_last_fixed
#' @importFrom gridExtra grid.arrange
#' @importFrom ggpubr ggarrange
make_sub_tot_plts <- function (data_tb, col_nms_chr, heights_int, plot_rows_cols_pair_int, 
    add_legend_1L_lgl = T, axis_text_sclg_1L_dbl = 1, axis_title_sclg_1L_dbl = 1, 
    legend_sclg_1L_dbl = 1, make_log_log_tfmn_1L_lgl = F, round_var_nm_1L_chr = "round", 
    x_labels_chr = character(0), y_label_1L_chr = "Percentage") 
{
    if (!is.null(col_nms_chr)) {
        plots_ls <- list()
        for (i in col_nms_chr) {
            if (make_log_log_tfmn_1L_lgl) {
                targetvar = paste0("tran_", i)
                data_tb <- dplyr::mutate(data_tb, `:=`(!!targetvar, 
                  log(-log(1 - !!as.name(i))))) %>% dplyr::mutate(`:=`(!!targetvar, 
                  ifelse(!!as.name(i) == 1, log(-log(1 - 0.999)), 
                    !!as.name(targetvar))))
            }
            if (identical(x_labels_chr, character(0))) {
                labelx <- eval(parse(text = paste0("attributes(data_tb$", 
                  i, ")$label")))
                labelx <- stringr::str_sub(labelx, start = stringi::stri_locate_last_fixed(labelx, 
                  " - ")[1, 1] %>% unname() + 2)
            }
            else {
                labelx <- x_labels_chr[which(col_nms_chr == i)]
            }
            if (make_log_log_tfmn_1L_lgl) {
                labelx <- paste0("log-log transformed ", labelx)
            }
            plots_ls[[i]] <- make_subtotal_plt(data_tb, legend_sclg_1L_dbl = legend_sclg_1L_dbl, 
                round_var_nm_1L_chr = round_var_nm_1L_chr, axis_text_sclg_1L_dbl = axis_text_sclg_1L_dbl, 
                axis_title_sclg_1L_dbl = axis_title_sclg_1L_dbl, 
                var_nm_1L_chr = i, x_label_1L_chr = labelx, y_label_1L_chr = y_label_1L_chr)
        }
        if (add_legend_1L_lgl & !identical(character(0), round_var_nm_1L_chr)) {
            plot_for_lgd_plt <- make_subtotal_plt(data_tb, legend_sclg_1L_dbl = legend_sclg_1L_dbl, 
                round_var_nm_1L_chr = round_var_nm_1L_chr, var_nm_1L_chr = i, 
                x_label_1L_chr = labelx, legend_position_1L_chr = "bottom", 
                label_fill_1L_chr = "Data collection", axis_text_sclg_1L_dbl = axis_text_sclg_1L_dbl, 
                axis_title_sclg_1L_dbl = axis_title_sclg_1L_dbl, 
                y_label_1L_chr = y_label_1L_chr)
            legend_ls <- get_guide_box_lgd(plot_for_lgd_plt)
            composite_plt <- gridExtra::grid.arrange(ggpubr::ggarrange(plotlist = plots_ls, 
                nrow = plot_rows_cols_pair_int[1], ncol = plot_rows_cols_pair_int[2]), 
                legend_ls, nrow = length(heights_int), heights = heights_int)
        }
        else {
            legend_ls <- NULL
            heights_int <- min(heights_int[-length(heights_int)], 
                length(plots_ls))
            composite_plt <- gridExtra::grid.arrange(ggpubr::ggarrange(plotlist = plots_ls, 
                nrow = max(plot_rows_cols_pair_int[1], ceiling(length(plots_ls)/plot_rows_cols_pair_int[2])), 
                ncol = plot_rows_cols_pair_int[2]), nrow = length(heights_int), 
                heights = heights_int)
        }
    }
    else {
        composite_plt <- NULL
    }
    return(composite_plt)
}
#' Make subtotal plot
#' @description make_subtotal_plt() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make subtotal plot. The function returns Subtotal (a plot).
#' @param data_tb Data (a tibble)
#' @param var_nm_1L_chr Variable name (a character vector of length one)
#' @param x_label_1L_chr X label (a character vector of length one)
#' @param legend_position_1L_chr Legend position (a character vector of length one), Default: 'none'
#' @param legend_sclg_1L_dbl Legend scaling (a double vector of length one), Default: 1
#' @param label_fill_1L_chr Label fill (a character vector of length one), Default: NULL
#' @param round_var_nm_1L_chr Round variable name (a character vector of length one), Default: 'round'
#' @param axis_text_sclg_1L_dbl Axis text scaling (a double vector of length one), Default: 1
#' @param axis_title_sclg_1L_dbl Axis title scaling (a double vector of length one), Default: 1
#' @param use_bw_theme_1L_lgl Use black and white theme (a logical vector of length one), Default: T
#' @param y_label_1L_chr Y label (a character vector of length one), Default: 'Percentage'
#' @param y_scale_scl_fn Y scale scale (a function), Default: scales::percent
#' @return Subtotal (a plot)
#' @rdname make_subtotal_plt
#' @export 
#' @importFrom scales percent
#' @importFrom ggplot2 ggplot aes_string geom_histogram aes labs theme_bw scale_y_continuous theme element_text rel scale_fill_manual
#' @importFrom ready4use remove_labels_from_ds
#' @importFrom rlang sym
#' @keywords internal
make_subtotal_plt <- function (data_tb, var_nm_1L_chr, x_label_1L_chr, legend_position_1L_chr = "none", 
    legend_sclg_1L_dbl = 1, label_fill_1L_chr = NULL, round_var_nm_1L_chr = "round", 
    axis_text_sclg_1L_dbl = 1, axis_title_sclg_1L_dbl = 1, use_bw_theme_1L_lgl = T, 
    y_label_1L_chr = "Percentage", y_scale_scl_fn = scales::percent) 
{
    subtotal_plt <- ggplot2::ggplot(data_tb %>% ready4use::remove_labels_from_ds(), 
        ggplot2::aes_string(var_nm_1L_chr)) + ggplot2::geom_histogram(bins = 8, 
        color = "white", if (identical(round_var_nm_1L_chr, character(0))) {
            ggplot2::aes(y = 2 * (..density..)/sum(..density..))
        }
        else {
            ggplot2::aes(fill = !!rlang::sym(round_var_nm_1L_chr), 
                y = 2 * (..density..)/sum(..density..))
        }, position = "dodge", alpha = 0.7)
    subtotal_plt <- subtotal_plt + ggplot2::labs(x = x_label_1L_chr, 
        y = y_label_1L_chr, fill = if (identical(round_var_nm_1L_chr, 
            character(0))) {
            NULL
        }
        else {
            label_fill_1L_chr
        })
    if (use_bw_theme_1L_lgl) {
        subtotal_plt <- subtotal_plt + ggplot2::theme_bw()
    }
    if (!is.null(y_scale_scl_fn)) {
        subtotal_plt <- subtotal_plt + ggplot2::scale_y_continuous(labels = y_scale_scl_fn)
    }
    subtotal_plt <- subtotal_plt + ggplot2::theme(legend.position = legend_position_1L_chr, 
        legend.text = ggplot2::element_text(size = ggplot2::rel(legend_sclg_1L_dbl)), 
        legend.title = ggplot2::element_text(size = ggplot2::rel(legend_sclg_1L_dbl)), 
        axis.text = ggplot2::element_text(size = ggplot2::rel(axis_text_sclg_1L_dbl)), 
        axis.title = ggplot2::element_text(size = ggplot2::rel(axis_title_sclg_1L_dbl)))
    if (!identical(character(0), round_var_nm_1L_chr)) {
        subtotal_plt <- subtotal_plt + ggplot2::scale_fill_manual(values = c("#de2d26", 
            "#fc9272"))
    }
    return(subtotal_plt)
}
#' Make synthetic series tibbles list
#' @description make_synth_series_tbs_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make synthetic series tibbles list. The function returns Synthetic series tibbles (a list).
#' @param synth_data_spine_ls Synthetic data spine (a list)
#' @param series_names_chr Series names (a character vector)
#' @return Synthetic series tibbles (a list)
#' @rdname make_synth_series_tbs_ls
#' @export 
#' @importFrom purrr map
#' @importFrom stats setNames
#' @keywords internal
make_synth_series_tbs_ls <- function (synth_data_spine_ls, series_names_chr) 
{
    synth_series_tbs_ls <- 1:length(series_names_chr) %>% purrr::map(~make_correlated_data_tb(synth_data_spine_ls = synth_data_spine_ls, 
        synth_data_idx_1L_dbl = .x) %>% replace_with_missing_vals(synth_data_spine_ls = synth_data_spine_ls, 
        idx_int = .x)) %>% stats::setNames(series_names_chr)
    return(synth_series_tbs_ls)
}
#' Make tableby controls
#' @description make_tableby_cntrls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make tableby controls. The function returns Tableby controls (a list).
#' @param test_1L_lgl Test (a logical vector of length one), Default: F
#' @return Tableby controls (a list)
#' @rdname make_tableby_cntrls
#' @export 
#' @importFrom arsenal tableby.control
#' @keywords internal
make_tableby_cntrls <- function (test_1L_lgl = F) 
{
    tableby_cntrls_ls <- arsenal::tableby.control(test = test_1L_lgl, 
        total = F, digits = 1, digits.pct = 1, digits.p = 3, 
        numeric.test = "anova", cat.test = "chisq", numeric.stats = c("meansd", 
            "medianq1q3", "range", "Nmiss2"), cat.stats = c("countpct", 
            "Nmiss2"), ordered.stats = c("countpct", "Nmiss2"), 
        stats.labels = list(meansd = "Mean (SD)", medianq1q3 = "Median (Q1, Q3)", 
            range = "Min - Max", Nmiss2 = "Missing"))
    return(tableby_cntrls_ls)
}
#' Make tableby list
#' @description make_tableby_ls() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make tableby list. The function returns Tableby (a list).
#' @param data_tb Data (a tibble)
#' @param key_var_nm_1L_chr Key variable name (a character vector of length one)
#' @param variable_nms_chr Variable names (a character vector)
#' @param test_1L_lgl Test (a logical vector of length one), Default: F
#' @return Tableby (a list)
#' @rdname make_tableby_ls
#' @export 
#' @importFrom arsenal tableby
#' @keywords internal
make_tableby_ls <- function (data_tb, key_var_nm_1L_chr, variable_nms_chr, test_1L_lgl = F) 
{
    forumla_fml <- make_formula(key_var_nm_1L_chr, predictors_chr = variable_nms_chr)
    tableby_ls <- arsenal::tableby(forumla_fml, data = data_tb, 
        control = make_tableby_cntrls(test_1L_lgl))
    return(tableby_ls)
}
#' Make transformed replication dataset dictionary ready4 submodule
#' @description make_tfd_repln_ds_dict_r3() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make transformed replication dataset dictionary ready4 submodule. The function returns Transformed replication dataset dictionary (a ready4 submodule).
#' @param repln_ds_dict_r3 Replication dataset dictionary (a ready4 submodule), Default: NULL
#' @return Transformed replication dataset dictionary (a ready4 submodule)
#' @rdname make_tfd_repln_ds_dict_r3
#' @export 
#' @importFrom dplyr mutate across case_when
#' @importFrom Hmisc label
make_tfd_repln_ds_dict_r3 <- function (repln_ds_dict_r3 = NULL) 
{
    if (is.null(repln_ds_dict_r3)) {
        data("repln_ds_dict_r3", package = "youthvars", envir = environment())
    }
    tfd_repln_ds_dict_r3 <- repln_ds_dict_r3 %>% dplyr::mutate(dplyr::across(.fns = as.character)) %>% 
        dplyr::mutate(var_nm_chr = dplyr::case_when(var_nm_chr == 
            "phq9_total" ~ "PHQ9", var_nm_chr == "bads_total" ~ 
            "BADS", var_nm_chr == "gad7_total" ~ "GAD7", var_nm_chr == 
            "oasis_total" ~ "OASIS", var_nm_chr == "scared_total" ~ 
            "SCARED", var_nm_chr == "k6_total" ~ "K6", var_nm_chr == 
            "c_sofas" ~ "SOFAS", T ~ var_nm_chr))
    Hmisc::label(tfd_repln_ds_dict_r3) = as.list(c("Variable", 
        "Category", "Description", "Class"))
    return(tfd_repln_ds_dict_r3)
}
#' Make variable by round plot
#' @description make_var_by_round_plt() is a Make function that creates a new R object. Specifically, this function implements an algorithm to make variable by round plot. The function returns Variable by round (a plot).
#' @param data_tb Data (a tibble)
#' @param var_nm_1L_chr Variable name (a character vector of length one)
#' @param x_label_1L_chr X label (a character vector of length one)
#' @param label_fill_1L_chr Label fill (a character vector of length one), Default: 'Data collection'
#' @param legend_sclg_1L_dbl Legend scaling (a double vector of length one), Default: 1
#' @param axis_text_sclg_1L_dbl Axis text scaling (a double vector of length one), Default: 1
#' @param axis_title_sclg_1L_dbl Axis title scaling (a double vector of length one), Default: 1
#' @param round_var_nm_1L_chr Round variable name (a character vector of length one), Default: 'round'
#' @param y_label_1L_chr Y label (a character vector of length one), Default: 'Percentage'
#' @param y_scale_scl_fn Y scale scale (a function), Default: scales::percent
#' @return Variable by round (a plot)
#' @rdname make_var_by_round_plt
#' @export 
#' @importFrom scales percent
#' @importFrom ggplot2 ggplot aes theme_bw geom_histogram after_stat scale_y_continuous labs scale_fill_manual theme element_text rel
#' @importFrom ready4use remove_labels_from_ds
#' @importFrom rlang sym
make_var_by_round_plt <- function (data_tb, var_nm_1L_chr, x_label_1L_chr, label_fill_1L_chr = "Data collection", 
    legend_sclg_1L_dbl = 1, axis_text_sclg_1L_dbl = 1, axis_title_sclg_1L_dbl = 1, 
    round_var_nm_1L_chr = "round", y_label_1L_chr = "Percentage", 
    y_scale_scl_fn = scales::percent) 
{
    var_by_round_plt <- ggplot2::ggplot(data_tb %>% ready4use::remove_labels_from_ds(), 
        if (identical(round_var_nm_1L_chr, character(0))) {
            ggplot2::aes(x = !!rlang::sym(var_nm_1L_chr))
        }
        else {
            ggplot2::aes(x = !!rlang::sym(var_nm_1L_chr), fill = !!rlang::sym(round_var_nm_1L_chr))
        }) + ggplot2::theme_bw() + ggplot2::geom_histogram(ggplot2::aes(y = ggplot2::after_stat(width * 
        density)), bins = 10, position = "dodge", colour = "white", 
        alpha = 0.7)
    if (!is.null(y_scale_scl_fn)) {
        var_by_round_plt <- var_by_round_plt + ggplot2::scale_y_continuous(labels = y_scale_scl_fn)
    }
    var_by_round_plt <- var_by_round_plt + ggplot2::labs(y = y_label_1L_chr, 
        x = x_label_1L_chr, fill = if (identical(round_var_nm_1L_chr, 
            character(0))) {
            NULL
        }
        else {
            label_fill_1L_chr
        }) + ggplot2::scale_fill_manual(values = c("#de2d26", 
        "#fc9272")) + ggplot2::theme(legend.position = "bottom", 
        legend.text = ggplot2::element_text(size = ggplot2::rel(legend_sclg_1L_dbl)), 
        legend.title = ggplot2::element_text(size = ggplot2::rel(legend_sclg_1L_dbl)), 
        axis.text = ggplot2::element_text(size = ggplot2::rel(axis_text_sclg_1L_dbl)), 
        axis.title = ggplot2::element_text(size = ggplot2::rel(axis_title_sclg_1L_dbl)))
    return(var_by_round_plt)
}