added template csp

Author: matthewphamilton

.Rbuildignore

@@ -129,3 +129,11 @@
 ^data-raw/vignettes/_Reporting_Params\.Rmd$
 ^data-raw/fns/rename\.R$
 ^data-raw/vignettes/_Adding_Predictions_To_DS\.R$
+^data-raw/inst/Project/CSP/CSP\.pdf$
+^data-raw/inst/Project/CSP/CSP\.Rmd$
+^data-raw/inst/Project/CSP/Filters/author-info-blocks\.lua$
+^data-raw/inst/Project/CSP/Filters/pagebreaks\.lua$
+^data-raw/inst/Project/CSP/Filters/scholarly-metadata\.lua$
+^data-raw/inst/Project/CSP/Header/abstract\.txt$
+^data-raw/inst/Project/CSP/Header/header_common\.yaml$
+^data-raw/inst/Project/CSP/preamble\.tex$

NAMESPACE

@@ -155,7 +155,6 @@ export(transform_dict_with_rename_lup)
 export(transform_ds_for_all_cmprsn_plts)
 export(transform_ds_for_mdlng)
 export(transform_ds_to_predn_ds)
-export(transform_ds_with_rename_lup)
 export(transform_mdl_vars_with_clss)
 export(transform_names)
 export(transform_params_ls_from_lup)
@@ -164,7 +163,6 @@ export(transform_paths_ls_for_scndry)
 export(transform_predd_var_nm)
 export(transform_predr_nm_part_of_phrases)
 export(transform_rprt_lup)
-export(transform_tb_for_merged_col_1)
 export(transform_tb_to_mdl_inp)
 export(transform_tbl_to_rnd_vars)
 export(transform_timepoint_vals)
@@ -370,5 +368,7 @@ importFrom(xfun,numbers_to_words)
 importFrom(youthvars,make_final_rpln_ds_dict)
 importFrom(youthvars,make_tfd_repln_ds_dict_r3)
 importFrom(youthvars,transform_ds_for_tstng)
+importFrom(youthvars,transform_ds_with_rename_lup)
 importFrom(youthvars,transform_raw_ds_for_analysis)
+importFrom(youthvars,transform_tb_for_merged_col_1)
 importFrom(youthvars,write_all_outp_dirs)

R/fn_make.R

@@ -767,9 +767,9 @@ make_fake_eq5d_ds <- function (country_1L_chr = "UK", version_1L_chr = "5L", typ
         stats::setNames(.x)) %>% purrr::flatten_dfr() %>% tidyr::expand(MO, 
         SC, UA, PD, AD) %>% dplyr::mutate(total_eq5d = eq5d::eq5d(., 
         country = country_1L_chr, version = version_1L_chr, type = type_1L_chr))
-    k10_lup_tb <- tibble::tibble(k10_int = (9.5 + rexp(sample_from_1L_int, 
+    k10_lup_tb <- tibble::tibble(K10_int = (9.5 + rexp(sample_from_1L_int, 
         rate = 0.18)) %>% purrr::map_int(~as.integer(min(max(.x, 
-        10), 50))), pred_eq5d_dbl = purrr::map2_dbl(k10_int, 
+        10), 50))), pred_eq5d_dbl = purrr::map2_dbl(K10_int, 
         rnorm(sample_from_1L_int, 0, 0.075), ~predict_utl_from_k10(.x, 
             eq5d_error_1L_dbl = .y)[2]), match_idx_int = purrr::map_int(pred_eq5d_dbl, 
         ~which.min(abs(data_tb$total_eq5d - .x))))
@@ -787,11 +787,11 @@ make_fake_eq5d_ds <- function (country_1L_chr = "UK", version_1L_chr = "5L", typ
         length(bl_uids_chr)), 0))
     data_tb <- data_tb %>% dplyr::filter(uid %in% bl_uids_chr) %>% 
         dplyr::filter(Timepoint == "BL" | uid %in% fup_uids_chr)
