diff --git a/.github/ISSUE_TEMPLATE/05_onboard.yml b/.github/ISSUE_TEMPLATE/05_onboard.yml deleted file mode 100644 index 6e27f833..00000000 --- a/.github/ISSUE_TEMPLATE/05_onboard.yml +++ /dev/null @@ -1,40 +0,0 @@ -name: Onboarding Tasks -description: Bringing a Core or non-Core member onto the admiral team [for admiral team only] -title: "Onboarding: " -labels: ["onboarding"] -assignees: - - octocat -body: - - type: markdown - attributes: - value: | - Welcome to the Team! We love contributors! - - type: checkboxes - id: core - attributes: - label: Onboarding tasks for Core (Roche-GSK) Team Members - description: - options: - - label: Given a tour of Github from a Core member - - label: Understand how to Create Issues and do a Pull Request - - label: Understand the Programming Strategy - - label: Read and understand [Developer Guides Articles](https://pharmaverse.github.io/admiral/index.html) - - label: Invited to all relevant meetings - Stand Ups, Retrospective, Sprint Planning, Question/Comments, Backlog, Community Meeting - - label: Given access to Box and relevant documents - - label: Given write access to Github Repository - - label: Slack channel invites to admiral and admiral_dev - - label: Introduction to Teams ways of working - - type: checkboxes - id: non-core - attributes: - label: Onboarding tasks for non-Core Team Members - description: - options: - - label: Given a tour of Github from a Core member - - label: Understand how to Create Issues and do a Pull Request - - label: Understand the Programming Strategy - - label: Read and understand [Developer Guides Articles](https://pharmaverse.github.io/admiral/index.html) - - label: Invited to all relevant meetings - Question/Comments, Community Meeting - - label: Given write access to Github Repository - - label: Slack channel invites to admiral - - label: Introduction to Teams ways of working diff --git a/DESCRIPTION b/DESCRIPTION index ac2473e1..95900d32 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: admiraldev Type: Package -Title: Development Tools for the Admiral Package Family -Version: 0.2.0 +Title: Utility Functions and Development Tools for the Admiral Package Family +Version: 0.3.0 Authors@R: c( person("Ben", "Straub", email = "ben.x.straub@gsk.com", role = c("aut", "cre")), person("Stefan", "Bundfuss", role = "aut"), @@ -46,7 +46,7 @@ Suggests: diffdf, lintr, pkgdown, - testthat, + testthat (>= 3.0.0), knitr, methods, miniUI, @@ -58,5 +58,7 @@ Suggests: tibble, usethis, covr, - DT + DT, + htmltools VignetteBuilder: knitr +Config/testthat/edition: 3 diff --git a/NAMESPACE b/NAMESPACE index 27842088..3c7f396c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -5,7 +5,6 @@ export("%or%") export(add_suffix_to_vars) export(anti_join) export(arg_name) -export(as_name) export(assert_atomic_vector) export(assert_character_scalar) export(assert_character_vector) @@ -39,6 +38,7 @@ export(dataset_vignette) export(dquote) export(enumerate) export(expect_dfs_equal) +export(expr_c) export(extract_vars) export(filter_if) export(get_constant_vars) @@ -52,9 +52,11 @@ export(is_named) export(is_order_vars) export(is_valid_dtc) export(left_join) +export(process_set_values_to) export(quo_c) export(quo_not_missing) export(remove_tmp_vars) +export(replace_symbol_in_expr) export(replace_symbol_in_quo) export(replace_values_by_names) export(squote) @@ -66,6 +68,7 @@ export(warn_if_inconsistent_list) export(warn_if_invalid_dtc) export(warn_if_vars_exist) export(what_is_it) +importFrom(dplyr,across) importFrom(dplyr,arrange) importFrom(dplyr,bind_cols) importFrom(dplyr,bind_rows) @@ -79,25 +82,20 @@ importFrom(dplyr,full_join) importFrom(dplyr,group_by) importFrom(dplyr,if_else) importFrom(dplyr,mutate) -importFrom(dplyr,mutate_at) -importFrom(dplyr,mutate_if) importFrom(dplyr,n) importFrom(dplyr,n_distinct) importFrom(dplyr,na_if) importFrom(dplyr,pull) importFrom(dplyr,rename) -importFrom(dplyr,rename_at) importFrom(dplyr,row_number) importFrom(dplyr,select) importFrom(dplyr,slice) importFrom(dplyr,starts_with) importFrom(dplyr,summarise) -importFrom(dplyr,summarise_at) importFrom(dplyr,tibble) importFrom(dplyr,transmute) importFrom(dplyr,ungroup) importFrom(dplyr,union) -importFrom(dplyr,vars) importFrom(hms,as_hms) importFrom(lifecycle,deprecate_stop) importFrom(lifecycle,deprecate_warn) @@ -139,6 +137,7 @@ importFrom(rlang,abort) importFrom(rlang,arg_match) importFrom(rlang,as_function) importFrom(rlang,as_label) +importFrom(rlang,as_name) importFrom(rlang,as_string) importFrom(rlang,call2) importFrom(rlang,call_name) @@ -151,33 +150,28 @@ importFrom(rlang,eval_tidy) importFrom(rlang,expr) importFrom(rlang,expr_interp) importFrom(rlang,expr_label) +importFrom(rlang,exprs) importFrom(rlang,f_lhs) importFrom(rlang,f_rhs) importFrom(rlang,inform) importFrom(rlang,is_bare_formula) importFrom(rlang,is_call) importFrom(rlang,is_character) +importFrom(rlang,is_expression) importFrom(rlang,is_formula) importFrom(rlang,is_integerish) importFrom(rlang,is_logical) +importFrom(rlang,is_missing) importFrom(rlang,is_quosure) -importFrom(rlang,is_quosures) importFrom(rlang,is_symbol) +importFrom(rlang,is_symbolic) importFrom(rlang,missing_arg) importFrom(rlang,new_formula) importFrom(rlang,parse_expr) importFrom(rlang,parse_exprs) importFrom(rlang,quo) -importFrom(rlang,quo_get_env) -importFrom(rlang,quo_get_expr) -importFrom(rlang,quo_is_call) importFrom(rlang,quo_is_missing) importFrom(rlang,quo_is_null) -importFrom(rlang,quo_is_symbol) -importFrom(rlang,quo_set_env) -importFrom(rlang,quo_squash) -importFrom(rlang,quo_text) -importFrom(rlang,quos) importFrom(rlang,set_names) importFrom(rlang,sym) importFrom(rlang,syms) diff --git a/NEWS.md b/NEWS.md index f3e0a739..1c0a9c95 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,44 @@ +# admiraldev 0.3.0 + +## New Features + - New function `process_set_values_to()` for creating the variables specified + by the `set_value_to` argument and catching errors (#70) + +## Updates of Existing Functions + - Using testthat3e (testthat 3rd edition) for unit testing. This is stricter + in that messages must be addressed and deprecated functions throw errors. + (#230) + - Slight boost to test coverage for `dev_utilities` (#102) + - Fix datatable styling for documentation (#197) + - The `assert_character_vector()` function gained a `named` argument to check + that all elements of the vector are named. (#70) + - The `assert_list_of()` function gained a `named` argument to check that all + elements of the list are named. (#203) + - The `quote_fun` argument of `enumerate()` was extended such that `NULL` can + be specified to request no quoting of the elements. (#203) + - The `assert_list_of()` function was enhanced such that it also considers the + type of the element, e.g., to check if a value is a list of symbols. (#208) + +## Breaking Changes +- The default value of the `optional` argument in `assert_date_vector()`, +`assert_list_of()`, and `assert_s3_class()` was changed from `TRUE` to `FALSE` +to make the default behavior consistent. (#87) +- admiral functions no longer expect list of quosures created by `vars()` but +list of expressions created by `exprs()`. Thus the following functions and +arguments were deprecated: + - `quo_c()` and `replace_symbol_in_quo()` + - the `quosures` argument in `get_source_vars()`, + `replace_values_by_names()`, and `vars2chr()` + +## Documentation + - New section in programming strategy regarding comments (#71) + - Removed requirement to add `@author` tags to code scripts from programming + strategy, as we will only be tracking authors in the DESCRIPTION file. Authors + have been removed from function documentation in line with this update. + (#206, #210) + - Removed On-boarding Issue Template (#225) + - Increased clarity for the scope of the package (#232) + # admiraldev 0.2.0 ## New Features @@ -22,7 +63,7 @@ - New vignette for our package release strategy (#79) - Updated multiple roxygen headers (#116, #133, #134, #141, #145, #172) - Description on how admiral options work for certain function inputs, i.e `subject_keys` (#133) - + ## Various - PR Checklist Template updated (#172) - New authors/contributors (#158) diff --git a/R/admiraldev-package.R b/R/admiraldev-package.R index 38b31500..af81bdc8 100644 --- a/R/admiraldev-package.R +++ b/R/admiraldev-package.R @@ -1,17 +1,16 @@ #' @keywords internal -#' @importFrom dplyr arrange bind_rows case_when desc ends_with filter full_join group_by -#' if_else mutate mutate_at mutate_if n pull rename rename_at row_number select slice -#' starts_with transmute ungroup vars n_distinct union distinct -#' summarise_at summarise coalesce bind_cols na_if tibble +#' @importFrom dplyr across arrange bind_rows case_when desc ends_with filter +#' full_join group_by if_else mutate n pull rename row_number select slice +#' starts_with transmute ungroup n_distinct union distinct summarise coalesce +#' bind_cols na_if tibble #' @importFrom magrittr %>% -#' @importFrom rlang := abort arg_match as_function as_label as_string call2 caller_env -#' call_name current_env .data enexpr enquo eval_bare eval_tidy expr -#' expr_interp expr_label f_lhs f_rhs inform missing_arg -#' is_bare_formula is_call is_character is_formula is_integerish -#' is_logical is_quosure is_quosures is_symbol new_formula -#' parse_expr parse_exprs quo quo_get_expr quo_is_call -#' quo_is_missing quo_is_null quo_is_symbol quos quo_squash quo_text -#' set_names sym syms type_of warn quo_set_env quo_get_env +#' @importFrom rlang := abort arg_match as_function as_label as_name as_string +#' call2 caller_env call_name current_env .data enexpr enquo eval_bare +#' eval_tidy expr expr_interp expr_label exprs f_lhs f_rhs inform missing_arg +#' is_bare_formula is_call is_character is_expression is_formula is_integerish +#' is_logical is_missing is_quosure is_symbol is_symbolic new_formula +#' parse_expr parse_exprs quo quo_is_missing quo_is_null set_names sym syms +#' type_of warn #' @importFrom utils capture.output str #' @importFrom purrr map map2 map_chr map_lgl reduce walk keep map_if transpose #' flatten every modify_at modify_if reduce compose diff --git a/R/assertions.R b/R/assertions.R index 8ef8288e..4cdd9a37 100644 --- a/R/assertions.R +++ b/R/assertions.R @@ -4,12 +4,11 @@ #' a set of required variables #' #' @param arg A function argument to be checked -#' @param required_vars A list of variables created using `vars()` +#' @param required_vars A list of variables created using `exprs()` #' @param check_is_grouped Throw an error is `dataset` is grouped? Defaults to `TRUE`. #' @param optional Is the checked parameter optional? If set to `FALSE` and `arg` #' is `NULL` then an error is thrown #' -#' @author Thomas Neitmann #' #' @return #' The function throws an error if `arg` is not a data frame or if `arg` @@ -24,10 +23,11 @@ #' @examples #' library(admiral.test) #' library(dplyr, warn.conflicts = FALSE) +#' library(rlang) #' data(admiral_dm) #' #' example_fun <- function(dataset) { -#' assert_data_frame(dataset, required_vars = vars(STUDYID, USUBJID)) +#' assert_data_frame(dataset, required_vars = exprs(STUDYID, USUBJID)) #' } #' #' example_fun(admiral_dm) @@ -95,7 +95,6 @@ assert_data_frame <- function(arg, #' @param optional Is the checked parameter optional? If set to `FALSE` and `arg` #' is `NULL` then an error is thrown #' -#' @author Thomas Neitmann #' #' @return #' The function throws an error if `arg` is not a character vector or if `arg` @@ -201,10 +200,11 @@ assert_character_scalar <- function(arg, #' #' @param arg A function argument to be checked #' @param values A `character` vector of valid values for `arg` +#' @param named If set to `TRUE`, an error is issued if not all elements of the +#' vector are named. #' @param optional Is the checked parameter optional? If set to `FALSE` and `arg` #' is `NULL` then an error is thrown #' -#' @author Thomas Neitmann #' #' @return #' The function throws an error if `arg` is not a character vector or if @@ -223,7 +223,14 @@ assert_character_scalar <- function(arg, #' example_fun(letters) #' #' try(example_fun(1:10)) -assert_character_vector <- function(arg, values = NULL, optional = FALSE) { +#' +#' example_fun2 <- function(chr) { +#' assert_character_vector(chr, named = TRUE) +#' } +#' +#' try(example_fun2(c(alpha = "a", "b", gamma = "c"))) +assert_character_vector <- function(arg, values = NULL, named = FALSE, optional = FALSE) { + assert_logical_scalar(named) assert_logical_scalar(optional) if (optional && is.null(arg)) { @@ -252,6 +259,22 @@ assert_character_vector <- function(arg, values = NULL, optional = FALSE) { )) } } + + if (named && length(arg) > 0) { + if (is.null(names(arg))) { + abort(paste0( + "All elements of ", arg_name(substitute(arg)), " must be named.\n", + "No element is named." + )) + } + unnamed <- which(names(arg) == "") + if (length(unnamed) > 0) { + abort(paste0( + "All elements of ", arg_name(substitute(arg)), " must be named.\n", + "The following elements are not named: ", enumerate(unnamed, quote_fun = NULL) + )) + } + } } #' Is an Argument a Logical Scalar (Boolean)? @@ -265,7 +288,6 @@ assert_character_vector <- function(arg, values = NULL, optional = FALSE) { #' If set to `FALSE` and `arg` is `NULL` then an error is thrown. Otherwise, #' `NULL` is considered as valid value. #' -#' @author Thomas Neitmann, Stefan Bundfuss #' #' @return #' The function throws an error if `arg` is neither `TRUE` or `FALSE`. Otherwise, @@ -308,11 +330,10 @@ assert_logical_scalar <- function(arg, optional = FALSE) { #' #' Checks if an argument is a symbol #' -#' @param arg A function argument to be checked. Must be a `quosure`. See examples. +#' @param arg A function argument to be checked. Must be a `symbol`. See examples. #' @param optional Is the checked parameter optional? If set to `FALSE` and `arg` #' is `NULL` then an error is thrown #' -#' @author Thomas Neitmann #' #' @return #' The function throws an error if `arg` is not a symbol and returns the input @@ -329,7 +350,7 @@ assert_logical_scalar <- function(arg, optional = FALSE) { #' data(admiral_dm) #' #' example_fun <- function(dat, var) { -#' var <- assert_symbol(enquo(var)) +#' var <- assert_symbol(enexpr(var)) #' select(dat, !!var) #' } #' @@ -343,20 +364,20 @@ assert_logical_scalar <- function(arg, optional = FALSE) { assert_symbol <- function(arg, optional = FALSE) { assert_logical_scalar(optional) - if (optional && quo_is_null(arg)) { + if (optional && is.null(arg)) { return(invisible(arg)) } - if (quo_is_missing(arg)) { + if (is_missing(arg)) { err_msg <- sprintf("Argument `%s` missing, with no default", arg_name(substitute(arg))) abort(err_msg) } - if (!quo_is_symbol(arg)) { + if (!is.symbol(arg)) { err_msg <- sprintf( "`%s` must be a symbol but is %s", arg_name(substitute(arg)), - what_is_it(quo_get_expr(arg)) + what_is_it(arg) ) abort(err_msg) } @@ -379,20 +400,20 @@ assert_symbol <- function(arg, optional = FALSE) { assert_expr <- function(arg, optional = FALSE) { assert_logical_scalar(optional) - if (optional && quo_is_null(arg)) { + if (optional && is.null(arg)) { return(invisible(arg)) } - if (quo_is_missing(arg)) { + if (is_missing(arg)) { err_msg <- sprintf("Argument `%s` missing, with no default", arg_name(substitute(arg))) abort(err_msg) } - if (!(quo_is_symbol(arg) || quo_is_call(arg))) { + if (!is_symbolic(arg)) { err_msg <- sprintf( "`%s` must be an expression but is %s", arg_name(substitute(arg)), - what_is_it(quo_get_expr(arg)) + what_is_it(arg) ) abort(err_msg) } @@ -414,7 +435,6 @@ assert_expr <- function(arg, optional = FALSE) { #' @export #' @keywords assertion #' @family assertion -#' @author Ondrej Slama #' #' @examples #' library(admiral.test) @@ -432,24 +452,18 @@ assert_expr <- function(arg, optional = FALSE) { #' #' try(example_fun(admiral_dm, USUBJID)) assert_filter_cond <- function(arg, optional = FALSE) { - stopifnot(is_quosure(arg)) assert_logical_scalar(optional) - if (optional && quo_is_null(arg)) { + if (optional && is.null(arg)) { return(invisible(arg)) } - provided <- !rlang::quo_is_missing(arg) - if (!provided & !optional) { - err_msg <- sprintf("Argument `%s` is missing, with no default", arg_name(substitute(arg))) - abort(err_msg) - } - - if (provided & !(quo_is_call(arg) | is_logical(quo_get_expr(arg)))) { + provided <- !is_missing(arg) + if (provided & !(is_call(arg) | is_logical(arg))) { err_msg <- sprintf( "`%s` must be a filter condition but is %s", arg_name(substitute(arg)), - what_is_it(quo_get_expr(arg)) + what_is_it(arg) ) abort(err_msg) } @@ -459,21 +473,20 @@ assert_filter_cond <- function(arg, optional = FALSE) { #' Is an Argument a List of Variables? #' -#' Checks if an argument is a valid list of variables created using `vars()` +#' Checks if an argument is a valid list of symbols (e.g., created by `exprs()`) #' #' @param arg A function argument to be checked #' +#' @param expect_names If the argument is set to `TRUE`, it is checked if all +#' variables are named, e.g., `exprs(APERSDT = APxxSDT, APEREDT = APxxEDT)`. +#' #' @param optional Is the checked parameter optional? If set to `FALSE` and `arg` #' is `NULL` then an error is thrown #' -#' @param expect_names If the argument is set to `TRUE`, it is checked if all -#' variables are named, e.g., `vars(APERSDT = APxxSDT, APEREDT = APxxEDT)`. -#' -#' @author Samia Kabi #' #' @return -#' The function throws an error if `arg` is not a list of variables created using `vars()` -#' and returns the input invisibly otherwise. +#' The function throws an error if `arg` is not a list of symbols (e.g., created +#' by `exprs()` and returns the input invisibly otherwise. #' #' @export #' @@ -487,26 +500,27 @@ assert_filter_cond <- function(arg, optional = FALSE) { #' assert_vars(by_vars) #' } #' -#' example_fun(vars(USUBJID, PARAMCD)) +#' example_fun(exprs(USUBJID, PARAMCD)) #' -#' try(example_fun(exprs(USUBJID, PARAMCD))) +#' try(example_fun(quos(USUBJID, PARAMCD))) #' #' try(example_fun(c("USUBJID", "PARAMCD", "VISIT"))) #' -#' try(example_fun(vars(USUBJID, toupper(PARAMCD), desc(AVAL)))) +#' try(example_fun(exprs(USUBJID, toupper(PARAMCD), desc(AVAL)))) #' #' example_fun_name <- function(by_vars) { #' assert_vars(by_vars, expect_names = TRUE) #' } #' -#' example_fun_name(vars(APERSDT = APxxSDT, APEREDT = APxxEDT)) +#' example_fun_name(exprs(APERSDT = APxxSDT, APEREDT = APxxEDT)) #' -#' try(example_fun_name(vars(APERSDT = APxxSDT, APxxEDT))) -assert_vars <- function(arg, optional = FALSE, expect_names = FALSE) { +#' try(example_fun_name(exprs(APERSDT = APxxSDT, APxxEDT))) +assert_vars <- function(arg, expect_names = FALSE, optional = FALSE) { + assert_logical_scalar(expect_names) assert_logical_scalar(optional) default_err_msg <- sprintf( - "`%s` must be a list of unquoted variable names, e.g. `vars(USUBJID, VISIT)`", + "`%s` must be a list of symbols, e.g. `exprs(USUBJID, VISIT)`", arg_name(substitute(arg)) ) @@ -514,53 +528,21 @@ assert_vars <- function(arg, optional = FALSE, expect_names = FALSE) { abort(default_err_msg) } - if (optional && is.null(arg)) { - return(invisible(arg)) - } - - if (!inherits(arg, "quosures")) { - abort(default_err_msg) - } - - is_symbol <- map_lgl(arg, quo_is_symbol) - if (!all(is_symbol)) { - expr_list <- map_chr(arg, quo_text) - err_msg <- paste0( - default_err_msg, - ", but the following elements are not: ", - enumerate(expr_list[!is_symbol]) - ) - abort(err_msg) - } - - if (expect_names) { - if (any(names(arg) == "")) { - abort(sprintf( - paste( - "`%s` must be a named list of unquoted variable names,", - "e.g. `vars(APERSDT = APxxSDT, APEREDT = APxxEDT)`" - ), - arg_name(substitute(arg)) - )) - } - } - - invisible(arg) + assert_list_of(arg, "symbol", named = expect_names, optional = optional) } #' Is an Argument a List of Order Variables? #' -#' Checks if an argument is a valid list of order variables created using `vars()` +#' Checks if an argument is a valid list of order variables created using `exprs()` #' #' @param arg A function argument to be checked #' @param optional Is the checked parameter optional? If set to `FALSE` and `arg` #' is `NULL` then an error is thrown #' -#' @author Stefan Bundfuss #' #' @return #' The function throws an error if `arg` is not a list of variables or `desc()` -#' calls created using `vars()` and returns the input invisibly otherwise. +#' calls created using `exprs()` and returns the input invisibly otherwise. #' #' @export #' @@ -574,20 +556,20 @@ assert_vars <- function(arg, optional = FALSE, expect_names = FALSE) { #' assert_order_vars(by_vars) #' } #' -#' example_fun(vars(USUBJID, PARAMCD, desc(AVISITN))) +#' example_fun(exprs(USUBJID, PARAMCD, desc(AVISITN))) #' -#' try(example_fun(exprs(USUBJID, PARAMCD))) +#' try(example_fun(quos(USUBJID, PARAMCD))) #' #' try(example_fun(c("USUBJID", "PARAMCD", "VISIT"))) #' -#' try(example_fun(vars(USUBJID, toupper(PARAMCD), -AVAL))) +#' try(example_fun(exprs(USUBJID, toupper(PARAMCD), -AVAL))) assert_order_vars <- function(arg, optional = FALSE) { assert_logical_scalar(optional) default_err_msg <- paste( backquote(arg_name(substitute(arg))), "must be a list of unquoted variable names or `desc()` calls,", - "e.g. `vars(USUBJID, desc(VISITNUM))`" + "e.g. `exprs(USUBJID, desc(VISITNUM))`" ) if (isTRUE(tryCatch(force(arg), error = function(e) TRUE))) { @@ -598,7 +580,7 @@ assert_order_vars <- function(arg, optional = FALSE) { return(invisible(arg)) } - if (!inherits(arg, "quosures")) { + if (!inherits(arg, "list")) { abort(default_err_msg) } @@ -619,7 +601,6 @@ assert_order_vars <- function(arg, optional = FALSE) { #' @param optional Is the checked parameter optional? If set to `FALSE` and `arg` #' is `NULL` then an error is thrown #' -#' @author Thomas Neitmann #' #' @return #' The function throws an error if `arg` is not an integer belonging to the @@ -677,7 +658,6 @@ assert_integer_scalar <- function(arg, subset = "none", optional = FALSE) { #' @param optional Is the checked parameter optional? If set to `FALSE` and `arg` #' is `NULL` then an error is thrown #' -#' @author Stefan Bundfuss #' #' @return #' The function throws an error if `arg` is not a numeric vector. @@ -720,7 +700,6 @@ assert_numeric_vector <- function(arg, optional = FALSE) { #' @param optional Is the checked parameter optional? If set to `FALSE` and `arg` #' is `NULL` then an error is thrown #' -#' @author Ania Golab #' #' @return #' The function throws an error if `arg` is not an atomic vector. @@ -763,7 +742,6 @@ assert_atomic_vector <- function(arg, optional = FALSE) { #' @param optional Is the checked parameter optional? If set to `FALSE` and `arg` #' is `NULL` then an error is thrown #' -#' @author Thomas Neitmann #' #' @return #' The function throws an error if `arg` is an object which does *not* inherit from `class`. @@ -783,7 +761,7 @@ assert_atomic_vector <- function(arg, optional = FALSE) { #' try(example_fun(letters)) #' #' try(example_fun(1:10)) -assert_s3_class <- function(arg, class, optional = TRUE) { +assert_s3_class <- function(arg, class, optional = FALSE) { assert_character_scalar(class) assert_logical_scalar(optional) @@ -804,21 +782,22 @@ assert_s3_class <- function(arg, class, optional = TRUE) { invisible(arg) } -#' Is an Argument a List of Objects of a Specific S3 Class? +#' Is an Argument a List of Objects of a Specific S3 Class or Type? #' -#' Checks if an argument is a `list` of objects inheriting from the S3 class specified. +#' Checks if an argument is a `list` of objects inheriting from the S3 class or type specified. #' #' @param arg A function argument to be checked -#' @param class The S3 class to check for +#' @param class The S3 class or type to check for +#' @param named If set to `TRUE`, an error is issued if not all elements of the +#' list are named. #' @param optional Is the checked parameter optional? If set to `FALSE` and `arg` #' is `NULL` then an error is thrown #' -#' @author Thomas Neitmann #' #' @return -#' The function throws an error if `arg` is not a list or if `arg` is a list but its -#' elements are not objects inheriting from `class`. Otherwise, the input is returned -#' invisibly. +#' The function throws an error if `arg` is not a list or if `arg` is a list but +#' its elements are not objects inheriting from `class` or of type `class`. +#' Otherwise, the input is returned invisibly. #' #' @export #' @@ -834,8 +813,14 @@ assert_s3_class <- function(arg, class, optional = TRUE) { #' try(example_fun(list(letters, 1:10))) #' #' try(example_fun(c(TRUE, FALSE))) -assert_list_of <- function(arg, class, optional = TRUE) { +#' +#' example_fun2 <- function(list) { +#' assert_list_of(list, "numeric", named = TRUE) +#' } +#' try(example_fun2(list(1, 2, 3, d = 4))) +assert_list_of <- function(arg, class, named = FALSE, optional = TRUE) { assert_character_scalar(class) + assert_logical_scalar(named) assert_logical_scalar(optional) if (is.null(arg) && optional) { @@ -844,14 +829,14 @@ assert_list_of <- function(arg, class, optional = TRUE) { assert_s3_class(arg, "list") - is_class <- map_lgl(arg, inherits, class) + is_class <- map_lgl(arg, inherits, class) | map_chr(arg, typeof) == class if (!all(is_class)) { info_msg <- paste( sprintf("\u2716 Element %s is %s", which(!is_class), map_chr(arg[!is_class], what_is_it)), collapse = "\n" ) err_msg <- sprintf( - "Each element of `%s` must be an object of class '%s' but the following are not:\n%s", + "Each element of `%s` must be an object of class/type '%s' but the following are not:\n%s", arg_name(substitute(arg)), class, info_msg @@ -859,6 +844,22 @@ assert_list_of <- function(arg, class, optional = TRUE) { abort(err_msg) } + if (named && length(arg) > 0) { + if (is.null(names(arg))) { + abort(paste0( + "All elements of ", arg_name(substitute(arg)), " must be named.\n", + "No element is named." + )) + } + unnamed <- which(names(arg) == "") + if (length(unnamed) > 0) { + abort(paste0( + "All elements of ", arg_name(substitute(arg)), " must be named.\n", + "The following elements are not named: ", enumerate(unnamed, quote_fun = NULL) + )) + } + } + invisible(arg) } @@ -902,7 +903,6 @@ assert_named_exprs <- function(arg, optional = FALSE) { #' @param dataset A `data.frame` #' @param required_vars A `character` vector of variable names #' -#' @author Thomas Neitmann #' #' @return The function throws an error if any of the required variables are #' missing in the input dataset. Otherwise, the dataset is returned invisibly. @@ -949,7 +949,6 @@ assert_has_variables <- function(dataset, required_vars) { #' #' If set to `FALSE` and `arg` is `NULL` then an error is thrown. #' -#' @author Stefan Bundfuss #' #' @return The function throws an error #' @@ -1062,7 +1061,6 @@ assert_function_param <- function(arg, params) { #' @param required_unit Expected unit #' @param get_unit_expr Expression used to provide the unit of `param` #' -#' @author Stefan Bundfuss #' #' @keywords assertion #' @family assertion @@ -1084,10 +1082,10 @@ assert_function_param <- function(arg, params) { #' #' assert_unit(advs, param = "WEIGHT", required_unit = "kg", get_unit_expr = VSSTRESU) assert_unit <- function(dataset, param, required_unit, get_unit_expr) { - assert_data_frame(dataset, required_vars = vars(PARAMCD)) + assert_data_frame(dataset, required_vars = exprs(PARAMCD)) assert_character_scalar(param) assert_character_scalar(required_unit) - get_unit_expr <- enquo(get_unit_expr) + get_unit_expr <- enexpr(get_unit_expr) units <- dataset %>% mutate(`_unit` = !!get_unit_expr) %>% @@ -1132,7 +1130,6 @@ assert_unit <- function(dataset, param, required_unit, get_unit_expr) { #' @param dataset A `data.frame` #' @param param Parameter code to check #' -#' @author Stefan Bundfuss #' #' @return #' The function throws an error if the parameter exists in the input @@ -1153,7 +1150,7 @@ assert_unit <- function(dataset, param, required_unit, get_unit_expr) { #' assert_param_does_not_exist(advs, param = "HR") #' try(assert_param_does_not_exist(advs, param = "WEIGHT")) assert_param_does_not_exist <- function(dataset, param) { - assert_data_frame(dataset, required_vars = vars(PARAMCD)) + assert_data_frame(dataset, required_vars = exprs(PARAMCD)) if (param %in% unique(dataset$PARAMCD)) { abort( paste0( @@ -1170,19 +1167,18 @@ assert_param_does_not_exist <- function(dataset, param) { #' Is an Argument a Variable-Value List? #' -#' Checks if the argument is a list of `quosures` where the expressions are +#' Checks if the argument is a list of expressions where the expressions are #' variable-value pairs. The value can be a symbol, a string, a numeric, or #' `NA`. More general expression are not allowed. #' #' @param arg A function argument to be checked #' @param required_elements A `character` vector of names that must be present in `arg` #' @param accept_expr Should expressions on the right hand side be accepted? -#' @param accept_var Should unnamed variable names (e.g. `vars(USUBJID)`) on the +#' @param accept_var Should unnamed variable names (e.g. `exprs(USUBJID)`) on the #' right hand side be accepted? #' @param optional Is the checked parameter optional? If set to `FALSE` and `arg` #' is `NULL` then an error is thrown. #' -#' @author Stefan Bundfuss, Thomas Neitmann #' #' @return #' The function throws an error if `arg` is not a list of variable-value expressions. @@ -1194,13 +1190,14 @@ assert_param_does_not_exist <- function(dataset, param) { #' #' @examples #' library(dplyr, warn.conflicts = FALSE) +#' library(rlang) #' #' example_fun <- function(vars) { #' assert_varval_list(vars) #' } -#' example_fun(vars(DTHDOM = "AE", DTHSEQ = AESEQ)) +#' example_fun(exprs(DTHDOM = "AE", DTHSEQ = AESEQ)) #' -#' try(example_fun(vars("AE", DTSEQ = AESEQ))) +#' try(example_fun(exprs("AE", DTSEQ = AESEQ))) assert_varval_list <- function(arg, # nolint required_elements = NULL, accept_expr = FALSE, @@ -1223,13 +1220,13 @@ assert_varval_list <- function(arg, # nolint valid_vals <- "a symbol, character scalar, numeric scalar, or `NA`" } - if (!accept_var & (!is_quosures(arg) || !is_named(arg))) { + if (!accept_var & (!inherits(arg, "list") || !is_named(arg))) { err_msg <- sprintf( paste0( - "`%s` must be a named list of quosures where each element is ", + "`%s` must be a named list of expressions where each element is ", valid_vals, " but it is %s\n", - "\u2139 To create a list of quosures use `vars()`" + "\u2139 To create a list of expressions use `exprs()`" ), arg_name(substitute(arg)), what_is_it(arg) @@ -1240,10 +1237,10 @@ assert_varval_list <- function(arg, # nolint if (accept_var & (!contains_vars(arg))) { err_msg <- sprintf( paste0( - "`%s` must be a list of quosures where each element is ", + "`%s` must be a list of expressions where each element is ", valid_vals, " but it is %s\n", - "\u2139 To create a list of quosures use `vars()`" + "\u2139 To create a list of expressions use `exprs()`" ), arg_name(substitute(arg)), what_is_it(arg) @@ -1263,10 +1260,9 @@ assert_varval_list <- function(arg, # nolint } } - expr_list <- map(arg, quo_get_expr) if (accept_expr) { - invalids <- expr_list[!map_lgl( - expr_list, + invalids <- arg[!map_lgl( + arg, ~ is.symbol(.x) || is.character(.x) || is.numeric(.x) || @@ -1274,8 +1270,8 @@ assert_varval_list <- function(arg, # nolint is.atomic(.x) && is.na(.x) )] } else { - invalids <- expr_list[!map_lgl( - expr_list, + invalids <- arg[!map_lgl( + arg, ~ is.symbol(.x) || is.character(.x) || is.numeric(.x) || @@ -1335,7 +1331,6 @@ assert_varval_list <- function(arg, # nolint #' If the condition contains objects apart from the element, they have to be #' passed to the function. See the second example below. #' -#' @author Stefan Bundfuss #' #' @return #' An error if the condition is not meet. The input otherwise. @@ -1347,12 +1342,12 @@ assert_varval_list <- function(arg, # nolint assert_list_element <- function(list, element, condition, message_text, ...) { assert_s3_class(list, "list") assert_character_scalar(element) - condition <- assert_filter_cond(enquo(condition)) + condition <- assert_filter_cond(enexpr(condition)) assert_character_scalar(message_text) # store elements of the lists/classes in a vector named as the element # rlang::env_poke(current_env(), eval(element), lapply(list, `[[`, element)) invalids <- !eval( - quo_get_expr(condition), + condition, envir = list(...), enclos = current_env() ) @@ -1388,7 +1383,6 @@ assert_list_element <- function(list, element, condition, message_text, ...) { #' #' @param vars2 Second list of variables #' -#' @author Stefan Bundfuss #' #' @return #' An error if the condition is not meet. The input otherwise. @@ -1400,7 +1394,7 @@ assert_list_element <- function(list, element, condition, message_text, ...) { assert_one_to_one <- function(dataset, vars1, vars2) { assert_vars(vars1) assert_vars(vars2) - assert_data_frame(dataset, required_vars = quo_c(vars1, vars2)) + assert_data_frame(dataset, required_vars = expr_c(vars1, vars2)) uniques <- unique(select(dataset, !!!vars1, !!!vars2)) one_to_many <- uniques %>% @@ -1457,7 +1451,6 @@ assert_one_to_one <- function(dataset, vars1, vars2) { #' #' @export #' -#' @author Stefan Bundfuss #' #' @keywords assertion #' @@ -1467,7 +1460,7 @@ assert_one_to_one <- function(dataset, vars1, vars2) { #' library(rlang) #' #' example_fun <- function(dataset, var) { -#' var <- assert_symbol(enquo(var)) +#' var <- assert_symbol(enexpr(var)) #' assert_date_var(dataset = dataset, var = !!var) #' } #' @@ -1488,7 +1481,7 @@ assert_one_to_one <- function(dataset, vars1, vars2) { #' )) #' #' example_fun2 <- function(dataset, var) { -#' var <- assert_symbol(enquo(var)) +#' var <- assert_symbol(enexpr(var)) #' assert_date_var( #' dataset = dataset, #' var = !!var, @@ -1502,8 +1495,8 @@ assert_one_to_one <- function(dataset, vars1, vars2) { #' var = USUBJID #' )) assert_date_var <- function(dataset, var, dataset_name = NULL, var_name = NULL) { - var <- assert_symbol(enquo(var)) - assert_data_frame(dataset, required_vars = vars(!!var)) + var <- assert_symbol(enexpr(var)) + assert_data_frame(dataset, required_vars = exprs(!!var)) assert_character_scalar(dataset_name, optional = TRUE) assert_character_scalar(var_name, optional = TRUE) column <- pull(dataset, !!var) @@ -1540,7 +1533,6 @@ assert_date_var <- function(dataset, var, dataset_name = NULL, var_name = NULL) #' #' @export #' -#' @author Sadchla Mascary #' #' @keywords assertion #' @@ -1555,7 +1547,7 @@ assert_date_var <- function(dataset, var, dataset_name = NULL, var_name = NULL) #' as.Date("2022-01-30", tz = "UTC") #' ) #' try(example_fun("1993-07-14")) -assert_date_vector <- function(arg, optional = TRUE) { +assert_date_vector <- function(arg, optional = FALSE) { assert_logical_scalar(optional) if (optional && is.null(arg)) { @@ -1564,9 +1556,11 @@ assert_date_vector <- function(arg, optional = TRUE) { if (!is.instant(arg)) { abort(paste0( + "`", deparse(substitute(arg)), - " must be a date or datetime variable but it's ", - friendly_type_of(arg) + "` must be a date or datetime variable but it's `", + friendly_type_of(arg), + "`" )) } } @@ -1578,7 +1572,6 @@ assert_date_vector <- function(arg, optional = TRUE) { #' #' @param ... Arguments to be checked #' -#' @author Stefan Bundfuss #' #' @return The function throws an error if not all arguments are of the same type. #' diff --git a/R/dataset_vignette.R b/R/dataset_vignette.R index eb6cc900..fe6afe6a 100644 --- a/R/dataset_vignette.R +++ b/R/dataset_vignette.R @@ -29,11 +29,11 @@ dataset_vignette <- function(dataset, display_vars = NULL, filter = NULL) { display_vars <- assert_vars(display_vars, optional = TRUE) assert_data_frame(dataset, required_vars = display_vars) - filter <- assert_filter_cond(enquo(filter), optional = TRUE) + filter <- assert_filter_cond(enexpr(filter), optional = TRUE) out <- dataset %>% filter_if(filter) %>% - mutate_if(is.character, as.factor) + mutate(across(where(is.character), as.factor)) # Create a short markdown table when this function is called outside {pkgdown} if (!identical(Sys.getenv("IN_PKGDOWN"), "true")) { @@ -50,26 +50,36 @@ dataset_vignette <- function(dataset, display_vars = NULL, filter = NULL) { } else { cols_to_hide <- list() } - - DT::datatable( - out, - rownames = FALSE, - filter = "top", - extensions = c("Buttons", "ColReorder", "Scroller"), - options = list( - columnDefs = cols_to_hide, - searchHighlight = TRUE, - searching = TRUE, - pageLength = 5, - lengthMenu = c(5, 10, 15, 20, 50, 100), - dom = "Bfrtipl", - buttons = list(list( - extend = "colvis", - text = "Choose the columns to display", - scroller = T, - collectionLayout = "fixed two-column" - )), - colReorder = TRUE + htmltools::tagList( + htmltools::htmlDependency( + name = "dt-scroll", + version = "1.0.0", + src = "www", + stylesheet = "style.css", + package = "admiraldev" + ), + DT::datatable( + out, + rownames = FALSE, + filter = "top", + height = "auto", + width = "auto", + extensions = c("Buttons", "ColReorder", "Scroller"), + options = list( + columnDefs = cols_to_hide, + searchHighlight = TRUE, + searching = TRUE, + pageLength = 5, + lengthMenu = c(5, 10, 15, 20, 50, 100), + dom = "ipl>", + buttons = list(list( + extend = "colvis", + text = "Choose the columns to display", + scroller = T, + collectionLayout = "fixed two-column" + )), + colReorder = TRUE + ) ) ) } diff --git a/R/datasets.R b/R/datasets.R index 0b4a84b5..8f46033b 100644 --- a/R/datasets.R +++ b/R/datasets.R @@ -4,7 +4,6 @@ #' #' @return A `data.frame` #' -#' @author Thomas Neitmann #' #' @keywords datasets #' @family datasets diff --git a/R/dev_utilities.R b/R/dev_utilities.R index 91fc9314..658851f4 100644 --- a/R/dev_utilities.R +++ b/R/dev_utilities.R @@ -8,7 +8,6 @@ #' #' @return A `logical` vector #' -#' @author Thomas Neitmann #' #' @keywords dev_utility #' @family dev_utility @@ -24,7 +23,6 @@ #' #' @return `character` vector #' -#' @author Ondrej Slama #' #' @keywords dev_utility #' @family dev_utility @@ -38,7 +36,6 @@ convert_dtm_to_dtc <- function(dtm) { #' #' @param expr An expression created inside a function using `substitute()` #' -#' @author Thomas Neitmann, Ondrej Slama #' #' @return `character` vector #' @@ -50,7 +47,7 @@ arg_name <- function(expr) { # nolint if (length(expr) == 1L && is.symbol(expr)) { deparse(expr) } else if (length(expr) == 2L && - (expr[[1L]] == quote(enquo) || expr[[1L]] == quote(rlang::enquo)) && + (expr[[1L]] == quote(enexpr) || expr[[1L]] == quote(rlang::enexpr)) && is.symbol(expr[[2L]])) { deparse(expr[[2L]]) } else if (is.call(expr) && length(expr) >= 2 && is.symbol(expr[[2]])) { @@ -62,14 +59,13 @@ arg_name <- function(expr) { # nolint } } -#' Extract All Symbols from a List of Quosures +#' Extract All Symbols from a List of Expressions #' #' @param x An `R` object #' @param side One of `"lhs"` (the default) or `"rhs"` #' -#' @return A list of `quosures` +#' @return A list of expressions #' -#' @author Thomas Neitmann #' #' @keywords dev_utility #' @family dev_utility @@ -78,18 +74,13 @@ extract_vars <- function(x, side = "lhs") { if (is.null(x)) { NULL } else if (is.list(x)) { - do.call(quo_c, map(x, extract_vars, side)) - } else if (is_quosure(x)) { - env <- quo_get_env(x) - symbols <- syms(all.vars(quo_get_expr(x))) - map(symbols, ~ quo_set_env(quo(!!.x), env)) + do.call(expr_c, map(x, extract_vars, side)) + } else if (is_expression(x)) { + syms(all.vars(x)) } else if (is_formula(x)) { funs <- list("lhs" = f_lhs, "rhs" = f_rhs) assert_character_scalar(side, values = names(funs)) - quo_set_env( - quo(!!funs[[side]](x)), - env = attr(x, ".Environment") - ) + expr(!!funs[[side]](x)) } else { abort() } @@ -115,28 +106,6 @@ extract_vars <- function(x, side = "lhs") { tryCatch(lhs, error = function(e) rhs) } - -#' Turn a Quosure into a String -#' -#' @details -#' This function is missing in earlier version of {rlang} which is why we re- -#' implement it here. -#' -#' @param x A `quosure` -#' -#' @return A `character` vector -#' -#' @keywords dev_utility -#' @family dev_utility -#' -#' @export -as_name <- function(x) { - if (is_quosure(x)) { - x <- quo_get_expr(x) - } - as_string(x) -} - #' Valid Time Units #' #' Contains the acceptable character vector of valid time units @@ -151,28 +120,29 @@ valid_time_units <- function() { c("years", "months", "days", "hours", "minutes", "seconds") } -#' check that argument contains valid variable(s) created with `vars()` or -#' Source Variables from a List of Quosures +#' check that argument contains valid variable(s) created with `exprs()` or +#' Source Variables from a List of Expressions #' #' @param arg A function argument to be checked #' -#' @return A TRUE if variables were valid variable +#' @return A `TRUE` if variables were valid variable #' #' @export #' #' @keywords dev_utility #' @family dev_utility contains_vars <- function(arg) { - inherits(arg, "quosures") && all(map_lgl(arg, quo_is_symbol) | names(arg) != "") + inherits(arg, "list") && all(map_lgl(arg, is_symbol) | names(arg) != "") } -#' Turn a List of Quosures into a Character Vector +#' Turn a List of Expressions into a Character Vector #' -#' @param quosures A `list` of `quosures` created using [`vars()`] +#' @param expressions A `list` of expressions created using [`exprs()`] +#' +#' @param quosures *Deprecated*, please use `expressions` instead. #' #' @return A character vector #' -#' @author Thomas Neitmann #' #' @export #' @@ -181,12 +151,21 @@ contains_vars <- function(arg) { #' #' @examples #' library(dplyr, warn.conflicts = FALSE) -#' -#' vars2chr(vars(USUBJID, AVAL)) -vars2chr <- function(quosures) { +#' library(rlang) +#' +#' vars2chr(exprs(USUBJID, AVAL)) +vars2chr <- function(expressions, quosures) { + if (!missing(quosures)) { + deprecate_warn( + "0.10.0", + "vars2chr(quosures = )", + "vars2chr(expressions = )" + ) + expressions <- map(quosures, rlang::quo_get_expr) + } rlang::set_names( - map_chr(quosures, ~ as_string(quo_get_expr(.x))), - names(quosures) + map_chr(expressions, as_string), + names(expressions) ) } @@ -195,12 +174,11 @@ vars2chr <- function(quosures) { #' Filters the input dataset if the provided expression is not `NULL` #' #' @param dataset Input dataset -#' @param filter A filter condition. Must be a quosure. +#' @param filter A filter condition. Must be an expression. #' #' @return A `data.frame` containing all rows in `dataset` matching `filter` or #' just `dataset` if `filter` is `NULL` #' -#' @author Thomas Neitmann #' #' @export #' @@ -210,7 +188,7 @@ vars2chr <- function(quosures) { filter_if <- function(dataset, filter) { assert_data_frame(dataset, check_is_grouped = FALSE) assert_filter_cond(filter, optional = TRUE) - if (quo_is_null(filter)) { + if (is.null(filter)) { dataset } else { filter(dataset, !!filter) diff --git a/R/expect_dfs_equal.R b/R/expect_dfs_equal.R index 0e83c0b3..efc995cc 100644 --- a/R/expect_dfs_equal.R +++ b/R/expect_dfs_equal.R @@ -12,7 +12,6 @@ #' @return #' An error if `base` and `compare` do not match or `NULL` invisibly if they do #' -#' @author Thomas Neitmann #' @keywords test_helper #' @family test_helper #' diff --git a/R/get.R b/R/get.R index 53a78a6b..2018ce99 100644 --- a/R/get.R +++ b/R/get.R @@ -35,7 +35,7 @@ get_constant_vars <- function(dataset, by_vars, ignore_vars = NULL) { # get unique values within each group by variables unique_count <- dataset %>% group_by(!!!by_vars) %>% - summarise_at(vars(!!non_by_vars), n_distinct) %>% + summarise(across(!!non_by_vars, n_distinct)) %>% ungroup() %>% select(!!!syms(non_by_vars)) @@ -46,7 +46,7 @@ get_constant_vars <- function(dataset, by_vars, ignore_vars = NULL) { names() %>% syms() - vars(!!!by_vars, !!!constant_vars) + exprs(!!!by_vars, !!!constant_vars) } @@ -72,19 +72,34 @@ get_duplicates <- function(x) { unique(x[duplicated(x)]) } -#' Get Source Variables from a List of Quosures +#' Get Source Variables from a List of Expressions #' -#' @param quosures A list of quosures +#' @param expressions A list of expressions +#' +#' @param quosures *Deprecated*, please use `expressions` instead. #' -#' @author Stefan Bundfuss #' #' @keywords get #' @family get #' -#' @return A list of quosures +#' @return A list of expressions #' @export -get_source_vars <- function(quosures) { - assert_varval_list(quosures, optional = TRUE) +get_source_vars <- function(expressions, quosures) { + if (!missing(quosures)) { + deprecate_warn( + "0.10.0", + "get_source_vars(quosures = )", + "get_source_vars(expressions = )" + ) + expressions <- map(quosures, rlang::quo_get_expr) + } + assert_varval_list(expressions, optional = TRUE) - quo_c(quosures)[lapply(quo_c(quosures), quo_is_symbol) == TRUE] + source_vars <- expr_c(expressions)[lapply(expr_c(expressions), is.symbol) == TRUE] + + if (length(source_vars) == 0) { + NULL + } else { + source_vars + } } diff --git a/R/global.R b/R/global.R index 7e73db53..387062b7 100644 --- a/R/global.R +++ b/R/global.R @@ -5,5 +5,6 @@ globalVariables(c( "_unit", "auto", "name", - "PARAMCD" + "PARAMCD", + "where" # this entry should be moved to @importFrom tidyselect once we use tidyselect 1.2.0 )) diff --git a/R/is.R b/R/is.R index d74799d9..6ca52d68 100644 --- a/R/is.R +++ b/R/is.R @@ -16,21 +16,20 @@ is_named <- function(x) { #' #' @param arg argument to check #' -#' @return `TRUE` if the argument equals the auto keyword, i.e., it is a quosure -#' of a symbol named auto. +#' @return `TRUE` if the argument equals the auto keyword, i.e., it is an +#' expression of a symbol named auto. #' -#' @author Stefan Bundfuss #' #' @keywords is #' @family is #' @export is_auto <- function(arg) { - is_quosure(arg) && quo_is_symbol(arg) && quo_get_expr(arg) == expr(auto) + is_symbol(arg) && arg == expr(auto) } #' Is order vars? #' -#' Check if inputs are created using `vars()` or calls involving `desc()` +#' Check if inputs are created using `exprs()` or calls involving `desc()` #' @param arg An R object #' #' @return `FALSE` if the argument is not a list of order vars @@ -40,16 +39,15 @@ is_auto <- function(arg) { #' @keywords is #' @family is is_order_vars <- function(arg) { - quo_is_desc_call <- function(quo) { - expr <- quo_get_expr(quo) + is_desc_call <- function(expr) { is_call(expr) && length(expr) == 2L && deparse(expr[[1L]]) == "desc" && is_symbol(expr[[2L]]) } - inherits(arg, "quosures") && - all(map_lgl(arg, ~ quo_is_symbol(.x) || quo_is_desc_call(.x))) + inherits(arg, "list") && + all(map_lgl(arg, ~ is.symbol(.x) || is_desc_call(.x))) } #' Is this string a valid DTC diff --git a/R/process_set_values_to.R b/R/process_set_values_to.R new file mode 100644 index 00000000..9d703774 --- /dev/null +++ b/R/process_set_values_to.R @@ -0,0 +1,115 @@ +#' Process `set_values_to` Argument +#' +#' The function creates the variables specified by the `set_values_to` argument, +#' catches errors, provides user friendly error messages, and optionally checks +#' the type of the created variables. +#' +#' @param dataset Input dataset +#' +#' @param set_values_to Variables to set +#' +#' A named list returned by `exprs()` defining the variables to be set, e.g. +#' `exprs(PARAMCD = "OS", PARAM = "Overall Survival")` is expected. The values +#' must be symbols, character strings, numeric values, expressions, or `NA`. +#' +#' @param expected_types +#' +#' If the argument is specified, the specified variables are checked whether +#' the specified type matches the type of the variables created by +#' `set_values_to`. +#' +#' *Permitted Values*: A character vector with values `"numeric"` or +#' `"character"` +#' +#' +#' @return The input dataset with the variables specified by `set_values_to` +#' added/updated +#' +#' @family utils_help +#' @keywords utils_help +#' +#' @export +#' +#' @examples +#' library(tibble) +#' data <- tribble( +#' ~AVAL, +#' 20 +#' ) +#' +#' try( +#' process_set_values_to( +#' data, +#' set_values_to = exprs( +#' PARAMCD = BMI +#' ) +#' ) +#' ) +#' +#' try( +#' process_set_values_to( +#' data, +#' set_values_to = exprs( +#' PARAMCD = 42 +#' ), +#' expected_types = c(PARAMCD = "character") +#' ) +#' ) +process_set_values_to <- function(dataset, + set_values_to, + expected_types = NULL) { + assert_data_frame(dataset) + assert_varval_list(set_values_to, accept_expr = TRUE) + assert_character_vector( + expected_types, + values = c("numeric", "character"), + named = TRUE, + optional = TRUE + ) + + tryCatch( + result <- mutate(dataset, !!!set_values_to), + error = function(cnd) { + abort( + paste0( + "Assigning variables failed!\n", + "set_values_to = (\n", + paste( + " ", + names(set_values_to), + "=", + set_values_to, + collapse = "\n" + ), + "\n)\nError message:\n ", + cnd + ) + ) + } + ) + if (!is.null(expected_types)) { + types <- map_chr(result, typeof) %>% + map_chr(function(x) if_else(x %in% c("integer", "double"), "numeric", x)) + vars_to_check <- intersect(names(set_values_to), names(expected_types)) + if (length(vars_to_check) > 0) { + actual <- types[vars_to_check] + expected <- expected_types[vars_to_check] + unexpected <- actual != expected + if (any(unexpected)) { + abort(paste0( + "The following variables have an unexpected type:\n", + paste0( + names(actual[unexpected]), + ": expected: ", + expected[unexpected], + ", actual: ", + actual[unexpected], + collapse = "\n" + ), + sep = "\n" + )) + } + } + } + result +} diff --git a/R/quo.R b/R/quo.R index 6386f2a1..17055e66 100644 --- a/R/quo.R +++ b/R/quo.R @@ -1,35 +1,72 @@ #' Concatenate One or More Quosure(s) #' +#' `r lifecycle::badge("deprecated")` +#' +#' This function is *deprecated*, please use `expr_c()` instead. +#' #' @param ... One or more objects of class `quosure` or `quosures` #' #' @return An object of class `quosures` #' -#' @author Thomas Neitmann #' #' @keywords quo #' @family quo #' #' @export quo_c <- function(...) { + deprecate_warn( + "0.10.0", + "quo_c()", + "expr_c()", + details = paste( + "Expressions created by `exprs()` must be used", + "instead of quosures created by `vars()`." + ) + ) inputs <- unlist(list(...), recursive = TRUE) stopifnot(all(map_lgl(inputs, is_quosure))) is_null <- map_lgl(inputs, quo_is_null) rlang::as_quosures(inputs[!is_null]) } +#' Concatenate One or More Expressions +#' +#' @param ... One or more expressions or list of expressions +#' +#' @return A list of expressions +#' +#' @keywords quo +#' @family quo +#' +#' @export +expr_c <- function(...) { + inputs <- unlist(list(...), recursive = TRUE) + stopifnot(all(map_lgl(inputs, is_expression))) + is_null <- map_lgl(inputs, is.null) + inputs[!is_null] +} + #' Check Whether an Argument Is Not a Quosure of a Missing Argument #' #' @param x Test object #' #' @return TRUE or error. #' -#' @author Thomas Neitmann, Ondrej Slama #' #' @keywords quo #' @family quo #' #' @export quo_not_missing <- function(x) { + deprecate_warn( + "0.3.0", + "quo_not_missing()", + details = paste( + "Due to changing from `vars()` to `exprs()` the function is no longer required.", + "It will be removed in future.", + sep = "\n" + ) + ) !rlang::quo_is_missing(x) if (is.null(missing(x)) || quo_is_missing(x)) { @@ -42,34 +79,41 @@ quo_not_missing <- function(x) { } -#' Replace Quosure Value with Name +#' Replace Expression Value with Name +#' +#' @param expressions A list of expressions #' -#' @param quosures A list of quosures +#' @param quosures *Deprecated*, please use `expressions` instead. #' -#' @author Thomas Neitmann #' #' @keywords quo #' @family quo #' #' -#' @return A list of quosures +#' @return A list of expressions #' @export -replace_values_by_names <- function(quosures) { - vars <- map2(quosures, names(quosures), function(q, n) { +replace_values_by_names <- function(expressions, quosures) { + if (!missing(quosures)) { + deprecate_warn( + "0.10.0", + "replace_values_by_names(quosures = )", + "replace_values_by_names(expressions = )" + ) + expressions <- map(quosures, rlang::quo_get_expr) + } + map2(expressions, names(expressions), function(e, n) { if (n == "") { - return(q) + return(e) } - quo_set_env( - quo(!!as.symbol(n)), - quo_get_env(q) - ) + as.symbol(n) }) - structure(vars, class = "quosures", names = NULL) } #' Replace Symbols in a Quosure #' -#' Replace symbols in a quosure +#' `r lifecycle::badge("deprecated")` +#' +#' This function is *deprecated*, please use `replace_symbol_in_expr()` instead. #' #' @param quosure Quosure #' @@ -77,64 +121,94 @@ replace_values_by_names <- function(quosures) { #' #' @param replace Replacing symbol #' -#' @author Stefan Bundfuss #' -#' @return The quosure where every occurence of the symbol `target` is replaced +#' @return The quosure where every occurrence of the symbol `target` is replaced #' by `replace` #' #' @keywords quo #' @family quo #' #' @export +replace_symbol_in_quo <- function(quosure, + target, + replace) { + deprecate_stop( + "0.10.0", + "replace_symbol_in_quo()", + "replace_symbol_in_expr()", + details = paste( + "Expressions created by `exprs()` must be used", + "instead of quosures created by `vars()`." + ) + ) +} + +#' Replace Symbols in an Expression +#' +#' Replace symbols in an expression +#' +#' @param expression Expression +#' +#' @param target Target symbol +#' +#' @param replace Replacing symbol +#' +#' @author Stefan Bundfuss +#' +#' @return The expression where every occurrence of the symbol `target` is +#' replaced by `replace` +#' +#' @keywords quo +#' @family quo +#' +#' @export #' #' @examples #' #' library(rlang) #' -#' replace_symbol_in_quo(quo(AVAL), target = AVAL, replace = AVAL.join) -#' replace_symbol_in_quo(quo(AVALC), target = AVAL, replace = AVAL.join) -#' replace_symbol_in_quo(quo(desc(AVAL)), target = AVAL, replace = AVAL.join) -replace_symbol_in_quo <- function(quosure, - target, - replace) { - assert_expr(quosure) - target <- quo_get_expr(assert_symbol(enquo(target))) - replace <- quo_get_expr(assert_symbol(enquo(replace))) - expr <- quo_get_expr(quosure) - if (is.symbol(expr)) { - if (expr == target) { - expr <- replace +#' replace_symbol_in_expr(expr(AVAL), target = AVAL, replace = AVAL.join) +#' replace_symbol_in_expr(expr(AVALC), target = AVAL, replace = AVAL.join) +#' replace_symbol_in_expr(expr(desc(AVAL)), target = AVAL, replace = AVAL.join) +replace_symbol_in_expr <- function(expression, + target, + replace) { + assert_expr(expression) + target <- assert_symbol(enexpr(target)) + replace <- assert_symbol(enexpr(replace)) + if (is.symbol(expression)) { + if (expression == target) { + expression <- replace } } else { - for (i in seq_along(quosure)) { - if (expr[[i]] == target) { - expr[[i]] <- replace + for (i in seq_along(expression)) { + if (expression[[i]] == target) { + expression[[i]] <- replace } } } - rlang::quo_set_expr(quosure, expr) + expression } -#' Add a Suffix to Variables in a List of Quosures +#' Add a Suffix to Variables in a List of Expressions #' -#' Add a suffix to variables in a list of quosures +#' Add a suffix to variables in a list of expressions #' -#' @param order List of quosures +#' @param order List of expressions #' #' *Permitted Values*: list of variables or `desc()` function calls -#' created by `vars()`, e.g., `vars(ADT, desc(AVAL))` +#' created by `exprs()`, e.g., `exprs(ADT, desc(AVAL))` #' #' @param vars Variables to change #' -#' *Permitted Values*: list of variables created by `vars()` +#' *Permitted Values*: list of variables created by `exprs()` #' #' @param suffix Suffix #' #' *Permitted Values*: A character scalar #' -#' @author Stefan Bundfuss #' -#' @return The list of quosures where for each element the suffix (`suffix`) is +#' @return The list of expression where for each element the suffix (`suffix`) is #' added to every symbol specified for `vars` #' #' @keywords quo @@ -144,8 +218,9 @@ replace_symbol_in_quo <- function(quosure, #' #' @examples #' library(dplyr, warn.conflicts = FALSE) +#' library(rlang) #' -#' add_suffix_to_vars(vars(ADT, desc(AVAL), AVALC), vars = vars(AVAL), suffix = ".join") +#' add_suffix_to_vars(exprs(ADT, desc(AVAL), AVALC), vars = exprs(AVAL), suffix = ".join") add_suffix_to_vars <- function(order, vars, suffix) { @@ -155,13 +230,10 @@ add_suffix_to_vars <- function(order, for (i in seq_along(vars)) { order <- lapply( order, - replace_symbol_in_quo, - target = !!quo_get_expr(vars[[i]]), - replace = !!sym(paste0(as_label( - quo_get_expr(vars[[i]]) - ), suffix)) + replace_symbol_in_expr, + target = !!vars[[i]], + replace = !!sym(paste0(as_label(vars[[i]]), suffix)) ) } - class(order) <- c("quosures", "list") order } diff --git a/R/quote.R b/R/quote.R index cfb3d25e..ae0a5b99 100644 --- a/R/quote.R +++ b/R/quote.R @@ -1,18 +1,28 @@ -#' Enumerate Multiple Strings +#' Enumerate Multiple Elements #' -#' @param x A `character` vector -#' @param quote_fun Quoting function, defaults to `backquote`. -#' @param conjunction Character to be used in the message, defaults to "and". +#' Enumerate multiple elements of a vector or list. +#' +#' @param x A vector or list +#' @param quote_fun Quoting function, defaults to `backquote`. If set to `NULL`, +#' the elements are not quoted. +#' @param conjunction Character to be used in the message, defaults to `"and"`. #' -#' @author Thomas Neitmann #' #' @return A `character` vector #' #' @keywords quote #' @family quote #' +#' @examples +#' enumerate(c("one", "two", "three")) +#' +#' enumerate(c(1, 2, 3), quote_fun = NULL) +#' #' @export enumerate <- function(x, quote_fun = backquote, conjunction = "and") { + if (is.null(quote_fun)) { + quote_fun <- function(x) x + } if (length(x) == 1L) { quote_fun(x) } else { @@ -28,7 +38,6 @@ enumerate <- function(x, quote_fun = backquote, conjunction = "and") { #' #' @param x A `character` vector #' -#' @author Thomas Neitmann #' #' @return A `character` vector #' @@ -44,7 +53,6 @@ backquote <- function(x) { #' #' @param x A `character` vector #' -#' @author Thomas Neitmann #' #' @return A `character` vector #' @@ -66,7 +74,6 @@ squote <- function(x) { #' @return If the input is `NULL`, the text `"NULL"` is returned. Otherwise, the #' input in double quotes is returned. #' -#' @author Stefan Bundfuss #' #' @keywords quote #' @family quote diff --git a/R/warnings.R b/R/warnings.R index 279d1973..13a905e5 100644 --- a/R/warnings.R +++ b/R/warnings.R @@ -7,7 +7,6 @@ #' #' @return No return value, called for side effects #' -#' @author Thomas Neitmann #' #' @keywords warnings #' @family warnings @@ -46,7 +45,6 @@ warn_if_vars_exist <- function(dataset, vars) { #' #' @return No return value, called for side effects #' -#' @author Samia Kabi #' #' @keywords warnings #' @family warnings @@ -119,8 +117,7 @@ warn_if_incomplete_dtc <- function(dtc, n) { "The function ", funtext, " expect a complete ", dt_dtm, ". ", "Please use the function `impute_dtc()` to build a complete ", dt_dtm, "." ) - warn(msg) - warn(paste(capture.output(print(tbl)), collapse = "\n")) + warn(paste(msg, capture.output(print(tbl)), collapse = "\n")) } } @@ -139,7 +136,6 @@ warn_if_incomplete_dtc <- function(dtc, n) { #' #' @param i the index id to compare the 2 lists #' -#' @author Samia Kabi #' #' @return a `warning` if the 2 lists have different names or length #' @@ -150,17 +146,18 @@ warn_if_incomplete_dtc <- function(dtc, n) { #' #' @examples #' library(dplyr, warn.conflicts = FALSE) +#' library(rlang) #' #' # no warning #' warn_if_inconsistent_list( -#' base = vars(DTHDOM = "DM", DTHSEQ = DMSEQ), -#' compare = vars(DTHDOM = "DM", DTHSEQ = DMSEQ), +#' base = exprs(DTHDOM = "DM", DTHSEQ = DMSEQ), +#' compare = exprs(DTHDOM = "DM", DTHSEQ = DMSEQ), #' list_name = "Test" #' ) #' # warning #' warn_if_inconsistent_list( -#' base = vars(DTHDOM = "DM", DTHSEQ = DMSEQ, DTHVAR = "text"), -#' compare = vars(DTHDOM = "DM", DTHSEQ = DMSEQ), +#' base = exprs(DTHDOM = "DM", DTHSEQ = DMSEQ, DTHVAR = "text"), +#' compare = exprs(DTHDOM = "DM", DTHSEQ = DMSEQ), #' list_name = "Test" #' ) warn_if_inconsistent_list <- function(base, compare, list_name, i = 2) { @@ -190,10 +187,6 @@ warn_if_inconsistent_list <- function(base, compare, list_name, i = 2) { #' #' @param regexpr Regular expression matching warnings to suppress #' -#' @author -#' - Thomas Neitmann -#' - Stefan Bundfuss -#' #' @return Return value of the expression #' #' @keywords warnings diff --git a/R/what.R b/R/what.R index 41dc13ea..575f6652 100644 --- a/R/what.R +++ b/R/what.R @@ -6,7 +6,6 @@ #' #' @return A `character` description of the type of `x` #' -#' @author Thomas Neitmann #' #' @keywords what #' @family what diff --git a/README.Rmd b/README.Rmd index 44daca01..eb397bdb 100644 --- a/README.Rmd +++ b/README.Rmd @@ -32,7 +32,7 @@ admiral_homepage <- "https://pharmaverse.github.io/admiral" # admiraldev -ADaM in R Asset Library Development Utilities +Utility Functions and Development Tools for the Admiral Package Family @@ -41,9 +41,9 @@ ADaM in R Asset Library Development Utilities ## Purpose -Tools for developing functions and maintaining a healthy code base within the family of admiral R packages. `{admiraldev}` is intended to be used when developing `{admiral}` or `{admiral}` extension packages. +Functions and Tools for developing core `{admiral}` functions. Most functions in `{admiraldev}` are around testing inputs going into `{admiral}` functions. There are also additional quality of life functions/Addins to assist developers of `{admiral}` or `{admiral}` extension packages as well as functions to help with rendering documentation. -**NOTE:** This package is not intended for standalone use but rather as a central dependency for all developer utilities of `{admiral}` and its extension packages +**NOTE:** This package is not intended for standalone use but rather as a central dependency for `{admiral}` and its extension packages ## Installation diff --git a/README.md b/README.md index 69eaf654..d4566c2a 100644 --- a/README.md +++ b/README.md @@ -2,7 +2,7 @@ # admiraldev -ADaM in R Asset Library Development Utilities +Utility Functions and Development Tools for the Admiral Package Family @@ -10,13 +10,15 @@ ADaM in R Asset Library Development Utilities ## Purpose -Tools for developing functions and maintaining a healthy code base -within the family of admiral R packages. `{admiraldev}` is intended to -be used when developing `{admiral}` or `{admiral}` extension packages. +Functions and Tools for developing core `{admiral}` functions. Most +functions in `{admiraldev}` are around testing inputs going into +`{admiral}` functions. There are also additional quality of life +functions/Addins to assist developers of `{admiral}` or `{admiral}` +extension packages as well as functions to help with rendering +documentation. __NOTE:__ This package is not intended for standalone use but rather as -a central dependency for all developer utilities of `{admiral}` and its -extension packages +a central dependency for `{admiral}` and its extension packages ## Installation diff --git a/_pkgdown.yml b/_pkgdown.yml index 0d231f0a..1ed36a31 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -1,4 +1,4 @@ -url: https://pharmaverse.github.io/admiraldev/devel/ +url: https://pharmaverse.github.io/admiraldev template: bootstrap: 5 @@ -64,6 +64,10 @@ reference: contents: - has_keyword('quote') +- subtitle: Utilities used within Derivation Functions + contents: + - has_keyword('utils_help') + - title: Join Functions desc: dplyr join function without warning about different attributes contents: diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 7edab153..e1010f62 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -1,5 +1,5 @@ -pandoc: '2.18' -pkgdown: 2.0.3 +pandoc: 2.17.1.1 +pkgdown: 2.0.6 pkgdown_sha: ~ articles: admiraldev: admiraldev.html @@ -10,7 +10,7 @@ articles: release_strategy: release_strategy.html unit_test_guidance: unit_test_guidance.html writing_vignettes: writing_vignettes.html -last_built: 2022-11-08T06:16Z +last_built: 2023-01-19T10:49Z urls: reference: https://pharmaverse.github.io/admiraldev/devel/reference article: https://pharmaverse.github.io/admiraldev/devel/articles diff --git a/inst/WORDLIST b/inst/WORDLIST index 50b14099..100c7409 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -1,36 +1,86 @@ -ADXX +ADSL +ADT ADaM -Biologics +ADaMs +AEs +Addin +Addins +BDS CDISC CMD Changelog -DM -Farrugia -GSK -Hoch +Codebase +Cyclomatic +DTC +Datetime +Github +GlaxoSmithKline +Hoffmann +IG +LLC LinkedIn -Onboarding -README +Modularity +OCCDS +PRs +Pandoc +Pharma +Quosure +Quosures +ROxygen +RStudio +Roxygen SDTM TAs -Template’ -USUBJIDs -adam -adamig +TOC +TTE +USUBJID +VSDTC +VSTESTCD addin -admiraltemplate -admiralxxx -admiraldev -anonymized -cdisc +adex +adlb +admiralci +advs codebase +cyclomatic +datatable +datetime +datetimes dev +developers’ +dplyr +dropdown +dtc +exprs +flexibilities +functions’ +funder github -https -onboarding -pharmaverse -renv +hotfixes +hotfix +insightsengineering +lifecycle +linter +lintr +lockfile +occds +optionality +pkgs +pre +proc +quosure +quosures repo +reproducibility roxygen -www -th +styler +testthat +tibble +tidyverse +ungrouped +unmerged +unstyled +useR +validatoR +xxxx +yyyyy diff --git a/inst/www/style.css b/inst/www/style.css new file mode 100644 index 00000000..2dc98412 --- /dev/null +++ b/inst/www/style.css @@ -0,0 +1,16 @@ +.dt-scroll { + overflow-x: auto; + width: 100%; + max-height: 600px; +} +.dt-scroll .dataTable thead tr th, +.dt-scroll thead tr td { + position: sticky; + background-color: #FFFFFF; +} +.dt-scroll thead tr th { + top: 0; +} +.dt-scroll thead tr td { + top: 2.45em; +} diff --git a/man/add_suffix_to_vars.Rd b/man/add_suffix_to_vars.Rd index 2f9a591a..8d561d7a 100644 --- a/man/add_suffix_to_vars.Rd +++ b/man/add_suffix_to_vars.Rd @@ -2,45 +2,45 @@ % Please edit documentation in R/quo.R \name{add_suffix_to_vars} \alias{add_suffix_to_vars} -\title{Add a Suffix to Variables in a List of Quosures} +\title{Add a Suffix to Variables in a List of Expressions} \usage{ add_suffix_to_vars(order, vars, suffix) } \arguments{ -\item{order}{List of quosures +\item{order}{List of expressions \emph{Permitted Values}: list of variables or \verb{desc()} function calls -created by \code{vars()}, e.g., \code{vars(ADT, desc(AVAL))}} +created by \code{exprs()}, e.g., \code{exprs(ADT, desc(AVAL))}} \item{vars}{Variables to change -\emph{Permitted Values}: list of variables created by \code{vars()}} +\emph{Permitted Values}: list of variables created by \code{exprs()}} \item{suffix}{Suffix \emph{Permitted Values}: A character scalar} } \value{ -The list of quosures where for each element the suffix (\code{suffix}) is +The list of expression where for each element the suffix (\code{suffix}) is added to every symbol specified for \code{vars} } \description{ -Add a suffix to variables in a list of quosures +Add a suffix to variables in a list of expressions } \examples{ library(dplyr, warn.conflicts = FALSE) +library(rlang) -add_suffix_to_vars(vars(ADT, desc(AVAL), AVALC), vars = vars(AVAL), suffix = ".join") +add_suffix_to_vars(exprs(ADT, desc(AVAL), AVALC), vars = exprs(AVAL), suffix = ".join") } \seealso{ Helpers for working with Quosures: +\code{\link{expr_c}()}, \code{\link{quo_c}()}, \code{\link{quo_not_missing}()}, +\code{\link{replace_symbol_in_expr}()}, \code{\link{replace_symbol_in_quo}()}, \code{\link{replace_values_by_names}()} } -\author{ -Stefan Bundfuss -} \concept{quo} \keyword{quo} diff --git a/man/admiraldev-package.Rd b/man/admiraldev-package.Rd index ce0bf3bc..e8c6db91 100644 --- a/man/admiraldev-package.Rd +++ b/man/admiraldev-package.Rd @@ -4,7 +4,7 @@ \name{admiraldev-package} \alias{admiraldev} \alias{admiraldev-package} -\title{admiraldev: Development Tools for the Admiral Package Family} +\title{admiraldev: Utility Functions and Development Tools for the Admiral Package Family} \description{ \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} diff --git a/man/arg_name.Rd b/man/arg_name.Rd index d9bed423..78fd3c79 100644 --- a/man/arg_name.Rd +++ b/man/arg_name.Rd @@ -19,7 +19,6 @@ Extract Argument Name from an Expression Developer Utility Functions: \code{\link{\%notin\%}()}, \code{\link{\%or\%}()}, -\code{\link{as_name}()}, \code{\link{contains_vars}()}, \code{\link{convert_dtm_to_dtc}()}, \code{\link{extract_vars}()}, @@ -27,8 +26,5 @@ Developer Utility Functions: \code{\link{valid_time_units}()}, \code{\link{vars2chr}()} } -\author{ -Thomas Neitmann, Ondrej Slama -} \concept{dev_utility} \keyword{dev_utility} diff --git a/man/as_name.Rd b/man/as_name.Rd deleted file mode 100644 index 7cc604de..00000000 --- a/man/as_name.Rd +++ /dev/null @@ -1,35 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/dev_utilities.R -\name{as_name} -\alias{as_name} -\title{Turn a Quosure into a String} -\usage{ -as_name(x) -} -\arguments{ -\item{x}{A \code{quosure}} -} -\value{ -A \code{character} vector -} -\description{ -Turn a Quosure into a String -} -\details{ -This function is missing in earlier version of {rlang} which is why we re- -implement it here. -} -\seealso{ -Developer Utility Functions: -\code{\link{\%notin\%}()}, -\code{\link{\%or\%}()}, -\code{\link{arg_name}()}, -\code{\link{contains_vars}()}, -\code{\link{convert_dtm_to_dtc}()}, -\code{\link{extract_vars}()}, -\code{\link{filter_if}()}, -\code{\link{valid_time_units}()}, -\code{\link{vars2chr}()} -} -\concept{dev_utility} -\keyword{dev_utility} diff --git a/man/assert_atomic_vector.Rd b/man/assert_atomic_vector.Rd index 9dc6ae85..aa5c2549 100644 --- a/man/assert_atomic_vector.Rd +++ b/man/assert_atomic_vector.Rd @@ -55,8 +55,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Ania Golab -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_character_scalar.Rd b/man/assert_character_scalar.Rd index a312669c..b66ce00a 100644 --- a/man/assert_character_scalar.Rd +++ b/man/assert_character_scalar.Rd @@ -85,8 +85,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Thomas Neitmann -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_character_vector.Rd b/man/assert_character_vector.Rd index 8927ad57..ec9a33c6 100644 --- a/man/assert_character_vector.Rd +++ b/man/assert_character_vector.Rd @@ -4,13 +4,16 @@ \alias{assert_character_vector} \title{Is an Argument a Character Vector?} \usage{ -assert_character_vector(arg, values = NULL, optional = FALSE) +assert_character_vector(arg, values = NULL, named = FALSE, optional = FALSE) } \arguments{ \item{arg}{A function argument to be checked} \item{values}{A \code{character} vector of valid values for \code{arg}} +\item{named}{If set to \code{TRUE}, an error is issued if not all elements of the +vector are named.} + \item{optional}{Is the checked parameter optional? If set to \code{FALSE} and \code{arg} is \code{NULL} then an error is thrown} } @@ -30,6 +33,12 @@ example_fun <- function(chr) { example_fun(letters) try(example_fun(1:10)) + +example_fun2 <- function(chr) { + assert_character_vector(chr, named = TRUE) +} + +try(example_fun2(c(alpha = "a", "b", gamma = "c"))) } \seealso{ Checks for valid input and returns warning or errors messages: @@ -58,8 +67,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Thomas Neitmann -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_data_frame.Rd b/man/assert_data_frame.Rd index a2faa0d2..cae983bc 100644 --- a/man/assert_data_frame.Rd +++ b/man/assert_data_frame.Rd @@ -14,7 +14,7 @@ assert_data_frame( \arguments{ \item{arg}{A function argument to be checked} -\item{required_vars}{A list of variables created using \code{vars()}} +\item{required_vars}{A list of variables created using \code{exprs()}} \item{check_is_grouped}{Throw an error is \code{dataset} is grouped? Defaults to \code{TRUE}.} @@ -33,10 +33,11 @@ a set of required variables \examples{ library(admiral.test) library(dplyr, warn.conflicts = FALSE) +library(rlang) data(admiral_dm) example_fun <- function(dataset) { - assert_data_frame(dataset, required_vars = vars(STUDYID, USUBJID)) + assert_data_frame(dataset, required_vars = exprs(STUDYID, USUBJID)) } example_fun(admiral_dm) @@ -72,8 +73,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Thomas Neitmann -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_date_var.Rd b/man/assert_date_var.Rd index 93feaf8e..853fb6c7 100644 --- a/man/assert_date_var.Rd +++ b/man/assert_date_var.Rd @@ -30,7 +30,7 @@ library(lubridate) library(rlang) example_fun <- function(dataset, var) { - var <- assert_symbol(enquo(var)) + var <- assert_symbol(enexpr(var)) assert_date_var(dataset = dataset, var = !!var) } @@ -51,7 +51,7 @@ try(example_fun( )) example_fun2 <- function(dataset, var) { - var <- assert_symbol(enquo(var)) + var <- assert_symbol(enexpr(var)) assert_date_var( dataset = dataset, var = !!var, @@ -65,7 +65,4 @@ try(example_fun2( var = USUBJID )) } -\author{ -Stefan Bundfuss -} \keyword{assertion} diff --git a/man/assert_date_vector.Rd b/man/assert_date_vector.Rd index 442afa65..bdf9de22 100644 --- a/man/assert_date_vector.Rd +++ b/man/assert_date_vector.Rd @@ -4,7 +4,7 @@ \alias{assert_date_vector} \title{Is an object a date or datetime vector?} \usage{ -assert_date_vector(arg, optional = TRUE) +assert_date_vector(arg, optional = FALSE) } \arguments{ \item{arg}{The function argument to be checked} @@ -56,8 +56,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Sadchla Mascary -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_filter_cond.Rd b/man/assert_filter_cond.Rd index 5abd7f69..69ac111b 100644 --- a/man/assert_filter_cond.Rd +++ b/man/assert_filter_cond.Rd @@ -65,8 +65,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Ondrej Slama -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_function.Rd b/man/assert_function.Rd index 1f82f577..34fac421 100644 --- a/man/assert_function.Rd +++ b/man/assert_function.Rd @@ -65,8 +65,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Stefan Bundfuss -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_has_variables.Rd b/man/assert_has_variables.Rd index 578653af..73b09b6e 100644 --- a/man/assert_has_variables.Rd +++ b/man/assert_has_variables.Rd @@ -53,8 +53,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Thomas Neitmann -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_integer_scalar.Rd b/man/assert_integer_scalar.Rd index 5014f8c6..1157d866 100644 --- a/man/assert_integer_scalar.Rd +++ b/man/assert_integer_scalar.Rd @@ -63,8 +63,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Thomas Neitmann -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_list_element.Rd b/man/assert_list_element.Rd index f93386a4..40018e9d 100644 --- a/man/assert_list_element.Rd +++ b/man/assert_list_element.Rd @@ -66,8 +66,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Stefan Bundfuss -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_list_of.Rd b/man/assert_list_of.Rd index 8c1e3826..9b481c2c 100644 --- a/man/assert_list_of.Rd +++ b/man/assert_list_of.Rd @@ -2,25 +2,28 @@ % Please edit documentation in R/assertions.R \name{assert_list_of} \alias{assert_list_of} -\title{Is an Argument a List of Objects of a Specific S3 Class?} +\title{Is an Argument a List of Objects of a Specific S3 Class or Type?} \usage{ -assert_list_of(arg, class, optional = TRUE) +assert_list_of(arg, class, named = FALSE, optional = TRUE) } \arguments{ \item{arg}{A function argument to be checked} -\item{class}{The S3 class to check for} +\item{class}{The S3 class or type to check for} + +\item{named}{If set to \code{TRUE}, an error is issued if not all elements of the +list are named.} \item{optional}{Is the checked parameter optional? If set to \code{FALSE} and \code{arg} is \code{NULL} then an error is thrown} } \value{ -The function throws an error if \code{arg} is not a list or if \code{arg} is a list but its -elements are not objects inheriting from \code{class}. Otherwise, the input is returned -invisibly. +The function throws an error if \code{arg} is not a list or if \code{arg} is a list but +its elements are not objects inheriting from \code{class} or of type \code{class}. +Otherwise, the input is returned invisibly. } \description{ -Checks if an argument is a \code{list} of objects inheriting from the S3 class specified. +Checks if an argument is a \code{list} of objects inheriting from the S3 class or type specified. } \examples{ example_fun <- function(list) { @@ -32,6 +35,11 @@ example_fun(list(mtcars, iris)) try(example_fun(list(letters, 1:10))) try(example_fun(c(TRUE, FALSE))) + +example_fun2 <- function(list) { + assert_list_of(list, "numeric", named = TRUE) +} +try(example_fun2(list(1, 2, 3, d = 4))) } \seealso{ Checks for valid input and returns warning or errors messages: @@ -60,8 +68,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Thomas Neitmann -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_logical_scalar.Rd b/man/assert_logical_scalar.Rd index b89908fc..1bab8367 100644 --- a/man/assert_logical_scalar.Rd +++ b/man/assert_logical_scalar.Rd @@ -61,8 +61,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Thomas Neitmann, Stefan Bundfuss -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_numeric_vector.Rd b/man/assert_numeric_vector.Rd index c037a952..ed6f7ffa 100644 --- a/man/assert_numeric_vector.Rd +++ b/man/assert_numeric_vector.Rd @@ -55,8 +55,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Stefan Bundfuss -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_one_to_one.Rd b/man/assert_one_to_one.Rd index a1608838..bdf6aa6f 100644 --- a/man/assert_one_to_one.Rd +++ b/man/assert_one_to_one.Rd @@ -48,8 +48,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Stefan Bundfuss -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_order_vars.Rd b/man/assert_order_vars.Rd index 52cd087a..b24e9794 100644 --- a/man/assert_order_vars.Rd +++ b/man/assert_order_vars.Rd @@ -14,10 +14,10 @@ is \code{NULL} then an error is thrown} } \value{ The function throws an error if \code{arg} is not a list of variables or \code{desc()} -calls created using \code{vars()} and returns the input invisibly otherwise. +calls created using \code{exprs()} and returns the input invisibly otherwise. } \description{ -Checks if an argument is a valid list of order variables created using \code{vars()} +Checks if an argument is a valid list of order variables created using \code{exprs()} } \examples{ library(dplyr, warn.conflicts = FALSE) @@ -27,13 +27,13 @@ example_fun <- function(by_vars) { assert_order_vars(by_vars) } -example_fun(vars(USUBJID, PARAMCD, desc(AVISITN))) +example_fun(exprs(USUBJID, PARAMCD, desc(AVISITN))) -try(example_fun(exprs(USUBJID, PARAMCD))) +try(example_fun(quos(USUBJID, PARAMCD))) try(example_fun(c("USUBJID", "PARAMCD", "VISIT"))) -try(example_fun(vars(USUBJID, toupper(PARAMCD), -AVAL))) +try(example_fun(exprs(USUBJID, toupper(PARAMCD), -AVAL))) } \seealso{ Checks for valid input and returns warning or errors messages: @@ -62,8 +62,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Stefan Bundfuss -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_param_does_not_exist.Rd b/man/assert_param_does_not_exist.Rd index 3f0d0d3e..9ce0c1f2 100644 --- a/man/assert_param_does_not_exist.Rd +++ b/man/assert_param_does_not_exist.Rd @@ -55,8 +55,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Stefan Bundfuss -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_s3_class.Rd b/man/assert_s3_class.Rd index cf5e3bb4..3243e551 100644 --- a/man/assert_s3_class.Rd +++ b/man/assert_s3_class.Rd @@ -4,7 +4,7 @@ \alias{assert_s3_class} \title{Is an Argument an Object of a Specific S3 Class?} \usage{ -assert_s3_class(arg, class, optional = TRUE) +assert_s3_class(arg, class, optional = FALSE) } \arguments{ \item{arg}{A function argument to be checked} @@ -59,8 +59,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Thomas Neitmann -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_same_type.Rd b/man/assert_same_type.Rd index 34683f76..639e5033 100644 --- a/man/assert_same_type.Rd +++ b/man/assert_same_type.Rd @@ -59,8 +59,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Stefan Bundfuss -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_symbol.Rd b/man/assert_symbol.Rd index dd1a8a52..c92dd72b 100644 --- a/man/assert_symbol.Rd +++ b/man/assert_symbol.Rd @@ -7,7 +7,7 @@ assert_symbol(arg, optional = FALSE) } \arguments{ -\item{arg}{A function argument to be checked. Must be a \code{quosure}. See examples.} +\item{arg}{A function argument to be checked. Must be a \code{symbol}. See examples.} \item{optional}{Is the checked parameter optional? If set to \code{FALSE} and \code{arg} is \code{NULL} then an error is thrown} @@ -26,7 +26,7 @@ library(rlang) data(admiral_dm) example_fun <- function(dat, var) { - var <- assert_symbol(enquo(var)) + var <- assert_symbol(enexpr(var)) select(dat, !!var) } @@ -65,8 +65,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Thomas Neitmann -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_unit.Rd b/man/assert_unit.Rd index 4821819a..7034fcec 100644 --- a/man/assert_unit.Rd +++ b/man/assert_unit.Rd @@ -61,8 +61,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} } -\author{ -Stefan Bundfuss -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_vars.Rd b/man/assert_vars.Rd index 99dc150f..c7c77cf4 100644 --- a/man/assert_vars.Rd +++ b/man/assert_vars.Rd @@ -4,23 +4,23 @@ \alias{assert_vars} \title{Is an Argument a List of Variables?} \usage{ -assert_vars(arg, optional = FALSE, expect_names = FALSE) +assert_vars(arg, expect_names = FALSE, optional = FALSE) } \arguments{ \item{arg}{A function argument to be checked} +\item{expect_names}{If the argument is set to \code{TRUE}, it is checked if all +variables are named, e.g., \code{exprs(APERSDT = APxxSDT, APEREDT = APxxEDT)}.} + \item{optional}{Is the checked parameter optional? If set to \code{FALSE} and \code{arg} is \code{NULL} then an error is thrown} - -\item{expect_names}{If the argument is set to \code{TRUE}, it is checked if all -variables are named, e.g., \code{vars(APERSDT = APxxSDT, APEREDT = APxxEDT)}.} } \value{ -The function throws an error if \code{arg} is not a list of variables created using \code{vars()} -and returns the input invisibly otherwise. +The function throws an error if \code{arg} is not a list of symbols (e.g., created +by \code{exprs()} and returns the input invisibly otherwise. } \description{ -Checks if an argument is a valid list of variables created using \code{vars()} +Checks if an argument is a valid list of symbols (e.g., created by \code{exprs()}) } \examples{ library(dplyr, warn.conflicts = FALSE) @@ -30,21 +30,21 @@ example_fun <- function(by_vars) { assert_vars(by_vars) } -example_fun(vars(USUBJID, PARAMCD)) +example_fun(exprs(USUBJID, PARAMCD)) -try(example_fun(exprs(USUBJID, PARAMCD))) +try(example_fun(quos(USUBJID, PARAMCD))) try(example_fun(c("USUBJID", "PARAMCD", "VISIT"))) -try(example_fun(vars(USUBJID, toupper(PARAMCD), desc(AVAL)))) +try(example_fun(exprs(USUBJID, toupper(PARAMCD), desc(AVAL)))) example_fun_name <- function(by_vars) { assert_vars(by_vars, expect_names = TRUE) } -example_fun_name(vars(APERSDT = APxxSDT, APEREDT = APxxEDT)) +example_fun_name(exprs(APERSDT = APxxSDT, APEREDT = APxxEDT)) -try(example_fun_name(vars(APERSDT = APxxSDT, APxxEDT))) +try(example_fun_name(exprs(APERSDT = APxxSDT, APxxEDT))) } \seealso{ Checks for valid input and returns warning or errors messages: @@ -73,8 +73,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_unit}()}, \code{\link{assert_varval_list}()} } -\author{ -Samia Kabi -} \concept{assertion} \keyword{assertion} diff --git a/man/assert_varval_list.Rd b/man/assert_varval_list.Rd index 104da0e4..82461851 100644 --- a/man/assert_varval_list.Rd +++ b/man/assert_varval_list.Rd @@ -19,7 +19,7 @@ assert_varval_list( \item{accept_expr}{Should expressions on the right hand side be accepted?} -\item{accept_var}{Should unnamed variable names (e.g. \code{vars(USUBJID)}) on the +\item{accept_var}{Should unnamed variable names (e.g. \code{exprs(USUBJID)}) on the right hand side be accepted?} \item{optional}{Is the checked parameter optional? If set to \code{FALSE} and \code{arg} @@ -30,19 +30,20 @@ The function throws an error if \code{arg} is not a list of variable-value expre Otherwise, the input it returned invisibly. } \description{ -Checks if the argument is a list of \code{quosures} where the expressions are +Checks if the argument is a list of expressions where the expressions are variable-value pairs. The value can be a symbol, a string, a numeric, or \code{NA}. More general expression are not allowed. } \examples{ library(dplyr, warn.conflicts = FALSE) +library(rlang) example_fun <- function(vars) { assert_varval_list(vars) } -example_fun(vars(DTHDOM = "AE", DTHSEQ = AESEQ)) +example_fun(exprs(DTHDOM = "AE", DTHSEQ = AESEQ)) -try(example_fun(vars("AE", DTSEQ = AESEQ))) +try(example_fun(exprs("AE", DTSEQ = AESEQ))) } \seealso{ Checks for valid input and returns warning or errors messages: @@ -71,8 +72,5 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_unit}()}, \code{\link{assert_vars}()} } -\author{ -Stefan Bundfuss, Thomas Neitmann -} \concept{assertion} \keyword{assertion} diff --git a/man/backquote.Rd b/man/backquote.Rd index 78d99fde..858e844d 100644 --- a/man/backquote.Rd +++ b/man/backquote.Rd @@ -21,8 +21,5 @@ Helpers for working with Quotes and Quoting: \code{\link{enumerate}()}, \code{\link{squote}()} } -\author{ -Thomas Neitmann -} \concept{quote} \keyword{quote} diff --git a/man/contains_vars.Rd b/man/contains_vars.Rd index 6fc77eb7..411aac94 100644 --- a/man/contains_vars.Rd +++ b/man/contains_vars.Rd @@ -2,8 +2,8 @@ % Please edit documentation in R/dev_utilities.R \name{contains_vars} \alias{contains_vars} -\title{check that argument contains valid variable(s) created with \code{vars()} or -Source Variables from a List of Quosures} +\title{check that argument contains valid variable(s) created with \code{exprs()} or +Source Variables from a List of Expressions} \usage{ contains_vars(arg) } @@ -11,18 +11,17 @@ contains_vars(arg) \item{arg}{A function argument to be checked} } \value{ -A TRUE if variables were valid variable +A \code{TRUE} if variables were valid variable } \description{ -check that argument contains valid variable(s) created with \code{vars()} or -Source Variables from a List of Quosures +check that argument contains valid variable(s) created with \code{exprs()} or +Source Variables from a List of Expressions } \seealso{ Developer Utility Functions: \code{\link{\%notin\%}()}, \code{\link{\%or\%}()}, \code{\link{arg_name}()}, -\code{\link{as_name}()}, \code{\link{convert_dtm_to_dtc}()}, \code{\link{extract_vars}()}, \code{\link{filter_if}()}, diff --git a/man/convert_dtm_to_dtc.Rd b/man/convert_dtm_to_dtc.Rd index b901d050..6ea86669 100644 --- a/man/convert_dtm_to_dtc.Rd +++ b/man/convert_dtm_to_dtc.Rd @@ -22,15 +22,11 @@ Developer Utility Functions: \code{\link{\%notin\%}()}, \code{\link{\%or\%}()}, \code{\link{arg_name}()}, -\code{\link{as_name}()}, \code{\link{contains_vars}()}, \code{\link{extract_vars}()}, \code{\link{filter_if}()}, \code{\link{valid_time_units}()}, \code{\link{vars2chr}()} } -\author{ -Ondrej Slama -} \concept{dev_utility} \keyword{dev_utility} diff --git a/man/dquote.Rd b/man/dquote.Rd index 041b3ace..effc2383 100644 --- a/man/dquote.Rd +++ b/man/dquote.Rd @@ -23,8 +23,5 @@ Helpers for working with Quotes and Quoting: \code{\link{enumerate}()}, \code{\link{squote}()} } -\author{ -Stefan Bundfuss -} \concept{quote} \keyword{quote} diff --git a/man/enumerate.Rd b/man/enumerate.Rd index 1c237129..390530b3 100644 --- a/man/enumerate.Rd +++ b/man/enumerate.Rd @@ -2,22 +2,29 @@ % Please edit documentation in R/quote.R \name{enumerate} \alias{enumerate} -\title{Enumerate Multiple Strings} +\title{Enumerate Multiple Elements} \usage{ enumerate(x, quote_fun = backquote, conjunction = "and") } \arguments{ -\item{x}{A \code{character} vector} +\item{x}{A vector or list} -\item{quote_fun}{Quoting function, defaults to \code{backquote}.} +\item{quote_fun}{Quoting function, defaults to \code{backquote}. If set to \code{NULL}, +the elements are not quoted.} -\item{conjunction}{Character to be used in the message, defaults to "and".} +\item{conjunction}{Character to be used in the message, defaults to \code{"and"}.} } \value{ A \code{character} vector } \description{ -Enumerate Multiple Strings +Enumerate multiple elements of a vector or list. +} +\examples{ +enumerate(c("one", "two", "three")) + +enumerate(c(1, 2, 3), quote_fun = NULL) + } \seealso{ Helpers for working with Quotes and Quoting: @@ -25,8 +32,5 @@ Helpers for working with Quotes and Quoting: \code{\link{dquote}()}, \code{\link{squote}()} } -\author{ -Thomas Neitmann -} \concept{quote} \keyword{quote} diff --git a/man/expect_dfs_equal.Rd b/man/expect_dfs_equal.Rd index 75eba41a..f4bff834 100644 --- a/man/expect_dfs_equal.Rd +++ b/man/expect_dfs_equal.Rd @@ -55,9 +55,6 @@ tlb3 <- tribble( # Note the sorting order of the keys is not required expect_dfs_equal(tbl1, tlb3, keys = "USUBJID") -} -\author{ -Thomas Neitmann } \concept{test_helper} \keyword{test_helper} diff --git a/man/expr_c.Rd b/man/expr_c.Rd new file mode 100644 index 00000000..8dc253ad --- /dev/null +++ b/man/expr_c.Rd @@ -0,0 +1,28 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/quo.R +\name{expr_c} +\alias{expr_c} +\title{Concatenate One or More Expressions} +\usage{ +expr_c(...) +} +\arguments{ +\item{...}{One or more expressions or list of expressions} +} +\value{ +A list of expressions +} +\description{ +Concatenate One or More Expressions +} +\seealso{ +Helpers for working with Quosures: +\code{\link{add_suffix_to_vars}()}, +\code{\link{quo_c}()}, +\code{\link{quo_not_missing}()}, +\code{\link{replace_symbol_in_expr}()}, +\code{\link{replace_symbol_in_quo}()}, +\code{\link{replace_values_by_names}()} +} +\concept{quo} +\keyword{quo} diff --git a/man/extract_vars.Rd b/man/extract_vars.Rd index 26b23cda..540015c6 100644 --- a/man/extract_vars.Rd +++ b/man/extract_vars.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/dev_utilities.R \name{extract_vars} \alias{extract_vars} -\title{Extract All Symbols from a List of Quosures} +\title{Extract All Symbols from a List of Expressions} \usage{ extract_vars(x, side = "lhs") } @@ -12,25 +12,21 @@ extract_vars(x, side = "lhs") \item{side}{One of \code{"lhs"} (the default) or \code{"rhs"}} } \value{ -A list of \code{quosures} +A list of expressions } \description{ -Extract All Symbols from a List of Quosures +Extract All Symbols from a List of Expressions } \seealso{ Developer Utility Functions: \code{\link{\%notin\%}()}, \code{\link{\%or\%}()}, \code{\link{arg_name}()}, -\code{\link{as_name}()}, \code{\link{contains_vars}()}, \code{\link{convert_dtm_to_dtc}()}, \code{\link{filter_if}()}, \code{\link{valid_time_units}()}, \code{\link{vars2chr}()} } -\author{ -Thomas Neitmann -} \concept{dev_utility} \keyword{dev_utility} diff --git a/man/figures/lifecycle-deprecated.svg b/man/figures/lifecycle-deprecated.svg new file mode 100644 index 00000000..4baaee01 --- /dev/null +++ b/man/figures/lifecycle-deprecated.svg @@ -0,0 +1 @@ +lifecyclelifecycledeprecateddeprecated \ No newline at end of file diff --git a/man/filter_if.Rd b/man/filter_if.Rd index 806ae844..23cd1447 100644 --- a/man/filter_if.Rd +++ b/man/filter_if.Rd @@ -9,7 +9,7 @@ filter_if(dataset, filter) \arguments{ \item{dataset}{Input dataset} -\item{filter}{A filter condition. Must be a quosure.} +\item{filter}{A filter condition. Must be an expression.} } \value{ A \code{data.frame} containing all rows in \code{dataset} matching \code{filter} or @@ -23,15 +23,11 @@ Developer Utility Functions: \code{\link{\%notin\%}()}, \code{\link{\%or\%}()}, \code{\link{arg_name}()}, -\code{\link{as_name}()}, \code{\link{contains_vars}()}, \code{\link{convert_dtm_to_dtc}()}, \code{\link{extract_vars}()}, \code{\link{valid_time_units}()}, \code{\link{vars2chr}()} } -\author{ -Thomas Neitmann -} \concept{dev_utility} \keyword{dev_utility} diff --git a/man/get_dataset.Rd b/man/get_dataset.Rd index d9795738..2b391952 100644 --- a/man/get_dataset.Rd +++ b/man/get_dataset.Rd @@ -15,8 +15,5 @@ A \code{data.frame} \description{ Retrieve a Dataset from the \code{admiraldev_environment} environment } -\author{ -Thomas Neitmann -} \concept{datasets} \keyword{datasets} diff --git a/man/get_source_vars.Rd b/man/get_source_vars.Rd index 7f30af39..f0458b4b 100644 --- a/man/get_source_vars.Rd +++ b/man/get_source_vars.Rd @@ -2,26 +2,25 @@ % Please edit documentation in R/get.R \name{get_source_vars} \alias{get_source_vars} -\title{Get Source Variables from a List of Quosures} +\title{Get Source Variables from a List of Expressions} \usage{ -get_source_vars(quosures) +get_source_vars(expressions, quosures) } \arguments{ -\item{quosures}{A list of quosures} +\item{expressions}{A list of expressions} + +\item{quosures}{\emph{Deprecated}, please use \code{expressions} instead.} } \value{ -A list of quosures +A list of expressions } \description{ -Get Source Variables from a List of Quosures +Get Source Variables from a List of Expressions } \seealso{ Brings something to you!?!: \code{\link{get_constant_vars}()}, \code{\link{get_duplicates}()} } -\author{ -Stefan Bundfuss -} \concept{get} \keyword{get} diff --git a/man/grapes-notin-grapes.Rd b/man/grapes-notin-grapes.Rd index fa366364..61c33f64 100644 --- a/man/grapes-notin-grapes.Rd +++ b/man/grapes-notin-grapes.Rd @@ -22,7 +22,6 @@ left operand in the right operand. Developer Utility Functions: \code{\link{\%or\%}()}, \code{\link{arg_name}()}, -\code{\link{as_name}()}, \code{\link{contains_vars}()}, \code{\link{convert_dtm_to_dtc}()}, \code{\link{extract_vars}()}, @@ -30,8 +29,5 @@ Developer Utility Functions: \code{\link{valid_time_units}()}, \code{\link{vars2chr}()} } -\author{ -Thomas Neitmann -} \concept{dev_utility} \keyword{dev_utility} diff --git a/man/grapes-or-grapes.Rd b/man/grapes-or-grapes.Rd index 0a83b302..b7c6da50 100644 --- a/man/grapes-or-grapes.Rd +++ b/man/grapes-or-grapes.Rd @@ -26,7 +26,6 @@ in an error, it catches that error and proceeds with evaluating the expression Developer Utility Functions: \code{\link{\%notin\%}()}, \code{\link{arg_name}()}, -\code{\link{as_name}()}, \code{\link{contains_vars}()}, \code{\link{convert_dtm_to_dtc}()}, \code{\link{extract_vars}()}, diff --git a/man/is_auto.Rd b/man/is_auto.Rd index e007bae9..3fc94ae5 100644 --- a/man/is_auto.Rd +++ b/man/is_auto.Rd @@ -10,8 +10,8 @@ is_auto(arg) \item{arg}{argument to check} } \value{ -\code{TRUE} if the argument equals the auto keyword, i.e., it is a quosure -of a symbol named auto. +\code{TRUE} if the argument equals the auto keyword, i.e., it is an +expression of a symbol named auto. } \description{ Checks if the argument equals the auto keyword @@ -22,8 +22,5 @@ Identifies type of Object with return of TRUE/FALSE: \code{\link{is_order_vars}()}, \code{\link{is_valid_dtc}()} } -\author{ -Stefan Bundfuss -} \concept{is} \keyword{is} diff --git a/man/is_order_vars.Rd b/man/is_order_vars.Rd index 1943487a..41a94c76 100644 --- a/man/is_order_vars.Rd +++ b/man/is_order_vars.Rd @@ -13,7 +13,7 @@ is_order_vars(arg) \code{FALSE} if the argument is not a list of order vars } \description{ -Check if inputs are created using \code{vars()} or calls involving \code{desc()} +Check if inputs are created using \code{exprs()} or calls involving \code{desc()} } \seealso{ Identifies type of Object with return of TRUE/FALSE: diff --git a/man/process_set_values_to.Rd b/man/process_set_values_to.Rd new file mode 100644 index 00000000..967d50b0 --- /dev/null +++ b/man/process_set_values_to.Rd @@ -0,0 +1,61 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/process_set_values_to.R +\name{process_set_values_to} +\alias{process_set_values_to} +\title{Process \code{set_values_to} Argument} +\usage{ +process_set_values_to(dataset, set_values_to, expected_types = NULL) +} +\arguments{ +\item{dataset}{Input dataset} + +\item{set_values_to}{Variables to set + +A named list returned by \code{exprs()} defining the variables to be set, e.g. +\code{exprs(PARAMCD = "OS", PARAM = "Overall Survival")} is expected. The values +must be symbols, character strings, numeric values, expressions, or \code{NA}.} + +\item{expected_types}{If the argument is specified, the specified variables are checked whether +the specified type matches the type of the variables created by +\code{set_values_to}. + +\emph{Permitted Values}: A character vector with values \code{"numeric"} or +\code{"character"}} +} +\value{ +The input dataset with the variables specified by \code{set_values_to} +added/updated +} +\description{ +The function creates the variables specified by the \code{set_values_to} argument, +catches errors, provides user friendly error messages, and optionally checks +the type of the created variables. +} +\examples{ +library(tibble) +data <- tribble( + ~AVAL, + 20 +) + +try( + process_set_values_to( + data, + set_values_to = exprs( + PARAMCD = BMI + ) + ) +) + +try( + process_set_values_to( + data, + set_values_to = exprs( + PARAMCD = 42 + ), + expected_types = c(PARAMCD = "character") + ) +) +} +\concept{utils_help} +\keyword{utils_help} diff --git a/man/quo_c.Rd b/man/quo_c.Rd index fd5342f1..dad6a5ab 100644 --- a/man/quo_c.Rd +++ b/man/quo_c.Rd @@ -13,17 +13,19 @@ quo_c(...) An object of class \code{quosures} } \description{ -Concatenate One or More Quosure(s) +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} +} +\details{ +This function is \emph{deprecated}, please use \code{expr_c()} instead. } \seealso{ Helpers for working with Quosures: \code{\link{add_suffix_to_vars}()}, +\code{\link{expr_c}()}, \code{\link{quo_not_missing}()}, +\code{\link{replace_symbol_in_expr}()}, \code{\link{replace_symbol_in_quo}()}, \code{\link{replace_values_by_names}()} } -\author{ -Thomas Neitmann -} \concept{quo} \keyword{quo} diff --git a/man/quo_not_missing.Rd b/man/quo_not_missing.Rd index fd2185d4..d1161bc0 100644 --- a/man/quo_not_missing.Rd +++ b/man/quo_not_missing.Rd @@ -18,12 +18,11 @@ Check Whether an Argument Is Not a Quosure of a Missing Argument \seealso{ Helpers for working with Quosures: \code{\link{add_suffix_to_vars}()}, +\code{\link{expr_c}()}, \code{\link{quo_c}()}, +\code{\link{replace_symbol_in_expr}()}, \code{\link{replace_symbol_in_quo}()}, \code{\link{replace_values_by_names}()} } -\author{ -Thomas Neitmann, Ondrej Slama -} \concept{quo} \keyword{quo} diff --git a/man/replace_symbol_in_expr.Rd b/man/replace_symbol_in_expr.Rd new file mode 100644 index 00000000..248eb19a --- /dev/null +++ b/man/replace_symbol_in_expr.Rd @@ -0,0 +1,44 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/quo.R +\name{replace_symbol_in_expr} +\alias{replace_symbol_in_expr} +\title{Replace Symbols in an Expression} +\usage{ +replace_symbol_in_expr(expression, target, replace) +} +\arguments{ +\item{expression}{Expression} + +\item{target}{Target symbol} + +\item{replace}{Replacing symbol} +} +\value{ +The expression where every occurrence of the symbol \code{target} is +replaced by \code{replace} +} +\description{ +Replace symbols in an expression +} +\examples{ + +library(rlang) + +replace_symbol_in_expr(expr(AVAL), target = AVAL, replace = AVAL.join) +replace_symbol_in_expr(expr(AVALC), target = AVAL, replace = AVAL.join) +replace_symbol_in_expr(expr(desc(AVAL)), target = AVAL, replace = AVAL.join) +} +\seealso{ +Helpers for working with Quosures: +\code{\link{add_suffix_to_vars}()}, +\code{\link{expr_c}()}, +\code{\link{quo_c}()}, +\code{\link{quo_not_missing}()}, +\code{\link{replace_symbol_in_quo}()}, +\code{\link{replace_values_by_names}()} +} +\author{ +Stefan Bundfuss +} +\concept{quo} +\keyword{quo} diff --git a/man/replace_symbol_in_quo.Rd b/man/replace_symbol_in_quo.Rd index 432fccec..57b3752a 100644 --- a/man/replace_symbol_in_quo.Rd +++ b/man/replace_symbol_in_quo.Rd @@ -14,29 +14,23 @@ replace_symbol_in_quo(quosure, target, replace) \item{replace}{Replacing symbol} } \value{ -The quosure where every occurence of the symbol \code{target} is replaced +The quosure where every occurrence of the symbol \code{target} is replaced by \code{replace} } \description{ -Replace symbols in a quosure +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} } -\examples{ - -library(rlang) - -replace_symbol_in_quo(quo(AVAL), target = AVAL, replace = AVAL.join) -replace_symbol_in_quo(quo(AVALC), target = AVAL, replace = AVAL.join) -replace_symbol_in_quo(quo(desc(AVAL)), target = AVAL, replace = AVAL.join) +\details{ +This function is \emph{deprecated}, please use \code{replace_symbol_in_expr()} instead. } \seealso{ Helpers for working with Quosures: \code{\link{add_suffix_to_vars}()}, +\code{\link{expr_c}()}, \code{\link{quo_c}()}, \code{\link{quo_not_missing}()}, +\code{\link{replace_symbol_in_expr}()}, \code{\link{replace_values_by_names}()} } -\author{ -Stefan Bundfuss -} \concept{quo} \keyword{quo} diff --git a/man/replace_values_by_names.Rd b/man/replace_values_by_names.Rd index 12093baa..821d85cf 100644 --- a/man/replace_values_by_names.Rd +++ b/man/replace_values_by_names.Rd @@ -2,28 +2,29 @@ % Please edit documentation in R/quo.R \name{replace_values_by_names} \alias{replace_values_by_names} -\title{Replace Quosure Value with Name} +\title{Replace Expression Value with Name} \usage{ -replace_values_by_names(quosures) +replace_values_by_names(expressions, quosures) } \arguments{ -\item{quosures}{A list of quosures} +\item{expressions}{A list of expressions} + +\item{quosures}{\emph{Deprecated}, please use \code{expressions} instead.} } \value{ -A list of quosures +A list of expressions } \description{ -Replace Quosure Value with Name +Replace Expression Value with Name } \seealso{ Helpers for working with Quosures: \code{\link{add_suffix_to_vars}()}, +\code{\link{expr_c}()}, \code{\link{quo_c}()}, \code{\link{quo_not_missing}()}, +\code{\link{replace_symbol_in_expr}()}, \code{\link{replace_symbol_in_quo}()} } -\author{ -Thomas Neitmann -} \concept{quo} \keyword{quo} diff --git a/man/squote.Rd b/man/squote.Rd index 5b22f2f9..beadc20e 100644 --- a/man/squote.Rd +++ b/man/squote.Rd @@ -21,8 +21,5 @@ Helpers for working with Quotes and Quoting: \code{\link{dquote}()}, \code{\link{enumerate}()} } -\author{ -Thomas Neitmann -} \concept{quote} \keyword{quote} diff --git a/man/suppress_warning.Rd b/man/suppress_warning.Rd index 2df87916..f5f6bb0b 100644 --- a/man/suppress_warning.Rd +++ b/man/suppress_warning.Rd @@ -28,11 +28,5 @@ Function that provide users with custom warnings \code{\link{warn_if_invalid_dtc}()}, \code{\link{warn_if_vars_exist}()} } -\author{ -\itemize{ -\item Thomas Neitmann -\item Stefan Bundfuss -} -} \concept{warnings} \keyword{warnings} diff --git a/man/valid_time_units.Rd b/man/valid_time_units.Rd index 2605d7f9..44d3d8ea 100644 --- a/man/valid_time_units.Rd +++ b/man/valid_time_units.Rd @@ -17,7 +17,6 @@ Developer Utility Functions: \code{\link{\%notin\%}()}, \code{\link{\%or\%}()}, \code{\link{arg_name}()}, -\code{\link{as_name}()}, \code{\link{contains_vars}()}, \code{\link{convert_dtm_to_dtc}()}, \code{\link{extract_vars}()}, diff --git a/man/vars2chr.Rd b/man/vars2chr.Rd index 4ac562a6..039beb93 100644 --- a/man/vars2chr.Rd +++ b/man/vars2chr.Rd @@ -2,38 +2,37 @@ % Please edit documentation in R/dev_utilities.R \name{vars2chr} \alias{vars2chr} -\title{Turn a List of Quosures into a Character Vector} +\title{Turn a List of Expressions into a Character Vector} \usage{ -vars2chr(quosures) +vars2chr(expressions, quosures) } \arguments{ -\item{quosures}{A \code{list} of \code{quosures} created using \code{\link[=vars]{vars()}}} +\item{expressions}{A \code{list} of expressions created using \code{\link[=exprs]{exprs()}}} + +\item{quosures}{\emph{Deprecated}, please use \code{expressions} instead.} } \value{ A character vector } \description{ -Turn a List of Quosures into a Character Vector +Turn a List of Expressions into a Character Vector } \examples{ library(dplyr, warn.conflicts = FALSE) +library(rlang) -vars2chr(vars(USUBJID, AVAL)) +vars2chr(exprs(USUBJID, AVAL)) } \seealso{ Developer Utility Functions: \code{\link{\%notin\%}()}, \code{\link{\%or\%}()}, \code{\link{arg_name}()}, -\code{\link{as_name}()}, \code{\link{contains_vars}()}, \code{\link{convert_dtm_to_dtc}()}, \code{\link{extract_vars}()}, \code{\link{filter_if}()}, \code{\link{valid_time_units}()} } -\author{ -Thomas Neitmann -} \concept{dev_utility} \keyword{dev_utility} diff --git a/man/warn_if_inconsistent_list.Rd b/man/warn_if_inconsistent_list.Rd index f7af69a6..1153c69c 100644 --- a/man/warn_if_inconsistent_list.Rd +++ b/man/warn_if_inconsistent_list.Rd @@ -25,17 +25,18 @@ issues a warning otherwise. } \examples{ library(dplyr, warn.conflicts = FALSE) +library(rlang) # no warning warn_if_inconsistent_list( - base = vars(DTHDOM = "DM", DTHSEQ = DMSEQ), - compare = vars(DTHDOM = "DM", DTHSEQ = DMSEQ), + base = exprs(DTHDOM = "DM", DTHSEQ = DMSEQ), + compare = exprs(DTHDOM = "DM", DTHSEQ = DMSEQ), list_name = "Test" ) # warning warn_if_inconsistent_list( - base = vars(DTHDOM = "DM", DTHSEQ = DMSEQ, DTHVAR = "text"), - compare = vars(DTHDOM = "DM", DTHSEQ = DMSEQ), + base = exprs(DTHDOM = "DM", DTHSEQ = DMSEQ, DTHVAR = "text"), + compare = exprs(DTHDOM = "DM", DTHSEQ = DMSEQ), list_name = "Test" ) } @@ -46,8 +47,5 @@ Function that provide users with custom warnings \code{\link{warn_if_invalid_dtc}()}, \code{\link{warn_if_vars_exist}()} } -\author{ -Samia Kabi -} \concept{warnings} \keyword{warnings} diff --git a/man/warn_if_invalid_dtc.Rd b/man/warn_if_invalid_dtc.Rd index 6d9f7b64..d630c69e 100644 --- a/man/warn_if_invalid_dtc.Rd +++ b/man/warn_if_invalid_dtc.Rd @@ -33,8 +33,5 @@ Function that provide users with custom warnings \code{\link{warn_if_inconsistent_list}()}, \code{\link{warn_if_vars_exist}()} } -\author{ -Samia Kabi -} \concept{warnings} \keyword{warnings} diff --git a/man/warn_if_vars_exist.Rd b/man/warn_if_vars_exist.Rd index be148c6d..c709439a 100644 --- a/man/warn_if_vars_exist.Rd +++ b/man/warn_if_vars_exist.Rd @@ -34,8 +34,5 @@ Function that provide users with custom warnings \code{\link{warn_if_inconsistent_list}()}, \code{\link{warn_if_invalid_dtc}()} } -\author{ -Thomas Neitmann -} \concept{warnings} \keyword{warnings} diff --git a/man/what_is_it.Rd b/man/what_is_it.Rd index ca53c44a..7e460ab7 100644 --- a/man/what_is_it.Rd +++ b/man/what_is_it.Rd @@ -21,8 +21,5 @@ what_is_it(1L) what_is_it(1:10) what_is_it(mtcars) } -\author{ -Thomas Neitmann -} \concept{what} \keyword{what} diff --git a/tests/testthat.R b/tests/testthat.R index 20b68db6..dcc37694 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,3 +1,11 @@ +# This file is part of the standard setup for testthat. +# It is recommended that you do not modify it. +# +# Where should you do additional test configuration? +# Learn more about the roles of various files in: +# * https://r-pkgs.org/tests.html +# * https://testthat.r-lib.org/reference/test_package.html#special-files + library(testthat) library(admiraldev) diff --git a/tests/testthat/test-assertions.R b/tests/testthat/test-assertions.R index 3b904736..740ecd0b 100644 --- a/tests/testthat/test-assertions.R +++ b/tests/testthat/test-assertions.R @@ -29,45 +29,84 @@ test_that("assert_has_variables Test 2: no error if a required variable exists", # assert_filter_cond ---- ## Test 3: `assert_filter_cond` works as expected ---- test_that("assert_filter_cond Test 3: `assert_filter_cond` works as expected", { - fc <- quo(AGE == 64) + fc <- expr(AGE == 64) expect_identical( assert_filter_cond(fc), fc ) - fc <- quo() - expect_error( - assert_filter_cond(arg = fc), - "Argument `fc` is missing, with no default" - ) - expect_identical( assert_filter_cond(arg = fc, optional = TRUE), fc ) - fc <- quo("string") + fc <- expr("string") expect_error( assert_filter_cond(arg = fc), "`fc` must be a filter condition but is `\"string\"`" ) + + vals <- c("A", "B") + fc <- expr(VAR %in% !!vals) + expect_identical( + assert_filter_cond(arg = fc), + fc + ) }) # assert_data_frame ---- ## Test 4: error if not a dataframe ---- test_that("assert_data_frame Test 4: error if not a dataframe", { example_fun <- function(dataset) { - assert_data_frame(dataset, required_vars = vars(STUDYID, USUBJID)) + assert_data_frame(dataset, required_vars = exprs(STUDYID, USUBJID)) } expect_error( example_fun(c(1, 2, 3)) ) }) -## Test 5: error if dataframe is grouped ---- -test_that("assert_data_frame Test 5: error if dataframe is grouped", { +## Test 5: assert_data_frame extract_vars() works as intended ---- +test_that("assert_data_frame Test 5: assert_data_frame extract_vars() works as intended", { + input <- tibble::tribble( + ~STUDYID, ~USUBJID, ~SEQ, + "A", "1", 1, + "A", "2", 2, + "A", "3", 3, + ) + + example_fun <- function(dataset, order) { + assert_data_frame(dataset, required_vars = expr_c( + exprs(STUDYID, USUBJID), + extract_vars(order) + )) + } + + expect_invisible(example_fun(input, order = exprs(SEQ))) +}) + +## Test 6: assert_data_frame throws not throw error if extract_vars() has NULL input ---- +test_that("assert_data_frame Test 6: assert_data_frame throws error if extract_vars() has NULL input", { # nolint + input <- tibble::tribble( + ~STUDYID, ~USUBJID, ~SEQ, + "A", "1", 1, + "A", "2", 2, + "A", "3", 3, + ) + + example_fun <- function(dataset, order = NULL) { + assert_data_frame(dataset, required_vars = expr_c( + exprs(STUDYID, USUBJID), + extract_vars(order) + )) + } + + expect_invisible(example_fun(input)) +}) + +## Test 7: error if dataframe is grouped ---- +test_that("assert_data_frame Test 7: error if dataframe is grouped", { example_fun <- function(dataset) { - assert_data_frame(dataset, required_vars = vars(STUDYID, USUBJID)) + assert_data_frame(dataset, required_vars = exprs(STUDYID, USUBJID)) } data <- tibble::tribble( @@ -82,8 +121,8 @@ test_that("assert_data_frame Test 5: error if dataframe is grouped", { }) # assert_character_scalar ---- -## Test 6: error if not a character scaler string ---- -test_that("assert_character_scalar Test 6: error if not a character scaler string", { +## Test 8: error if not a character scaler string ---- +test_that("assert_character_scalar Test 8: error if not a character scaler string", { example_fun2 <- function(msg_type) { msg_type <- assert_character_scalar(msg_type, values = c("warning", "error"), case_sensitive = FALSE @@ -96,8 +135,8 @@ test_that("assert_character_scalar Test 6: error if not a character scaler strin expect_error(example_fun2(2)) }) -## Test 7: error if input is a vector ---- -test_that("assert_character_scalar Test 7: error if input is a vector", { +## Test 9: error if input is a vector ---- +test_that("assert_character_scalar Test 9: error if input is a vector", { example_fun2 <- function(msg_type) { msg_type <- assert_character_scalar(msg_type, values = c("warning", "error"), case_sensitive = FALSE @@ -111,29 +150,29 @@ test_that("assert_character_scalar Test 7: error if input is a vector", { }) # assert_vars ---- -## Test 8: no error if expected input ---- -test_that("assert_vars Test 8: no error if expected input", { - expect_invisible(assert_vars(vars(USUBJID, PARAMCD))) +## Test 10: no error if expected input ---- +test_that("assert_vars Test 10: no error if expected input", { + expect_invisible(assert_vars(exprs(USUBJID, PARAMCD))) expect_invisible(assert_vars( - vars(APERSDT = APxxSDT, APEREDT = APxxEDT), + exprs(APERSDT = APxxSDT, APEREDT = APxxEDT), expect_names = TRUE )) }) -## Test 9: error if unexpected input ---- -test_that("assert_vars Test 9: error if unexpected input", { +## Test 11: error if unexpected input ---- +test_that("assert_vars Test 11: error if unexpected input", { expect_error(assert_vars(AVAL + 1)) - expect_error(assert_vars(rlang::exprs(USUBJID, PARAMCD))) + expect_error(assert_vars(rlang::quos(USUBJID, PARAMCD))) expect_error(assert_vars(c("USUBJID", "PARAMCD", "VISIT"))) - expect_error(assert_vars(vars(USUBJID, AVAL + 2))) - expect_error(assert_vars(vars(APERSDT = APxxSDT, APxxEDT), expect_names = TRUE)) + expect_error(assert_vars(exprs(USUBJID, AVAL + 2))) + expect_error(assert_vars(exprs(APERSDT = APxxSDT, APxxEDT), expect_names = TRUE)) }) # assert_data_frame ---- -## Test 10: no error if optional is TRUE and `arg` is NULL ---- -test_that("assert_data_frame Test 10: no error if optional is TRUE and `arg` is NULL", { +## Test 12: no error if optional is TRUE and `arg` is NULL ---- +test_that("assert_data_frame Test 12: no error if optional is TRUE and `arg` is NULL", { example_fun <- function(dataset) { - assert_data_frame(dataset, required_vars = vars(STUDYID, USUBJID), optional = TRUE) + assert_data_frame(dataset, required_vars = exprs(STUDYID, USUBJID), optional = TRUE) } expect_invisible( @@ -141,10 +180,10 @@ test_that("assert_data_frame Test 10: no error if optional is TRUE and `arg` is ) }) -## Test 11: error if required variables are missing ---- -test_that("assert_data_frame Test 11: error if required variables are missing", { +## Test 13: error if required variables are missing ---- +test_that("assert_data_frame Test 13: error if required variables are missing", { example_fun <- function(dataset) { - assert_data_frame(dataset, required_vars = vars(STUDYID, USUBJID)) + assert_data_frame(dataset, required_vars = exprs(STUDYID, USUBJID)) } admiral_dm <- admiral.test::admiral_dm %>% select(-c(STUDYID, USUBJID)) @@ -154,10 +193,10 @@ test_that("assert_data_frame Test 11: error if required variables are missing", ) }) -## Test 12: error if required variable is missing ---- -test_that("assert_data_frame Test 12: error if required variable is missing", { +## Test 14: error if required variable is missing ---- +test_that("assert_data_frame Test 14: error if required variable is missing", { example_fun <- function(dataset) { - assert_data_frame(dataset, required_vars = vars(STUDYID, USUBJID)) + assert_data_frame(dataset, required_vars = exprs(STUDYID, USUBJID)) } admiral_dm <- admiral.test::admiral_dm %>% select(-c(USUBJID)) @@ -168,8 +207,8 @@ test_that("assert_data_frame Test 12: error if required variable is missing", { }) # assert_character_scalar ---- -## Test 13: no error if optional is TRUE and `arg` is NULL ---- -test_that("assert_character_scalar Test 13: no error if optional is TRUE and `arg` is NULL", { +## Test 15: no error if optional is TRUE and `arg` is NULL ---- +test_that("assert_character_scalar Test 15: no error if optional is TRUE and `arg` is NULL", { example_fun <- function(character) { assert_character_scalar(character, optional = TRUE) } @@ -179,8 +218,8 @@ test_that("assert_character_scalar Test 13: no error if optional is TRUE and `ar ) }) -## Test 14: no error, case_sensitive = FALSE ---- -test_that("assert_character_scalar Test 14: no error, case_sensitive = FALSE", { +## Test 16: no error, case_sensitive = FALSE ---- +test_that("assert_character_scalar Test 16: no error, case_sensitive = FALSE", { example_fun <- function(character) { assert_character_scalar(character, values = c("test"), case_sensitive = FALSE) } @@ -217,8 +256,8 @@ test_that("assert_character_scalar Test 14: no error, case_sensitive = FALSE", { expect_equal(out, "months") }) -## Test 15: error if `arg` not in values ---- -test_that("assert_character_scalar Test 15: error if `arg` not in values", { +## Test 17: error if `arg` not in values ---- +test_that("assert_character_scalar Test 17: error if `arg` not in values", { example_fun <- function(character) { assert_character_scalar(character, values = c("test")) } @@ -276,8 +315,8 @@ test_that("assert_character_scalar Test 15: error if `arg` not in values", { ) }) -## Test 16: error if `arg` not a character vector ---- -test_that("assert_character_scalar Test 16: error if `arg` not a character vector", { +## Test 18: error if `arg` not a character vector ---- +test_that("assert_character_scalar Test 18: error if `arg` not a character vector", { arg <- c(1, 2, 3) expect_error( @@ -285,8 +324,8 @@ test_that("assert_character_scalar Test 16: error if `arg` not a character vecto ) }) -## Test 17: error if `arg` is not in values ---- -test_that("assert_character_scalar Test 17: error if `arg` is not in values", { +## Test 19: error if `arg` is not in values ---- +test_that("assert_character_scalar Test 19: error if `arg` is not in values", { example_fun <- function(character) { assert_character_vector(character, values = c("test", "oak")) } @@ -297,8 +336,8 @@ test_that("assert_character_scalar Test 17: error if `arg` is not in values", { }) # assert_logical_scalar ---- -## Test 18: no error if optional is TRUE and `arg` is NULL ---- -test_that("assert_logical_scalar Test 18: no error if optional is TRUE and `arg` is NULL", { +## Test 20: no error if optional is TRUE and `arg` is NULL ---- +test_that("assert_logical_scalar Test 20: no error if optional is TRUE and `arg` is NULL", { example_fun <- function(arg) { assert_logical_scalar(arg, optional = TRUE) } @@ -308,8 +347,8 @@ test_that("assert_logical_scalar Test 18: no error if optional is TRUE and `arg` ) }) -## Test 19: error if `arg` is not TRUE or FALSE ---- -test_that("assert_logical_scalar Test 19: error if `arg` is not TRUE or FALSE", { +## Test 21: error if `arg` is not TRUE or FALSE ---- +test_that("assert_logical_scalar Test 21: error if `arg` is not TRUE or FALSE", { example_fun <- function(arg) { assert_logical_scalar(arg) } @@ -320,10 +359,10 @@ test_that("assert_logical_scalar Test 19: error if `arg` is not TRUE or FALSE", }) # assert_symbol ---- -## Test 20: no error if optional = TRUE and `arg` = NULL ---- -test_that("assert_symbol Test 20: no error if optional = TRUE and `arg` = NULL", { +## Test 22: no error if optional = TRUE and `arg` = NULL ---- +test_that("assert_symbol Test 22: no error if optional = TRUE and `arg` = NULL", { f <- function(var) { - v <- enquo(var) + v <- enexpr(var) } example_fun <- function(arg) { @@ -337,10 +376,10 @@ test_that("assert_symbol Test 20: no error if optional = TRUE and `arg` = NULL", ) }) -## Test 21: `assert_symbol` throws an error if `arg` is missing ---- -test_that("assert_symbol Test 21: `assert_symbol` throws an error if `arg` is missing", { +## Test 23: `assert_symbol` throws an error if `arg` is missing ---- +test_that("assert_symbol Test 23: `assert_symbol` throws an error if `arg` is missing", { f <- function(var) { - v <- enquo(var) + v <- enexpr(var) } example_fun <- function(arg) { @@ -354,10 +393,10 @@ test_that("assert_symbol Test 21: `assert_symbol` throws an error if `arg` is mi ) }) -## Test 22: `assert_symbol` throws an error if `arg` is not a symbol ---- -test_that("assert_symbol Test 22: `assert_symbol` throws an error if `arg` is not a symbol", { +## Test 24: `assert_symbol` throws an error if `arg` is not a symbol ---- +test_that("assert_symbol Test 24: `assert_symbol` throws an error if `arg` is not a symbol", { f <- function(var) { - v <- enquo(var) + v <- enexpr(var) } example_fun <- function(arg) { @@ -371,10 +410,10 @@ test_that("assert_symbol Test 22: `assert_symbol` throws an error if `arg` is no ) }) -## Test 23: `assert_symbol` does not throw an error if `arg` is a symbol ---- -test_that("assert_symbol Test 23: `assert_symbol` does not throw an error if `arg` is a symbol", { +## Test 25: `assert_symbol` does not throw an error if `arg` is a symbol ---- +test_that("assert_symbol Test 25: `assert_symbol` does not throw an error if `arg` is a symbol", { f <- function(var) { - v <- enquo(var) + v <- enexpr(var) } admiral_dm <- admiral.test::admiral_dm @@ -391,10 +430,10 @@ test_that("assert_symbol Test 23: `assert_symbol` does not throw an error if `ar }) # assert_expr ---- -## Test 24: `assert_expr` does not throw an error if `arg` is an expression ---- -test_that("assert_expr Test 24: `assert_expr` does not throw an error if `arg` is an expression", { +## Test 26: `assert_expr` does not throw an error if `arg` is an expression ---- +test_that("assert_expr Test 26: `assert_expr` does not throw an error if `arg` is an expression", { f <- function(var) { - v <- enquo(var) + v <- enexpr(var) } example_fun <- function(arg) { @@ -408,10 +447,10 @@ test_that("assert_expr Test 24: `assert_expr` does not throw an error if `arg` i ) }) -## Test 25: no error if optional is TRUE and `arg` is NULL ---- -test_that("assert_expr Test 25: no error if optional is TRUE and `arg` is NULL", { +## Test 27: no error if optional is TRUE and `arg` is NULL ---- +test_that("assert_expr Test 27: no error if optional is TRUE and `arg` is NULL", { f <- function(var) { - v <- enquo(var) + v <- enexpr(var) } example_fun <- function(arg) { @@ -425,10 +464,10 @@ test_that("assert_expr Test 25: no error if optional is TRUE and `arg` is NULL", ) }) -## Test 26: `assert_expr` throws an error if `arg` is missing ---- -test_that("assert_expr Test 26: `assert_expr` throws an error if `arg` is missing", { +## Test 28: `assert_expr` throws an error if `arg` is missing ---- +test_that("assert_expr Test 28: `assert_expr` throws an error if `arg` is missing", { f <- function(var) { - v <- enquo(var) + v <- enexpr(var) } example_fun <- function(arg) { @@ -440,10 +479,10 @@ test_that("assert_expr Test 26: `assert_expr` throws an error if `arg` is missin ) }) -## Test 27: `assert_expr` throws an error if `arg` is not an expression ---- -test_that("assert_expr Test 27: `assert_expr` throws an error if `arg` is not an expression", { +## Test 29: `assert_expr` throws an error if `arg` is not an expression ---- +test_that("assert_expr Test 29: `assert_expr` throws an error if `arg` is not an expression", { f <- function(var) { - v <- enquo(var) + v <- enexpr(var) } example_fun <- function(arg) { @@ -458,8 +497,8 @@ test_that("assert_expr Test 27: `assert_expr` throws an error if `arg` is not an }) # assert_vars ---- -## Test 28: no error if `arg` is not a list of unquoted variable names ---- -test_that("assert_vars Test 28: no error if `arg` is not a list of unquoted variable names", { +## Test 30: no error if `arg` is not a list of unquoted variable names ---- +test_that("assert_vars Test 30: no error if `arg` is not a list of unquoted variable names", { example_fun <- function(arg) { assert_vars(arg) } @@ -472,20 +511,20 @@ test_that("assert_vars Test 28: no error if `arg` is not a list of unquoted vari ) }) -## Test 29: error if some elements of `arg` are not unquoted variable names ---- -test_that("assert_vars Test 29: error if some elements of `arg` are not unquoted variable names", { +## Test 31: error if some elements of `arg` are not unquoted variable names ---- +test_that("assert_vars Test 31: error if some elements of `arg` are not unquoted variable names", { example_fun <- function(arg) { assert_vars(arg) } expect_error( - example_fun(vars(USUBJID, PARAMCD, NULL)) + example_fun(exprs(USUBJID, PARAMCD, NULL)) ) }) # assert_order_vars ---- -## Test 30: error if `arg` is not a list variable names or `desc()` ---- -test_that("assert_order_vars Test 30: error if `arg` is not a list variable names or `desc()`", { +## Test 32: error if `arg` is not a list variable names or `desc()` ---- +test_that("assert_order_vars Test 32: error if `arg` is not a list variable names or `desc()`", { example_fun <- function(arg) { assert_order_vars(arg) } @@ -498,8 +537,8 @@ test_that("assert_order_vars Test 30: error if `arg` is not a list variable name ) }) -## Test 31: no error if `arg` is NULL and optional is TRUE ---- -test_that("assert_order_vars Test 31: no error if `arg` is NULL and optional is TRUE", { +## Test 33: no error if `arg` is NULL and optional is TRUE ---- +test_that("assert_order_vars Test 33: no error if `arg` is NULL and optional is TRUE", { example_fun <- function(arg) { assert_order_vars(arg, optional = TRUE) } @@ -510,8 +549,8 @@ test_that("assert_order_vars Test 31: no error if `arg` is NULL and optional is }) # assert_integer_scalar ---- -## Test 32: no error if `arg` is NULL and optional is TRUE ---- -test_that("assert_integer_scalar Test 32: no error if `arg` is NULL and optional is TRUE", { +## Test 34: no error if `arg` is NULL and optional is TRUE ---- +test_that("assert_integer_scalar Test 34: no error if `arg` is NULL and optional is TRUE", { example_fun <- function(arg) { assert_integer_scalar(arg, optional = TRUE) } @@ -521,8 +560,8 @@ test_that("assert_integer_scalar Test 32: no error if `arg` is NULL and optional ) }) -## Test 33: error if chosen subset not in subsets ---- -test_that("assert_integer_scalar Test 33: error if chosen subset not in subsets", { +## Test 35: error if chosen subset not in subsets ---- +test_that("assert_integer_scalar Test 35: error if chosen subset not in subsets", { example_fun <- function(arg) { assert_integer_scalar(arg, subset = "infinity") } @@ -532,8 +571,8 @@ test_that("assert_integer_scalar Test 33: error if chosen subset not in subsets" ) }) -## Test 34: no error if `arg` is in selected subset ---- -test_that("assert_integer_scalar Test 34: no error if `arg` is in selected subset", { +## Test 36: no error if `arg` is in selected subset ---- +test_that("assert_integer_scalar Test 36: no error if `arg` is in selected subset", { example_fun <- function(arg) { assert_integer_scalar(arg, subset = "positive") } @@ -543,8 +582,8 @@ test_that("assert_integer_scalar Test 34: no error if `arg` is in selected subse ) }) -## Test 35: error if `arg` is not an integer scalar ---- -test_that("assert_integer_scalar Test 35: error if `arg` is not an integer scalar", { +## Test 37: error if `arg` is not an integer scalar ---- +test_that("assert_integer_scalar Test 37: error if `arg` is not an integer scalar", { example_fun <- function(arg) { assert_integer_scalar(arg) } @@ -558,8 +597,8 @@ test_that("assert_integer_scalar Test 35: error if `arg` is not an integer scala }) # assert_numeric_vector ---- -## Test 36: no error if `arg` is NULL and optional is TRUE ---- -test_that("assert_numeric_vector Test 36: no error if `arg` is NULL and optional is TRUE", { +## Test 38: no error if `arg` is NULL and optional is TRUE ---- +test_that("assert_numeric_vector Test 38: no error if `arg` is NULL and optional is TRUE", { example_fun <- function(arg) { assert_numeric_vector(arg, optional = TRUE) } @@ -570,8 +609,8 @@ test_that("assert_numeric_vector Test 36: no error if `arg` is NULL and optional }) # assert_integer_scalar ---- -## Test 37: error if `arg` is not an integer scalar ---- -test_that("assert_integer_scalar Test 37: error if `arg` is not an integer scalar", { +## Test 39: error if `arg` is not an integer scalar ---- +test_that("assert_integer_scalar Test 39: error if `arg` is not an integer scalar", { example_fun <- function(arg) { assert_numeric_vector(arg) } @@ -584,8 +623,8 @@ test_that("assert_integer_scalar Test 37: error if `arg` is not an integer scala }) # assert_s3_class ---- -## Test 38: error if `arg` is not an object of a specific class S3 ---- -test_that("assert_s3_class Test 38: error if `arg` is not an object of a specific class S3", { +## Test 40: error if `arg` is not an object of a specific class S3 ---- +test_that("assert_s3_class Test 40: error if `arg` is not an object of a specific class S3", { example_fun <- function(arg) { assert_s3_class(arg, "factor") } @@ -593,8 +632,8 @@ test_that("assert_s3_class Test 38: error if `arg` is not an object of a specifi expect_error(example_fun("test")) }) -## Test 39: no error if `arg` is NULL and optional is TRUE ---- -test_that("assert_s3_class Test 39: no error if `arg` is NULL and optional is TRUE", { +## Test 41: no error if `arg` is NULL and optional is TRUE ---- +test_that("assert_s3_class Test 41: no error if `arg` is NULL and optional is TRUE", { example_fun <- function(arg) { assert_s3_class(arg, class = "factor", optional = TRUE) } @@ -604,8 +643,21 @@ test_that("assert_s3_class Test 39: no error if `arg` is NULL and optional is TR ) }) -## Test 40: no error if `arg` is an object of a specific class S3 ---- -test_that("assert_s3_class Test 40: no error if `arg` is an object of a specific class S3", { +## Test 42: error if `arg` is NULL and optional is FALSE ---- +test_that("assert_s3_class Test 42: error if `arg` is NULL and optional is FALSE", { + example_fun <- function(arg) { + assert_s3_class(arg, class = "factor", optional = FALSE) + } + + expect_error( + example_fun(NULL), + "`arg` must be an object of class 'factor' but is `NULL`", + fixed = TRUE + ) +}) + +## Test 43: no error if `arg` is an object of a specific class S3 ---- +test_that("assert_s3_class Test 43: no error if `arg` is an object of a specific class S3", { example_fun <- function(arg) { assert_s3_class(arg, "factor") } @@ -614,8 +666,8 @@ test_that("assert_s3_class Test 40: no error if `arg` is an object of a specific }) # assert_list_of ---- -## Test 41: error if `arg` is not a list of specific class S3 objects ---- -test_that("assert_list_of Test 41: error if `arg` is not a list of specific class S3 objects", { +## Test 44: error if `arg` is not a list of specific class S3 objects ---- +test_that("assert_list_of Test 44: error if `arg` is not a list of specific class S3 objects", { example_fun <- function(arg) { assert_list_of(arg, "factor") } @@ -623,8 +675,8 @@ test_that("assert_list_of Test 41: error if `arg` is not a list of specific clas expect_error(example_fun(list("test"))) }) -## Test 42: no error if `arg` is NULL and optional is TRUE ---- -test_that("assert_list_of Test 42: no error if `arg` is NULL and optional is TRUE", { +## Test 45: no error if `arg` is NULL and optional is TRUE ---- +test_that("assert_list_of Test 45: no error if `arg` is NULL and optional is TRUE", { example_fun <- function(arg) { assert_list_of(arg, class = "factor", optional = TRUE) } @@ -634,8 +686,21 @@ test_that("assert_list_of Test 42: no error if `arg` is NULL and optional is TRU ) }) -## Test 43: no error if `arg` is a list of specific class S3 objects ---- -test_that("assert_list_of Test 43: no error if `arg` is a list of specific class S3 objects", { +## Test 46: error if `arg` is NULL and optional is FALSE ---- +test_that("assert_list_of Test 46: error if `arg` is NULL and optional is FALSE", { + example_fun <- function(arg) { + assert_list_of(arg, class = "factor", optional = FALSE) + } + + expect_error( + example_fun(NULL), + "`arg` must be an object of class 'list' but is `NULL`", + fixed = TRUE + ) +}) + +## Test 47: no error if `arg` is a list of specific class S3 objects ---- +test_that("assert_list_of Test 47: no error if `arg` is a list of specific class S3 objects", { example_fun <- function(arg) { assert_list_of(arg, "factor") } @@ -647,9 +712,40 @@ test_that("assert_list_of Test 43: no error if `arg` is a list of specific class ) }) +## Test 48: error if `arg` is not a named list (no elements named) ---- +test_that("assert_list_of Test 48: error if `arg` is not a named list (no elements named)", { + expect_error( + assert_list_of(mylist <- list(1, 2, 3), class = "numeric", named = TRUE), + paste( + "All elements of mylist must be named.", + "No element is named.", + sep = "\n" + ) + ) +}) + +## Test 49: error if `arg` is not a named list (some elements named) ---- +test_that("assert_list_of Test 49: error if `arg` is not a named list (some elements named)", { + expect_error( + assert_list_of(mylist <- list(1, 2, 3, d = 4), class = "numeric", named = TRUE), + paste( + "All elements of mylist must be named.", + "The following elements are not named: 1, 2 and 3", + sep = "\n" + ) + ) +}) + +## Test 50: no error if `arg` is a named list ---- +test_that("assert_list_of Test 50: no error if `arg` is a named list", { + expect_invisible( + assert_list_of(mylist <- list(a = 1, b = 2, c = 3), class = "numeric", named = TRUE) + ) +}) + # assert_named_exprs ---- -## Test 44: error if `arg` is not a named list of expressions ---- -test_that("assert_named_exprs Test 44: error if `arg` is not a named list of expressions", { +## Test 51: error if `arg` is not a named list of expressions ---- +test_that("assert_named_exprs Test 51: error if `arg` is not a named list of expressions", { example_fun <- function(arg) { assert_named_exprs(arg) } @@ -663,8 +759,8 @@ test_that("assert_named_exprs Test 44: error if `arg` is not a named list of exp expect_error(example_fun(arg)) }) -## Test 45: no error if `arg` is NULL and optional is TRUE ---- -test_that("assert_named_exprs Test 45: no error if `arg` is NULL and optional is TRUE", { +## Test 52: no error if `arg` is NULL and optional is TRUE ---- +test_that("assert_named_exprs Test 52: no error if `arg` is NULL and optional is TRUE", { example_fun <- function(arg) { assert_named_exprs(arg, optional = TRUE) } @@ -674,8 +770,8 @@ test_that("assert_named_exprs Test 45: no error if `arg` is NULL and optional is ) }) -## Test 46: no error if `arg` is a named list of expressions ---- -test_that("assert_named_exprs Test 46: no error if `arg` is a named list of expressions", { +## Test 53: no error if `arg` is a named list of expressions ---- +test_that("assert_named_exprs Test 53: no error if `arg` is a named list of expressions", { example_fun <- function(arg) { assert_named_exprs(arg) } @@ -688,8 +784,8 @@ test_that("assert_named_exprs Test 46: no error if `arg` is a named list of expr }) # assert_function ---- -## Test 47: error if `arg` is not a function ---- -test_that("assert_function Test 47: error if `arg` is not a function", { +## Test 54: error if `arg` is not a function ---- +test_that("assert_function Test 54: error if `arg` is not a function", { example_fun <- function(arg) { assert_function(arg) } @@ -698,8 +794,8 @@ test_that("assert_function Test 47: error if `arg` is not a function", { expect_error(example_fun()) }) -## Test 48: no error if `arg` is NULL and optional is TRUE ---- -test_that("assert_function Test 48: no error if `arg` is NULL and optional is TRUE", { +## Test 55: no error if `arg` is NULL and optional is TRUE ---- +test_that("assert_function Test 55: no error if `arg` is NULL and optional is TRUE", { example_fun <- function(arg) { assert_function(arg, optional = TRUE) } @@ -709,8 +805,8 @@ test_that("assert_function Test 48: no error if `arg` is NULL and optional is TR ) }) -## Test 49: no error if `arg` is a function with all parameters defined ---- -test_that("assert_function Test 49: no error if `arg` is a function with all parameters defined", { +## Test 56: no error if `arg` is a function with all parameters defined ---- +test_that("assert_function Test 56: no error if `arg` is a function with all parameters defined", { example_fun <- function(arg) { assert_function(arg, params = c("x")) } @@ -718,8 +814,8 @@ test_that("assert_function Test 49: no error if `arg` is a function with all par expect_invisible(example_fun(mean)) }) -## Test 50: error if `params` is missing with no default ---- -test_that("assert_function Test 50: error if `params` is missing with no default", { +## Test 57: error if `params` is missing with no default ---- +test_that("assert_function Test 57: error if `params` is missing with no default", { example_fun <- function(arg) { assert_function(arg, params = c("x")) } @@ -735,8 +831,8 @@ test_that("assert_function Test 50: error if `params` is missing with no defau # assert_function_param ---- -## Test 51: no error if `arg` is a parameter of a function ---- -test_that("assert_function_param Test 51: no error if `arg` is a parameter of a function", { +## Test 58: no error if `arg` is a parameter of a function ---- +test_that("assert_function_param Test 58: no error if `arg` is a parameter of a function", { hello <- function(name) { print(sprintf("Hello %s", name)) } @@ -744,8 +840,8 @@ test_that("assert_function_param Test 51: no error if `arg` is a parameter of a expect_invisible(assert_function_param("hello", "name")) }) -## Test 52: error if expected function parameters are missing ---- -test_that("assert_function_param Test 52: error if expected function parameters are missing", { +## Test 59: error if expected function parameters are missing ---- +test_that("assert_function_param Test 59: error if expected function parameters are missing", { hello <- function(name) { print(sprintf("Hello %s", name)) } @@ -755,8 +851,8 @@ test_that("assert_function_param Test 52: error if expected function parameters }) # assert_unit ---- -## Test 53: no error if the parameter is provided in the expected unit ---- -test_that("assert_unit Test 53: no error if the parameter is provided in the expected unit", { +## Test 60: no error if the parameter is provided in the expected unit ---- +test_that("assert_unit Test 60: no error if the parameter is provided in the expected unit", { advs <- tibble::tribble( ~USUBJID, ~VSTESTCD, ~VSTRESN, ~VSSTRESU, ~PARAMCD, ~AVAL, "P01", "WEIGHT", 80.1, "kg", "WEIGHT", 80.1, @@ -768,8 +864,8 @@ test_that("assert_unit Test 53: no error if the parameter is provided in the exp ) }) -## Test 54: error if there are multiple units in the input dataset ---- -test_that("assert_unit Test 54: error if there are multiple units in the input dataset", { +## Test 61: error if there are multiple units in the input dataset ---- +test_that("assert_unit Test 61: error if there are multiple units in the input dataset", { advs <- tibble::tribble( ~USUBJID, ~VSTESTCD, ~VSTRESN, ~VSSTRESU, ~PARAMCD, ~AVAL, "P01", "WEIGHT", 80.1, "kg", "WEIGHT", 80.1, @@ -781,8 +877,8 @@ test_that("assert_unit Test 54: error if there are multiple units in the input d ) }) -## Test 55: error if unexpected unit in the input dataset ---- -test_that("assert_unit Test 55: error if unexpected unit in the input dataset", { +## Test 62: error if unexpected unit in the input dataset ---- +test_that("assert_unit Test 62: error if unexpected unit in the input dataset", { advs <- tibble::tribble( ~USUBJID, ~VSTESTCD, ~VSTRESN, ~VSSTRESU, ~PARAMCD, ~AVAL, "P01", "WEIGHT", 80.1, "kg", "WEIGHT", 80.1, @@ -795,8 +891,8 @@ test_that("assert_unit Test 55: error if unexpected unit in the input dataset", }) # assert_param_does_not_exist ---- -## Test 56: error if parameter exists in the input dataset ---- -test_that("assert_param_does_not_exist Test 56: error if parameter exists in the input dataset", { +## Test 63: error if parameter exists in the input dataset ---- +test_that("assert_param_does_not_exist Test 63: error if parameter exists in the input dataset", { advs <- tibble::tribble( ~USUBJID, ~VSTESTCD, ~VSTRESN, ~VSSTRESU, ~PARAMCD, ~AVAL, "P01", "WEIGHT", 80.1, "kg", "WEIGHT", 80.1, @@ -808,8 +904,8 @@ test_that("assert_param_does_not_exist Test 56: error if parameter exists in the ) }) -## Test 57: no error if the parameter exists in the dataset ---- -test_that("assert_param_does_not_exist Test 57: no error if the parameter exists in the dataset", { +## Test 64: no error if the parameter exists in the dataset ---- +test_that("assert_param_does_not_exist Test 64: no error if the parameter exists in the dataset", { advs <- tibble::tribble( ~USUBJID, ~VSTESTCD, ~VSTRESN, ~VSSTRESU, ~PARAMCD, ~AVAL, "P01", "WEIGHT", 80.1, "kg", "WEIGHT", 80.1, @@ -822,8 +918,8 @@ test_that("assert_param_does_not_exist Test 57: no error if the parameter exists }) # assert_varval_list ---- -## Test 58: error if `arg` is not a list of var-value expressions ---- -test_that("assert_varval_list Test 58: error if `arg` is not a list of var-value expressions", { +## Test 65: error if `arg` is not a list of var-value expressions ---- +test_that("assert_varval_list Test 65: error if `arg` is not a list of var-value expressions", { example_fun <- function(arg) { assert_varval_list(arg, accept_var = FALSE) } @@ -833,30 +929,30 @@ test_that("assert_varval_list Test 58: error if `arg` is not a list of var-value ) }) -## Test 59: error if `arg` is not a list of var-value expressions ---- -test_that("assert_varval_list Test 59: error if `arg` is not a list of var-value expressions", { +## Test 66: error if `arg` is not a list of var-value expressions ---- +test_that("assert_varval_list Test 66: error if `arg` is not a list of var-value expressions", { example_fun <- function(arg) { assert_varval_list(arg, accept_var = TRUE) } expect_error( - example_fun(vars(USUBJID, PARAMCD, NULL)) + example_fun(exprs(USUBJID, PARAMCD, NULL)) ) }) -## Test 60: error if `required_elements` are missing from `arg` ---- -test_that("assert_varval_list Test 60: error if `required_elements` are missing from `arg`", { +## Test 67: error if `required_elements` are missing from `arg` ---- +test_that("assert_varval_list Test 67: error if `required_elements` are missing from `arg`", { example_fun <- function(arg) { assert_varval_list(arg, required_elements = "DTHDOM") } expect_error( - example_fun(vars(DTHSEQ = AESEQ)) + example_fun(exprs(DTHSEQ = AESEQ)) ) }) -## Test 61: no error if `arg` is NULL and optional is TRUE ---- -test_that("assert_varval_list Test 61: no error if `arg` is NULL and optional is TRUE", { +## Test 68: no error if `arg` is NULL and optional is TRUE ---- +test_that("assert_varval_list Test 68: no error if `arg` is NULL and optional is TRUE", { example_fun <- function(arg) { assert_varval_list(arg, optional = TRUE) } @@ -866,83 +962,92 @@ test_that("assert_varval_list Test 61: no error if `arg` is NULL and optional is ) }) -## Test 62: error if `accept_expr` is TRUE and value is invalid ---- -test_that("assert_varval_list Test 62: error if `accept_expr` is TRUE and value is invalid", { +## Test 69: error if `accept_expr` is TRUE and value is invalid ---- +test_that("assert_varval_list Test 69: error if `accept_expr` is TRUE and value is invalid", { example_fun <- function(arg) { assert_varval_list(arg, accept_expr = TRUE) } expect_error( - example_fun(vars(DTHSEQ = TRUE)) + example_fun(exprs(DTHSEQ = TRUE)) ) }) -## Test 63: error if `accept_expr` is FALSE and value is invalid ---- -test_that("assert_varval_list Test 63: error if `accept_expr` is FALSE and value is invalid", { +## Test 70: error if `accept_expr` is FALSE and value is invalid ---- +test_that("assert_varval_list Test 70: error if `accept_expr` is FALSE and value is invalid", { example_fun <- function(arg) { assert_varval_list(arg, accept_expr = FALSE) } expect_error( - example_fun(vars(DTHSEQ = vars())) + example_fun(exprs(DTHSEQ = exprs())) ) }) -## Test 64: no error if an argument is a variable-value list ---- -test_that("assert_varval_list Test 64: no error if an argument is a variable-value list", { +## Test 71: no error if an argument is a variable-value list ---- +test_that("assert_varval_list Test 71: no error if an argument is a variable-value list", { example_fun <- function(arg) { assert_varval_list(arg) } expect_invisible( - example_fun(vars(DTHDOM = "AE", DTHSEQ = AESEQ)) + example_fun(exprs(DTHDOM = "AE", DTHSEQ = AESEQ)) ) }) # assert_list_element ---- -## Test 65: no error if the elements fulfill a certain condition ---- -test_that("assert_list_element Test 65: no error if the elements fulfill a certain condition", { - expect_invisible( - assert_list_element(vars(DTHDOM = "AE", DTHSEQ = AESEQ), "DTHSEQ", TRUE, message_text = "") - ) +## Test 72: no error if the elements fulfill a certain condition ---- +test_that("assert_list_element Test 72: no error if the elements fulfill a certain condition", { expect_invisible( - assert_list_element(vars(DTHDOM = "AE", DTHSEQ = admiral.test::admiral_dm), "DTHSEQ", - (admiral.test::admiral_dm)$DOMAIN == "DM", + assert_list_element( + list( + list(var = expr(DTHDT), val = 1), + list(var = expr(EOSDT), val = 0) + ), + element = "val", + condition = val >= 0, message_text = "" ) ) }) -## Test 66: error if the elements do not fulfill the condition ---- -test_that("assert_list_element Test 66: error if the elements do not fulfill the condition", { +## Test 73: error if the elements do not fulfill the condition ---- +test_that("assert_list_element Test 73: error if the elements do not fulfill the condition", { expect_error( - assert_list_element(vars(DTHDOM = "AE", DTHSEQ = admiral.test::admiral_dm), "DTHSEQ", - (admiral.test::admiral_dm)$DOMAIN == "GM", - message_text = "" - ) + assert_list_element( + input <- list( + list(var = expr(DTHDT), val = 1), + list(var = expr(EOSDT), val = -1) + ), + element = "val", + condition = val >= 0, + message_text = "Invalid value for `val`:" + ), + "Invalid value for `val`:\ninput[[2]]$val = -1", + fixed = TRUE ) }) # assert_one_to_one ---- -## Test 67: error if there is a one to many mapping ---- -test_that("assert_one_to_one Test 67: error if there is a one to many mapping", { +## Test 74: error if there is a one to many mapping ---- +test_that("assert_one_to_one Test 74: error if there is a one to many mapping", { expect_error( - assert_one_to_one(admiral.test::admiral_dm, vars(DOMAIN), vars(USUBJID)) + assert_one_to_one(admiral.test::admiral_dm, exprs(DOMAIN), exprs(USUBJID)) ) }) -## Test 68: error if there is a many to one mapping ---- -test_that("assert_one_to_one Test 68: error if there is a many to one mapping", { +## Test 75: error if there is a many to one mapping ---- +test_that("assert_one_to_one Test 75: error if there is a many to one mapping", { expect_error( - assert_one_to_one(admiral.test::admiral_dm, vars(USUBJID), vars(DOMAIN)) + assert_one_to_one(admiral.test::admiral_dm, exprs(USUBJID), exprs(DOMAIN)) ) }) # assert_date_var ---- -## Test 69: error if variable is not a date or datetime variable ---- -test_that("assert_date_var Test 69: error if variable is not a date or datetime variable", { +## Test 76: error if variable is not a date or datetime variable ---- +test_that("assert_date_var Test 76: error if variable is not a date or datetime variable", { example_fun <- function(dataset, var) { - var <- assert_symbol(enquo(var)) + var <- assert_symbol(enexpr(var)) assert_date_var(dataset = dataset, var = !!var) } @@ -961,18 +1066,18 @@ test_that("assert_date_var Test 69: error if variable is not a date or datetime }) # assert_date_vector ---- -## Test 70: returns error if input vector is not a date formatted ---- -test_that("assert_date_vector Test 70: returns error if input vector is not a date formatted", { +## Test 77: returns error if input vector is not a date formatted ---- +test_that("assert_date_vector Test 77: returns error if input vector is not a date formatted", { expect_error(assert_date_vector("2018-08-23")) }) -## Test 71: returns invisible if input is date formatted ---- -test_that("assert_date_vector Test 71: returns invisible if input is date formatted", { +## Test 78: returns invisible if input is date formatted ---- +test_that("assert_date_vector Test 78: returns invisible if input is date formatted", { expect_invisible(assert_date_vector(as.Date("2022-10-25"))) }) -## Test 72: no error if `arg` is NULL and optional is TRUE ---- -test_that("assert_date_vector Test 72: no error if `arg` is NULL and optional is TRUE", { +## Test 79: no error if `arg` is NULL and optional is TRUE ---- +test_that("assert_date_vector Test 79: no error if `arg` is NULL and optional is TRUE", { example_fun <- function(arg) { assert_date_vector(arg, optional = TRUE) } @@ -982,23 +1087,37 @@ test_that("assert_date_vector Test 72: no error if `arg` is NULL and optional is ) }) +## Test 80: error if `arg` is NULL and optional is FALSE ---- +test_that("assert_date_vector Test 80: error if `arg` is NULL and optional is FALSE", { + example_fun <- function(arg) { + assert_date_vector(arg, optional = FALSE) + } + + expect_error( + example_fun(NULL), + "`arg` must be a date or datetime variable but it's `NULL`", + fixed = TRUE + ) +}) + + # assert_atomic_vector ---- -## Test 73: error if input is not atomic vector ---- -test_that("assert_atomic_vector Test 73: error if input is not atomic vector", { +## Test 81: error if input is not atomic vector ---- +test_that("assert_atomic_vector Test 81: error if input is not atomic vector", { x <- list("a", "a", "b", "c", "d", "d", 1, 1, 4) expect_error(assert_atomic_vector(x)) }) # assert_same_type ---- -## Test 74: no error if same type ---- -test_that("assert_same_type Test 74: no error if same type", { +## Test 82: no error if same type ---- +test_that("assert_same_type Test 82: no error if same type", { true_value <- "Y" false_value <- "N" expect_invisible(assert_same_type(true_value, false_value)) }) -## Test 75: error if different type ---- -test_that("assert_same_type Test 75: error if different type", { +## Test 83: error if different type ---- +test_that("assert_same_type Test 83: error if different type", { true_value <- "Y" false_value <- "N" missing_value <- 0 @@ -1016,3 +1135,11 @@ test_that("assert_same_type Test 75: error if different type", { fixed = TRUE ) }) + +## Test 84: works as intended ---- +test_that("assert_same_type Test 84: works as intended", { + expect_equal( + valid_time_units(), + c("years", "months", "days", "hours", "minutes", "seconds") + ) +}) diff --git a/tests/testthat/test-compat_friendly_type.R b/tests/testthat/test-compat_friendly_type.R index a7600e1f..34be20cc 100644 --- a/tests/testthat/test-compat_friendly_type.R +++ b/tests/testthat/test-compat_friendly_type.R @@ -52,7 +52,7 @@ test_that("friendly_type_of Test 4: friendly_type_of() edge cases", { # expect_equal(friendly_type_of(xml2::read_xml("")$node), "a pointer") nolint test_weakref <- rlang::new_weakref(new.env(parent = emptyenv()), - finalizer = function(e) message("finalized") + finalizer = function(e) suppressMessages(message("finalized")) ) expect_equal(friendly_type_of(test_weakref), "a weak reference") diff --git a/tests/testthat/test-dataset_vignette.R b/tests/testthat/test-dataset_vignette.R index 03806c6c..d1b47887 100644 --- a/tests/testthat/test-dataset_vignette.R +++ b/tests/testthat/test-dataset_vignette.R @@ -13,11 +13,11 @@ test_that("dataset_vignette Test 1: A 'knitr_kable' object is outputted when run ) expect_s3_class(dataset_vignette(dm), "knitr_kable") - expect_s3_class(dataset_vignette(dm, display_vars = vars(STUDYID, USUBJID)), "knitr_kable") + expect_s3_class(dataset_vignette(dm, display_vars = exprs(STUDYID, USUBJID)), "knitr_kable") }) ## Test 2: A 'datatables' object is outputted when run inside pkgdown ---- -test_that("dataset_vignette Test 2: A 'datatables' object is outputted when run inside pkgdown", { +test_that("dataset_vignette Test 2: A 'shiny.tag.list' is outputted when run inside pkgdown", { Sys.setenv(IN_PKGDOWN = "true") on.exit(Sys.setenv(IN_PKGDOWN = "")) @@ -30,8 +30,8 @@ test_that("dataset_vignette Test 2: A 'datatables' object is outputted when run ) - expect_s3_class(dataset_vignette(dm), "datatables") - expect_s3_class(dataset_vignette(dm, display_vars = vars(STUDYID, USUBJID)), "datatables") + expect_s3_class(dataset_vignette(dm), "shiny.tag.list") + expect_s3_class(dataset_vignette(dm, display_vars = exprs(STUDYID, USUBJID)), "shiny.tag.list") }) ## Test 3: An error is outputted when calling variable not in dataset ---- @@ -44,5 +44,5 @@ test_that("dataset_vignette Test 3: An error is outputted when calling variable "STUDY1", "4", "USA" ) - expect_error(dataset_vignette(dm, display_vars = vars(AGE))) + expect_error(dataset_vignette(dm, display_vars = exprs(AGE))) }) diff --git a/tests/testthat/test-dev_utilities.R b/tests/testthat/test-dev_utilities.R index 6457e8d8..0481d6c2 100644 --- a/tests/testthat/test-dev_utilities.R +++ b/tests/testthat/test-dev_utilities.R @@ -24,36 +24,37 @@ test_that("convert_dtm_to_dtc Test 3: Error is thrown if dtm is not in correct f ) }) +# filter_if ---- ## Test 4: Input is returned as is if filter is NULL ---- -test_that("convert_dtm_to_dtc Test 4: Input is returned as is if filter is NULL", { +test_that("filter_if Test 4: Input is returned as is if filter is NULL", { input <- tibble::tribble( ~USUBJID, ~VSTESTCD, ~VSSTRESN, - "P01", "WEIGHT", 80.9, - "P01", "HEIGHT", 189.2 + "P01", "WEIGHT", 80.9, + "P01", "HEIGHT", 189.2 ) expected_output <- input expect_dfs_equal( expected_output, - filter_if(input, quo(NULL)), + filter_if(input, expr(NULL)), keys = c("USUBJID", "VSTESTCD") ) }) ## Test 5: Input is filtered if filter is not NULL ---- -test_that("convert_dtm_to_dtc Test 5: Input is filtered if filter is not NULL", { +test_that("filter_if Test 5: Input is filtered if filter is not NULL", { input <- tibble::tribble( ~USUBJID, ~VSTESTCD, ~VSSTRESN, - "P01", "WEIGHT", 80.9, - "P01", "HEIGHT", 189.2 + "P01", "WEIGHT", 80.9, + "P01", "HEIGHT", 189.2 ) expected_output <- input[1L, ] expect_dfs_equal( expected_output, - filter_if(input, quo(VSTESTCD == "WEIGHT")), + filter_if(input, expr(VSTESTCD == "WEIGHT")), keys = c("USUBJID", "VSTESTCD") ) }) @@ -61,10 +62,25 @@ test_that("convert_dtm_to_dtc Test 5: Input is filtered if filter is not NULL", # contains_vars ---- ## Test 6: returns TRUE for valid arguments ---- test_that("contains_vars Test 6: returns TRUE for valid arguments", { - expect_true(contains_vars(vars(USUBJID, PARAMCD))) + expect_true(contains_vars(exprs(USUBJID, PARAMCD))) }) ## Test 7: returns TRUE for valid arguments ---- test_that("contains_vars Test 7: returns TRUE for valid arguments", { expect_error(contains_vars(USUBJID)) }) +# vars2chr ---- +## Test 8: returns character vector ---- +test_that("vars2chr Test 8: returns character vector", { + expected <- c("STUDYID", "USUBJID") + names(expected) <- c("", "") + expect_equal(vars2chr(exprs(STUDYID, USUBJID)), expected) +}) + +## Test 9: warning if quosures argument is used ---- +test_that("vars2chr Test 9: warning if quosures argument is used", { + expect_warning( + vars2chr(quosures = rlang::quos(STUDYID, USUBJID)), + class = "lifecycle_warning_deprecated" + ) +}) diff --git a/tests/testthat/test-get.R b/tests/testthat/test-get.R index 1ec91228..f2a88101 100644 --- a/tests/testthat/test-get.R +++ b/tests/testthat/test-get.R @@ -10,8 +10,8 @@ test_that("get_constant_vars Test 1: without ignore_vars", { ) expect_equal( - get_constant_vars(data, by_vars = vars(USUBJID)), - vars(USUBJID, AGE) + get_constant_vars(data, by_vars = exprs(USUBJID)), + exprs(USUBJID, AGE) ) }) @@ -26,8 +26,8 @@ test_that("get_constant_vars Test 2: with ignore_vars", { ) expect_equal( - get_constant_vars(data, by_vars = vars(USUBJID), ignore_vars = vars(WGTBL, HGTBL)), - vars(USUBJID, AGE) + get_constant_vars(data, by_vars = exprs(USUBJID), ignore_vars = exprs(WGTBL, HGTBL)), + exprs(USUBJID, AGE) ) }) @@ -43,9 +43,9 @@ test_that("get_duplicates Test 3: x atomic vector", { }) # get_source_vars ---- -## Test 4: x is a list of quosures ---- -test_that("get_source_vars Test 4: x is a list of quosures", { - x <- vars(DTHDOM = "AE", DTHSEQ = AESEQ) +## Test 4: x is a list of expressions ---- +test_that("get_source_vars Test 4: x is a list of expressions", { + x <- exprs(DTHDOM = "AE", DTHSEQ = AESEQ) expect_equal( get_source_vars(x), @@ -53,10 +53,25 @@ test_that("get_source_vars Test 4: x is a list of quosures", { ) }) -## Test 5: quosures is NULL ---- -test_that("get_source_vars Test 5: quosures is NULL", { +## Test 5: NULL returns NULL ---- +test_that("get_source_vars Test 5: NULL returns NULL", { expect_equal( get_source_vars(NULL), - quo_c(NULL) + expr_c(NULL) + ) +}) + +## Test 6: warning if quosures argument is used ---- +test_that("get_source_vars Test 6: warning if quosures argument is used", { + expect_warning( + get_source_vars(quosures = rlang::quos(DTHDOM = "AE", DTHSEQ = AESEQ)), + class = "lifecycle_warning_deprecated" + ) +}) +## Test 7: no source vars returns NULL ---- +test_that("get_source_vars Test 7: no source vars returns NULL", { + expect_equal( + get_source_vars(x <- exprs(DTHDOM = "AE", DTHVAR = "AEDECOD")), + NULL ) }) diff --git a/tests/testthat/test-is.R b/tests/testthat/test-is.R index 75f146a3..cee5944c 100644 --- a/tests/testthat/test-is.R +++ b/tests/testthat/test-is.R @@ -6,7 +6,7 @@ test_that("is_order_vars Test 1: returns error if input were created incorrectly ## Test 2: returns TRUE if input were created correctly ---- test_that("is_order_vars Test 2: returns TRUE if input were created correctly", { - expect_true(is_order_vars(vars(AVAL, desc(ADT)))) + expect_true(is_order_vars(exprs(AVAL, desc(ADT)))) }) # is_valid_dtc ---- diff --git a/tests/testthat/test-process_set_values_to.R b/tests/testthat/test-process_set_values_to.R new file mode 100644 index 00000000..44c44712 --- /dev/null +++ b/tests/testthat/test-process_set_values_to.R @@ -0,0 +1,85 @@ +## Test 1: add variables ---- +test_that("process_set_values_to Test 1: add variables", { + bds <- tibble::tribble( + ~USUBJID, ~AVAL, + "1", 20, + "2", 35 + ) + expected <- bds %>% + mutate( + PARAMCD = "BMI", + PARAM = "Body-Mass-Index", + PARAMN = 1 + ) + expect_dfs_equal( + base = expected, + compare = process_set_values_to( + bds, + set_values_to = exprs( + PARAMCD = "BMI", + PARAM = "Body-Mass-Index", + PARAMN = 1 + ), + expected_types = c( + PARAMCD = "character", + PARAM = "character", + PARAMN = "numeric" + ) + ), + keys = c("USUBJID") + ) +}) + +## Test 2: catch error ---- +test_that("process_set_values_to Test 2: catch error", { + bds <- tibble::tribble( + ~USUBJID, ~AVAL, + "1", 20, + "2", 35 + ) + + expect_error( + process_set_values_to( + bds, + set_values_to = exprs( + PARAMCD = BMI, + PARAM = "Body-Mass-Index", + PARAMN = 1 + ) + ), + "Assigning variables failed!\nset_values_to = (", + fixed = TRUE + ) +}) + +## Test 3: check types ---- +test_that("process_set_values_to Test 3: check types", { + bds <- tibble::tribble( + ~USUBJID, ~AVAL, + "1", 20, + "2", 35 + ) + + expect_error( + process_set_values_to( + bds, + set_values_to = exprs( + PARAMCD = 1, + PARAM = "Body-Mass-Index", + PARAMN = "BMI" + ), + expected_types = c( + PARAMCD = "character", + PARAM = "character", + PARAMN = "numeric" + ) + ), + paste( + "The following variables have an unexpected type:", + "PARAMCD: expected: character, actual: numeric", + "PARAMN: expected: numeric, actual: character", + sep = "\n" + ), + fixed = TRUE + ) +}) diff --git a/tests/testthat/test-quo.R b/tests/testthat/test-quo.R index 78c4b7c2..3811feb3 100644 --- a/tests/testthat/test-quo.R +++ b/tests/testthat/test-quo.R @@ -1,6 +1,14 @@ # quo_c ---- -## Test 1: `quo_c` works in concatenating and indexing quosures ---- -test_that("quo_c Test 1: `quo_c` works in concatenating and indexing quosures", { +## Test 1: issues deprecation warning ---- +test_that("quo_c Test 1: issues deprecation warning", { + expect_warning( + quo_c(quo(USUBJID), quo(STUDYID)), + class = "lifecycle_warning_deprecated" + ) +}) + +## Test 2: `quo_c` works in concatenating and indexing quosures ---- +test_that("quo_c Test 2: `quo_c` works in concatenating and indexing quosures", { x <- quo(USUBJID) y <- quo(STUDYID) @@ -14,8 +22,8 @@ test_that("quo_c Test 1: `quo_c` works in concatenating and indexing quosures", ) }) -## Test 2: `quo_c` returns error if non-quosures are input ---- -test_that("quo_c Test 2: `quo_c` returns error if non-quosures are input", { +## Test 3: `quo_c` returns error if non-quosures are input ---- +test_that("quo_c Test 3: `quo_c` returns error if non-quosures are input", { USUBJID <- "01-701-1015" # nolint expect_error( @@ -23,18 +31,44 @@ test_that("quo_c Test 2: `quo_c` returns error if non-quosures are input", { ) }) +# expr_c ---- +## Test 4: concatenating and indexing expressions ---- +test_that("expr_c Test 4: concatenating and indexing expressions", { + x <- expr(USUBJID) + y <- expr(STUDYID) + + expect_equal( + expected = expr(USUBJID), + object = expr_c(x, NULL, y)[[1]] + ) + expect_equal( + expected = expr(STUDYID), + object = expr_c(x, NULL, y)[[2]] + ) +}) + +## Test 5: returns error if non-expressions are input ---- +test_that("expr_c Test 5: returns error if non-expressions are input", { + expect_error( + object = expr_c(expr(USUBJID), mean) + ) +}) + # quo_not_missing ---- -## Test 3: `quo_not_missing` returns TRUE if no missing argument ---- -test_that("quo_not_missing Test 3: `quo_not_missing` returns TRUE if no missing argument", { +## Test 6: issues deprecation warning ---- +test_that("quo_not_missing Test 6: issues deprecation warning", { test_fun <- function(x) { x <- enquo(x) !isTRUE(quo_not_missing(x)) } - expect_true(test_fun(my_variable)) + expect_warning( + test_fun(my_variable), + class = "lifecycle_warning_deprecated" + ) }) -## Test 4: `quo_not_missing` throws an Error if missing argument ---- -test_that("quo_not_missing Test 4: `quo_not_missing` throws an Error if missing argument", { +## Test 7: `quo_not_missing` throws an Error if missing argument ---- +test_that("quo_not_missing Test 7: `quo_not_missing` throws an Error if missing argument", { test_fun <- function(x) { x <- enquo(x) isTrue(quo_not_missing(x)) @@ -43,11 +77,9 @@ test_that("quo_not_missing Test 4: `quo_not_missing` throws an Error if missing }) # replace_values_by_names ---- -## Test 5: names of quosures replace value ---- -test_that("replace_values_by_names Test 5: names of quosures replace value", { - x <- quo(USUBJID) - y <- quo(STUDYID) - z <- quo_c(x, y) +## Test 8: names of quosures replace value ---- +test_that("replace_values_by_names Test 8: names of quosures replace value", { + z <- exprs(USUBJID, STUDYID) z_noname <- replace_values_by_names(z) @@ -55,55 +87,72 @@ test_that("replace_values_by_names Test 5: names of quosures replace value", { z_named <- replace_values_by_names(z) expect_equal( - expected = quo(USUBJID), + expected = expr(USUBJID), object = z_noname[[1]] ) expect_equal( - expected = quo(STUDYID), + expected = expr(STUDYID), object = z_noname[[2]] ) expect_equal( - expected = quo(`Unique Subject Identifier`), + expected = expr(`Unique Subject Identifier`), object = z_named[[1]] ) expect_equal( - expected = quo(`Study Identifier`), + expected = expr(`Study Identifier`), object = z_named[[2]] ) }) +## Test 9: warning if quosures argument is used ---- +test_that("replace_values_by_names Test 9: warning if quosures argument is used", { + expect_warning( + replace_values_by_names(quosures = rlang::quos(STUDYID, USUBJID)), + class = "lifecycle_warning_deprecated" + ) +}) + # replace_symbol_in_quo ---- -## Test 6: symbol is replaced ---- -test_that("replace_symbol_in_quo Test 6: symbol is replaced", { +## Test 10: error if called ---- +test_that("replace_symbol_in_quo Test 10: error if called", { + expect_error( + replace_symbol_in_quo(), + class = "lifecycle_error_deprecated" + ) +}) + +# replace_symbol_in_expr ---- +## Test 11: symbol is replaced ---- +test_that("replace_symbol_in_expr Test 11: symbol is replaced", { expect_equal( - expected = quo(AVAL.join), - object = replace_symbol_in_quo( - quo(AVAL), + expected = expr(AVAL.join), + object = replace_symbol_in_expr( + expr(AVAL), target = AVAL, replace = AVAL.join ) ) }) -## Test 7: partial match is not replaced ---- -test_that("replace_symbol_in_quo Test 7: partial match is not replaced", { +## Test 12: partial match is not replaced ---- +test_that("replace_symbol_in_expr Test 12: partial match is not replaced", { expect_equal( - expected = quo(AVALC), - object = replace_symbol_in_quo( - quo(AVALC), + expected = expr(AVALC), + object = replace_symbol_in_expr( + expr(AVALC), target = AVAL, replace = AVAL.join ) ) }) -## Test 8: symbol in expression is replaced ---- -test_that("replace_symbol_in_quo Test 8: symbol in expression is replaced", { +## Test 13: symbol in expression is replaced ---- +test_that("replace_symbol_in_expr Test 13: symbol in expression is replaced", { expect_equal( - expected = quo(desc(AVAL.join)), - object = replace_symbol_in_quo( - quo(desc(AVAL)), + expected = expr(desc(AVAL.join)), + object = replace_symbol_in_expr( + expr(desc(AVAL)), target = AVAL, replace = AVAL.join ) @@ -111,21 +160,25 @@ test_that("replace_symbol_in_quo Test 8: symbol in expression is replaced", { }) # add_suffix_to_vars ---- -## Test 9: with single variable ---- -test_that("add_suffix_to_vars Test 9: with single variable", { +## Test 14: with single variable ---- +test_that("add_suffix_to_vars Test 14: with single variable", { expect_equal( - expected = vars(ADT, desc(AVAL.join), AVALC), - object = add_suffix_to_vars(vars(ADT, desc(AVAL), AVALC), vars = vars(AVAL), suffix = ".join") + expected = exprs(ADT, desc(AVAL.join), AVALC), + object = add_suffix_to_vars( + exprs(ADT, desc(AVAL), AVALC), + vars = exprs(AVAL), + suffix = ".join" + ) ) }) -## Test 10: with more than one variable ---- -test_that("add_suffix_to_vars Test 10: with more than one variable", { +## Test 15: with more than one variable ---- +test_that("add_suffix_to_vars Test 15: with more than one variable", { expect_equal( - expected = vars(ADT, desc(AVAL.join), AVALC.join), + expected = exprs(ADT, desc(AVAL.join), AVALC.join), object = add_suffix_to_vars( - vars(ADT, desc(AVAL), AVALC), - vars = vars(AVAL, AVALC), + exprs(ADT, desc(AVAL), AVALC), + vars = exprs(AVAL, AVALC), suffix = ".join" ) ) diff --git a/tests/testthat/test-quote.R b/tests/testthat/test-quote.R index 58922aa3..13da4941 100644 --- a/tests/testthat/test-quote.R +++ b/tests/testthat/test-quote.R @@ -3,6 +3,7 @@ test_that("enumerate Test 1: enumerate works", { expect_equal(enumerate(letters[1]), "`a`") expect_equal(enumerate(letters[1:3]), "`a`, `b` and `c`") + expect_equal(enumerate(1:3, quote_fun = NULL), "1, 2 and 3") }) # squote ---- diff --git a/tests/testthat/test-warnings.R b/tests/testthat/test-warnings.R index d443b0e2..23df263e 100644 --- a/tests/testthat/test-warnings.R +++ b/tests/testthat/test-warnings.R @@ -31,20 +31,46 @@ test_that("warn_if_invalud_dtc Test 2: Warning if vector contains unknown dateti # warn_if_inclomplete_dtc ---- ## Test 3: Warning if vector contains an incomplete dtc ---- -test_that("warn_if_inclomplete_dtc Test 3: Warning if vector contains an incomplete dtc", { +test_that("warn_if_inclomplete_dtc Test 3: Warning if vector contains an incomplete date", { expect_warning( - warn_if_incomplete_dtc("2021-04-06", n = 19) + warn_if_incomplete_dtc("2021-04", n = 10) + ) +}) + +# warn_if_inclomplete_dtc ---- +## Test 4: Warning if vector contains an incomplete dtc ---- +test_that("warn_if_inclomplete_dtc Test 4: Warning if vector contains an incomplete datetime", { + expect_warning( + warn_if_incomplete_dtc("2021-04-06T12:30", n = 19) ) }) # warn_if_inconsistent_list ---- -## Test 4: Warning if two lists are inconsistent ---- -test_that("warn_if_inconsistent_list Test 4: Warning if two lists are inconsistent", { +## Test 5: Warning if two lists are inconsistent ---- +test_that("warn_if_inconsistent_list Test 5: Warning if two lists are inconsistent", { expect_warning( warn_if_inconsistent_list( - base = vars(DTHDOM = "DM", DTHSEQ = DMSEQ, DTHVAR = "text"), - compare = vars(DTHDOM = "DM", DTHSEQ = DMSEQ), + base = exprs(DTHDOM = "DM", DTHSEQ = DMSEQ, DTHVAR = "text"), + compare = exprs(DTHDOM = "DM", DTHSEQ = DMSEQ), list_name = "Test" ) ) }) + +# suppress_warning ---- +## Test 6: Suppress certain warnings issued by an expression ---- +test_that("suppress_warning Test 6: Suppress certain warnings issued by an expression", { + # Verify if warning is issued + expect_warning( + suppress_warning(as.numeric("fun"), "x") + ) + + # Actual result + actual_result <- as.numeric(NA) + + # Call the suppress_warning() to suppress warning messages containing "NAs introduced by coercion" + expected_result <- suppress_warning(as.numeric("fun"), "coercion") + + # Expect that the warning message has been suppressed and that the result is NA + expect_equal(expected_result, actual_result) +}) diff --git a/vignettes/admiraldev.Rmd b/vignettes/admiraldev.Rmd index a2962768..fbbb88d4 100644 --- a/vignettes/admiraldev.Rmd +++ b/vignettes/admiraldev.Rmd @@ -56,5 +56,5 @@ A developer working on `{admiralonco}` implements a new type of derivation funct Loose guidelines: -1. The derivation function should be closely looked at to see if it can be generalized to other ADaM datsets. If that is the case, then it should be moved to `{admiral}` core. If the function is very specific to oncology needs, then it should remain in `{admiralonco}`. +1. The derivation function should be closely looked at to see if it can be generalized to other ADaM datasets. If that is the case, then it should be moved to `{admiral}` core. If the function is very specific to oncology needs, then it should remain in `{admiralonco}`. 1. The `assert` custom checking functions follow a similar principle - if they can be generalized to other therapeutic areas then move to `{admiraldev}`, whereas if very specific to oncology needs, then they should remain in `{admiralonco}`. diff --git a/vignettes/development_process.Rmd b/vignettes/development_process.Rmd index 01c6ca0c..c0617c5f 100644 --- a/vignettes/development_process.Rmd +++ b/vignettes/development_process.Rmd @@ -16,7 +16,7 @@ knitr::opts_chunk$set( ``` Once you’ve familiarized yourself with the `{admiral}` [contribution -model](contribution_model.html) and you’re ready to make your first code +model](https://pharmaverse.github.io/admiral/articles/contribution_model.html) and you’re ready to make your first code contribution, this development process step-by-step guide will help tie all the other detailed vignettes together to give you the simplest experience of helping to grow and enhance our codebase. @@ -29,16 +29,16 @@ core team will assign you to the issue. strategy](programming_strategy.html), and then make the required code updates. 1. Before making a pull request, check the [Pull Request Review Guidance](pr_review_guidance.html) & the following checklist of common things developers miss: a. Is all your code formatted according to the [tidyverse](https://style.tidyverse.org/) style guide? - a. Did you create/add appropriate [unit tests](unit_test_guidance.html#writing-unit-tests-in-admiral-)? - a. If you removed/replaced any function and/or function parameters, did you fully follow the [deprecation guidance](programming_strategy.html#deprecation-1)? - a. Did you update the [documentation](programming_strategy.html#function-header-documentation-)? If so, remember to run `devtools::document()` and include the updated `NAMESPACE` and `.Rd` files in `man/` - a. Does your code update have any impact on the [ADaM template](admiral.html#starting-a-script-1) R scripts stored in `inst/templates`? + a. Did you create/add appropriate [unit tests](unit_test_guidance.html#writing-unit-tests-in-admiral)? + a. If you removed/replaced any function and/or function parameters, did you fully follow the [deprecation guidance](programming_strategy.html#deprecation)? + a. Did you update the [documentation](programming_strategy.html#function-header-documentation)? If so, remember to run `devtools::document()` and include the updated `NAMESPACE` and `.Rd` files in `man/` + a. Does your code update have any impact on the [ADaM template](https://pharmaverse.github.io/admiral/articles/admiral.html#starting-a-script) R scripts stored in `inst/templates`? a. Does your code update have any impact on the vignettes stored in vignettes? a. Did you update the Changelog `NEWS.md`? a. Did you build `{admiral}` site `pkgdown::build_site()` and check that all affected examples are displayed correctly and that all new functions occur on the "[Reference](../reference/index.html)" page? 1. Once happy with all the updates, make a [pull request](git_usage.html#pull-request) to merge to the development branch `devel` and link the issue so that it closes after successful merging. 1. Check that there are no merge conflicts. If there are any, fix them before requesting review. See [solving merge conflicts](git_usage.html#solving-merge-conflicts-in-the-terminal-on-rstudio) guidance. -1. Check the results of the automated `R-CMD check` and `lintr` checks and if any issues consult this [guide](pr_review_guidance.html#common-r-cmd-check-issues-1). +1. Check the results of the automated `R-CMD check` and `lintr` checks and if any issues consult this [guide](pr_review_guidance.html#common-r-cmd-check-issues). 1. Assign a reviewer from the `{admiral}` core development team – this could be anyone you discussed the issue with previously via Slack or GitHub. If unsure, add a comment that the pull request is ready for review and add the diff --git a/vignettes/programming_strategy.Rmd b/vignettes/programming_strategy.Rmd index f50f8253..211723f7 100644 --- a/vignettes/programming_strategy.Rmd +++ b/vignettes/programming_strategy.Rmd @@ -94,19 +94,33 @@ If `BASE` is used, the values are categorized while if `ANRIND` is used, the val * The behavior of the function is only determined by its input, not by any global object, i.e. all input like datasets, variable names, options, … must be provided to the function by parameters. * It is expected that the input datasets are not grouped. If any are grouped, the function must issue an error. -* If a function requires grouping, the function must provide the by_vars parameter. +* If a function requires grouping, the function must provide the `by_vars` parameter. * The output dataset must be ungrouped. * The functions should not sort (arrange) the output dataset at the end. -* If the function needs to create temporary variables in an input dataset, these -variables must start with `temp_` and must be removed from the output dataset. -* If the input dataset includes variables starting with `temp_`, an error must be issued. +* If the function needs to create temporary variables in an input dataset, names +for these variables must be generated by `get_new_tmp_var()` to avoid that +variables of the input dataset are accidentally overwritten. The temporary +variables must be removed from the output dataset by calling +`remove_tmp_vars()`. * If developers find the need to use or create *environment* objects to achieve flexibility, use the `admiral_environment` environment object created in `admiral_environment.R`. All objects which are stored in this environment must be documented in `admiral_environment.R`. An equivalent environment object and `.R` file exist for admiraldev as well. For more details how environments work, see relevant sections on environments in [R Packages](https://r-pkgs.org) and [Advanced R](https://adv-r.hadley.nz) textbooks. * In general, the function must not have any side-effects like creating or modifying global objects, printing, writing files, ... ## Admiral Options -* An exception is made for admiral options, see `get_admiral_option()` and `set_admiral_options()`, where we have certain pre-defined defaults with added flexibility to allow for user-defined defaults on *commonly used* function arguments e.g. `subject_keys` currently pre-defined as `vars(STUDYID, USUBJID)`, but can be modified using `set_admiral_options(subject_keys = vars(...))` at the top of a script. The reasoning behind this was to relieve the user of repeatedly changing aforementioned *commonly used* function arguments multiple times in a script, which may be called across many admiral functions. -* If this additional flexibility needs to be added for another *commonly used* function argument e.g. `future_input` to be set as `vars(...)` it can be added as an admiral option. In the function formals define `future_input = get_admiral_option("future_input")` then proceed to modify the body and roxygen documentation of `set_admiral_options()`. +* An exception is made for admiral options, see `get_admiral_option()` and +`set_admiral_options()`, where we have certain pre-defined defaults with added +flexibility to allow for user-defined defaults on *commonly used* function +arguments e.g. `subject_keys` currently pre-defined as `exprs(STUDYID, +USUBJID)`, but can be modified using `set_admiral_options(subject_keys = +exprs(...))` at the top of a script. The reasoning behind this was to relieve +the user of repeatedly changing aforementioned *commonly used* function +arguments multiple times in a script, which may be called across many admiral +functions. +* If this additional flexibility needs to be added for another *commonly used* +function argument e.g. `future_input` to be set as `exprs(...)` it can be added +as an admiral option. In the function formals define `future_input = +get_admiral_option("future_input")` then proceed to modify the body and roxygen +documentation of `set_admiral_options()`. ## Function Names @@ -154,14 +168,14 @@ There is a recommended parameter order that all contributors are asked to adhere * Make sure to always mention `start_date` before `end_date` (or related). Names of variables inside a dataset should be passed as symbols rather than strings, i.e. `AVAL` rather than `"AVAL"`. -If a parameter accepts one or more variables as input, the variables should be wrapped inside `vars()`. +If a parameter accepts one or more variables as input, the variables should be wrapped inside `exprs()`. For example: * `new_var = TEMPBL` -* `by_vars = vars(PARAMCD, AVISIT)` +* `by_vars = exprs(PARAMCD, AVISIT)` * `filter = PARAMCD == "TEMP"` -* `order = vars(AVISIT, desc(AESEV))` +* `order = exprs(AVISIT, desc(AESEV))` Parameter must not accept expressions for assigning the value of the new variable. Instead separate parameters need to be provided for defining the @@ -170,9 +184,9 @@ following is **not acceptable**. ``` ... - new_var = vars(mydtm = convert_dtc_to_dtm(impute_dtc(cmstdtc, - date_imputation = "last", - time_imputation = "last"))), + new_var = exprs(mydtm = convert_dtc_to_dtm(impute_dtc(cmstdtc, + date_imputation = "last", + time_imputation = "last"))), ... ``` @@ -217,7 +231,7 @@ Parameters which expect a boolean or boolean vector must start with a verb, e.g. |------------------|--------------------------------------------------------------------------------------------------------------------| | `dataset` | The input dataset. Expects a data.frame or a tibble. | | `by_vars` | Variables to group by. | -| `order` | List of expressions for sorting a dataset, e.g., `vars(PARAMCD, AVISITN, desc(AVAL))`. | +| `order` | List of expressions for sorting a dataset, e.g., `exprs(PARAMCD, AVISITN, desc(AVAL))`. | | `new_var` | Name of a single variable to be added to the dataset. | | `new_vars` | List of variables to be added to the dataset. | | `new_var_unit` | Name of the unit variable to be added. It should be the unit of the variable specified for the new_var parameter. | @@ -227,15 +241,74 @@ Parameters which expect a boolean or boolean vector must start with a verb, e.g. | `start_dtc` | (Partial) start date/datetime in ISO 8601 format. | | `dtc` | (Partial) date/datetime in ISO 8601 format. | | `date` | Date of an event / interval. Expects a date object. | -| `set_values_to` | List of variable name-value pairs. | -| `subject_keys` | Variables to uniquely identify a subject, defaults to `vars(STUDYID, USUBJID)`. In function formals, use `subject_keys = get_admiral_option("subject_keys")` | +| `set_values_to` | List of variable name-value pairs. Use `process_set_values_to()` for processing the value and providing user friendly error messages. | +| `subject_keys` | Variables to uniquely identify a subject, defaults to `exprs(STUDYID, USUBJID)`. In function formals, use `subject_keys = get_admiral_option("subject_keys")` | ## Source Code Formatting -All source code should be formatted according to the [tidyverse](https://style.tidyverse.org/) style guide. -The [lintr](https://github.com/jimhester/lintr) package will be used to check and enforce this. +All source code should be formatted according to the +[tidyverse](https://style.tidyverse.org/) style guide. The +[lintr](https://github.com/jimhester/lintr) and +[styler](https://github.com/r-lib/styler) packages are used to check and enforce +this. +## Comments + +Comments should be added to help other readers than the author to understand the +code. There are two main cases: + +- If the intention of a chunk of code is not clear, a comment should be added. +The comment should not rephrase the code but provide additional information. + + *Bad* + + ``` + # If AVAL equals zero, set it to 0.0001. Otherwise, do not change it + mutate(dataset, AVAL = if_else(AVAL == 0, 0.0001, AVAL)) + ``` + + *Good* + + ``` + # AVAL is to be displayed on a logarithmic scale. + # Thus replace zeros by a small value to avoid gaps. + mutate(dataset, AVAL = if_else(AVAL == 0, 0.0001, AVAL)) + ``` + +- For long functions (>100 lines) comments can be added to structure the code +and simplify navigation. In this case the comment should end with `----` to add +an entry to the document outline in RStudio. For example: + ``` + # Check arguments ---- + ``` + +The formatting of the comments must follow the +[tidyverse](https://style.tidyverse.org/syntax.html#comments) style guide. I.e., +the comment should start with a single `#` and a space. No decoration (except +for outline entries) must be added. + +*Bad* +``` +# This is a comment # + +########################### +# This is another comment # +########################### + +#+++++++++++++++++++++++++++++++ +# This is a section comment ---- +#+++++++++++++++++++++++++++++++ +``` + +*Good* +``` +# This is a comment + +# This is another comment + +# This is a section comment ---- +``` ## Input Checking @@ -266,10 +339,9 @@ This rule is applicable only if both functions are part of `{admiral}`. Every function that is exported from the package must have an accompanying header that should be formatted according to the [roxygen2](https://roxygen2.r-lib.org/) convention. -In addition to the roxygen2 parameters, `@author` and `@keywords` are also used. +In addition to the roxygen2 parameters, `@keywords` is also used. -Author is the owner of the function while the keywords are used to categorize the function. -Please see section "Categorization of functions". +The keywords are used to categorize the function. Please see section "Categorization of functions". An example is given below: @@ -292,14 +364,12 @@ An example is given below: #' character vector to a date object. #' #' @param source_vars A list of datetime or date variables created using -#' `vars()` from which dates are to be extracted. This can either be a list of +#' `exprs()` from which dates are to be extracted. This can either be a list of #' date(time) variables or named `--DY` variables and corresponding --DT(M) -#' variables e.g. `vars(TRTSDTM, ASTDTM, AENDT)` or `vars(TRTSDT, ASTDTM, +#' variables e.g. `exprs(TRTSDTM, ASTDTM, AENDT)` or `exprs(TRTSDT, ASTDTM, #' AENDT, DEATHDY = DTHDT)`. If the source variable does not end in --DT(M), a #' name for the resulting `--DY` variable must be provided. #' -#' @author Teckla Akinyi -#' #' @details The relative day is derived as number of days from the reference #' date to the end date. If it is nonnegative, one is added. I.e., the #' relative day of the reference date is 1. Unless a name is explicitly @@ -333,7 +403,7 @@ An example is given below: #' derive_vars_dy( #' datain, #' reference_date = TRTSDTM, -#' source_vars = vars(TRTSDTM, ASTDTM, AENDT) +#' source_vars = exprs(TRTSDTM, ASTDTM, AENDT) #' ) ``` @@ -344,7 +414,6 @@ The following fields are mandatory: The following attributes should be described: expected data type (e.g. `data.frame`, `logical`, `numeric` etc.), default value (if any), permitted values (if applicable), optionality (i.e. is this a required parameter). If the expected input is a dataset then the required variables should be clearly stated. * `@details`: A natural-language description of the derivation used inside the function. -* `@author`: The person who wrote the function. In case a function is later on updated by another person the name should be appended to the list of authors. * `@keyword`: One applicable tag to the function - identical to family. * `@family`: One applicable tag to the function - identical to keyword. * `@return`: A description of the return value of the function. @@ -429,7 +498,8 @@ add an issue in GitHub for discussion. | `utils_fmt` | Utilities for Formatting Observations | | `utils_help` | Utilities used within Derivation functions | | `utils_examples` | Utilities used for examples and template scripts | -| `source_specifications` | Source Specifications | +| `source_specifications` | Source Objects | +| `other_advanced` | Other Advanced Functions | | `high_order_function` | Higher Order Functions | | | `internal` | Internal functions only available to admiral developers | | | | @@ -476,7 +546,11 @@ Functions from other packages have to be explicitly imported by using the `@impo To import the `if_else()` and `mutate()` function from `dplyr` the following line would have to be included in that file: `#' @importFrom dplyr if_else mutate`. -Some of these functions become critically important while using admiral and should be included as an export. This applies to functions which are frequently called within `{admiral }`function calls like `dplyr::vars()`, `dplyr::desc()` or the pipe operator `magrittr::%>%`. To export these functions, the following R code should be included in the `R/reexports.R` file using the format: +Some of these functions become critically important while using admiral and +should be included as an export. This applies to functions which are frequently +called within `{admiral }`function calls like `rlang::exprs()`, `dplyr::desc()` +or the pipe operator `magrittr::%>%`. To export these functions, the following R +code should be included in the `R/reexports.R` file using the format: ``` #' @export @@ -491,7 +565,7 @@ Functions should only perform the derivation logic and not add any kind of metad # Unit Testing A function requires a set of unit tests to verify it produces the expected result. -See [Writing Unit Tests in {admiral}](unit_test_guidance.html#writing-unit-tests-in-admiral-) for details. +See [Writing Unit Tests in {admiral}](unit_test_guidance.html#writing-unit-tests-in-admiral) for details. # Deprecation @@ -590,19 +664,19 @@ If a parameter is removed and is not replaced, an **error** must be generated: ### END DEPRECATION ``` -If the parameter is renamed or replaced, a **warning** must be issued and the new parameter takes -the value of the old parameter until the next release. -Note: parameters which are not passed as `vars()` argument (e.g. `new_var = VAR1` or `filter = AVAL >10`) -will need to be quoted. +If the parameter is renamed or replaced, a **warning** must be issued and the +new parameter takes the value of the old parameter until the next release. Note: +parameters which are not passed as `exprs()` argument (e.g. `new_var = VAR1` or +`filter = AVAL >10`) will need to be quoted. ``` ### BEGIN DEPRECATION if (!missing(old_param)) { deprecate_warn("x.y.z", "fun_xxx(old_param = )", "fun_xxx(new_param = )") - # old_param is given using vars() + # old_param is given using exprs() new_param <- old_param - # old_param is NOT given using vars() - new_param <- enquo(old_param) + # old_param is NOT given using exprs() + new_param <- enexpr(old_param) } ### END DEPRECATION ``` @@ -648,83 +722,10 @@ Other unit tests of deprecated functions must be removed. Please take the following list as recommendation and try to adhere to its rules if possible. * Parameters in function calls should be named except for the first parameter -(e.g. `assert_data_frame(dataset, required_vars = vars(var1, var2), optional = TRUE)`). +(e.g. `assert_data_frame(dataset, required_vars = exprs(var1, var2), optional = TRUE)`). * `dplyr::if_else()` should be used when there are only two conditions. Try to always set the `missing` parameter whenever appropriate. - -# Readable Code for ADaM - -Each function should be considered as readable code by default. - - -## Basic Rules - -All R code that produces ADaM datasets should be based on readable code for their 1st line code. -Producing Readable Code should not be part or the responsibility of any QC activities or 2nd line programming. - -ADaMs in R will be highly modularized. This means code needs to be commented across the set of functions that produces the final ADaM dataset. - -This guidance is built on the assumption that each ADaM dataset will have one R script that will call a set of functions needed to produce the corresponding ADaM dataset. - - -## Header for the main R-Script - -The main R-script would contain all function calls to create the ADaM dataset. In the header, describe the ADaM dataset that will be produced: - -* Name -* Label -* Input SDTMs and ADaMs -* Short description of its purpose if not obvious by the label (novel endpoints mainly) - - -### Header for functions - -* See Function header - - -### Functions - -* Function calls should have a preceding comment which is a short and meaningful description for which purpose the function is called, like: - * Derive variable X if function name is not descriptive or if it is a customized variable. - * Ideally use plain english to describe what a function is deriving. - * \# derive analysis study day - * \# derive age group <= 18 - * Impute date with missing days. - * Check for missing values. -* A comment can cover multiple function calls that belong to a category or group of variables. -Ideally one keeps it in line with the ADaM IG terminology, like Treatment Variables, Timing Variables, Identifier Variables as much as possible - * \# derive all population indicator variables RANDFL, SAFFL ... -* Functions that create user defined variables, specific to the molecule or study or support a specific endpoint should be called out specifically, like: -the following function calls flag the special Adverse Events or a comment that highlights a molecule specific endoint -* A function that covers a whole algorithm should have a preceding comment that indicates the purpose of the algorithm, like - * \# derive secondary endpoint XYZ - - -### Code - -The code itself should be described in meaningful, plain English, so that a reviewer can understand how the piece of code works, e.g. - -* \# calculates the sum of scores divided by the non missing numbers of scores to calculate the average score - -Code within a function that creates a specific variable should have a starting comment and an ending comment, e.g. - -```{r, eval=F} -# calculate X -# describe how the code works in meaningful plain english -"" -# end of X -``` - -If meaningful, comments can cover multiple variables within a piece of code - -```{r, eval=F} -# creates X, Y, Z -# describe how the code works in meaningful plain english -"" -# end of X, Y, Z -``` - # R and package versions for development * The choice of R Version is not set in stone. However, a common development environment is important to establish when working across multiple companies and multiple developers. We currently work in the earliest of the three latest R Versions. This need for a common development environment also carries over for our choice of package versions. diff --git a/vignettes/release_strategy.Rmd b/vignettes/release_strategy.Rmd index cad575b5..5e042f51 100644 --- a/vignettes/release_strategy.Rmd +++ b/vignettes/release_strategy.Rmd @@ -47,9 +47,14 @@ A package release is done in five parts: 1) Verify that all CI/CD checks are passing for the `devel` into the `pre-release` Pull Request, merge and then bundle up and send off to CRAN. 1) Once the package is available on CRAN, another Pull Request is created for merging the `pre-release` branch into the `main` branch. This will trigger the GitHub action to rebuild the `{admiral}` website with all the updates for this release. 1) Use the release button on GitHub to "release" the package onto GitHub. This release onto Github archives the version of code within the `main` branch, attaches the News/Changelog file, bundles the code into a `tar.gz` file and makes a validation report via the GitHub action `validation` from [insightsengineering/validatoR](https://github.com/insightsengineering/thevalidatoR). Please see past [admiral releases](https://github.com/pharmaverse/admiral/releases) for reference. -1) Any issues fixed in the `pre-release/main` branches should be merged back into `devel`. +1) Any issues fixed in the `pre-release/main` branches should be merged back into `devel`. +1) Once a release is completed the `main` branch should be merged into `patch` to be ready for hotfixes. -**Quarterly Release:** `devel >> pre-release >> main` +**Quarterly Release:** + +* `devel >> pre-release >> main` +* `pre-release >> main >> devel` (Fixes done after a CRAN rejection) +* `main >> patch` (To be prepared in case of a needed hotfix) ## Hot Fix Release diff --git a/vignettes/writing_vignettes.Rmd b/vignettes/writing_vignettes.Rmd index 0ac4bce0..ba72accc 100644 --- a/vignettes/writing_vignettes.Rmd +++ b/vignettes/writing_vignettes.Rmd @@ -129,7 +129,6 @@ library(lubridate) library(dplyr) library(admiral.test) library(DT) -#library(admiral) data(admiral_vs) ``` @@ -158,7 +157,7 @@ vs1 <- admiral_vs %>% dataset_vignette( vs1, - display_vars = vars(USUBJID, VSTESTCD, VISIT, VSDTC, ADT), + display_vars = exprs(USUBJID, VSTESTCD, VISIT, VSDTC, ADT), filter = VSTESTCD == "WEIGHT" ) ``` @@ -170,7 +169,7 @@ Note: The call to get the formatted dataset would be: ```{r, eval=FALSE, echo=TRUE} dataset_vignette( vs1, - display_vars = vars(USUBJID, VSTESTCD, VISIT, VSDTC, ADT), + display_vars = exprs(USUBJID, VSTESTCD, VISIT, VSDTC, ADT), filter = VSTESTCD == "WEIGHT" ) ```