added TTUSynopsis class

CITATION.cff

@@ -1,12 +1,12 @@
 cff-version: 1.2.0
-message: "Caroline Gao and Matthew Hamilton (2022). TTU: Implement Transfer to Utility Mapping Algorithms. Version 0.0.0.9335. Zenodo. https://doi.org/10.5281/zenodo.5646593"
+message: "Caroline Gao and Matthew Hamilton (2022). TTU: Implement Transfer to Utility Mapping Algorithms. Version 0.0.0.9337. Zenodo. https://doi.org/10.5281/zenodo.5646593"
 authors:
  - family-names: "Gao"
  given-names: "Caroline"
  - family-names: "Hamilton"
  given-names: "Matthew"
 title: "TTU: Implement Transfer to Utility Mapping Algorithms"
-version: 0.0.0.9335
+version: 0.0.0.9337
 doi: 10.5281/zenodo.5646593
-date-released: 2022-02-18
+date-released: 2022-02-22
 url: "https://ready4-dev.github.io/TTU/"

NAMESPACE

@@ -2,13 +2,29 @@
 
 export("%>%")
 export(TTUReports)
+export(TTUSynopsis)
 export(deprecated)
+export(get_pkg_citation)
 export(make_report_fl_nms_ls)
 exportClasses(TTUReports)
+exportClasses(TTUSynopsis)
 exportMethods(author)
 import(methods)
 import(ready4)
+import(specific)
+importFrom(dplyr,mutate)
+importFrom(ggplot2,ggsave)
 importFrom(lifecycle,deprecated)
 importFrom(magrittr,"%>%")
+importFrom(purrr,discard)
+importFrom(purrr,flatten_chr)
+importFrom(purrr,map)
+importFrom(purrr,map_chr)
+importFrom(purrr,pluck)
+importFrom(purrr,reduce)
 importFrom(ready4,author)
 importFrom(ready4show,make_rmd_fl_nms_ls)
+importFrom(stringr,str_locate)
+importFrom(stringr,str_replace_all)
+importFrom(stringr,str_sub)
+importFrom(utils,packageDescription)

R/C4_TTUReports.R

@@ -1,8 +1,9 @@
 #' TTUReports
-#'
+#' 
 #' Metadata to produce utility mapping study reports.
-#'
-#' @slot a_SpecificSynopsis (an instance of the SpecificSynopsis class)
+#' 
+#' @include C4_TTUSynopsis.R
+#' @slot a_TTUSynopsis (an instance of the TTUSynopsis class)
 #' @slot catalogue_tmpl_chr Catalogue template (a character vector)
 #' @slot catalogue_fl_nms_ls Catalogue file names (a list)
 #' @slot manuscript_tmpl_chr Manuscript template (a character vector)
@@ -15,8 +16,8 @@
 #' @exportClass TTUReports
 TTUReports <- methods::setClass("TTUReports",
 contains = "Ready4Module",
-slots = c(a_SpecificSynopsis = "SpecificSynopsis",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_SpecificSynopsis = specific::SpecificSynopsis(),catalogue_tmpl_chr = c("https://github.com/ready4-dev/ttu_mdl_ctlg","0.0.9.5"),catalogue_fl_nms_ls = ready4show::make_rmd_fl_nms_ls("Lngl_Mdls_HTML",
+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.0.9.5"),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.6"),manuscript_fl_nms_ls = ready4show::make_rmd_fl_nms_ls(pdf_fl_nm_1L_chr = "Main_PDF",
  word_fl_nm_1L_chr = "Main_Word")))

R/C4_TTUSynopsis.R

