Skip to content

Commit

Permalink
buggy version
Browse files Browse the repository at this point in the history
  • Loading branch information
matthewphamilton committed Jun 23, 2023
1 parent 05def9e commit 5929cf5
Show file tree
Hide file tree
Showing 25 changed files with 1,068 additions and 215 deletions.
4 changes: 4 additions & 0 deletions .Rbuildignore
Original file line number Diff line number Diff line change
Expand Up @@ -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$
10 changes: 7 additions & 3 deletions DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -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'
Expand All @@ -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
16 changes: 16 additions & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
2 changes: 1 addition & 1 deletion R/C4_TTUReports.R
Original file line number Diff line number Diff line change
Expand Up @@ -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")))


Expand Down
125 changes: 120 additions & 5 deletions R/mthd_author.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
}
Expand Down Expand Up @@ -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) {
Expand All @@ -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)
})
19 changes: 19 additions & 0 deletions R/mthd_exhibit.R
Original file line number Diff line number Diff line change
@@ -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",
... = ...)
}
})
69 changes: 69 additions & 0 deletions R/mthd_investigate.R
Original file line number Diff line number Diff line change
@@ -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)
})
Loading

0 comments on commit 5929cf5

Please sign in to comment.