diff --git a/.Rbuildignore b/.Rbuildignore index ad4a9fd0..09d1bf4d 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -167,3 +167,7 @@ ^data-raw/fix_authorReport_Ready4showSynopisis\.R$ ^data-raw/fixes_ready4\.R$ ^data-raw/fixes_specific\.R$ +^data-raw/s4_fns/exhibit\.R$ +^data-raw/s4_fns/investigate\.R$ +^data-raw/s4_fns/renew\.R$ +^data-raw/s4_fns/share\.R$ diff --git a/DESCRIPTION b/DESCRIPTION index c1079a88..f9a7b2c8 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -42,7 +42,8 @@ Imports: VignetteBuilder: knitr Depends: R (>= 2.10), - specific + scorz (>= 0.0.0.9058), + specific (>= 0.0.0.9098) LazyData: true Collate: 'C4_TTUSynopsis.R' @@ -66,9 +67,12 @@ Suggests: betareg, caret, knitrBootstrap, - rmarkdown + rmarkdown, + youthvars (>= 0.0.0.9120) Remotes: ready4-dev/ready4, ready4-dev/ready4show, ready4-dev/ready4use, - ready4-dev/specific + ready4-dev/specific, + ready4-dev/youthvars, + ready4-dev/scorz diff --git a/NAMESPACE b/NAMESPACE index c1dcd312..482540d7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,23 +11,39 @@ exportClasses(TTUProject) exportClasses(TTUReports) exportClasses(TTUSynopsis) exportMethods(author) +exportMethods(exhibit) +exportMethods(investigate) +exportMethods(renew) +exportMethods(share) import(methods) import(ready4) import(specific) +importFrom(Hmisc,capitalize) +importFrom(R.utils,copyDirectory) importFrom(dplyr,mutate) importFrom(ggplot2,ggsave) importFrom(lifecycle,deprecated) importFrom(magrittr,"%>%") +importFrom(methods,callNextMethod) importFrom(purrr,discard) importFrom(purrr,flatten_chr) importFrom(purrr,map) importFrom(purrr,map_chr) +importFrom(purrr,map_lgl) importFrom(purrr,pluck) importFrom(purrr,reduce) +importFrom(purrr,walk) importFrom(ready4,author) +importFrom(ready4,exhibit) +importFrom(ready4,investigate) importFrom(ready4,make_list_phrase) +importFrom(ready4,renew) +importFrom(ready4,share) +importFrom(ready4,write_fls_to_dv) importFrom(ready4,write_with_consent) importFrom(ready4show,make_rmd_fl_nms_ls) +importFrom(ready4use,Ready4useRepos) +importFrom(rlang,exec) importFrom(stringr,str_locate) importFrom(stringr,str_replace_all) importFrom(stringr,str_sub) diff --git a/R/C4_TTUReports.R b/R/C4_TTUReports.R index 2c12f111..1a3fb258 100644 --- a/R/C4_TTUReports.R +++ b/R/C4_TTUReports.R @@ -19,7 +19,7 @@ contains = "Ready4Module", slots = c(a_TTUSynopsis = "TTUSynopsis",catalogue_tmpl_chr = "character",catalogue_fl_nms_ls = "list",manuscript_tmpl_chr = "character",manuscript_fl_nms_ls = "list",dissemination_1L_chr = "character"), prototype = list(a_TTUSynopsis = TTUSynopsis(),catalogue_tmpl_chr = c("https://github.com/ready4-dev/ttu_mdl_ctlg","0.1.0.1"),catalogue_fl_nms_ls = ready4show::make_rmd_fl_nms_ls("Lngl_Mdls_HTML", pdf_fl_nm_1L_chr = "Lngl_Mdls_PDF", - word_fl_nm_1L_chr = "Lngl_Mdls_Word"),manuscript_tmpl_chr = c("https://github.com/ready4-dev/ttu_lng_ss","0.9.0.0"),manuscript_fl_nms_ls = ready4show::make_rmd_fl_nms_ls(pdf_fl_nm_1L_chr = "Main_PDF", + word_fl_nm_1L_chr = "Lngl_Mdls_Word"),manuscript_tmpl_chr = c("https://github.com/ready4-dev/ttu_lng_ss","0.9.0.1"),manuscript_fl_nms_ls = ready4show::make_rmd_fl_nms_ls(pdf_fl_nm_1L_chr = "Main_PDF", word_fl_nm_1L_chr = "Main_Word"))) diff --git a/R/mthd_author.R b/R/mthd_author.R index 472bd32c..d651f880 100644 --- a/R/mthd_author.R +++ b/R/mthd_author.R @@ -60,8 +60,8 @@ methods::setMethod("author", "TTUReports", function (x, args_ls = NULL, consent_ if (type_1L_chr == "Dependencies") { df <- data.frame(Package = c("youthvars", "scorz", "specific", "TTU") %>% purrr::map(~{ - utils::packageDescription(.x) %>% c("Depends", - "Imports")[] %>% purrr::map(~{ + desc_ls <- utils::packageDescription(.x) + desc_ls[c("Depends", "Imports")] %>% purrr::map(~{ if (is.null(.x)) { character(0) } @@ -96,13 +96,14 @@ methods::setMethod("author", "TTUReports", function (x, args_ls = NULL, consent_ "."), declined_msg_1L_chr = "Write request cancelled - no new files have been written.") } if (type_1L_chr == "Plots") { - composite_1_plt <- depict(x@a_TTUSynopsis, depnt_var_desc_1L_chr = depnt_var_desc_1L_chr, + composite_1_plt <- depict(x@a_TTUSynopsis, consent_1L_chr = consent_1L_chr, + depnt_var_desc_1L_chr = depnt_var_desc_1L_chr, depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, timepoint_old_nms_chr = procureSlot(x, "a_TTUSynopsis@d_YouthvarsProfile@timepoint_vals_chr"), timepoint_new_nms_chr = timepoint_new_nms_chr, what_1L_chr = "composite_mdl", write_1L_lgl = T) - composite_2_plt <- depict(x@a_TTUSynopsis, what_1L_chr = "composite_utl", - write_1L_lgl = T) + composite_2_plt <- depict(x@a_TTUSynopsis, consent_1L_chr = consent_1L_chr, + what_1L_chr = "composite_utl", write_1L_lgl = T) if (!is.na(what_1L_chr)) { consented_fn <- function(composite_1_plt, composite_2_plt, dir_1L_chr, fl_type_1L_chr) { @@ -125,3 +126,117 @@ methods::setMethod("author", "TTUReports", function (x, args_ls = NULL, consent_ } } }) +#' +#' Author and save files +#' @name author-TTUProject +#' @description author method applied to TTUProject +#' @param x An object of class TTUProject +#' @param consent_1L_chr Consent (a character vector of length one), Default: '' +#' @param depnt_var_min_val_1L_dbl Dependent variable minimum value (a double vector of length one), Default: numeric(0) +#' @param digits_1L_int Digits (an integer vector of length one), Default: 2 +#' @param download_tmpl_1L_lgl Download template (a logical vector of length one), Default: T +#' @param supplement_fl_nm_1L_chr Supplement file name (a character vector of length one), Default: 'TA_PDF' +#' @param timepoint_new_nms_chr Timepoint new names (a character vector), Default: 'NA' +#' @param type_1L_chr Type (a character vector of length one), Default: 'auto' +#' @param what_1L_chr What (a character vector of length one), Default: 'default' +#' @param ... Additional arguments +#' @return x (An object of class TTUProject) +#' @rdname author-methods +#' @aliases author,TTUProject-method +#' @export +#' @importFrom Hmisc capitalize +#' @importFrom ready4 write_with_consent author +#' @importFrom R.utils copyDirectory +#' @importFrom ready4show make_rmd_fl_nms_ls +#' @importFrom methods callNextMethod +methods::setMethod("author", "TTUProject", function (x, consent_1L_chr = "", depnt_var_min_val_1L_dbl = numeric(0), + digits_1L_int = 2L, download_tmpl_1L_lgl = T, supplement_fl_nm_1L_chr = "TA_PDF", + timepoint_new_nms_chr = NA_character_, type_1L_chr = "auto", + what_1L_chr = "default", ...) +{ + if (what_1L_chr %in% c("catalogue", "Catalogue", "dependencies", + "Dependencies", "descriptives", "Descriptives", "manuscript", + "Manuscript", "models", "Models", "plots", "Plots", "purge", + "Purge", "supplement", "Supplement")) { + if (what_1L_chr %in% c("catalogue", "Catalogue")) { + authorSlot(x, "d_TTUReports", consent_1L_chr = consent_1L_chr, + download_tmpl_1L_lgl = download_tmpl_1L_lgl, + what_1L_chr = Hmisc::capitalize(what_1L_chr)) + } + if (what_1L_chr %in% c("descriptives", "Descriptives")) { + x <- renewSlot(x, "c_SpecificProject", authorSlot(x, + "c_SpecificProject", consent_1L_chr = consent_1L_chr, + digits_1L_int = digits_1L_int, what_1L_chr = tolower(what_1L_chr))) + } + if (what_1L_chr %in% c("manuscript", "Manuscript")) { + if (type_1L_chr == "auto") { + x@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@ms_dir_1L_chr <- paste0(Hmisc::capitalize(what_1L_chr), + "_", Hmisc::capitalize(type_1L_chr)) + authorSlot(x, "d_TTUReports", consent_1L_chr = consent_1L_chr, + download_tmpl_1L_lgl = download_tmpl_1L_lgl, + type_1L_chr = "Report", what_1L_chr = x@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@ms_dir_1L_chr) + } + if (type_1L_chr == "copy") { + from_1L_chr <- paste0(A@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@outp_data_dir_1L_chr, + "/", A@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@mkdn_data_dir_1L_chr, + "/Manuscript_Auto") + to_1L_chr <- paste0(A@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@outp_data_dir_1L_chr, + "/", A@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@mkdn_data_dir_1L_chr, + "/Manuscript_Submission") + ready4::write_with_consent(consented_fn = R.utils::copyDirectory, + prompt_1L_chr = paste0("Do you confirm that you want to copy the directory ", + from_1L_chr, " (and all its contents) to ", + to_1L_chr, "?"), consent_1L_chr = consent_1L_chr, + consented_args_ls = list(from = from_1L_chr, + to = to_1L_chr), consented_msg_1L_chr = paste0("The directory ", + from_1L_chr, " has been copied to ", to_1L_chr, + "."), declined_msg_1L_chr = "Write request cancelled - no new directory copy has been written.") + } + if (type_1L_chr %in% c("dependencies", "Dependencies")) { + author(x@d_TTUReports, consent_1L_chr = consent_1L_chr, + type_1L_chr = Hmisc::capitalize(type_1L_chr), + what_1L_chr = "Manuscript_Submission") + } + if (type_1L_chr %in% c("plots", "Plots")) { + authorSlot(x, "d_TTUReports", consent_1L_chr = consent_1L_chr, + depnt_var_desc_1L_chr = x@d_TTUReports@a_TTUSynopsis@b_SpecificResults@a_SpecificShareable@shareable_outp_ls$results_ls$study_descs_ls$health_utl_nm_1L_chr, + depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, + timepoint_new_nms_chr = timepoint_new_nms_chr, + type_1L_chr = Hmisc::capitalize(type_1L_chr), + what_1L_chr = "Manuscript_Submission") + } + if (type_1L_chr == "submission") { + x@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@ms_dir_1L_chr <- paste0(Hmisc::capitalize(what_1L_chr), + "_", Hmisc::capitalize(type_1L_chr)) + authorSlot(x, "d_TTUReports", consent_1L_chr = consent_1L_chr, + download_tmpl_1L_lgl = download_tmpl_1L_lgl, + type_1L_chr = "Report", what_1L_chr = x@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@ms_dir_1L_chr) + } + } + if (what_1L_chr %in% c("models", "Models")) { + x <- renewSlot(x, "c_SpecificProject", authorData(procureSlot(x, + "c_SpecificProject"), consent_1L_chr = consent_1L_chr)) + } + if (what_1L_chr %in% c("purge")) { + authorSlot(x, "c_SpecificProject", type_1L_chr = "purge_write") + } + if (what_1L_chr %in% c("plots", "Plots")) { + authorSlot(x, "d_TTUReports", consent_1L_chr = consent_1L_chr, + depnt_var_desc_1L_chr = x@d_TTUReports@a_TTUSynopsis@b_SpecificResults@a_SpecificShareable@shareable_outp_ls$results_ls$study_descs_ls$health_utl_nm_1L_chr, + type_1L_chr = Hmisc::capitalize(what_1L_chr)) + } + if (what_1L_chr %in% c("supplement", "Supplement")) { + x@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@ms_dir_1L_chr <- paste0("Manuscript_", + Hmisc::capitalize(type_1L_chr)) + authorReport(procureSlot(x, "d_TTUReports") %>% renewSlot("a_TTUSynopsis@rmd_fl_nms_ls", + ready4show::make_rmd_fl_nms_ls(pdf_fl_nm_1L_chr = supplement_fl_nm_1L_chr)) %>% + renewSlot("a_TTUSynopsis@outp_formats_chr", rep(x@d_TTUReports@a_TTUSynopsis@outp_formats_chr[2], + 2)) %>% procureSlot("a_TTUSynopsis"), consent_1L_chr = consent_1L_chr, + fl_nm_1L_chr = "Supplement", what_1L_chr = x@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@ms_dir_1L_chr) + } + } + else { + x <- methods::callNextMethod() + } + return(x) +}) diff --git a/R/mthd_exhibit.R b/R/mthd_exhibit.R new file mode 100644 index 00000000..2a8c3859 --- /dev/null +++ b/R/mthd_exhibit.R @@ -0,0 +1,19 @@ +#' +#' Exhibit features of a dataset by printing them to the R console +#' @name exhibit-TTUProject +#' @description exhibit method applied to TTUProject +#' @param x An object of class TTUProject +#' @param what_1L_chr What (a character vector of length one), Default: 'predictors' +#' @param ... Additional arguments +#' @return NULL +#' @rdname exhibit-methods +#' @aliases exhibit,TTUProject-method +#' @export +#' @importFrom ready4 exhibit +methods::setMethod("exhibit", "TTUProject", function (x, what_1L_chr = "predictors", ...) +{ + if (what_1L_chr == "predictors") { + exhibitSlot(x, "b_SpecificParameters@predictors_lup", + ... = ...) + } +}) diff --git a/R/mthd_investigate.R b/R/mthd_investigate.R new file mode 100644 index 00000000..32c16e0f --- /dev/null +++ b/R/mthd_investigate.R @@ -0,0 +1,69 @@ +#' +#' Investigate solutions to an inverse problem +#' @name investigate-TTUProject +#' @description investigate method applied to TTUProject +#' @param x An object of class TTUProject +#' @param backend_1L_chr Backend (a character vector of length one), Default: 'cmdstanr' +#' @param combinations_1L_lgl Combinations (a logical vector of length one), Default: F +#' @param consent_1L_chr Consent (a character vector of length one), Default: '' +#' @param cores_1L_int Cores (an integer vector of length one), Default: 1 +#' @param depnt_var_max_val_1L_dbl Dependent variable maximum value (a double vector of length one), Default: numeric(0) +#' @param depnt_var_min_val_1L_dbl Dependent variable minimum value (a double vector of length one), Default: numeric(0) +#' @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) +#' @param new_dir_nm_1L_chr New directory name (a character vector of length one), Default: 'F_TS_Mdls' +#' @param scndry_anlys_params_ls Secondary analysis parameters (a list), Default: NULL +#' @param session_ls Session (a list), Default: NULL +#' @param signft_covars_cdn_1L_chr Significant covariates condition (a character vector of length one), Default: 'any' +#' @param ... Additional arguments +#' @return x (An object of class TTUProject) +#' @rdname investigate-methods +#' @aliases investigate,TTUProject-method +#' @export +#' @importFrom rlang exec +#' @importFrom ready4 investigate +methods::setMethod("investigate", "TTUProject", function (x, backend_1L_chr = "cmdstanr", combinations_1L_lgl = F, + consent_1L_chr = "", cores_1L_int = 1L, depnt_var_max_val_1L_dbl = numeric(0), + depnt_var_min_val_1L_dbl = numeric(0), existing_predrs_ls = NULL, + max_nbr_of_covars_1L_int = integer(0), new_dir_nm_1L_chr = "F_TS_Mdls", + scndry_anlys_params_ls = NULL, session_ls = NULL, signft_covars_cdn_1L_chr = "any", + ...) +{ + args_ls <- list(...) + args_ls <- append(list(slot_nm_1L_chr = "c_SpecificProject", + consent_1L_chr = consent_1L_chr), args_ls) + if (inherits(x@c_SpecificProject, what = "SpecificModels") & + !(inherits(x@c_SpecificProject, what = "SpecificFixed") | + inherits(x@c_SpecificProject, what = "SpecificMixed") | + inherits(x@c_SpecificProject, what = "SpecificPredictors"))) { + args_ls <- append(list(depnt_var_max_val_1L_dbl = ifelse(identical(depnt_var_max_val_1L_dbl, + numeric(0)), 1, depnt_var_max_val_1L_dbl), depnt_var_min_val_1L_dbl = ifelse(identical(depnt_var_max_val_1L_dbl, + numeric(0)), -1, depnt_var_max_val_1L_dbl), session_ls = session_ls), + args_ls) + } + if (inherits(x@c_SpecificProject, what = "SpecificPredictors") & + !(inherits(x@c_SpecificProject, what = "SpecificFixed") | + inherits(x@c_SpecificProject, what = "SpecificMixed"))) { + args_ls <- append(list(depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, + signft_covars_cdn_1L_chr = signft_covars_cdn_1L_chr), + args_ls) + } + if (inherits(x@c_SpecificProject, what = "SpecificFixed") & + !(inherits(x@c_SpecificProject, what = "SpecificMixed"))) { + args_ls <- append(list(combinations_1L_lgl = combinations_1L_lgl, + depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, + existing_predrs_ls = existing_predrs_ls, max_nbr_of_covars_1L_int = max_nbr_of_covars_1L_int), + args_ls) + } + if (inherits(x@c_SpecificProject, what = "SpecificMixed")) { + args_ls <- append(list(backend_1L_chr = backend_1L_chr, + combinations_1L_lgl = combinations_1L_lgl, cores_1L_int = cores_1L_int, + depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, + existing_predrs_ls = existing_predrs_ls, max_nbr_of_covars_1L_int = max_nbr_of_covars_1L_int, + new_dir_nm_1L_chr = new_dir_nm_1L_chr, scndry_anlys_params_ls = scndry_anlys_params_ls), + args_ls) + } + new_val_xx <- rlang::exec(investigateSlot, x, !!!args_ls) + x <- renewSlot(x, "c_SpecificProject", new_val_xx) + return(x) +}) diff --git a/R/mthd_renew.R b/R/mthd_renew.R new file mode 100644 index 00000000..a736228c --- /dev/null +++ b/R/mthd_renew.R @@ -0,0 +1,219 @@ +#' +#' Renew values in a dataset +#' @name renew-TTUProject +#' @description renew method applied to TTUProject +#' @param x An object of class TTUProject +#' @param new_val_xx New value (an output object of multiple potential types), Default: NULL +#' @param consent_1L_chr Consent (a character vector of length one), Default: '' +#' @param depnt_var_min_val_1L_dbl Dependent variable minimum value (a double vector of length one), Default: numeric(0) +#' @param fl_nm_1L_chr File name (a character vector of length one), Default: character(0) +#' @param paths_chr Paths (a character vector), Default: character(0) +#' @param type_1L_chr Type (a character vector of length one), Default: 'default' +#' @param y_Ready4useRepos PARAM_DESCRIPTION, Default: ready4use::Ready4useRepos() +#' @param what_1L_chr What (a character vector of length one), Default: 'utility' +#' @param ... Additional arguments +#' @return x (An object of class TTUProject) +#' @rdname renew-methods +#' @aliases renew,TTUProject-method +#' @export +#' @importFrom ready4use Ready4useRepos +#' @importFrom ready4 renew +methods::setMethod("renew", "TTUProject", function (x, new_val_xx = NULL, consent_1L_chr = "", depnt_var_min_val_1L_dbl = numeric(0), + fl_nm_1L_chr = character(0), paths_chr = character(0), type_1L_chr = "default", + y_Ready4useRepos = ready4use::Ready4useRepos(), what_1L_chr = "utility", + ...) +{ + if (what_1L_chr == "parameters") { + if (type_1L_chr == "default") { + x <- renewSlot(x, "b_SpecificParameters", SpecificConverter(a_ScorzProfile = x@a_ScorzProfile) %>% + metamorphose() %>% procureSlot("b_SpecificParameters")) + } + if (type_1L_chr == "range") { + x <- renewSlot(x, "b_SpecificParameters@depnt_var_min_max_dbl", + new_val_xx) + } + if (type_1L_chr == "predictors_lup") { + if (new_val_xx == "use_renew_mthd") { + predictors_lup <- 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(fl_nm_1L_chr), + metadata_1L_lgl = F) + } + else { + predictors_lup <- new_val_xx + } + x <- renewSlot(x, "b_SpecificParameters@predictors_lup", + predictors_lup) + } + if (type_1L_chr == "predictors_vars") { + x <- renewSlot(x, "b_SpecificParameters@candidate_predrs_chr", + new_val_xx) + } + if (type_1L_chr == "covariates") { + x <- renewSlot(x, "b_SpecificParameters@candidate_covars_chr", + new_val_xx) + } + if (type_1L_chr == "descriptives") { + x <- renewSlot(x, "b_SpecificParameters@descv_var_nms_chr", + new_val_xx) + } + if (type_1L_chr == "is_fake") { + x <- renewSlot(x, "b_SpecificParameters@fake_1L_lgl", + new_val_xx) + } + if (type_1L_chr == "temporal") { + x <- renewSlot(x, "b_SpecificParameters@msrmnt_date_var_nm_1L_chr", + new_val_xx) + } + } + if (what_1L_chr == "project") { + x <- renewSlot(x, "c_SpecificProject", SpecificModels(a_YouthvarsProfile = x@a_ScorzProfile@a_YouthvarsProfile, + b_SpecificParameters = x@b_SpecificParameters, paths_chr = paths_chr)) + x <- ratifySlot(x, "c_SpecificProject") + x <- renewSlot(x, "c_SpecificProject", authorSlot(x, + "c_SpecificProject", consent_1L_chr = consent_1L_chr, + what_1L_chr = "workspace")) + } + if (what_1L_chr == "reporting") { + if (type_1L_chr == "default") { + Y <- metamorphoseSlot(x, "c_SpecificProject") + Y <- TTUSynopsis(a_Ready4showPaths = Y@a_Ready4showPaths, + b_SpecificResults = Y@b_SpecificResults, c_SpecificParameters = Y@c_SpecificParameters, + d_YouthvarsProfile = Y@d_YouthvarsProfile, rmd_fl_nms_ls = Y@rmd_fl_nms_ls) + Y <- TTUReports(a_TTUSynopsis = Y) + x <- renewSlot(x, "d_TTUReports", Y) + } + if (type_1L_chr == "abstract") { + if (new_val_xx == "use_renew_mthd") { + descs_ls <- x@d_TTUReports@a_TTUSynopsis@b_SpecificResults@a_SpecificShareable@shareable_outp_ls$results_ls$study_descs_ls + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis@abstract_args_ls", + manufactureSlot(x, "d_TTUReports@a_TTUSynopsis", + what_1L_chr = "abstract_args_ls", depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, + depnt_var_nms_chr = c(descs_ls$health_utl_nm_1L_chr, + descs_ls$health_utl_long_nm_1L_chr))) + } + else { + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", + procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% + renewSlot("abstract_args_ls", new_val_xx)) + } + } + if (type_1L_chr == "authors") { + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, + "d_TTUReports@a_TTUSynopsis") %>% renewSlot("authors_r3", + new_val_xx)) + } + if (type_1L_chr == "background") { + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, + "d_TTUReports@a_TTUSynopsis") %>% renewSlot("background_1L_chr", + new_val_xx)) + } + if (type_1L_chr == "changes") { + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, + "d_TTUReports@a_TTUSynopsis") %>% renewSlot("correspondences_r3", + new_val_xx)) + } + if (type_1L_chr == "conflicts") { + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, + "d_TTUReports@a_TTUSynopsis") %>% renewSlot("coi_1L_chr", + new_val_xx)) + } + if (type_1L_chr == "conclusion") { + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, + "d_TTUReports@a_TTUSynopsis") %>% renewSlot("conclusion_1L_chr", + new_val_xx)) + } + if (type_1L_chr == "digits") { + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, + "d_TTUReports@a_TTUSynopsis") %>% renewSlot("digits_int", + new_val_xx)) + } + if (type_1L_chr == "ethics") { + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, + "d_TTUReports@a_TTUSynopsis") %>% renewSlot("ethics_1L_chr", + new_val_xx)) + } + if (type_1L_chr == "formats") { + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, + "d_TTUReports@a_TTUSynopsis") %>% renewSlot("outp_formats_chr", + new_val_xx)) + } + if (type_1L_chr == "figures-body") { + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, + "d_TTUReports@a_TTUSynopsis") %>% renewSlot("figures_in_body_lgl", + new_val_xx)) + } + if (type_1L_chr == "funding") { + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, + "d_TTUReports@a_TTUSynopsis") %>% renewSlot("funding_1L_chr", + new_val_xx)) + } + if (type_1L_chr == "institutes") { + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, + "d_TTUReports@a_TTUSynopsis") %>% renewSlot("institutes_r3", + new_val_xx)) + } + if (type_1L_chr == "interval") { + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, + "d_TTUReports@a_TTUSynopsis") %>% renewSlot("interval_chr", + new_val_xx)) + } + if (type_1L_chr == "keywords") { + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, + "d_TTUReports@a_TTUSynopsis") %>% renewSlot("keywords_chr", + new_val_xx)) + } + if (type_1L_chr == "naming") { + x <- enhanceSlot(x, "d_TTUReports@a_TTUSynopsis", + depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, + depnt_var_nms_chr = new_val_xx, with_1L_chr = "results_ls") + } + if (type_1L_chr == "repos") { + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, + "d_TTUReports@a_TTUSynopsis") %>% renewSlot("e_Ready4useRepos", + new_val_xx)) + } + if (type_1L_chr == "sample") { + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, + "d_TTUReports@a_TTUSynopsis") %>% renewSlot("sample_desc_1L_chr", + new_val_xx)) + } + if (type_1L_chr == "tables-body") { + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, + "d_TTUReports@a_TTUSynopsis") %>% renewSlot("tables_in_body_lgl", + new_val_xx)) + } + if (type_1L_chr == "template-catalaogue") { + x <- renewSlot(x, "d_TTUReports", procureSlot(x, + "d_TTUReports") %>% renewSlot("catalogue_tmpl_chr", + new_val_xx)) + } + if (type_1L_chr == "template-manuscript") { + x <- renewSlot(x, "d_TTUReports", procureSlot(x, + "d_TTUReports") %>% renewSlot("manuscript_tmpl_chr", + new_val_xx)) + } + if (type_1L_chr == "title") { + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, + "d_TTUReports@a_TTUSynopsis") %>% renewSlot("title_1L_chr", + new_val_xx)) + } + } + if (what_1L_chr == "results") { + if (type_1L_chr == "covariates") { + x <- renewSlot(x, "c_SpecificProject", renew(procureSlot(x, + "c_SpecificProject"), new_val_xx = new_val_xx, + type_1L_chr = "results", what_1L_chr = "prefd_covars")) + } + if (type_1L_chr == "models") { + x <- renewSlot(x, "c_SpecificProject", renew(procureSlot(x, + "c_SpecificProject"), new_val_xx = new_val_xx, + type_1L_chr = "results", what_1L_chr = "prefd_mdls")) + } + } + if (what_1L_chr == "utility") { + x <- renewSlot(x, "a_ScorzProfile") + } + return(x) +}) diff --git a/R/mthd_share.R b/R/mthd_share.R new file mode 100644 index 00000000..575043f8 --- /dev/null +++ b/R/mthd_share.R @@ -0,0 +1,59 @@ +#' +#' Share data via an online repository +#' @name share-TTUProject +#' @description share method applied to TTUProject +#' @param x An object of class TTUProject +#' @param formats_chr Formats (a character vector), Default: c(".docx", ".pdf", ".tex") +#' @param types_chr Types (a character vector), Default: 'auto' +#' @param what_chr What (a character vector), Default: c("catalogue", "models") +#' @return x (An object of class TTUProject) +#' @rdname share-methods +#' @aliases share,TTUProject-method +#' @export +#' @importFrom purrr walk map_lgl map_chr +#' @importFrom Hmisc capitalize +#' @importFrom ready4 write_fls_to_dv share +methods::setMethod("share", "TTUProject", function (x, formats_chr = c(".docx", ".pdf", ".tex"), types_chr = "auto", + what_chr = c("catalogue", "models")) +{ + if ("manuscript" %in% what_chr | "supplement" %in% what_chr) { + purrr::walk(paste0("Manuscript_", Hmisc::capitalize(types_chr)), + ~{ + x <- x@d_TTUReports@a_TTUSynopsis + what_1L_chr <- .x + files_chr <- list.files(paste0(x@a_Ready4showPaths@outp_data_dir_1L_chr, + "/", x@a_Ready4showPaths@reports_dir_1L_chr, + "/", what_1L_chr)) + files_chr <- files_chr[files_chr %>% purrr::map_lgl(~{ + string_1L_chr <- .x + any(formats_chr %>% purrr::map_lgl(~endsWith(string_1L_chr, + .x))) + })] + files_chr <- files_chr[files_chr %>% purrr::map_lgl(~{ + string_1L_chr <- .x + any(Hmisc::capitalize(what_chr) %>% purrr::map_lgl(~startsWith(string_1L_chr, + .x))) + })] + ms_nm_1L_chr <- "Manuscript" + idx_1L_int <- ready4::write_fls_to_dv(paste0(paste0(x@a_Ready4showPaths@outp_data_dir_1L_chr, + "/", x@a_Ready4showPaths@reports_dir_1L_chr, + "/", what_1L_chr, "/"), files_chr), descriptions_chr = files_chr %>% + purrr::map_chr(~paste0("Scientific summary of utility mapping study", + " ", ifelse(startsWith(.x, "Supplement"), + "(Supplement) ", ""), ifelse(endsWith(.x, + ".tex"), "(LaTeX) ", ""), ifelse(what_1L_chr == + "Manuscript_Auto", " (algorithm generated)", + ""))), ds_url_1L_chr = x@e_Ready4useRepos@dv_ds_nm_1L_chr) + Sys.sleep(5L) + }) + } + if ("catalogue" %in% what_chr) { + shareSlot(x, "d_TTUReports@a_TTUSynopsis", type_1L_chr = "Report", + what_1L_chr = "Catalogue") + } + if ("models" %in% what_chr) { + shareSlot(A, "d_TTUReports@a_TTUSynopsis", type_1L_chr = "Models", + what_1L_chr = "ingredients") + } + return(x) +}) diff --git a/_pkgdown.yml b/_pkgdown.yml index ee0d1b41..bb970943 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -27,4 +27,9 @@ reference: - TTUProject - title: "Methods" - contents: + - author-TTUProject - author-TTUReports + - exhibit-TTUProject + - investigate-TTUProject + - renew-TTUProject + - share-TTUProject diff --git a/data-raw/DATASET.R b/data-raw/DATASET.R index 9ea70108..71568e14 100644 --- a/data-raw/DATASET.R +++ b/data-raw/DATASET.R @@ -68,7 +68,7 @@ y <- ready4class::ready4class_constructor() %>% catalogue_fl_nms_ls = "ready4show::make_rmd_fl_nms_ls(\"Lngl_Mdls_HTML\", pdf_fl_nm_1L_chr = \"Lngl_Mdls_PDF\", word_fl_nm_1L_chr = \"Lngl_Mdls_Word\")", - manuscript_tmpl_chr = "c(\"https://github.com/ready4-dev/ttu_lng_ss\",\"0.9.0.0\")", + manuscript_tmpl_chr = "c(\"https://github.com/ready4-dev/ttu_lng_ss\",\"0.9.0.1\")", manuscript_fl_nms_ls = "ready4show::make_rmd_fl_nms_ls(pdf_fl_nm_1L_chr = \"Main_PDF\", word_fl_nm_1L_chr = \"Main_Word\")")), class_desc_chr = "Metadata to produce utility mapping study reports.", diff --git a/data-raw/s4_fns/author.R b/data-raw/s4_fns/author.R index 78530fa9..34eeee3c 100644 --- a/data-raw/s4_fns/author.R +++ b/data-raw/s4_fns/author.R @@ -48,8 +48,9 @@ author_TTUReports <- function(x, if(type_1L_chr == "Dependencies"){ df <- data.frame(Package = c("youthvars","scorz","specific","TTU") %>% purrr::map(~ { - utils::packageDescription(.x) %>% - `[`(c("Depends", "Imports")) %>% + desc_ls <- utils::packageDescription(.x) + desc_ls[c("Depends", "Imports")] %>% + # `[`(c("Depends", "Imports")) %>% purrr::map(~{ if(is.null(.x)){ character(0) @@ -102,6 +103,7 @@ author_TTUReports <- function(x, } if(type_1L_chr == "Plots"){ composite_1_plt <- depict(x@a_TTUSynopsis,# + consent_1L_chr = consent_1L_chr, depnt_var_desc_1L_chr = depnt_var_desc_1L_chr, depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, timepoint_old_nms_chr = procureSlot(x, @@ -110,6 +112,7 @@ author_TTUReports <- function(x, what_1L_chr = "composite_mdl", write_1L_lgl = T) composite_2_plt <- depict(x@a_TTUSynopsis,# + consent_1L_chr = consent_1L_chr, what_1L_chr = "composite_utl", write_1L_lgl = T) if(!is.na(what_1L_chr)){ @@ -147,21 +150,89 @@ author_TTUReports <- function(x, } author_TTUProject <- function(x, consent_1L_chr = "", + depnt_var_min_val_1L_dbl = numeric(0), digits_1L_int = 2L, + download_tmpl_1L_lgl = T, + supplement_fl_nm_1L_chr = "TA_PDF", + timepoint_new_nms_chr = NA_character_, + type_1L_chr = "auto", what_1L_chr = "default", ...){ - if(what_1L_chr %in% c("descriptives", "models")){ - if(what_1L_chr == "descriptives"){ + if(what_1L_chr %in% c("catalogue","Catalogue","dependencies", "Dependencies", "descriptives", "Descriptives", "manuscript", "Manuscript", "models", "Models", + "plots", "Plots", "purge", "Purge", "supplement", "Supplement")){ + if(what_1L_chr %in% c("catalogue","Catalogue")){ + authorSlot(x, "d_TTUReports", consent_1L_chr = consent_1L_chr, download_tmpl_1L_lgl = download_tmpl_1L_lgl, what_1L_chr = Hmisc::capitalize(what_1L_chr)) + } + if(what_1L_chr %in% c("descriptives","Descriptives")){ x <- renewSlot(x, "c_SpecificProject", authorSlot(x, "c_SpecificProject", consent_1L_chr = consent_1L_chr, digits_1L_int = digits_1L_int, - what_1L_chr = what_1L_chr)) + what_1L_chr = tolower(what_1L_chr))) } - if(what_1L_chr == "models"){ + if(what_1L_chr %in% c("manuscript", "Manuscript")){ + if(type_1L_chr=="auto"){ + x@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@ms_dir_1L_chr <- paste0(Hmisc::capitalize(what_1L_chr),"_",Hmisc::capitalize(type_1L_chr)) + authorSlot(x, "d_TTUReports", consent_1L_chr = consent_1L_chr, download_tmpl_1L_lgl = download_tmpl_1L_lgl, type_1L_chr = "Report", what_1L_chr = x@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@ms_dir_1L_chr) + } + if(type_1L_chr == "copy"){ + from_1L_chr <- paste0(A@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@outp_data_dir_1L_chr, + "/", + A@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@mkdn_data_dir_1L_chr, + "/Manuscript_Auto") + to_1L_chr <- paste0(A@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@outp_data_dir_1L_chr, + "/", + A@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@mkdn_data_dir_1L_chr, + "/Manuscript_Submission") + ready4::write_with_consent(consented_fn = R.utils::copyDirectory, + prompt_1L_chr = paste0("Do you confirm that you want to copy the directory ", + from_1L_chr, #"packages.RDS", + " (and all its contents) to ", + to_1L_chr, + "?"), + consent_1L_chr = consent_1L_chr, + consented_args_ls = list(from = from_1L_chr, + to = to_1L_chr), + consented_msg_1L_chr = paste0("The directory ", + from_1L_chr, + " has been copied to ", + to_1L_chr, + "."), + declined_msg_1L_chr = "Write request cancelled - no new directory copy has been written.") + + } + if(type_1L_chr %in% c("dependencies", "Dependencies")){ + author(x@d_TTUReports, consent_1L_chr = consent_1L_chr, type_1L_chr = Hmisc::capitalize(type_1L_chr), what_1L_chr = "Manuscript_Submission") + } + if(type_1L_chr %in% c("plots","Plots")){ + authorSlot(x, "d_TTUReports", consent_1L_chr = consent_1L_chr, depnt_var_desc_1L_chr = x@d_TTUReports@a_TTUSynopsis@b_SpecificResults@a_SpecificShareable@shareable_outp_ls$results_ls$study_descs_ls$health_utl_nm_1L_chr, + depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, timepoint_new_nms_chr = timepoint_new_nms_chr, type_1L_chr = Hmisc::capitalize(type_1L_chr), what_1L_chr = "Manuscript_Submission") + } + if(type_1L_chr=="submission"){ + x@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@ms_dir_1L_chr <- paste0(Hmisc::capitalize(what_1L_chr),"_",Hmisc::capitalize(type_1L_chr)) + authorSlot(x, "d_TTUReports", consent_1L_chr = consent_1L_chr, download_tmpl_1L_lgl = download_tmpl_1L_lgl, type_1L_chr = "Report", what_1L_chr = x@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@ms_dir_1L_chr) + } + } + if(what_1L_chr %in% c("models", "Models")){ x <- renewSlot(x, "c_SpecificProject", authorData(procureSlot(x, "c_SpecificProject"), consent_1L_chr = consent_1L_chr)) } + if(what_1L_chr %in% c("purge")){ + authorSlot(x,"c_SpecificProject", type_1L_chr = "purge_write") + } + if(what_1L_chr %in% c("plots","Plots")){ + authorSlot(x, "d_TTUReports", consent_1L_chr = consent_1L_chr, + depnt_var_desc_1L_chr = x@d_TTUReports@a_TTUSynopsis@b_SpecificResults@a_SpecificShareable@shareable_outp_ls$results_ls$study_descs_ls$health_utl_nm_1L_chr, + type_1L_chr = Hmisc::capitalize(what_1L_chr)) + } + if(what_1L_chr %in% c("supplement","Supplement")){ + x@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@ms_dir_1L_chr <- paste0("Manuscript_",Hmisc::capitalize(type_1L_chr)) + authorReport(procureSlot(x, "d_TTUReports") %>% + renewSlot("a_TTUSynopsis@rmd_fl_nms_ls", ready4show::make_rmd_fl_nms_ls(pdf_fl_nm_1L_chr = supplement_fl_nm_1L_chr)) %>% + renewSlot("a_TTUSynopsis@outp_formats_chr", rep(x@d_TTUReports@a_TTUSynopsis@outp_formats_chr[2],2)) %>% + procureSlot("a_TTUSynopsis"), + consent_1L_chr = consent_1L_chr, fl_nm_1L_chr = "Supplement", what_1L_chr = x@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@ms_dir_1L_chr) + } }else{ x <- methods::callNextMethod() } diff --git a/data-raw/s4_fns/renew.R b/data-raw/s4_fns/renew.R index 241e5ee1..d3df933f 100644 --- a/data-raw/s4_fns/renew.R +++ b/data-raw/s4_fns/renew.R @@ -1,29 +1,26 @@ renew_TTUProject <- function(x, new_val_xx = NULL, consent_1L_chr = "", + depnt_var_min_val_1L_dbl = numeric(0), fl_nm_1L_chr = character(0), paths_chr = character(0), - predictors_lup = NULL, type_1L_chr = "default", y_Ready4useRepos = ready4use::Ready4useRepos(), what_1L_chr = "utility", ...){ if(what_1L_chr == "parameters"){ if(type_1L_chr=="default"){ - x <- renewSlot(x, "b_SpecificParameters", SpecificConverter(a_ScorzProfile = x@a_ScorzProfile) %>% - metamorphose() %>% - procureSlot("b_SpecificParameters")) + x <- renewSlot(x, "b_SpecificParameters", SpecificConverter(a_ScorzProfile = x@a_ScorzProfile) %>% metamorphose() %>% procureSlot("b_SpecificParameters")) } if(type_1L_chr == "range"){ x <- renewSlot(x, "b_SpecificParameters@depnt_var_min_max_dbl", new_val_xx) } if(type_1L_chr=="predictors_lup"){ - if(is.null(predictors_lup)){ - predictors_lup <- 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(fl_nm_1L_chr), - metadata_1L_lgl = F) + if(new_val_xx == "use_renew_mthd"){ + predictors_lup <- 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(fl_nm_1L_chr), metadata_1L_lgl = F) + }else{ + predictors_lup <- new_val_xx } x <- renewSlot(x, "b_SpecificParameters@predictors_lup", predictors_lup) } @@ -45,76 +42,96 @@ renew_TTUProject <- function(x, } if(what_1L_chr == "project"){ x <- renewSlot(x, "c_SpecificProject", SpecificModels(a_YouthvarsProfile = x@a_ScorzProfile@a_YouthvarsProfile, - b_SpecificParameters = x@b_SpecificParameters, - paths_chr = paths_chr)) + b_SpecificParameters = x@b_SpecificParameters, paths_chr = paths_chr)) x <- ratifySlot(x, "c_SpecificProject") - x <- renewSlot(x, "c_SpecificProject", - authorSlot(x, "c_SpecificProject", consent_1L_chr = consent_1L_chr, what_1L_chr = "workspace")) + x <- renewSlot(x, "c_SpecificProject", authorSlot(x, "c_SpecificProject", consent_1L_chr = consent_1L_chr, what_1L_chr = "workspace")) } if(what_1L_chr == "reporting"){ - if(type_1L_chr=="default"){ - x <- renewSlot(x, "d_TTUReports", - { - Y <- metamorphoseSlot(x, "c_SpecificProject") - Y <- TTUSynopsis(a_Ready4showPaths = Y@a_Ready4showPaths, - b_SpecificResults = Y@b_SpecificResults, - c_SpecificParameters = Y@c_SpecificParameters, - d_YouthvarsProfile = Y@d_YouthvarsProfile, - rmd_fl_nms_ls = Y@rmd_fl_nms_ls) - Y <- TTUReports(a_TTUSynopsis = Y) - Y - }) + if(type_1L_chr == "default"){ + Y <- metamorphoseSlot(x, "c_SpecificProject") + Y <- TTUSynopsis(a_Ready4showPaths = Y@a_Ready4showPaths, b_SpecificResults = Y@b_SpecificResults, c_SpecificParameters = Y@c_SpecificParameters, + d_YouthvarsProfile = Y@d_YouthvarsProfile, rmd_fl_nms_ls = Y@rmd_fl_nms_ls) + Y <- TTUReports(a_TTUSynopsis = Y) + x <- renewSlot(x, "d_TTUReports", Y) + } + if(type_1L_chr == "abstract"){ + if(new_val_xx == "use_renew_mthd"){ + descs_ls <- x@d_TTUReports@a_TTUSynopsis@b_SpecificResults@a_SpecificShareable@shareable_outp_ls$results_ls$study_descs_ls + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis@abstract_args_ls", + manufactureSlot(x,"d_TTUReports@a_TTUSynopsis", what_1L_chr = "abstract_args_ls", depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, + depnt_var_nms_chr = c(descs_ls$health_utl_nm_1L_chr,descs_ls$health_utl_long_nm_1L_chr))) + + }else{ + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% renewSlot("abstract_args_ls", new_val_xx)) + } } if(type_1L_chr == "authors"){ - x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", - procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% - renewSlot("authors_r3", new_val_xx)) + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% renewSlot("authors_r3", new_val_xx)) + } + if(type_1L_chr == "background"){ + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% renewSlot("background_1L_chr", new_val_xx)) } if(type_1L_chr == "changes"){ - x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", - procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% - renewSlot("correspondences_r3", new_val_xx)) + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% renewSlot("correspondences_r3", new_val_xx)) + } + if(type_1L_chr == "conflicts"){ + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% renewSlot("coi_1L_chr", new_val_xx)) + } + if(type_1L_chr == "conclusion"){ + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% renewSlot("conclusion_1L_chr", new_val_xx)) } if(type_1L_chr == "digits"){ - x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", - procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% - renewSlot("digits_int", new_val_xx)) + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% renewSlot("digits_int", new_val_xx)) + } + if(type_1L_chr == "ethics"){ + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% renewSlot("ethics_1L_chr", new_val_xx)) } if(type_1L_chr == "formats"){ - x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", - procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% - renewSlot("outp_formats_chr", new_val_xx)) + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% renewSlot("outp_formats_chr", new_val_xx)) + } + if(type_1L_chr == "figures-body"){ + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% renewSlot("figures_in_body_lgl", new_val_xx)) + } + if(type_1L_chr == "funding"){ + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% renewSlot("funding_1L_chr", new_val_xx)) } if(type_1L_chr == "institutes"){ - x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", - procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% - renewSlot("institutes_r3", new_val_xx)) + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% renewSlot("institutes_r3", new_val_xx)) + } + if(type_1L_chr == "interval"){ + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% renewSlot("interval_chr", new_val_xx)) + } + if(type_1L_chr == "keywords"){ + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% renewSlot("keywords_chr", new_val_xx)) + } + if(type_1L_chr == "naming"){ + x <- enhanceSlot(x, "d_TTUReports@a_TTUSynopsis", depnt_var_min_val_1L_dbl = depnt_var_min_val_1L_dbl, depnt_var_nms_chr = new_val_xx, with_1L_chr = "results_ls") } if(type_1L_chr == "repos"){ - x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", - procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% - renewSlot("e_Ready4useRepos", new_val_xx)) + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% renewSlot("e_Ready4useRepos", new_val_xx)) + } + if(type_1L_chr == "sample"){ + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% renewSlot("sample_desc_1L_chr", new_val_xx)) + } + if(type_1L_chr == "tables-body"){ + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% renewSlot("tables_in_body_lgl", new_val_xx)) + } + if(type_1L_chr == "template-catalaogue"){ + x <- renewSlot(x, "d_TTUReports", procureSlot(x, "d_TTUReports") %>% renewSlot("catalogue_tmpl_chr", new_val_xx)) + } + if(type_1L_chr == "template-manuscript"){ + x <- renewSlot(x, "d_TTUReports", procureSlot(x, "d_TTUReports") %>% renewSlot("manuscript_tmpl_chr", new_val_xx)) } if(type_1L_chr == "title"){ - x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", - procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% - renewSlot("title_1L_chr", new_val_xx)) + x <- renewSlot(x, "d_TTUReports@a_TTUSynopsis", procureSlot(x, "d_TTUReports@a_TTUSynopsis") %>% renewSlot("title_1L_chr", new_val_xx)) } } if(what_1L_chr == "results"){ if(type_1L_chr =="covariates"){ - x <- renewSlot(x, "c_SpecificProject", - renew(procureSlot(x, "c_SpecificProject"), - new_val_xx = new_val_xx, - type_1L_chr = "results", - what_1L_chr = "prefd_covars")) + x <- renewSlot(x, "c_SpecificProject", renew(procureSlot(x, "c_SpecificProject"), new_val_xx = new_val_xx, type_1L_chr = "results", what_1L_chr = "prefd_covars")) } if(type_1L_chr == "models"){ - x <- renewSlot(x, "c_SpecificProject", - renew(procureSlot(x, "c_SpecificProject"), - new_val_xx = new_val_xx, - type_1L_chr = "results", - what_1L_chr = "prefd_mdls")) + x <- renewSlot(x, "c_SpecificProject", renew(procureSlot(x, "c_SpecificProject"), new_val_xx = new_val_xx, type_1L_chr = "results", what_1L_chr = "prefd_mdls")) } } diff --git a/data-raw/s4_fns/share.R b/data-raw/s4_fns/share.R new file mode 100644 index 00000000..b0be73a1 --- /dev/null +++ b/data-raw/s4_fns/share.R @@ -0,0 +1,53 @@ +share_TTUProject <- function(x, + formats_chr = c(".docx",".pdf", ".tex"), + types_chr = "auto", + what_chr = c("catalogue", "models")){ + if("manuscript" %in% what_chr | "supplement" %in% what_chr){ + purrr::walk(paste0("Manuscript_", Hmisc::capitalize(types_chr)), + ~ { + x <- x@d_TTUReports@a_TTUSynopsis + what_1L_chr <- .x + + files_chr <- list.files(paste0(x@a_Ready4showPaths@outp_data_dir_1L_chr, + "/", + x@a_Ready4showPaths@reports_dir_1L_chr, + "/", + what_1L_chr)) + files_chr <- files_chr[files_chr %>% purrr::map_lgl(~{ + string_1L_chr <- .x + any(formats_chr %>% purrr::map_lgl(~endsWith(string_1L_chr,.x))) + })] + files_chr <- files_chr[files_chr %>% purrr::map_lgl(~{ + string_1L_chr <- .x + any(Hmisc::capitalize(what_chr) %>% purrr::map_lgl(~startsWith(string_1L_chr,.x))) + })] + ms_nm_1L_chr <- "Manuscript" + idx_1L_int <- ready4::write_fls_to_dv(paste0(paste0(x@a_Ready4showPaths@outp_data_dir_1L_chr, + "/", + x@a_Ready4showPaths@reports_dir_1L_chr, + "/", + what_1L_chr, + "/"), + files_chr), + descriptions_chr = files_chr %>% purrr::map_chr(~paste0("Scientific summary of utility mapping study", + " ", + ifelse(startsWith(.x,"Supplement"),"(Supplement) ",""), + ifelse(endsWith(.x,".tex"),"(LaTeX) ",""), + ifelse(what_1L_chr == "Manuscript_Auto", " (algorithm generated)",""))), + ds_url_1L_chr = x@e_Ready4useRepos@dv_ds_nm_1L_chr) + Sys.sleep(5L) + } + ) + } + if("catalogue" %in% what_chr){ + shareSlot(x, "d_TTUReports@a_TTUSynopsis", type_1L_chr = "Report", what_1L_chr = "Catalogue") + } + if("models" %in% what_chr){ + shareSlot(A, "d_TTUReports@a_TTUSynopsis", type_1L_chr = "Models", what_1L_chr = "ingredients") + } + + return(x) + + + +} diff --git a/man/author-methods.Rd b/man/author-methods.Rd index 28b47ade..0cf578ed 100644 --- a/man/author-methods.Rd +++ b/man/author-methods.Rd @@ -3,6 +3,8 @@ \name{author-TTUReports} \alias{author-TTUReports} \alias{author,TTUReports-method} +\alias{author-TTUProject} +\alias{author,TTUProject-method} \title{Author and save files} \usage{ \S4method{author}{TTUReports}( @@ -18,9 +20,22 @@ what_1L_chr = NA_character_, ... ) + +\S4method{author}{TTUProject}( + x, + consent_1L_chr = "", + depnt_var_min_val_1L_dbl = numeric(0), + digits_1L_int = 2L, + download_tmpl_1L_lgl = T, + supplement_fl_nm_1L_chr = "TA_PDF", + timepoint_new_nms_chr = NA_character_, + type_1L_chr = "auto", + what_1L_chr = "default", + ... +) } \arguments{ -\item{x}{An object of class TTUReports} +\item{x}{An object of class TTUProject} \item{args_ls}{Arguments (a list), Default: NULL} @@ -36,12 +51,21 @@ \item{timepoint_new_nms_chr}{Timepoint new names (a character vector), Default: 'NA'} -\item{type_1L_chr}{Type (a character vector of length one), Default: 'Report'} +\item{type_1L_chr}{Type (a character vector of length one), Default: 'auto'} -\item{what_1L_chr}{What (a character vector of length one), Default: 'NA'} +\item{what_1L_chr}{What (a character vector of length one), Default: 'default'} \item{...}{Additional arguments} + +\item{digits_1L_int}{Digits (an integer vector of length one), Default: 2} + +\item{supplement_fl_nm_1L_chr}{Supplement file name (a character vector of length one), Default: 'TA_PDF'} +} +\value{ +x (An object of class TTUProject) } \description{ author method applied to TTUReports + +author method applied to TTUProject } diff --git a/man/exhibit-methods.Rd b/man/exhibit-methods.Rd new file mode 100644 index 00000000..0eba57ac --- /dev/null +++ b/man/exhibit-methods.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mthd_exhibit.R +\name{exhibit-TTUProject} +\alias{exhibit-TTUProject} +\alias{exhibit,TTUProject-method} +\title{Exhibit features of a dataset by printing them to the R console} +\usage{ +\S4method{exhibit}{TTUProject}(x, what_1L_chr = "predictors", ...) +} +\arguments{ +\item{x}{An object of class TTUProject} + +\item{what_1L_chr}{What (a character vector of length one), Default: 'predictors'} + +\item{...}{Additional arguments} +} +\description{ +exhibit method applied to TTUProject +} diff --git a/man/investigate-methods.Rd b/man/investigate-methods.Rd new file mode 100644 index 00000000..fc930dcd --- /dev/null +++ b/man/investigate-methods.Rd @@ -0,0 +1,59 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mthd_investigate.R +\name{investigate-TTUProject} +\alias{investigate-TTUProject} +\alias{investigate,TTUProject-method} +\title{Investigate solutions to an inverse problem} +\usage{ +\S4method{investigate}{TTUProject}( + x, + backend_1L_chr = "cmdstanr", + combinations_1L_lgl = F, + consent_1L_chr = "", + cores_1L_int = 1L, + depnt_var_max_val_1L_dbl = numeric(0), + depnt_var_min_val_1L_dbl = numeric(0), + existing_predrs_ls = NULL, + max_nbr_of_covars_1L_int = integer(0), + new_dir_nm_1L_chr = "F_TS_Mdls", + scndry_anlys_params_ls = NULL, + session_ls = NULL, + signft_covars_cdn_1L_chr = "any", + ... +) +} +\arguments{ +\item{x}{An object of class TTUProject} + +\item{backend_1L_chr}{Backend (a character vector of length one), Default: 'cmdstanr'} + +\item{combinations_1L_lgl}{Combinations (a logical vector of length one), Default: F} + +\item{consent_1L_chr}{Consent (a character vector of length one), Default: ''} + +\item{cores_1L_int}{Cores (an integer vector of length one), Default: 1} + +\item{depnt_var_max_val_1L_dbl}{Dependent variable maximum value (a double vector of length one), Default: numeric(0)} + +\item{depnt_var_min_val_1L_dbl}{Dependent variable minimum value (a double vector of length one), Default: numeric(0)} + +\item{existing_predrs_ls}{Existing predictors (a list), Default: NULL} + +\item{max_nbr_of_covars_1L_int}{Maximum number of covariates (an integer vector of length one), Default: integer(0)} + +\item{new_dir_nm_1L_chr}{New directory name (a character vector of length one), Default: 'F_TS_Mdls'} + +\item{scndry_anlys_params_ls}{Secondary analysis parameters (a list), Default: NULL} + +\item{session_ls}{Session (a list), Default: NULL} + +\item{signft_covars_cdn_1L_chr}{Significant covariates condition (a character vector of length one), Default: 'any'} + +\item{...}{Additional arguments} +} +\value{ +x (An object of class TTUProject) +} +\description{ +investigate method applied to TTUProject +} diff --git a/man/renew-methods.Rd b/man/renew-methods.Rd new file mode 100644 index 00000000..e85170fc --- /dev/null +++ b/man/renew-methods.Rd @@ -0,0 +1,47 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mthd_renew.R +\name{renew-TTUProject} +\alias{renew-TTUProject} +\alias{renew,TTUProject-method} +\title{Renew values in a dataset} +\usage{ +\S4method{renew}{TTUProject}( + x, + new_val_xx = NULL, + consent_1L_chr = "", + depnt_var_min_val_1L_dbl = numeric(0), + fl_nm_1L_chr = character(0), + paths_chr = character(0), + type_1L_chr = "default", + y_Ready4useRepos = ready4use::Ready4useRepos(), + what_1L_chr = "utility", + ... +) +} +\arguments{ +\item{x}{An object of class TTUProject} + +\item{new_val_xx}{New value (an output object of multiple potential types), Default: NULL} + +\item{consent_1L_chr}{Consent (a character vector of length one), Default: ''} + +\item{depnt_var_min_val_1L_dbl}{Dependent variable minimum value (a double vector of length one), Default: numeric(0)} + +\item{fl_nm_1L_chr}{File name (a character vector of length one), Default: character(0)} + +\item{paths_chr}{Paths (a character vector), Default: character(0)} + +\item{type_1L_chr}{Type (a character vector of length one), Default: 'default'} + +\item{y_Ready4useRepos}{PARAM_DESCRIPTION, Default: ready4use::Ready4useRepos()} + +\item{what_1L_chr}{What (a character vector of length one), Default: 'utility'} + +\item{...}{Additional arguments} +} +\value{ +x (An object of class TTUProject) +} +\description{ +renew method applied to TTUProject +} diff --git a/man/share-methods.Rd b/man/share-methods.Rd new file mode 100644 index 00000000..d377e66a --- /dev/null +++ b/man/share-methods.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mthd_share.R +\name{share-TTUProject} +\alias{share-TTUProject} +\alias{share,TTUProject-method} +\title{Share data via an online repository} +\usage{ +\S4method{share}{TTUProject}( + x, + formats_chr = c(".docx", ".pdf", ".tex"), + types_chr = "auto", + what_chr = c("catalogue", "models") +) +} +\arguments{ +\item{x}{An object of class TTUProject} + +\item{formats_chr}{Formats (a character vector), Default: c(".docx", ".pdf", ".tex")} + +\item{types_chr}{Types (a character vector), Default: 'auto'} + +\item{what_chr}{What (a character vector), Default: c("catalogue", "models")} +} +\value{ +x (An object of class TTUProject) +} +\description{ +share method applied to TTUProject +} diff --git a/vignettes/CSP_AQOL6D_TTU.R b/vignettes/CSP_AQOL6D_TTU.R new file mode 100644 index 00000000..8b137891 --- /dev/null +++ b/vignettes/CSP_AQOL6D_TTU.R @@ -0,0 +1 @@ + diff --git a/vignettes/CSP_EQ5D_TTU.R b/vignettes/CSP_EQ5D_TTU.R new file mode 100644 index 00000000..8b137891 --- /dev/null +++ b/vignettes/CSP_EQ5D_TTU.R @@ -0,0 +1 @@ + diff --git a/vignettes/Model_TTU.R b/vignettes/Model_TTU.R new file mode 100644 index 00000000..8b137891 --- /dev/null +++ b/vignettes/Model_TTU.R @@ -0,0 +1 @@ + diff --git a/vignettes/TTU.R b/vignettes/TTU.R new file mode 100644 index 00000000..5ac95bae --- /dev/null +++ b/vignettes/TTU.R @@ -0,0 +1,9 @@ +## ---- include = FALSE--------------------------------------------------------- +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) + +## ----setup, message=FALSE, warning=FALSE, results='hide'---------------------- +library(TTU) + diff --git a/vignettes/V_01.R b/vignettes/V_01.R new file mode 100644 index 00000000..4c22f246 --- /dev/null +++ b/vignettes/V_01.R @@ -0,0 +1,96 @@ +## ----eval=F------------------------------------------------------------------- +# @article {Hamilton2021.07.07.21260129, +# author = {Hamilton, Matthew P and Gao, Caroline X and Filia, Kate M and Menssink, Jana M and Sharmin, Sonia and Telford, Nic and Herrman, Helen and Hickie, Ian B and Mihalopoulos, Cathrine and Rickwood, Debra J and McGorry, Patrick D and Cotton, Sue M}, +# title = {Predicting Quality Adjusted Life Years in young people attending primary mental health services}, +# elocation-id = {2021.07.07.21260129}, +# year = {2021}, +# doi = {10.1101/2021.07.07.21260129}, +# publisher = {Cold Spring Harbor Laboratory Press}, +# URL = {https://www.medrxiv.org/content/early/2021/07/12/2021.07.07.21260129}, +# eprint = {https://www.medrxiv.org/content/early/2021/07/12/2021.07.07.21260129.full.pdf}, +# journal = {medRxiv} +# } + +## ----eval=FALSE--------------------------------------------------------------- +# @software{hamilton_matthew_2022_6212704, +# author = {Hamilton, Matthew and +# Gao, Caroline}, +# title = {{Complete study program to reproduce all steps from +# data ingest through to results dissemination for a +# study to map mental health measures to AQoL-6D +# health utility}}, +# month = feb, +# year = 2022, +# note = {{Matthew Hamilton and Caroline Gao (2022). +# Complete study program to reproduce all steps from +# data ingest through to results dissemination for a +# study to map mental health measures to AQoL-6D +# health utility. Zenodo. +# https://doi.org/10.5281/zenodo.6116077. Version +# 0.0.9.3}}, +# publisher = {Zenodo}, +# version = {0.0.9.3}, +# doi = {10.5281/zenodo.6212704}, +# url = {https://doi.org/10.5281/zenodo.6212704} +# } + +## ----message=FALSE, warning=FALSE--------------------------------------------- +library(ready4) +library(ready4show) +library(ready4use) +library(youthvars) +library(scorz) +library(TTU) + +## ----eval = FALSE------------------------------------------------------------- +# consent_1L_chr <- "" # Default value - asks for consent prior to writing each file. + +## ----echo = FALSE------------------------------------------------------------- +consent_1L_chr <- "Y" # Gives consent to write files without additional requests. + +## ----------------------------------------------------------------------------- +A <- Ready4useDyad(ds_tb = Ready4useRepos(dv_nm_1L_chr = "fakes", dv_ds_nm_1L_chr = "https://doi.org/10.7910/DVN/HJXYKQ", dv_server_1L_chr = "dataverse.harvard.edu") %>% + ingest(fls_to_ingest_chr = c("ymh_clinical_tb"), metadata_1L_lgl = F) %>% youthvars::transform_raw_ds_for_analysis(), + 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)) %>% + renew(type_1L_chr = "label") + +## ----------------------------------------------------------------------------- +A <- YouthvarsSeries(a_Ready4useDyad = A, id_var_nm_1L_chr = "fkClientID", timepoint_var_nm_1L_chr = "round", + timepoint_vals_chr = levels(procureSlot(A, "ds_tb")$round)) + +## ----------------------------------------------------------------------------- +A <- TTUProject(a_ScorzProfile = ScorzAqol6Adol(a_YouthvarsProfile = A)) +A <- renew(A, what_1L_chr = "utility") + +## ----------------------------------------------------------------------------- +A <- renew(A, what_1L_chr = "parameters") + +## ----------------------------------------------------------------------------- +A <- renew(A, "use_renew_mthd", fl_nm_1L_chr = "predictors_r3", type_1L_chr = "predictors_lup", + y_Ready4useRepos = 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"), + what_1L_chr = "parameters") + +## ----------------------------------------------------------------------------- +exhibit(A, scroll_box_args_ls = list(width = "100%")) + +## ----------------------------------------------------------------------------- +A <- renew(A, c(0.03,1), type_1L_chr = "range", what_1L_chr = "parameters") %>% + renew(c("BADS","GAD7", "K6", "OASIS", "PHQ9", "SCARED"), + type_1L_chr = "predictors_vars", what_1L_chr = "parameters") %>% + renew(c("d_sex_birth_s", "d_age", "d_sexual_ori_s", "d_studying_working", "c_p_diag_s", "c_clinical_staging_s", "SOFAS"), + type_1L_chr = "covariates", what_1L_chr = "parameters") %>% + renew(c("d_age","Gender","d_relation_s", "d_sexual_ori_s" ,"Region", "d_studying_working", "c_p_diag_s", "c_clinical_staging_s","SOFAS"), + type_1L_chr = "descriptives", what_1L_chr = "parameters") %>% + renew("d_interview_date", type_1L_chr = "temporal", what_1L_chr = "parameters") + +## ----------------------------------------------------------------------------- +A <- renew(A, T, type_1L_chr = "is_fake", what_1L_chr = "parameters") + +## ----------------------------------------------------------------------------- +A <- renew(A, consent_1L_chr = consent_1L_chr, paths_chr = tempdir(), what_1L_chr = "project") + +## ----message=FALSE, results='hide', warning=FALSE----------------------------- +A <- author(A, consent_1L_chr = consent_1L_chr, digits_1L_int = 3L, what_1L_chr = "descriptives") + diff --git a/vignettes/V_01.Rmd b/vignettes/V_01.Rmd index 652f59c4..8d254923 100644 --- a/vignettes/V_01.Rmd +++ b/vignettes/V_01.Rmd @@ -101,28 +101,18 @@ consent_1L_chr <- "Y" # Gives consent to write files without additional requests We use the Ready4useDyad and Ready4useRepos modules to [retrieve and ingest](https://ready4-dev.github.io/ready4use/articles/V_01.html) and to then [pair a dataset and its data dictionary](_https://ready4-dev.github.io/ready4use/articles/V_02.html). ```{r} -A <- Ready4useDyad(ds_tb = Ready4useRepos(dv_nm_1L_chr = "fakes", - dv_ds_nm_1L_chr = "https://doi.org/10.7910/DVN/HJXYKQ", - dv_server_1L_chr = "dataverse.harvard.edu") %>% - ingest(fls_to_ingest_chr = c("ymh_clinical_tb"), - metadata_1L_lgl = F) %>% - youthvars::transform_raw_ds_for_analysis(), - 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)) %>% +A <- Ready4useDyad(ds_tb = Ready4useRepos(dv_nm_1L_chr = "fakes", dv_ds_nm_1L_chr = "https://doi.org/10.7910/DVN/HJXYKQ", dv_server_1L_chr = "dataverse.harvard.edu") %>% + ingest(fls_to_ingest_chr = c("ymh_clinical_tb"), metadata_1L_lgl = F) %>% youthvars::transform_raw_ds_for_analysis(), + 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)) %>% renew(type_1L_chr = "label") ``` We use the YouthvarsSeries module to [supply metadata about out a longitudinal dataset vignette](https://ready4-dev.github.io/youthvars/articles/V_02.html). ```{r} -A <- YouthvarsSeries(a_Ready4useDyad = A, - id_var_nm_1L_chr = "fkClientID", - timepoint_var_nm_1L_chr = "round", - timepoint_vals_chr = levels(procureSlot(A, - "ds_tb")$round)) +A <- YouthvarsSeries(a_Ready4useDyad = A, id_var_nm_1L_chr = "fkClientID", timepoint_var_nm_1L_chr = "round", + timepoint_vals_chr = levels(procureSlot(A, "ds_tb")$round)) ``` ### Score health utility @@ -148,7 +138,7 @@ A <- renew(A, what_1L_chr = "parameters") We next ingest a lookup table of metadata about the variables we plan to explore as candidate predictors. In this case, we are sourcing the lookup table from an online data repository. ```{r} -A <- renew(A, fl_nm_1L_chr = "predictors_r3", type_1L_chr = "predictors_lup", +A <- renew(A, "use_renew_mthd", fl_nm_1L_chr = "predictors_r3", type_1L_chr = "predictors_lup", y_Ready4useRepos = 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"), what_1L_chr = "parameters") @@ -238,20 +228,20 @@ A <- investigate(A, consent_1L_chr = consent_1L_chr, prefd_covars_chr = "PHQ9")) ``` -### Report and disseminate findings +### Report findings #### Create shareable models The model objects created and saved in our working directory by the preceding steps are not suitable for public dissemination. They are both too large in file size and, more importantly, include copies of our source dataset. We can overcome these limitations by creating shareable versions of the models. Two types of shareable version are created - copies of the original model objects in which fake data overwrites the original source data and summary tables of model coefficients. ```{r eval =F} -author(A, consent_1L_chr = consent_1L_chr, what_1L_chr = "models") +A <- author(A, consent_1L_chr = consent_1L_chr, what_1L_chr = "models") ``` #### Specify study reporting metadata We update `A` so that we can begin use it to render and share reports. ```{r eval =F} -A <- renew_TTUProject(A, what_1L_chr == "reporting") +A <- renew(A, what_1L_chr = "reporting") ``` We add metadata relevant to the reports that we will be generating to these fields. Note that the data we supply to the Ready4useRepos object below must relate to a repository to which we have write permissions (otherwise subsequent steps will fail). @@ -262,145 +252,85 @@ A <- renew(A, ready4show::authors_tb, type_1L_chr = "authors", what_1L_chr = "re renew(c(3L,3L), type_1L_chr = "digits", what_1L_chr = "reporting") %>% renew(c("PDF","PDF"), type_1L_chr = "formats", what_1L_chr = "reporting") %>% renew("A hypothetical utility mapping study using fake data", type_1L_chr = "title", what_1L_chr = "reporting") %>% - renew(renew(ready4show_correspondences(),old_nms_chr = c("PHQ9", "GAD7"), new_nms_chr = c("PHQ-9", "GAD-7")), type_1L_chr = "changes", what_1L_chr = "reporting") %>% + renew(renew(ready4show_correspondences(), old_nms_chr = c("PHQ9", "GAD7"), new_nms_chr = c("PHQ-9", "GAD-7")), type_1L_chr = "changes", what_1L_chr = "reporting") %>% renew(Ready4useRepos(dv_nm_1L_chr = "fakes", dv_ds_nm_1L_chr = "https://doi.org/10.7910/DVN/D74QMP", dv_server_1L_chr = "dataverse.harvard.edu"), type_1L_chr = "repos", what_1L_chr = "reporting") ``` -```{r echo = F, eval =F} -## Describe and share models -# We now create a `TTUReports` object, that we can use to efficiently retrieve and apply programs that can summarise our study results. -# C <- TTUReports(a_TTUSynopsis = B) -``` - #### Author model catalogues We download a program for generating a catalogue of models and use it to summarising the models created under each study analysis (one primary and two secondary). The catalogues are saved locally. ```{r eval =F} -authorSlot(A, "d_TTUReports", consent_1L_chr = consent_1L_chr, download_tmpl_1L_lgl = T, what_1L_chr = "Catalogue") -``` - -#### Share model catalogue -We share the catalogues that we created, uploading a copy to our study online repository. To run this step you will need write permissions to the online repository. - -```{r eval =F} -shareSlot(A, "d_TTUReports@a_TTUSynopsis", type_1L_chr = "Report", what_1L_chr = "Catalogue") -``` - -#### Share models -We share tables of coefficients and other meta-data about the models we have created by posting them to the online repository. The object we create and share is designed to be used in conjunction with the `youthu` package to make it easier to make predictions with these models using new data. Again, you will need write permissions to the online repository. - -```{r eval =F} -shareSlot(A, "d_TTUReports@a_TTUSynopsis", type_1L_chr = "Models", what_1L_chr = "ingredients") +A <- author(A, consent_1L_chr = consent_1L_chr, download_tmpl_1L_lgl = T, what_1L_chr = "catalogue") ``` #### Author manuscript We add some content about the manuscript we wish to author. ```{r eval =F} -A <- renewSlot(A, "d_TTUReports@a_TTUSynopsis", - procureSlot(A, "d_TTUReports@a_TTUSynopsis") %>% - renewSlot("background_1L_chr", "Quality Adjusted Life Years (QALYs) are often used in economic evaluations, yet utility weights for deriving them are rarely directly measured in mental health services.") %>% - renewSlot("coi_1L_chr", "None declared") %>% - renewSlot("conclusion_1L_chr","Nothing should be concluded from this study as it is purely hypothetical.") %>% - renewSlot("ethics_1L_chr", "The study was reviewed and granted approval by no-one." ) %>% - renewSlot("funding_1L_chr", "The study was funded by no-one.") %>% - renewSlot("interval_chr", "three months") %>% - renewSlot("keywords_chr", c("anxiety", "AQoL","depression", "psychological distress", "QALYs", "utility mapping")) %>% - renewSlot("sample_desc_1L_chr", "The study sample is fake data.") ) +A <- renew(A, "Quality Adjusted Life Years (QALYs) are often used in economic evaluations, yet utility weights for deriving them are rarely directly measured in mental health services.", + type_1L_chr = "background", what_1L_chr = "reporting") %>% + renew("None declared", type_1L_chr = "conflicts", what_1L_chr = "reporting") %>% + renew("Nothing should be concluded from this study as it is purely hypothetical.", type_1L_chr = "conclusion", what_1L_chr = "reporting") %>% + renew("The study was reviewed and granted approval by no-one." , type_1L_chr = "ethics", what_1L_chr = "reporting") %>% + renew("The study was funded by no-one.", type_1L_chr = "funding", what_1L_chr = "reporting") %>% + renew("three months", type_1L_chr = "interval", what_1L_chr = "reporting") %>% + renew(c("anxiety", "AQoL","depression", "psychological distress", "QALYs", "utility mapping"), type_1L_chr = "keywords", what_1L_chr = "reporting") %>% + renew("The study sample is fake data.", type_1L_chr = "sample", what_1L_chr = "reporting") ``` -We create a summary of results that can be interpreted by the program that authors the manuscript. +We create a brief summary of results that can be interpreted by the program that authors the manuscript. ```{r eval =F} -A <- renewSlot(A, "d_TTUReports@a_TTUSynopsis@abstract_args_ls", - manufactureSlot(A,"d_TTUReports@a_TTUSynopsis", what_1L_chr = "abstract_args_ls", - depnt_var_nms_chr = c("AQoL-6D", "Adolescent AQoL Six Dimension"))) +A <- renew(A, c("AQoL-6D", "Adolescent AQoL Six Dimension"), type_1L_chr = "naming", what_1L_chr = "reporting") ``` ```{r eval =F} -A <- enhanceSlot(A, "d_TTUReports@a_TTUSynopsis", with_1L_chr = "results_ls", - depnt_var_nms_chr = c("AQoL-6D", "Adolescent AQoL Six Dimension")) +A <- renew(A, "use_renew_mthd", type_1L_chr = "abstract", what_1L_chr = "reporting") ``` We create and save the plots that will be used in the manuscript. ```{r eval =F} -authorSlot(A, "d_TTUReports", consent_1L_chr = consent_1L_chr, - depnt_var_desc_1L_chr = A@d_TTUReports@a_TTUSynopsis@b_SpecificResults@a_SpecificShareable@shareable_outp_ls$results_ls$study_descs_ls$health_utl_nm_1L_chr, - type_1L_chr = "Plots") +A <- author(A, consent_1L_chr = consent_1L_chr, what_1L_chr = "plots") ``` We download a program for generating a template manuscript and run it to author a first draft of the manuscript. ```{r eval =F} -authorSlot(A, "d_TTUReports", consent_1L_chr = consent_1L_chr, type_1L_chr = "Report", what_1L_chr = "Manuscript_Auto", download_tmpl_1L_lgl = T) +A <- author(A, consent_1L_chr = consent_1L_chr, download_tmpl_1L_lgl = T, what_1L_chr = "manuscript") ``` -We can copy the RMarkdown files that created the template manuscript to a new director (which we call "Manuscript_Submission") so that we can then manually edit those files to produce a manuscript that we can submit for publication. Note that in this example we have not made any edits to the template manuscript. +We can copy the RMarkdown files that created the template manuscript to a new directory (called "Manuscript_Submission") so that we can then manually edit those files to produce a manuscript that we can submit for publication. ```{r eval =F} -R.utils::copyDirectory(paste0(A@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@outp_data_dir_1L_chr, - "/", - A@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@mkdn_data_dir_1L_chr, - "/Manuscript_Auto"), - paste0(A@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@outp_data_dir_1L_chr, - "/", - A@d_TTUReports@a_TTUSynopsis@a_Ready4showPaths@mkdn_data_dir_1L_chr, - "/Manuscript_Submission")) +A <- author(A, consent_1L_chr = consent_1L_chr, type_1L_chr = "copy", what_1L_chr = "manuscript") ``` +At this point in the workflow, additional steps are required to adapt / author the manuscript that will be submitted for publication. However, in this example we are going to skip that step and keep working with the unedited template manuscript. If we had a finalised manuscript authoring program stored online, we could now specify the repository from which the program can be retrieved. + +```{reval=FALSE} +# Not run +# A <- renew(A, c("URL of GitHub repository with", "Program version number"), type_1L_chr = "template-manuscript", what_1L_chr = "reporting") +``` ```{r echo=FALSE, eval=FALSE} -# We create the files we will be using for figures submitted to our target journal and also a table of all the dependency packages used in our analysis and reporting. -# authorSlot(A, "d_TTUReports", type_1L_chr = "Plots", what_1L_chr = "Manuscript_Submission", -# depnt_var_desc_1L_chr = "AQoL-6D" # Inherit from TTUAqolAdol -# #,timepoint_new_nms_chr = c("Baseline","Follow-up") -# ) # Not required for vignette -# author(A@d_TTUReports, type_1L_chr = "Dependencies", what_1L_chr = "Manuscript_Submission") #ERROR - Not required for vignette +# Not required for vignette article +# A <- author(A, consent_1L_chr = consent_1L_chr, type_1L_chr = "plots", what_1L_chr = "manuscript") +# A <- author(A, consent_1L_chr = consent_1L_chr, type_1L_chr = "dependencies", what_1L_chr = "manuscript") ``` -Once any edits to the RMarkdown files for creating the submission manuscript have been finalised, we can run the following command to author the manuscript. The below commands will generate a Microsoft Word format manuscript and a PDF technical appendix. Unlike the template manuscript, the figures and tables are positioned after (and not within) the main body of the manuscript. Note that the Word version of the manuscript generated by these commands will require some minor formatting edits (principally to the display of tables and numbering of sections). +We can now configure the output to be generated by the manuscript authoring program. The below commands will specify a Microsoft Word format manuscript and a PDF technical appendix. Unlike the template manuscript, the figures and tables will be positioned after (and not within) the main body of the manuscript. Note that the Word version of the manuscript generated by these values will require some minor formatting edits (principally to the display of tables and numbering of sections). ```{r eval =F} -A <- renewSlot(A, "d_TTUReports", - procureSlot(A, "d_TTUReports") %>% - renewSlot("a_TTUSynopsis@tables_in_body_lgl", F) %>% - renewSlot("a_TTUSynopsis@figures_in_body_lgl", F) %>% - renewSlot("a_TTUSynopsis@outp_formats_chr", c("Word","PDF"))) -authorSlot(A, "d_TTUReports", consent_1L_chr = consent_1L_chr, what_1L_chr = "Manuscript_Submission", download_tmpl_1L_lgl = F) +A <- renew(A, F, type_1L_chr = "figures-body", what_1L_chr = "reporting") %>% + renew(F, type_1L_chr = "tables-body", what_1L_chr = "reporting") %>% + renew(c("Word","PDF"), type_1L_chr = "formats", what_1L_chr = "reporting") ``` -```{r echo=FALSE, eval=FALSE} -# UPLOAD MS -purrr::walk2(c("Manuscript_Auto","Manuscript_Submission"), - 2:1, - ~ { - x <- A@d_TTUReports@a_TTUSynopsis - what_1L_chr <- .x - idx_1L_int <- .y - if(what_1L_chr %in% c("Manuscript_Auto","Manuscript_Submission")){ # ADD THIS TO share_SpecificSynopsis - ms_nm_1L_chr <- "Manuscript" - idx_1L_int <- ready4::write_fls_to_dv(paste0(x@a_Ready4showPaths@outp_data_dir_1L_chr, - "/", - x@a_Ready4showPaths@reports_dir_1L_chr, - "/", - what_1L_chr, - "/", - ms_nm_1L_chr, - ifelse(x@outp_formats_chr[idx_1L_int] == "Word", - ".docx", - paste0(".",tolower(x@outp_formats_chr[idx_1L_int])))), - consent_1L_chr = consent_1L_chr, - descriptions_chr = paste0("Scientific summary of utility mapping study", - ifelse(what_1L_chr == "Manuscript_Auto", " (algorithm generated)","")), - ds_url_1L_chr = x@e_Ready4useRepos@dv_ds_nm_1L_chr) - - - } - Sys.sleep(5L) - } - ) +Once any edits to the RMarkdown files for creating the submission manuscript have been finalised, we can run the following command to author the manuscript. If we are using a custom manuscript authoring program downloaded from an online repository the `download_tmpl_1L_lgl` argument will need to be set to `T`. +```{r eval =F} +A <- author(A, consent_1L_chr = consent_1L_chr, download_tmpl_1L_lgl = F, type_1L_chr="submission", what_1L_chr = "manuscript") ``` ```{r echo=F, eval=F} # NEVER RUN THIS STEP FOR REAL DATA - THIS IS ONLY APPROPRIATE FOR A VIGNETTE EXAMPLE USING FAKE DATA @@ -419,38 +349,24 @@ outp_dirs_chr[2:7] %>% }) ``` + We can now generate the Supplementary Information for the submission manuscript. -```{r echo=FALSE, eval=FALSE} -authorReport(procureSlot(A, "d_TTUReports") %>% - renewSlot("a_TTUSynopsis@rmd_fl_nms_ls", ready4show::make_rmd_fl_nms_ls(pdf_fl_nm_1L_chr = "TA_PDF")) %>% - renewSlot("a_TTUSynopsis@outp_formats_chr", c("PDF","PDF")) %>% - procureSlot("a_TTUSynopsis"), - consent_1L_chr = consent_1L_chr, fl_nm_1L_chr = "Supplement", what_1L_chr = "Manuscript_Submission") +```{r eval=FALSE} +A <- author(A, consent_1L_chr = consent_1L_chr, supplement_fl_nm_1L_chr = "TA_PDF", type_1L_chr="submission", what_1L_chr = "supplement") +``` + +### Share outputs +We can now share non-confidential elements (ie no copies of individual records) of the outputs that we have created via our study online repository. To run this step you will need write permissions to the online repository. In the below step we are sharing model catalogues, the shareable models (designed to be used in conjunction with the [youthu](https://ready4-dev.github.io/youthu/index.html) package), our manuscript files and our supplementary information. In most real world studies the manuscript would not be shared via an online repository - the `what_chr` argument would need to be ammended to reflect this. + +```{r eval=FALSE} +A <- share(A, types_chr = c("auto", "submission"), what_chr = c("catalogue", "manuscript", "models", "supplement")) ``` ### Tidy workspace The preceding steps saved multiple objects (mostly R model objects) that have embedded within them copies of the source dataset. We can now purge all such copies from our output data directory. ```{r eval = F} -authorSlot(A,"c_SpecificProject", type_1L_chr = "purge_write") -#author(procureSlot(A,"c_SpecificProject"), type_1L_chr = "purge_write") +A <- author(A, what_1L_chr = "purge") ``` -```{r echo=FALSE, eval=FALSE} -# transform_dyad_for_analysis <- function(data_Ready4useDyad){ -# data_Ready4useDyad@ds_tb <- data_Ready4useDyad@ds_tb %>% -# youthvars::transform_raw_ds_for_analysis() -# data_Ready4useDyad@dictionary_r3 <- data_Ready4useDyad@dictionary_r3 %>% -# 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 == "sofas_total" ~ "SOFAS", -# T ~ var_nm_chr %>% purrr::map_chr(~.x) -# )) -# return(data_Ready4useDyad) -# } -```