@@ -0,0 +1,45 @@
+#' TTUSynopsis
+#' 
+#' Input, Output and Authorship Data For Generating Utility Mapping Study Reports.
+#' 
+#' @slot a_Ready4showPaths (an instance of the Ready4showPaths class)
+#' @slot b_SpecificResults (an instance of the SpecificResults class)
+#' @slot c_SpecificParameters (an instance of the SpecificParameters class)
+#' @slot d_YouthvarsProfile (an instance of the YouthvarsProfile class)
+#' @slot e_Ready4useRepos (an instance of the Ready4useRepos class)
+#' @slot abstract_args_ls Abstract arguments (a list)
+#' @slot authors_r3 Authors (a ready4 S3)
+#' @slot background_1L_chr Background (a character vector of length one)
+#' @slot coi_1L_chr Conflict of interest (a character vector of length one)
+#' @slot conclusion_1L_chr Conclusion (a character vector of length one)
+#' @slot correspondences_r3 Correspondences (a ready4 S3)
+#' @slot digits_int Digits (an integer vector)
+#' @slot ethics_1L_chr Ethics (a character vector of length one)
+#' @slot fl_nm_1L_chr File name (a character vector of length one)
+#' @slot figures_in_body_lgl Figures in body (a logical vector)
+#' @slot funding_1L_chr Funding (a character vector of length one)
+#' @slot institutes_r3 Institutes (a ready4 S3)
+#' @slot interval_chr Interval (a character vector)
+#' @slot keywords_chr Keywords (a character vector)
+#' @slot outp_formats_chr Output formats (a character vector)
+#' @slot rmd_fl_nms_ls R Markdown file names (a list)
+#' @slot sample_desc_1L_chr Sample description (a character vector of length one)
+#' @slot tables_in_body_lgl Tables in body (a logical vector)
+#' @slot title_1L_chr Title (a character vector of length one)
+#' @slot dissemination_1L_chr Dissemination (a character vector of length one)
+#' @import specific
+#' @name TTUSynopsis-class
+#' @rdname TTUSynopsis-class
+#' @export TTUSynopsis
+#' @exportClass TTUSynopsis
+TTUSynopsis <- methods::setClass("TTUSynopsis",
+contains = "SpecificSynopsis",
+slots = c(a_Ready4showPaths = "Ready4showPaths",b_SpecificResults = "SpecificResults",c_SpecificParameters = "SpecificParameters",d_YouthvarsProfile = "YouthvarsProfile",e_Ready4useRepos = "Ready4useRepos",abstract_args_ls = "list",authors_r3 = "ready4show_authors",background_1L_chr = "character",coi_1L_chr = "character",conclusion_1L_chr = "character",correspondences_r3 = "ready4show_correspondences",digits_int = "integer",ethics_1L_chr = "character",fl_nm_1L_chr = "character",figures_in_body_lgl = "logical",funding_1L_chr = "character",institutes_r3 = "ready4show_institutes",interval_chr = "character",keywords_chr = "character",outp_formats_chr = "character",rmd_fl_nms_ls = "list",sample_desc_1L_chr = "character",tables_in_body_lgl = "logical",title_1L_chr = "character",dissemination_1L_chr = "character"),
+prototype = list(a_Ready4showPaths = ready4show::Ready4showPaths(),b_SpecificResults = specific::SpecificResults(),c_SpecificParameters = specific::SpecificParameters(),d_YouthvarsProfile = youthvars::YouthvarsProfile(),e_Ready4useRepos = ready4use::Ready4useRepos()))
+
+
+methods::setValidity(methods::className("TTUSynopsis"),
+function(object){
+msg <- NULL
+if (is.null(msg)) TRUE else msg
+})

R/fn_get.R

@@ -0,0 +1,18 @@
+#' Get package citation
+#' @description get_pkg_citation() is a Get function that retrieves a pre-existing data object from memory, local file system or online repository. Specifically, this function implements an algorithm to get package citation. Function argument pkg_nm_1L_chr specifies the where to look for the required object. The function returns Citation (a character vector of length one).
+#' @param pkg_nm_1L_chr Package name (a character vector of length one)
+#' @return Citation (a character vector of length one)
+#' @rdname get_pkg_citation
+#' @export 
+#' @keywords internal
+get_pkg_citation <- function (pkg_nm_1L_chr) 
+{
+ citation_chr <- suppressWarnings(citation(pkg_nm_1L_chr)) %>% 
+ capture.output()
+ start_idx_1L_int <- 4
+ end_idx_1L_int <- which(citation_chr == "")[which(which(citation_chr == 
+ "") > start_idx_1L_int)[1]] - 1
+ citation_1L_chr <- citation_chr[start_idx_1L_int:end_idx_1L_int] %>% 
+ paste0(collapse = "")
+ return(citation_1L_chr)
+}

R/mthd_author.R

@@ -3,33 +3,97 @@
 #' @name author-TTUReports
 #' @description author method applied to TTUReports
 #' @param x An object of class TTUReports
+#' @param depnt_var_desc_1L_chr Dependent variable description (a character vector of length one), Default: 'NA'
 #' @param download_tmpl_1L_lgl Download template (a logical vector of length one), Default: T
-#' @param what_1L_chr What (a character vector of length one), Default: 'Catalogue'
+#' @param fl_type_1L_chr File type (a character vector of length one), Default: '.eps'
+#' @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: 'Report'
+#' @param what_1L_chr What (a character vector of length one), Default: 'NA'
 #' @return NULL
 #' @rdname author-methods
 #' @aliases author,TTUReports-method
 #' @export 
+#' @importFrom purrr map flatten_chr discard reduce map_chr pluck
+#' @importFrom utils packageDescription
+#' @importFrom stringr str_replace_all str_locate str_sub
+#' @importFrom dplyr mutate
+#' @importFrom ggplot2 ggsave
 #' @importFrom ready4 author
