Skip to content

Commit

Permalink
fix to renew
Browse files Browse the repository at this point in the history
  • Loading branch information
@matthewphamilton
matthewphamilton committed Nov 4, 2024
1 parent 9778f76 commit 96dd80d
Show file tree
Hide file tree
Showing 3 changed files with 70 additions and 65 deletions.
131 changes: 66 additions & 65 deletions R/mthd_renew.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,22 +11,22 @@
#' @param slice_indcs_int Slice indices (an integer vector), Default: NA
#' @return x (An object)
#' @rdname renew-methods
#' @export
#' @export
#' @importFrom lifecycle is_present deprecate_warn
#' @importFrom rlang current_env
#' @importFrom ready4 update_tb_r3 add_lups renew
renew.ready4use_dictionary <- function (x, var_nm_chr = NA_character_, var_ctg_chr = NA_character_,
var_desc_chr = NA_character_, var_type_chr = NA_character_,
filter_cdn_1L_chr = NA_character_, new_cases_r3 = NULL, new_ready4_dict_r3 = deprecated(),
slice_indcs_int = NA_integer_)
renew.ready4use_dictionary <- function (x, var_nm_chr = NA_character_, var_ctg_chr = NA_character_,
var_desc_chr = NA_character_, var_type_chr = NA_character_,
filter_cdn_1L_chr = NA_character_, new_cases_r3 = NULL, new_ready4_dict_r3 = deprecated(),
slice_indcs_int = NA_integer_)
{
if (lifecycle::is_present(new_ready4_dict_r3)) {
lifecycle::deprecate_warn("0.0.0.9211", "ready4use::renew.ready4use_dictionary(new_ready4_dict_r3)",
lifecycle::deprecate_warn("0.0.0.9211", "ready4use::renew.ready4use_dictionary(new_ready4_dict_r3)",
details = "Please use `ready4use::renew.ready4use_dictionary(new_cases_r3)` instead.")
}
fn_env_ls <- as.list(rlang::current_env())[-1]
x <- ready4::update_tb_r3(x, filter_cdn_1L_chr = filter_cdn_1L_chr,
fn = renew.ready4use_dictionary, fn_env_ls = fn_env_ls,
x <- ready4::update_tb_r3(x, filter_cdn_1L_chr = filter_cdn_1L_chr,
fn = renew.ready4use_dictionary, fn_env_ls = fn_env_ls,
slice_indcs_int = slice_indcs_int)
if (!is.null(new_cases_r3)) {
x <- ready4::add_lups(x, new_lup = new_cases_r3, key_var_nm_1L_chr = "var_nm_chr")
Expand All @@ -52,32 +52,32 @@ methods::setMethod("renew", methods::className("ready4use_dictionary", package =
#' @param urls_vec_chr Urls vector (a character vector), Default: 'NA'
#' @return x (An object)
#' @rdname renew-methods
#' @export
#' @export
#' @importFrom rlang current_env
#' @importFrom ready4 update_tb_r3 renew
#' @importFrom purrr reduce
renew.ready4use_imports <- function (x, local_file_src_chr = NA_character_, path_to_make_script_chr = NA_character_,
download_url_chr = NA_character_, inc_file_main_chr = NA_character_,
inc_fls_to_rename_ls = list(), new_nms_for_inc_fls_ls = list(),
filter_cdn_1L_chr = NA_character_, local_to_url_vec_chr = NA_character_,
slice_indcs_int = NA_integer_, urls_vec_chr = NA_character_)
renew.ready4use_imports <- function (x, local_file_src_chr = NA_character_, path_to_make_script_chr = NA_character_,
download_url_chr = NA_character_, inc_file_main_chr = NA_character_,
inc_fls_to_rename_ls = list(), new_nms_for_inc_fls_ls = list(),
filter_cdn_1L_chr = NA_character_, local_to_url_vec_chr = NA_character_,
slice_indcs_int = NA_integer_, urls_vec_chr = NA_character_)
{
fn_env_ls <- as.list(rlang::current_env())[-1]
x <- ready4::update_tb_r3(x, filter_cdn_1L_chr = filter_cdn_1L_chr,
fn = renew.ready4use_imports, fn_env_ls = fn_env_ls,
x <- ready4::update_tb_r3(x, filter_cdn_1L_chr = filter_cdn_1L_chr,
fn = renew.ready4use_imports, fn_env_ls = fn_env_ls,
slice_indcs_int = slice_indcs_int)
if (!is.na(local_to_url_vec_chr) & !is.na(urls_vec_chr))
x <- purrr::reduce(1:length(local_to_url_vec_chr), .init = x,
~update_tb_src_loc_to_url_sngl_tb(x = .x, y = .y,
local_to_url_vec_chr = local_to_url_vec_chr,
if (!is.na(local_to_url_vec_chr) & !is.na(urls_vec_chr))
x <- purrr::reduce(1:length(local_to_url_vec_chr), .init = x,
~update_tb_src_loc_to_url_sngl_tb(x = .x, y = .y,
local_to_url_vec_chr = local_to_url_vec_chr,
urls_vec_chr = urls_vec_chr))
return(x)
}
#' @rdname renew-methods
#' @aliases renew,ready4use_imports-method
#' @importFrom ready4 renew
methods::setMethod("renew", methods::className("ready4use_imports", package = "ready4use"), renew.ready4use_imports)
#'
#'
#' Renew (update) values
#' @name renew-Ready4useDyad
#' @description renew method applied to Ready4useDyad
Expand All @@ -88,6 +88,7 @@ methods::setMethod("renew", methods::className("ready4use_imports", package = "r
#' @param dictionary_lups_ls Dictionary lookup tables (a list), Default: list()
#' @param dictionary_r3 Dictionary (a ready4 submodule), Default: ready4use_dictionary()
#' @param dummys_ls Dummys (a list), Default: NULL
#' @param dyad_ls Dummys (a list), Default: NULL
#' @param exclude_chr Exclude (a character vector), Default: character(0)
#' @param factors_chr Factors (a character vector), Default: character(0)
#' @param fn Function (a function), Default: NULL
Expand All @@ -99,8 +100,8 @@ methods::setMethod("renew", methods::className("ready4use_imports", package = "r
#' @param new_val_xx New value (an output object of multiple potential types), Default: NULL
#' @param remove_old_lbls_1L_lgl Remove old labels (a logical vector of length one), Default: T
#' @param tfmn_1L_chr Transformation (a character vector of length one), Default: 'capitalise'
#' @param type_1L_chr Type (a character vector of length one), Default: c("label", "base", "case", "drop", "dummys", "join", "keep",
#' "levels", "mutate", "new", "rbind", "unlabel", "update",
#' @param type_1L_chr Type (a character vector of length one), Default: c("label", "base", "case", "drop", "dummys", "join", "keep",
#' "levels", "mutate", "new", "rbind", "unlabel", "update",
#' "sequential", "batch", "self")
#' @param uid_var_nm_1L_chr Unique identifier variable name (a character vector of length one), Default: character(0)
#' @param var_ctg_chr Variable category (a character vector), Default: 'Uncategorised'
Expand All @@ -110,7 +111,7 @@ methods::setMethod("renew", methods::className("ready4use_imports", package = "r
#' @return x (An object of class Ready4useDyad)
#' @rdname renew-methods
#' @aliases renew,Ready4useDyad-method
#' @export
#' @export
#' @importFrom assertthat assert_that
#' @importFrom purrr map_lgl reduce map_chr
#' @importFrom ready4show is_ready4show_correspondences
Expand All @@ -120,43 +121,43 @@ methods::setMethod("renew", methods::className("ready4use_imports", package = "r
#' @importFrom dplyr pull mutate
#' @importFrom rlang sym
#' @importFrom stringi stri_replace_first_fixed
methods::setMethod("renew", "Ready4useDyad", function (x, arrange_by_1L_chr = c("category", "name", "both"),
categories_chr = character(0), drop_chr = character(0), dictionary_lups_ls = list(),
dictionary_r3 = ready4use_dictionary(), dummys_ls = NULL,
exclude_chr = character(0), factors_chr = character(0), fn = NULL,
fn_args_ls = NULL, lup_tb = NULL, match_var_nm_1L_chr = character(0),
method_1L_chr = c("first", "sample"), names_chr = character(0),
new_val_xx = NULL, remove_old_lbls_1L_lgl = T, tfmn_1L_chr = "capitalise",
type_1L_chr = c("label", "base", "case", "drop", "dummys",
"join", "keep", "levels", "mutate", "new", "rbind", "unlabel",
"update", "sequential", "batch", "self"), uid_var_nm_1L_chr = character(0),
var_ctg_chr = "Uncategorised", vars_chr = character(0), what_1L_chr = c("all",
"dataset", "dictionary"), ...)
methods::setMethod("renew", "Ready4useDyad", function (x, arrange_by_1L_chr = c("category", "name", "both"),
categories_chr = character(0), drop_chr = character(0), dictionary_lups_ls = list(),
dictionary_r3 = ready4use_dictionary(), dummys_ls = NULL, dyad_ls = NULL,
exclude_chr = character(0), factors_chr = character(0), fn = NULL,
fn_args_ls = NULL, lup_tb = NULL, match_var_nm_1L_chr = character(0),
method_1L_chr = c("first", "sample"), names_chr = character(0),
new_val_xx = NULL, remove_old_lbls_1L_lgl = T, tfmn_1L_chr = "capitalise",
type_1L_chr = c("label", "base", "case", "drop", "dummys",
"join", "keep", "levels", "mutate", "new", "rbind", "unlabel",
"update", "sequential", "batch", "self"), uid_var_nm_1L_chr = character(0),
var_ctg_chr = "Uncategorised", vars_chr = character(0), what_1L_chr = c("all",
"dataset", "dictionary"), ...)
{
type_1L_chr <- match.arg(type_1L_chr)
what_1L_chr <- match.arg(what_1L_chr)
assertthat::assert_that((is.list(dictionary_lups_ls) & (dictionary_lups_ls %>%
purrr::map_lgl(~ready4show::is_ready4show_correspondences(.x)) %>%
assertthat::assert_that((is.list(dictionary_lups_ls) & (dictionary_lups_ls %>%
purrr::map_lgl(~ready4show::is_ready4show_correspondences(.x)) %>%
all())), msg = "dictionary_lups_ls must be comprised solely of elements that are ready4show_correspondences.")
if (what_1L_chr %in% c("all", "dataset") & type_1L_chr %in%
if (what_1L_chr %in% c("all", "dataset") & type_1L_chr %in%
c("label", "base", "case", "dummys", "levels", "unlabel")) {
if (type_1L_chr %in% c("label", "case")) {
dictionary_tb <- x@dictionary_r3
if (tfmn_1L_chr == "capitalise") {
dictionary_tb$var_desc_chr <- dictionary_tb$var_desc_chr %>%
dictionary_tb$var_desc_chr <- dictionary_tb$var_desc_chr %>%
Hmisc::capitalize()
}
if (tfmn_1L_chr == "title") {
dictionary_tb$var_desc_chr <- dictionary_tb$var_desc_chr %>%
dictionary_tb$var_desc_chr <- dictionary_tb$var_desc_chr %>%
stringr::str_to_title()
}
}
if (type_1L_chr == "case") {
x@dictionary_r3 <- dictionary_tb
}
if (type_1L_chr == "label") {
tfd_ds_tb <- add_labels_from_dictionary(x@ds_tb,
dictionary_tb = dictionary_tb %>% ready4::remove_lbls_from_df(),
tfd_ds_tb <- add_labels_from_dictionary(x@ds_tb,
dictionary_tb = dictionary_tb %>% ready4::remove_lbls_from_df(),
remove_old_lbls_1L_lgl = remove_old_lbls_1L_lgl)
x@ds_tb <- tfd_ds_tb
}
Expand All @@ -167,27 +168,27 @@ methods::setMethod("renew", "Ready4useDyad", function (x, arrange_by_1L_chr = c(
if (is.null(dummys_ls)) {
dummys_ls <- new_val_xx
}
dummys_dict_r3 <- manufacture(x, dummys_ls = dummys_ls,
flatten_1L_lgl = F, type_1L_chr = ifelse(type_1L_chr ==
dummys_dict_r3 <- manufacture(x, dummys_ls = dummys_ls,
flatten_1L_lgl = F, type_1L_chr = ifelse(type_1L_chr ==
"levels", "all", type_1L_chr), what_1L_chr = "factors-d")
x@dictionary_r3 <- renew.ready4use_dictionary(x@dictionary_r3,
x@dictionary_r3 <- renew.ready4use_dictionary(x@dictionary_r3,
new_cases_r3 = dummys_dict_r3)
x@ds_tb <- purrr::reduce(dummys_dict_r3$var_ctg_chr %>%
x@ds_tb <- purrr::reduce(dummys_dict_r3$var_ctg_chr %>%
unique(), .init = x@ds_tb, ~{
var_nm_1L_chr <- .y
val_1_1L_chr <- if ("base" %in% ready4::get_from_lup_obj(dummys_dict_r3,
match_value_xx = .y, match_var_nm_1L_chr = "var_ctg_chr",
val_1_1L_chr <- if ("base" %in% ready4::get_from_lup_obj(dummys_dict_r3,
match_value_xx = .y, match_var_nm_1L_chr = "var_ctg_chr",
target_var_nm_1L_chr = "var_type_chr")) {
character(0)
}
else {
levels(.x %>% dplyr::pull(!!rlang::sym(.y)))[1]
}
.x %>% dplyr::mutate(`:=`(!!rlang::sym(.y), factor(!!rlang::sym(.y),
labels = c(val_1_1L_chr, ready4::get_from_lup_obj(dummys_dict_r3,
match_value_xx = .y, match_var_nm_1L_chr = "var_ctg_chr",
target_var_nm_1L_chr = "var_nm_chr") %>%
purrr::map_chr(~stringi::stri_replace_first_fixed(.x,
.x %>% dplyr::mutate(`:=`(!!rlang::sym(.y), factor(!!rlang::sym(.y),
labels = c(val_1_1L_chr, ready4::get_from_lup_obj(dummys_dict_r3,
match_value_xx = .y, match_var_nm_1L_chr = "var_ctg_chr",
target_var_nm_1L_chr = "var_nm_chr") %>%
purrr::map_chr(~stringi::stri_replace_first_fixed(.x,
var_nm_1L_chr, ""))))))
})
}
Expand All @@ -198,19 +199,19 @@ methods::setMethod("renew", "Ready4useDyad", function (x, arrange_by_1L_chr = c(
}
}
if (what_1L_chr == "dictionary" & type_1L_chr == "new") {
x <- add_dictionary(x, new_cases_r3 = dictionary_r3,
var_ctg_chr = var_ctg_chr, arrange_by_1L_chr = ifelse(arrange_by_1L_chr ==
x <- add_dictionary(x, new_cases_r3 = dictionary_r3,
var_ctg_chr = var_ctg_chr, arrange_by_1L_chr = ifelse(arrange_by_1L_chr ==
"both", "category", arrange_by_1L_chr))
}
if (type_1L_chr %in% c("drop", "keep", "mutate", "sequential",
"batch", "self") | (what_1L_chr == "dictionary" & type_1L_chr ==
if (type_1L_chr %in% c("drop", "keep", "mutate", "sequential",
"batch", "self") | (what_1L_chr == "dictionary" & type_1L_chr ==
"update")) {
x <- update_dyad(x, arrange_1L_chr = arrange_by_1L_chr,
categories_chr = categories_chr, dictionary_lups_ls = dictionary_lups_ls,
dictionary_r3 = dictionary_r3, fn = fn, fn_args_ls = fn_args_ls,
exclude_chr = exclude_chr, lup_prototype_tb = lup_tb,
match_var_nm_1L_chr = match_var_nm_1L_chr, method_1L_chr = method_1L_chr,
names_chr = names_chr, type_1L_chr = type_1L_chr,
x <- update_dyad(x, arrange_1L_chr = arrange_by_1L_chr,
categories_chr = categories_chr, dictionary_lups_ls = dictionary_lups_ls,
dictionary_r3 = dictionary_r3, fn = fn, fn_args_ls = fn_args_ls,
exclude_chr = exclude_chr, lup_prototype_tb = lup_tb,
match_var_nm_1L_chr = match_var_nm_1L_chr, method_1L_chr = method_1L_chr,
names_chr = names_chr, type_1L_chr = type_1L_chr,
vars_chr = vars_chr, what_1L_chr = what_1L_chr)
}
if (type_1L_chr == "join") {
Expand All @@ -223,7 +224,7 @@ methods::setMethod("renew", "Ready4useDyad", function (x, arrange_by_1L_chr = c(
else {
tfmn_fn <- fn
}
x <- bind_dyads(dyad_ls, drop_chr = drop_chr, factors_chr = factors_chr,
x <- bind_dyads(dyad_ls, drop_chr = drop_chr, factors_chr = factors_chr,
tfmn_fn = tfmn_fn, uid_var_nm_1L_chr = uid_var_nm_1L_chr)
}
return(x)
Expand Down
1 change: 1 addition & 0 deletions data-raw/s4_fns/renew.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,6 +7,7 @@ renew_Ready4useDyad <- function(x,
dummys_ls = NULL,
exclude_chr = character(0),
factors_chr = character(0),
dyad_ls = NULL,
fn = NULL,
fn_args_ls = NULL,
lup_tb = NULL,
Expand Down
3 changes: 3 additions & 0 deletions man/renew-methods.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 96dd80d

Please sign in to comment.