|
3 | 3 | #' @name author-TTUReports |
4 | 4 | #' @description author method applied to TTUReports |
5 | 5 | #' @param x An object of class TTUReports |
| 6 | +#' @param depnt_var_desc_1L_chr Dependent variable description (a character vector of length one), Default: 'NA' |
6 | 7 | #' @param download_tmpl_1L_lgl Download template (a logical vector of length one), Default: T |
7 | | -#' @param what_1L_chr What (a character vector of length one), Default: 'Catalogue' |
| 8 | +#' @param fl_type_1L_chr File type (a character vector of length one), Default: '.eps' |
| 9 | +#' @param timepoint_new_nms_chr Timepoint new names (a character vector), Default: 'NA' |
| 10 | +#' @param type_1L_chr Type (a character vector of length one), Default: 'Report' |
| 11 | +#' @param what_1L_chr What (a character vector of length one), Default: 'NA' |
8 | 12 | #' @return NULL |
9 | 13 | #' @rdname author-methods |
10 | 14 | #' @aliases author,TTUReports-method |
11 | 15 | #' @export |
| 16 | +#' @importFrom purrr map flatten_chr discard reduce map_chr pluck |
| 17 | +#' @importFrom utils packageDescription |
| 18 | +#' @importFrom stringr str_replace_all str_locate str_sub |
| 19 | +#' @importFrom dplyr mutate |
| 20 | +#' @importFrom ggplot2 ggsave |
12 | 21 | #' @importFrom ready4 author |
13 | | -methods::setMethod("author", "TTUReports", function (x, download_tmpl_1L_lgl = T, what_1L_chr = "Catalogue") |
| 22 | +methods::setMethod("author", "TTUReports", function (x, depnt_var_desc_1L_chr = NA_character_, download_tmpl_1L_lgl = T, |
| 23 | + fl_type_1L_chr = ".eps", timepoint_new_nms_chr = NA_character_, |
| 24 | + type_1L_chr = "Report", what_1L_chr = NA_character_) |
14 | 25 | { |
15 | | - if (download_tmpl_1L_lgl) { |
16 | | - authorData(x@a_SpecificSynopsis, tmpl_url_1L_chr = ifelse(what_1L_chr == |
17 | | - "Catalogue", x@catalogue_tmpl_chr[1], x@manuscript_tmpl_chr[1]), |
18 | | - tmpl_version_1_L_chr = ifelse(what_1L_chr == "Catalogue", |
19 | | - x@catalogue_tmpl_chr[2], x@manuscript_tmpl_chr[2]), |
20 | | - what_1L_chr = what_1L_chr) |
21 | | - } |
22 | | - if (what_1L_chr == "Catalogue") { |
23 | | - x@a_SpecificSynopsis@rmd_fl_nms_ls <- x@catalogue_fl_nms_ls |
24 | | - } |
25 | | - else { |
26 | | - x@a_SpecificSynopsis@rmd_fl_nms_ls <- x@manuscript_fl_nms_ls |
27 | | - } |
28 | | - if (what_1L_chr == "Catalogue") { |
29 | | - author(x@a_SpecificSynopsis, type_1L_chr = "Report", |
30 | | - what_1L_chr = what_1L_chr) |
| 26 | + if (type_1L_chr == "Report") { |
| 27 | + if (download_tmpl_1L_lgl) { |
| 28 | + authorData(x@a_TTUSynopsis, tmpl_url_1L_chr = ifelse(what_1L_chr == |
| 29 | + "Catalogue", x@catalogue_tmpl_chr[1], x@manuscript_tmpl_chr[1]), |
| 30 | + tmpl_version_1_L_chr = ifelse(what_1L_chr == |
| 31 | + "Catalogue", x@catalogue_tmpl_chr[2], x@manuscript_tmpl_chr[2]), |
| 32 | + what_1L_chr = what_1L_chr) |
| 33 | + } |
| 34 | + if (what_1L_chr == "Catalogue") { |
| 35 | + x@a_TTUSynopsis@rmd_fl_nms_ls <- x@catalogue_fl_nms_ls |
| 36 | + } |
| 37 | + else { |
| 38 | + x@a_TTUSynopsis@rmd_fl_nms_ls <- x@manuscript_fl_nms_ls |
| 39 | + } |
| 40 | + if (what_1L_chr == "Catalogue") { |
| 41 | + author(x@a_TTUSynopsis, type_1L_chr = "Report", what_1L_chr = what_1L_chr) |
| 42 | + } |
| 43 | + else { |
| 44 | + authorReport(x@a_TTUSynopsis, what_1L_chr = what_1L_chr) |
| 45 | + } |
31 | 46 | } |
32 | 47 | else { |
33 | | - authorReport(x@a_SpecificSynopsis, what_1L_chr = what_1L_chr) |
| 48 | + dir_1L_chr <- paste0(x@a_TTUSynopsis@a_Ready4showPaths@outp_data_dir_1L_chr, |
| 49 | + "/", x@a_TTUSynopsis@a_Ready4showPaths@mkdn_data_dir_1L_chr, |
| 50 | + "/", what_1L_chr) |
| 51 | + if (type_1L_chr == "Dependencies") { |
| 52 | + df <- data.frame(Package = c("youthvars", "scorz", |
| 53 | + "specific", "TTU", ) %>% purrr::map(~{ |
| 54 | + utils::packageDescription(.x) %>% c("Depends", |
| 55 | + "Imports")[] %>% purrr::map(~{ |
| 56 | + if (is.null(.x)) { |
| 57 | + character(0) |
| 58 | + } |
| 59 | + else { |
| 60 | + .x %>% strsplit(",\\n") %>% purrr::flatten_chr() %>% |
| 61 | + purrr::map(~strsplit(.x, ", ") %>% purrr::flatten_chr()) %>% |
| 62 | + purrr::flatten_chr() %>% sort() %>% purrr::discard(~startsWith(.x, |
| 63 | + "R ")) |
| 64 | + } |
| 65 | + }) %>% purrr::flatten_chr() %>% unique() %>% |
| 66 | + sort() |
| 67 | + }) %>% purrr::reduce(~c(.x, .y)) %>% purrr::map_chr(~{ |
| 68 | + updated_1L_chr <- stringr::str_replace_all(.x, |
| 69 | + "\\n", " ") |
| 70 | + problem_idx_1L_chr <- stringr::str_locate(updated_1L_chr, |
| 71 | + " ")[1, 1] %>% unname() |
| 72 | + if (!is.na(problem_idx_1L_chr)) |
| 73 | + updated_1L_chr <- updated_1L_chr %>% stringr::str_sub(end = problem_idx_1L_chr - |
| 74 | + 1) |
| 75 | + updated_1L_chr %>% trimws(which = "left") |
| 76 | + }) %>% unique() %>% sort()) |
| 77 | + df <- df %>% dplyr::mutate(Version = Package %>% |
| 78 | + purrr::map_chr(~utils::packageDescription(.x) %>% |
| 79 | + purrr::pluck("Version")), Citation = Package %>% |
| 80 | + purrr::map_chr(~get_pkg_citation(.x))) |
| 81 | + saveRDS(df, paste0(dir_1L_chr, "/packages.RDS")) |
| 82 | + } |
| 83 | + if (type_1L_chr == "Plots") { |
| 84 | + composite_1_plt <- depictSlot(x, "a_TTUSynopsis", |
| 85 | + depnt_var_desc_1L_chr = depnt_var_desc_1L_chr, |
| 86 | + timepoint_old_nms_chr = procureSlot(x, "a_TTUSynopsis@d_YouthvarsProfile@timepoint_vals_chr"), |
| 87 | + timepoint_new_nms_chr = timepoint_new_nms_chr, |
| 88 | + what_1L_chr = "composite_mdl", write_1L_lgl = T) |
| 89 | + composite_2_plt <- depictSlot(x, slot_nm_1L_chr = "a_TTUSynopsis", |
| 90 | + what_1L_chr = "composite_utl", write_1L_lgl = T) |
| 91 | + if (!is.na(what_1L_chr)) { |
| 92 | + ggplot2::ggsave(file = paste0(dir_1L_chr, "/fig1", |
| 93 | + fl_type_1L_chr), composite_2_plt) |
| 94 | + ggplot2::ggsave(file = paste0(dir_1L_chr, "/fig2", |
| 95 | + fl_type_1L_chr), composite_1_plt) |
| 96 | + } |
| 97 | + } |
34 | 98 | } |
35 | 99 | }) |
0 commit comments