-methods::setMethod("author", "TTUReports", function (x, download_tmpl_1L_lgl = T, what_1L_chr = "Catalogue") 
+methods::setMethod("author", "TTUReports", function (x, depnt_var_desc_1L_chr = NA_character_, download_tmpl_1L_lgl = T, 
+ fl_type_1L_chr = ".eps", timepoint_new_nms_chr = NA_character_, 
+ type_1L_chr = "Report", what_1L_chr = NA_character_) 
 {
- if (download_tmpl_1L_lgl) {
- authorData(x@a_SpecificSynopsis, tmpl_url_1L_chr = ifelse(what_1L_chr == 
- "Catalogue", x@catalogue_tmpl_chr[1], x@manuscript_tmpl_chr[1]), 
- tmpl_version_1_L_chr = ifelse(what_1L_chr == "Catalogue", 
- x@catalogue_tmpl_chr[2], x@manuscript_tmpl_chr[2]), 
- what_1L_chr = what_1L_chr)
- }
- if (what_1L_chr == "Catalogue") {
- x@a_SpecificSynopsis@rmd_fl_nms_ls <- x@catalogue_fl_nms_ls
- }
- else {
- x@a_SpecificSynopsis@rmd_fl_nms_ls <- x@manuscript_fl_nms_ls
- }
- if (what_1L_chr == "Catalogue") {
- author(x@a_SpecificSynopsis, type_1L_chr = "Report", 
- what_1L_chr = what_1L_chr)
+ if (type_1L_chr == "Report") {
+ if (download_tmpl_1L_lgl) {
+ authorData(x@a_TTUSynopsis, tmpl_url_1L_chr = ifelse(what_1L_chr == 
+ "Catalogue", x@catalogue_tmpl_chr[1], x@manuscript_tmpl_chr[1]), 
+ tmpl_version_1_L_chr = ifelse(what_1L_chr == 
+ "Catalogue", x@catalogue_tmpl_chr[2], x@manuscript_tmpl_chr[2]), 
+ what_1L_chr = what_1L_chr)
+ }
+ if (what_1L_chr == "Catalogue") {
+ x@a_TTUSynopsis@rmd_fl_nms_ls <- x@catalogue_fl_nms_ls
+ }
+ else {
+ x@a_TTUSynopsis@rmd_fl_nms_ls <- x@manuscript_fl_nms_ls
+ }
+ if (what_1L_chr == "Catalogue") {
+ author(x@a_TTUSynopsis, type_1L_chr = "Report", what_1L_chr = what_1L_chr)
+ }
+ else {
+ authorReport(x@a_TTUSynopsis, what_1L_chr = what_1L_chr)
+ }
  }
  else {
- authorReport(x@a_SpecificSynopsis, what_1L_chr = what_1L_chr)
+ dir_1L_chr <- paste0(x@a_TTUSynopsis@a_Ready4showPaths@outp_data_dir_1L_chr, 
+ "/", x@a_TTUSynopsis@a_Ready4showPaths@mkdn_data_dir_1L_chr, 
+ "/", what_1L_chr)
+ if (type_1L_chr == "Dependencies") {
+ df <- data.frame(Package = c("youthvars", "scorz", 
+ "specific", "TTU", ) %>% purrr::map(~{
+ utils::packageDescription(.x) %>% c("Depends", 
+ "Imports")[] %>% purrr::map(~{
+ if (is.null(.x)) {
+ character(0)
+ }
+ else {
+ .x %>% strsplit(",\\n") %>% purrr::flatten_chr() %>% 
+ purrr::map(~strsplit(.x, ", ") %>% purrr::flatten_chr()) %>% 
+ purrr::flatten_chr() %>% sort() %>% purrr::discard(~startsWith(.x, 
+ "R "))
+ }
+ }) %>% purrr::flatten_chr() %>% unique() %>% 
+ sort()
+ }) %>% purrr::reduce(~c(.x, .y)) %>% purrr::map_chr(~{
+ updated_1L_chr <- stringr::str_replace_all(.x, 
+ "\\n", " ")
+ problem_idx_1L_chr <- stringr::str_locate(updated_1L_chr, 
+ " ")[1, 1] %>% unname()
+ if (!is.na(problem_idx_1L_chr)) 
+ updated_1L_chr <- updated_1L_chr %>% stringr::str_sub(end = problem_idx_1L_chr - 
+ 1)
+ updated_1L_chr %>% trimws(which = "left")
+ }) %>% unique() %>% sort())
+ df <- df %>% dplyr::mutate(Version = Package %>% 
+ purrr::map_chr(~utils::packageDescription(.x) %>% 
+ purrr::pluck("Version")), Citation = Package %>% 
+ purrr::map_chr(~get_pkg_citation(.x)))
+ saveRDS(df, paste0(dir_1L_chr, "/packages.RDS"))
+ }
+ if (type_1L_chr == "Plots") {
+ composite_1_plt <- depictSlot(x, "a_TTUSynopsis", 
+ depnt_var_desc_1L_chr = depnt_var_desc_1L_chr, 
+ 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 <- depictSlot(x, slot_nm_1L_chr = "a_TTUSynopsis", 
+ what_1L_chr = "composite_utl", write_1L_lgl = T)
+ if (!is.na(what_1L_chr)) {
+ ggplot2::ggsave(file = paste0(dir_1L_chr, "/fig1", 
+ fl_type_1L_chr), composite_2_plt)
+ ggplot2::ggsave(file = paste0(dir_1L_chr, "/fig2", 
+ fl_type_1L_chr), composite_1_plt)
+ }
+ }
  }
 })

README.md

@@ -8,7 +8,7 @@
 [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.5646593.svg)](https://doi.org/10.5281/zenodo.5646593)
 <!-- badges: end -->
 
-Tools for developping, reporting and sharing Transfer To
+Tools for developing, reporting and sharing Transfer To
 Utility (TTU) mapping algorithms that predict health utility from
 other health measures. This development version of the TTU package
 has been made available as part of the process of testing and

_pkgdown.yml

@@ -22,6 +22,7 @@ reference:
  - rprt_lup
 - title: "S4 Classes"
 - contents:
+ - TTUSynopsis
  - TTUReports
 - title: "Methods"
 - contents:

data-raw/DATASET.R

@@ -38,13 +38,27 @@ x <- ready4fun::make_pkg_desc_ls(pkg_title_1L_chr = "Implement Transfer to Utili
  zenodo_badge_1L_chr = "[![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.5646593.svg)](https://doi.org/10.5281/zenodo.5646593)")
 y <- ready4class::ready4class_constructor() %>%
  dplyr::bind_rows(ready4class::make_pt_ready4class_constructor(make_s3_lgl = FALSE,
+ name_stub_chr = "Synopsis",
+ slots_ls = list("a_Ready4showPaths",
+ "b_SpecificResults",
+ "c_SpecificParameters",
+ "d_YouthvarsProfile",
+ "e_Ready4useRepos") %>% list(),
+ pt_ls = list("Ready4showPaths",
+ "SpecificResults",
+ "SpecificParameters",
+ "YouthvarsProfile",
+ "Ready4useRepos") %>% list(),
+ class_desc_chr = "Input, Output and Authorship Data For Generating Utility Mapping Study Reports.",
+ parent_class_chr = "SpecificSynopsis"),
+ ready4class::make_pt_ready4class_constructor(make_s3_lgl = FALSE,
  name_stub_chr = "Reports",
- slots_ls = list("a_SpecificSynopsis",
+ slots_ls = list("a_TTUSynopsis",
  "catalogue_tmpl_chr",
  "catalogue_fl_nms_ls",
  "manuscript_tmpl_chr",
  "manuscript_fl_nms_ls") %>% list(),
- pt_ls = list("SpecificSynopsis",
+ pt_ls = list("TTUSynopsis",
  "character",
  "list",
  "character",
@@ -57,8 +71,8 @@ y <- ready4class::ready4class_constructor() %>%
  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.",
- parent_class_chr = "Ready4Module"
- ))
+ parent_class_chr = "Ready4Module",
+  inc_clss_ls = list("TTUSynopsis") %>% list()))
 datasets_ls <- list(tibble::tibble(short_name_chr = c("OLS_NTF",
  "OLS_LOG",
  "OLS_LOGIT",
@@ -161,9 +175,9 @@ z <- ready4pack::make_pt_ready4pack_manifest(x,
 z <- ready4::author(z)
 ready4::write_citation_cff(packageDescription("TTU"),
  citation_chr = readLines("inst/CITATION"))
-usethis::use_dev_package("specific",
- type = "Imports",
- remote = "ready4-dev/specific")
+# usethis::use_dev_package("specific",
+#  type = "Imports",
+#  remote = "ready4-dev/specific")
 # usethis::use_package("readr")
 # MANUAL DELETION OF TRAILING INCLUDE
 # usethis::use_dev_package("ready4",

data-raw/fns/get.R

@@ -0,0 +1,7 @@
+get_pkg_citation <- function(pkg_nm_1L_chr){
+ citation_chr <- suppressWarnings(citation(pkg_nm_1L_chr)) %>% capture.output()
+ start_idx_1L_int <- 4
+ end_idx_1L_int <- which(citation_chr== "")[which(which(citation_chr== "")>start_idx_1L_int)[1]]-1
+ citation_1L_chr<- citation_chr[start_idx_1L_int:end_idx_1L_int] %>% paste0(collapse = "")
+ return(citation_1L_chr)
+}