|
3 | 3 | #' @name share-SpecificProject |
4 | 4 | #' @description share method applied to SpecificProject |
5 | 5 | #' @param x An object of class SpecificProject |
6 | | -#' @param fl_nm_1L_chr File name (a character vector of length one) |
| 6 | +#' @param fl_nm_1L_chr File name (a character vector of length one), Default: 'mdl_ingredients' |
7 | 7 | #' @param repos_Ready4useRepos PARAM_DESCRIPTION |
8 | 8 | #' @return NULL |
9 | 9 | #' @rdname share-methods |
10 | 10 | #' @aliases share,SpecificProject-method |
11 | 11 | #' @export |
12 | 12 | #' @importFrom ready4 share |
13 | | -methods::setMethod("share", "SpecificProject", function (x, fl_nm_1L_chr, repos_Ready4useRepos) |
| 13 | +methods::setMethod("share", "SpecificProject", function (x, fl_nm_1L_chr = "mdl_ingredients", repos_Ready4useRepos) |
14 | 14 | { |
15 | 15 | x@c_SpecificResults@b_SpecificPrivate <- SpecificPrivate() |
16 | 16 | x@paths_chr <- NA_character_ |
17 | 17 | y <- share(repos_Ready4useRepos, obj_to_share_xx = x, fl_nm_1L_chr = fl_nm_1L_chr) |
18 | 18 | }) |
| 19 | +#' |
| 20 | +#' Share (publish) open data |
| 21 | +#' @name share-SpecificSynopsis |
| 22 | +#' @description share method applied to SpecificSynopsis |
| 23 | +#' @param x An object of class SpecificSynopsis |
| 24 | +#' @param consolidate_1L_lgl Consolidate (a logical vector of length one), Default: T |
| 25 | +#' @param fl_nm_1L_chr File name (a character vector of length one), Default: 'mdl_ingredients' |
| 26 | +#' @param type_1L_chr Type (a character vector of length one), Default: 'Models' |
| 27 | +#' @param what_1L_chr What (a character vector of length one), Default: 'ingredients' |
| 28 | +#' @return NULL |
| 29 | +#' @rdname share-methods |
| 30 | +#' @aliases share,SpecificSynopsis-method |
| 31 | +#' @export |
| 32 | +#' @importFrom purrr reduce map_chr |
| 33 | +#' @importFrom dplyr bind_rows distinct mutate |
| 34 | +#' @importFrom ready4 write_to_dv_with_wait share |
| 35 | +#' @importFrom tibble tibble |
| 36 | +methods::setMethod("share", "SpecificSynopsis", function (x, consolidate_1L_lgl = T, fl_nm_1L_chr = "mdl_ingredients", |
| 37 | + type_1L_chr = "Models", what_1L_chr = "ingredients") |
| 38 | +{ |
| 39 | + path_to_outp_dir_1L_chr <- x@a_Ready4showPaths@outp_data_dir_1L_chr |
| 40 | + if (type_1L_chr == "Models" & what_1L_chr %in% c("ingredients")) { |
| 41 | + secondary_1L_int <- x@b_SpecificResults@a_SpecificShareable@shareable_outp_ls %>% |
| 42 | + names() %>% startsWith("secondary_") %>% sum() |
| 43 | + object_xx <- paste0(path_to_outp_dir_1L_chr, "/Output/G_Shareable/Ingredients/mdl_ingredients.RDS") %>% |
| 44 | + readRDS() |
| 45 | + if (secondary_1L_int > 0 & consolidate_1L_lgl) { |
| 46 | + object_xx <- 1:secondary_1L_int %>% purrr::reduce(.init = object_xx, |
| 47 | + ~if (.y > 0) { |
| 48 | + ingredients_ls <- paste0(path_to_outp_dir_1L_chr, |
| 49 | + "/secondary_", .y, "/G_Shareable/Ingredients/mdl_ingredients.RDS") %>% |
| 50 | + readRDS() |
| 51 | + .x <- append(.x, list(ingredients_ls) %>% setNames(paste0("secondary_", |
| 52 | + .y))) |
| 53 | + .x$dictionary_tb <- dplyr::bind_rows(.x$dictionary_tb, |
| 54 | + ingredients_ls$dictionary_tb) %>% dplyr::distinct() |
| 55 | + .x$mdls_lup <- dplyr::bind_rows(.x$mdls_lup, |
| 56 | + ingredients_ls$mdls_lup %>% dplyr::mutate(source_chr = paste0("Secondary Analysis ", |
| 57 | + LETTERS[.y]))) %>% dplyr::distinct() |
| 58 | + .x$mdls_smry_tb <- dplyr::bind_rows(.x$mdls_smry_tb, |
| 59 | + ingredients_ls$mdls_smry_tb) %>% dplyr::distinct() |
| 60 | + .x$predictors_lup <- dplyr::bind_rows(.x$predictors_lup, |
| 61 | + ingredients_ls$predictors_lup) %>% dplyr::distinct() |
| 62 | + .x |
| 63 | + } |
| 64 | + else { |
| 65 | + .x$Primary <- .x |
| 66 | + .x$mdls_lup <- .x$mdls_lup %>% dplyr::mutate(source_chr = "Primary Analysis") |
| 67 | + .x |
| 68 | + }) |
| 69 | + saveRDS(object_xx, paste0(path_to_outp_dir_1L_chr, |
| 70 | + "/Output/G_Shareable/Ingredients/mdl_ingredients.RDS")) |
| 71 | + } |
| 72 | + Y <- share(x@e_Ready4useRepos, obj_to_share_xx = object_xx, |
| 73 | + fl_nm_1L_chr = fl_nm_1L_chr) |
| 74 | + } |
| 75 | + if (type_1L_chr == "Report") { |
| 76 | + if (what_1L_chr == "Catalogue") { |
| 77 | + ctlg_path_1L_chr <- paste0(path_to_outp_dir_1L_chr, |
| 78 | + "/", x@a_Ready4showPaths@reports_dir_1L_chr, |
| 79 | + "/", what_1L_chr) |
| 80 | + outp_smry_ls_ls <- manufacture(x@b_SpecificResults, |
| 81 | + what_1L_chr = "indexed_shareable") |
| 82 | + refs_int <- 1:length(outp_smry_ls_ls) |
| 83 | + ctlg_nms_chr <- purrr::map_chr(refs_int, ~paste0("AAA_TTU_MDL_CTG", |
| 84 | + ifelse(.x == 1, "", paste0("-", (.x - 1))))) |
| 85 | + ready4::write_to_dv_with_wait(dss_tb = tibble::tibble(ds_obj_nm_chr = ctlg_nms_chr, |
| 86 | + title_chr = purrr::map_chr(1:length(ctlg_nms_chr), |
| 87 | + ~paste0("Catalogue of utility mapping models", |
| 88 | + ifelse(.x == 1, " (Primary Analysis)", paste0(" (Supplementary Analysis ", |
| 89 | + (.x - 1), ")"))))), dv_nm_1L_chr = x@e_Ready4useRepos@dv_nm_1L_chr, |
| 90 | + ds_url_1L_chr = x@e_Ready4useRepos@dv_ds_nm_1L_chr, |
| 91 | + parent_dv_dir_1L_chr = paste0(x@b_SpecificResults@a_SpecificShareable@shareable_outp_ls$path_to_write_to_1L_chr, |
| 92 | + "/H_Dataverse"), paths_to_dirs_chr = paste0(x@a_Ready4showPaths@outp_data_dir_1L_chr, |
| 93 | + "/", x@a_Ready4showPaths@reports_dir_1L_chr, |
| 94 | + "/", what_1L_chr), inc_fl_types_chr = ".pdf", |
| 95 | + paths_are_rltv_1L_lgl = F) |
| 96 | + } |
| 97 | + } |
| 98 | +}) |
0 commit comments