-    data_tb <- data_tb %>% dplyr::mutate(psych_well_int = faux::rnorm_pre(k10_int, 
+    data_tb <- data_tb %>% dplyr::mutate(Psych_well_int = faux::rnorm_pre(K10_int, 
         mu = 69.9, sd = 9.9, r = -0.56) %>% round(0) %>% purrr::map_int(~min(.x, 
         90) %>% max(18) %>% as.integer()))
     data_tb <- data_tb %>% dplyr::select(uid, Timepoint, MO, 
-        SC, UA, PD, AD, k10_int, psych_well_int)
+        SC, UA, PD, AD, K10_int, Psych_well_int)
     data("replication_popl_tb", package = "youthvars", envir = environment())
     demog_data_tb <- replication_popl_tb %>% youthvars::transform_raw_ds_for_analysis() %>% 
         dplyr::filter(round == "Baseline") %>% dplyr::mutate(uid = 1:dplyr::n()) %>% 
@@ -1879,8 +1879,8 @@ make_prmry_analysis_params_ls <- function (analysis_core_params_ls, candidate_co
 #' @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", 
+    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, 

R/fn_print.R

@@ -24,17 +24,21 @@ print_all_plts_for_mdl_set <- function (output_ls, start_from_1L_int = 0L)
 #' @return NULL
 #' @rdname print_cohort_table
 #' @export 
-#' @importFrom dplyr mutate_all
+#' @importFrom dplyr mutate mutate_all
+#' @importFrom purrr map_chr
+#' @importFrom Hmisc capitalize
 #' @importFrom stringr str_replace
 #' @importFrom kableExtra kbl kable_styling column_spec add_header_above collapse_rows
 #' @importFrom knitr opts_current
+#' @importFrom youthvars transform_tb_for_merged_col_1
 #' @importFrom ready4show print_table
 #' @keywords internal
 print_cohort_table <- function (params_ls, caption_1L_chr, mkdn_tbl_ref_1L_chr) 
 {
     results_ls <- params_ls$results_ls
     df <- results_ls$tables_ls$participant_descs
     df$variable <- gsub("\\s*\\([^\\)]+\\)", "", df$variable)
+    df <- df %>% dplyr::mutate(variable = variable %>% purrr::map_chr(~Hmisc::capitalize(.x)))
     if (params_ls$output_type_1L_chr == "PDF") {
         df <- df %>% dplyr::mutate_all(~stringr::str_replace(.x, 
             "%", "\\\\%") %>% stringr::str_replace(",", "\\\\,"))
@@ -50,7 +54,7 @@ print_cohort_table <- function (params_ls, caption_1L_chr, mkdn_tbl_ref_1L_chr)
             " ", Baseline = 2, `Follow-Up` = 2)) %>% kableExtra::collapse_rows(columns = 1)
     }
     else {
-        df <- df %>% transform_tb_for_merged_col_1(output_type_1L_chr = params_ls$output_type_1L_chr)
+        df <- df %>% youthvars::transform_tb_for_merged_col_1(output_type_1L_chr = params_ls$output_type_1L_chr)
         add_to_row_ls <- make_bl_fup_add_to_row_ls(df, n_at_bl_1L_int = results_ls$cohort_ls$n_inc_1L_dbl, 
             n_at_fup_1L_int = results_ls$cohort_ls$n_fup_1L_dbl)
         df %>% ready4show::print_table(output_type_1L_chr = params_ls$output_type_1L_chr, 
@@ -73,14 +77,15 @@ print_cohort_table <- function (params_ls, caption_1L_chr, mkdn_tbl_ref_1L_chr)
 #' @importFrom stringr str_remove_all
 #' @importFrom kableExtra kbl kable_styling column_spec add_header_above collapse_rows
 #' @importFrom knitr opts_current
+#' @importFrom youthvars transform_tb_for_merged_col_1
 #' @importFrom ready4show print_table
 #' @keywords internal
 print_corls_tbl <- function (params_ls, caption_1L_chr, mkdn_tbl_ref_1L_chr) 
 {
     results_ls <- params_ls$results_ls
     tb <- results_ls$tables_ls$pred_dist_and_cors
     tb <- tb %>% dplyr::mutate(label = label %>% purrr::map_chr(~stringr::str_remove_all(.x, 
-        " \\(Weighted total\\)")))
+        " \\(weighted total\\)")))
     if (params_ls$output_type_1L_chr == "PDF") {
         names(tb) <- c("", "", "(N =", paste0(results_ls$cohort_ls$n_inc_1L_dbl, 
             ")"), "(N =", paste0(results_ls$cohort_ls$n_fup_1L_dbl, 
@@ -92,7 +97,7 @@ print_corls_tbl <- function (params_ls, caption_1L_chr, mkdn_tbl_ref_1L_chr)
             " ", Baseline = 2, `Follow-Up` = 2, " ")) %>% kableExtra::collapse_rows(columns = 1)
     }
     else {
-        tb <- tb %>% transform_tb_for_merged_col_1(output_type_1L_chr = params_ls$output_type_1L_chr)
+        tb <- tb %>% youthvars::transform_tb_for_merged_col_1(output_type_1L_chr = params_ls$output_type_1L_chr)
         tb %>% ready4show::print_table(output_type_1L_chr = params_ls$output_type_1L_chr, 
             caption_1L_chr = caption_1L_chr, mkdn_tbl_ref_1L_chr = mkdn_tbl_ref_1L_chr, 
             use_rdocx_1L_lgl = ifelse(params_ls$output_type_1L_chr == 

R/fn_transform.R

@@ -206,27 +206,6 @@ transform_ds_to_predn_ds <- function (data_tb, predr_vars_nms_chr, tfmn_1L_chr,
                 evaluate_lgl = F)), ungroup_1L_lgl = T, tfmn_1L_chr = tfmn_1L_chr)
     return(data_tb)
 }
-#' Transform dataset with rename
-#' @description transform_ds_with_rename_lup() is a Transform function that edits an object in such a way that core object attributes - e.g. shape, dimensions, elements, type - are altered. Specifically, this function implements an algorithm to transform dataset with rename lookup table. Function argument ds_tb specifies the object to be updated. Argument rename_lup provides the object to be updated. The function returns Tfmd dataset (a tibble).
-#' @param ds_tb Dataset (a tibble)
-#' @param rename_lup Rename (a lookup table)
-#' @param target_var_nms_chr Target variable names (a character vector), Default: NULL
-#' @return Tfmd dataset (a tibble)
-#' @rdname transform_ds_with_rename_lup
-#' @export 
-#' @importFrom dplyr rename_with
-#' @importFrom ready4fun get_from_lup_obj
-#' @keywords internal
-transform_ds_with_rename_lup <- function (ds_tb, rename_lup, target_var_nms_chr = NULL) 
-{
-    if (is.null(target_var_nms_chr)) 
-        target_var_nms_chr <- intersect(names(ds_tb), rename_lup$old_nms_chr)
-    tfmd_ds_tb <- dplyr::rename_with(ds_tb, .cols = target_var_nms_chr, 
-        ~ready4fun::get_from_lup_obj(rename_lup, match_value_xx = .x, 
-            match_var_nm_1L_chr = "old_nms_chr", target_var_nm_1L_chr = "new_nms_chr", 
-            evaluate_lgl = F))
-    return(tfmd_ds_tb)
-}
 #' Transform model variables with classes
 #' @description transform_mdl_vars_with_clss() is a Transform function that edits an object in such a way that core object attributes - e.g. shape, dimensions, elements, type - are altered. Specifically, this function implements an algorithm to transform model variables with classes. Function argument ds_tb specifies the object to be updated. Argument predictors_lup provides the object to be updated. The function returns Transformed dataset (a tibble).
 #' @param ds_tb Dataset (a tibble)
@@ -372,6 +351,7 @@ transform_params_ls_from_lup <- function (params_ls, rename_lup)
 #' @importFrom stringi stri_replace_last_fixed stri_replace_all_fixed
 #' @importFrom tibble tibble
 #' @importFrom dplyr filter
+#' @importFrom youthvars transform_ds_with_rename_lup
 #' @keywords internal
 transform_params_ls_to_valid <- function (params_ls, scndry_analysis_extra_vars_chr = NA_character_) 
 {
@@ -387,7 +367,7 @@ transform_params_ls_to_valid <- function (params_ls, scndry_analysis_extra_vars_
         target_var_nms_chr), new_nms_chr = make.unique(c(unchanged_var_nms_chr, 
         valid_var_nms_chr), sep = "V")) %>% dplyr::filter(!old_nms_chr %in% 
         unchanged_var_nms_chr)
-    params_ls$ds_tb <- transform_ds_with_rename_lup(params_ls$ds_tb, 
+    params_ls$ds_tb <- youthvars::transform_ds_with_rename_lup(params_ls$ds_tb, 
         rename_lup = rename_lup, target_var_nms_chr = target_var_nms_chr)
     params_ls$ds_descvs_ls$dictionary_tb <- params_ls$ds_descvs_ls$dictionary_tb %>% 
         transform_dict_with_rename_lup(rename_lup = rename_lup)
@@ -529,26 +509,6 @@ transform_rprt_lup <- function (rprt_lup, add_suplry_rprt_1L_lgl = T, add_sharin
     }
     return(rprt_lup)
 }
-#' Transform tibble for merged column 1
-#' @description transform_tb_for_merged_col_1() is a Transform function that edits an object in such a way that core object attributes - e.g. shape, dimensions, elements, type - are altered. Specifically, this function implements an algorithm to transform tibble for merged column 1. Function argument df specifies the object to be updated. Argument output_type_1L_chr provides the object to be updated. The function returns Data.frame (a data.frame).
-#' @param df Data.frame (a data.frame)
-#' @param output_type_1L_chr Output type (a character vector of length one), Default: 'PDF'
-#' @return Data.frame (a data.frame)
-#' @rdname transform_tb_for_merged_col_1
-#' @export 
-
-#' @keywords internal
-transform_tb_for_merged_col_1 <- function (df, output_type_1L_chr = "PDF") 
-{
-    df[[1]] <- as.character(df[[1]])
-    rle.lengths <- rle(df[[1]])$lengths
-    first <- !duplicated(df[[1]])
-    df[[1]][!first] <- ""
-    if (output_type_1L_chr == "PDF") 
-        df[[1]][first] <- paste0("\\midrule\\multirow{", rle.lengths, 
-            "}{*}{\\textbf{", df[[1]][first], "}}")
-    return(df)
-}
 #' Transform tibble to model input
 #' @description transform_tb_to_mdl_inp() is a Transform function that edits an object in such a way that core object attributes - e.g. shape, dimensions, elements, type - are altered. Specifically, this function implements an algorithm to transform tibble to model input. Function argument data_tb specifies the object to be updated. Argument depnt_var_nm_1L_chr provides the object to be updated. The function returns Transformed for model input (a tibble).
 #' @param data_tb Data (a tibble)

_pkgdown.yml

@@ -1,11 +1,3 @@
-home:
-  links:
-  - text: User manual (PDF)
-    href: https://github.com/ready4-dev/TTU/files/6277705/TTU_user_0.0.0.9133.pdf
-  - text: Developer version of usual manual (PDF)
-    href: https://github.com/ready4-dev/TTU/files/6277710/TTU_developer_0.0.0.9133.pdf
-  - text: Project website
-    href: https://www.ready4-dev.com/
 development:
   mode: auto
 reference:

data-raw/DATASET.R

@@ -260,12 +260,12 @@ ready4fun::write_and_doc_fn_fls(fns_dmt_tb,
                                 update_pkgdown_1L_lgl = T)
 ##
 ## PART FOUR
-data("prototype_lup")
-if(!identical(prototype_lup,ready4fun::get_rds_from_dv("prototype_lup"))){
-  prototype_lup %>%
-    ready4use::write_paired_ds_fls_to_dv(fl_nm_1L_chr = "prototype_lup",
-                                         desc_1L_chr = "Prototypes lookup table")
-}
+# data("prototype_lup")
+# if(!identical(prototype_lup,ready4fun::get_rds_from_dv("prototype_lup"))){
+#   prototype_lup %>%
+#     ready4use::write_paired_ds_fls_to_dv(fl_nm_1L_chr = "prototype_lup",
+#                                          desc_1L_chr = "Prototypes lookup table")
+# }
 # devtools::build_vignettes()
 ready4fun::write_links_for_website(user_manual_url_1L_chr = "https://github.com/ready4-dev/TTU/files/6277705/TTU_user_0.0.0.9133.pdf",
                                    developer_manual_url_1L_chr = "https://github.com/ready4-dev/TTU/files/6277710/TTU_developer_0.0.0.9133.pdf",

data-raw/fns/make.R

@@ -635,8 +635,8 @@ make_fake_eq5d_ds <- function(country_1L_chr = "UK",
     purrr::flatten_dfr() %>%
     tidyr::expand(MO,SC,UA,PD,AD) %>%
     dplyr::mutate(total_eq5d = eq5d::eq5d(., country = country_1L_chr, version = version_1L_chr, type = type_1L_chr))
-  k10_lup_tb <- tibble::tibble(k10_int = (9.5 + rexp(sample_from_1L_int,rate=0.18)) %>% purrr::map_int(~as.integer(min(max(.x,10),50))),
-                               pred_eq5d_dbl = purrr::map2_dbl(k10_int,rnorm(sample_from_1L_int,0,0.075), ~ predict_utl_from_k10(.x,
+  k10_lup_tb <- tibble::tibble(K10_int = (9.5 + rexp(sample_from_1L_int,rate=0.18)) %>% purrr::map_int(~as.integer(min(max(.x,10),50))),
+                               pred_eq5d_dbl = purrr::map2_dbl(K10_int,rnorm(sample_from_1L_int,0,0.075), ~ predict_utl_from_k10(.x,
                                                                                                                        eq5d_error_1L_dbl = .y)[2]),
                                match_idx_int = purrr::map_int(pred_eq5d_dbl, ~which.min(abs(data_tb$total_eq5d-.x))))
   data_tb <- dplyr::left_join(k10_lup_tb,
@@ -658,10 +658,10 @@ make_fake_eq5d_ds <- function(country_1L_chr = "UK",
     dplyr::filter(uid %in% bl_uids_chr) %>%
     dplyr::filter(Timepoint == "BL" | uid %in% fup_uids_chr)
   data_tb <- data_tb %>%
-    dplyr::mutate(psych_well_int = faux::rnorm_pre(k10_int, mu = 69.9, sd = 9.9, r = -0.56) %>%
+    dplyr::mutate(Psych_well_int = faux::rnorm_pre(K10_int, mu = 69.9, sd = 9.9, r = -0.56) %>%
                     round(0) %>% purrr::map_int(~min(.x,90) %>% max(18) %>%
                                                   as.integer()))
-  data_tb <- data_tb %>% dplyr::select(uid,Timepoint,MO,SC,UA,PD,AD,k10_int,psych_well_int)
+  data_tb <- data_tb %>% dplyr::select(uid,Timepoint,MO,SC,UA,PD,AD,K10_int,Psych_well_int)
   data("replication_popl_tb", package = "youthvars", envir = environment())
   demog_data_tb <- replication_popl_tb %>%
     youthvars::transform_raw_ds_for_analysis() %>%
@@ -1541,7 +1541,7 @@ make_prmry_analysis_params_ls <- function(analysis_core_params_ls,
   return(prmry_analysis_params_ls)
 }
 make_psych_predrs_lup <- function(){
-  predictors_lup <- TTU_predictors_lup(make_pt_TTU_predictors_lup(short_name_chr = c("k10_int","psych_well_int"),
+  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),

data-raw/fns/print.R

@@ -13,6 +13,9 @@ print_cohort_table <- function(params_ls,
   results_ls <- params_ls$results_ls
   df <- results_ls$tables_ls$participant_descs
   df$variable <- gsub("\\s*\\([^\\)]+\\)","",df$variable)
+  df <- df %>%
+    dplyr::mutate(variable = variable %>%
+                    purrr::map_chr(~Hmisc::capitalize(.x)))
   if(params_ls$output_type_1L_chr == "PDF"){
     df <- df %>%
       dplyr::mutate_all(~ stringr::str_replace(.x,"%","\\\\%") %>%
@@ -32,7 +35,7 @@ print_cohort_table <- function(params_ls,
       kableExtra::add_header_above(c(" ", " ", "Baseline" = 2, "Follow-Up" = 2)) %>%
       kableExtra::collapse_rows(columns = 1)
   }else{
-    df <- df %>% transform_tb_for_merged_col_1(output_type_1L_chr = params_ls$output_type_1L_chr)
+    df <- df %>% youthvars::transform_tb_for_merged_col_1(output_type_1L_chr = params_ls$output_type_1L_chr)
     add_to_row_ls <- make_bl_fup_add_to_row_ls(df,
                                                n_at_bl_1L_int = results_ls$cohort_ls$n_inc_1L_dbl,
                                                n_at_fup_1L_int = results_ls$cohort_ls$n_fup_1L_dbl)
@@ -52,7 +55,7 @@ print_corls_tbl <- function(params_ls,
   tb <- results_ls$tables_ls$pred_dist_and_cors
   tb <- tb %>%
     dplyr::mutate(label = label %>%
-                    purrr::map_chr(~stringr::str_remove_all(.x," \\(Weighted total\\)")))
+                    purrr::map_chr(~stringr::str_remove_all(.x," \\(weighted total\\)")))
   if(params_ls$output_type_1L_chr == "PDF"){
     names(tb) <- c("","",
                    "(N =",
@@ -70,7 +73,7 @@ print_corls_tbl <- function(params_ls,
       kableExtra::collapse_rows(columns = 1)
   }else{
     tb <- tb %>%
-      transform_tb_for_merged_col_1(output_type_1L_chr = params_ls$output_type_1L_chr)
+      youthvars::transform_tb_for_merged_col_1(output_type_1L_chr = params_ls$output_type_1L_chr)
     tb %>%
       ready4show::print_table(output_type_1L_chr = params_ls$output_type_1L_chr,
                               caption_1L_chr = caption_1L_chr,