diff --git a/.Rbuildignore b/.Rbuildignore index 7adf8bb6..ed4e8d8a 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -17,6 +17,7 @@ ^vignettes/git_usage\.Rmd$ ^vignettes/writing_vignettes\.Rmd$ ^vignettes/unit_test_guidance\.Rmd$ +^vignettes/release_strategy\.Rmd$ ^vignettes/.+png$ ^LICENSE\.md$ ^\.github$ diff --git a/.github/pull_request_template.md b/.github/pull_request_template.md index c871b5c9..213e0063 100644 --- a/.github/pull_request_template.md +++ b/.github/pull_request_template.md @@ -1,18 +1,18 @@ -Thank you for your Pull Request! We have developed this task checklist from the [Development Process Guide](https://pharmaverse.github.io/admiral/articles/development_process.html) to help with the final steps of the process. Completing the below tasks helps to ensure our reviewers can maximize their time on your code as well as making sure the admiral codebase remains robust and consistent. +Thank you for your Pull Request! We have developed this task checklist from the [Development Process Guide](https://pharmaverse.github.io/admiraldev/devel/articles/development_process.html) to help with the final steps of the process. Completing the below tasks helps to ensure our reviewers can maximize their time on your code as well as making sure the admiral codebase remains robust and consistent. Please check off each taskbox as an acknowledgment that you completed the task or check off that it is not relevant to your Pull Request. This checklist is part of the Github Action workflows and the Pull Request will not be merged into the `devel` branch until you have checked off each task. - [ ] Place Closes # into the beginning of your Pull Request Title (Use Edit button in top-right if you need to update) - [ ] Code is formatted according to the [tidyverse style guide](https://style.tidyverse.org/). Run `styler::style_file()` to style R and Rmd files -- [ ] Updated relevant unit tests or have written new unit tests - See [Unit Test Guide](https://pharmaverse.github.io/admiral/articles/unit_test_guidance.html) -- [ ] If you removed/replaced any function and/or function parameters, did you fully follow the [deprecation guidance](https://pharmaverse.github.io/admiral/articles/programming_strategy.html#deprecation)? -- [ ] Update to all relevant roxygen headers and examples. +- [ ] Updated relevant unit tests or have written new unit tests, which should consider realistic data scenarios and edge cases, e.g. empty datasets, errors, boundary cases etc. - See [Unit Test Guide](https://pharmaverse.github.io/admiraldev/devel/articles/unit_test_guidance.html#tests-should-be-robust-to-cover-realistic-data-scenarios) +- [ ] If you removed/replaced any function and/or function parameters, did you fully follow the [deprecation guidance](https://pharmaverse.github.io/admiraldev/devel/articles/programming_strategy.html#deprecation)? +- [ ] Update to all relevant roxygen headers and examples, including keywords and families. Refer to the [categorization of functions](https://pharmaverse.github.io/admiraldev/devel/articles/programming_strategy.html#categorization-of-functions) to tag appropriate keyword/family. - [ ] Run `devtools::document()` so all `.Rd` files in the `man` folder and the `NAMESPACE` file in the project root are updated appropriately - [ ] Address any updates needed for vignettes and/or templates - [ ] Update `NEWS.md` if the changes pertain to a user-facing function (i.e. it has an `@export` tag) or documentation aimed at users (rather than developers) -- [ ] Build admiral site `pkgdown::build_site()` and check that all affected examples are displayed correctly and that all new functions occur on the "[Reference](https://pharmaverse.github.io/admiral/reference/index.html)" page. +- [ ] Build admiral site `pkgdown::build_site()` and check that all affected examples are displayed correctly and that all new functions occur on the "[Reference](https://pharmaverse.github.io/admiraldev/devel/reference/index.html)" page. - [ ] Address or fix all lintr warnings and errors - `lintr::lint_package()` - [ ] Run `R CMD check` locally and address all errors and warnings - `devtools::check()` -- [ ] Link the issue so that it closes after successful merging. -- [ ] Address all merge conflicts and resolve appropriately. +- [ ] Link the issue in the Development Section on the right hand side. +- [ ] Address all merge conflicts and resolve appropriately - [ ] Pat yourself on the back for a job well done! Much love to your accomplishment! diff --git a/.github/workflows/common.yml b/.github/workflows/common.yml index 584a828e..518c64af 100644 --- a/.github/workflows/common.yml +++ b/.github/workflows/common.yml @@ -45,25 +45,25 @@ jobs: uses: pharmaverse/admiralci/.github/workflows/style.yml@main if: github.event_name == 'pull_request' with: - r-version: $R_VERSION + r-version: "4.0" spellcheck: name: Spelling uses: pharmaverse/admiralci/.github/workflows/spellcheck.yml@main if: github.event_name == 'pull_request' with: - r-version: $R_VERSION + r-version: "4.0" readme: name: Render README uses: pharmaverse/admiralci/.github/workflows/readme-render.yml@main if: github.event_name == 'push' with: - r-version: $R_VERSION + r-version: "4.0" validation: name: Validation uses: pharmaverse/admiralci/.github/workflows/r-pkg-validation.yml@main if: github.event_name == 'release' with: - r-version: $R_VERSION + r-version: "4.0" check: name: Check uses: pharmaverse/admiralci/.github/workflows/r-cmd-check.yml@main @@ -73,17 +73,19 @@ jobs: uses: pharmaverse/admiralci/.github/workflows/pkgdown.yml@main if: github.event_name == 'push' with: - r-version: $R_VERSION + r-version: "4.0" # Whether to skip multiversion docs # Note that if you have multiple versions of docs, # your URL links are likely to break due to path changes skip-multiversion-docs: false + # Ref to use for the multiversion docs landing page + multiversion-docs-landing-page: devel linter: name: Lint uses: pharmaverse/admiralci/.github/workflows/lintr.yml@main if: github.event_name == 'pull_request' with: - r-version: $R_VERSION + r-version: "4.0" links: name: Links uses: pharmaverse/admiralci/.github/workflows/links.yml@main @@ -95,7 +97,7 @@ jobs: if: > github.event_name == 'push' || github.event_name == 'pull_request' with: - r-version: $R_VERSION + r-version: "4.0" # Whether to skip code coverage badge creation # Setting to 'false' will require you to create # an orphan branch called 'badges' in your repository @@ -105,4 +107,4 @@ jobs: uses: pharmaverse/admiralci/.github/workflows/man-pages.yml@main if: github.event_name == 'pull_request' with: - r-version: $R_VERSION + r-version: "4.0" diff --git a/DESCRIPTION b/DESCRIPTION index 93bc010e..ac2473e1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: admiraldev Type: Package Title: Development Tools for the Admiral Package Family -Version: 0.1.0 +Version: 0.2.0 Authors@R: c( person("Ben", "Straub", email = "ben.x.straub@gsk.com", role = c("aut", "cre")), person("Stefan", "Bundfuss", role = "aut"), @@ -9,12 +9,17 @@ Authors@R: c( person("Samia", "Kabi", role = "aut"), person("Pooja", "Kumari", role = "aut"), person("Syed", "Mubasheer", role = "aut"), + person("Ross", "Farrugia", role = "aut"), + person("Sadchla", "Mascary", role = "aut"), + person("Zelos", "Zhu", role = "aut"), + person("Jeffrey", "Dickinson", role = "aut"), + person("Ania", "Golab", role = "aut"), person("Ondrej", "Slama", role = "ctb"), person("F. Hoffmann-La Roche AG", role = c("cph", "fnd")), person("GlaxoSmithKline LLC", role = c("cph", "fnd")) ) Description: Utility functions to check data, variables and conditions for functions used in - 'admiral' and 'admiral' extension packages. Additional utility helper functions to to assist developers + 'admiral' and 'admiral' extension packages. Additional utility helper functions to assist developers with maintaining documentation, testing and general upkeep of 'admiral' and 'admiral' extension packages. License: Apache License (>= 2) URL: https://pharmaverse.github.io/admiraldev/main/, https://github.com/pharmaverse/admiraldev/ @@ -22,20 +27,19 @@ Encoding: UTF-8 Language: en-US LazyData: false Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.0 +RoxygenNote: 7.2.1 Depends: R (>= 3.5) Imports: - assertthat, - dplyr, - lubridate, - magrittr, - purrr, - rlang, - stringr, - hms, - tidyr, - tidyselect, - lifecycle + dplyr (>= 0.8.4), + hms (>= 0.5.3), + lifecycle (>= 0.1.0), + lubridate (>= 1.7.4), + magrittr (>= 1.5), + purrr (>= 0.3.3), + rlang (>= 0.4.4), + stringr (>= 1.4.0), + tidyr (>= 1.0.2), + tidyselect (>= 1.0.0) Suggests: admiral.test, devtools, diff --git a/NAMESPACE b/NAMESPACE index b50534d2..27842088 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,13 +2,16 @@ export("%notin%") 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) export(assert_data_frame) export(assert_date_var) +export(assert_date_vector) export(assert_expr) export(assert_filter_cond) export(assert_function) @@ -24,14 +27,15 @@ export(assert_one_to_one) export(assert_order_vars) export(assert_param_does_not_exist) export(assert_s3_class) +export(assert_same_type) export(assert_symbol) export(assert_unit) export(assert_vars) export(assert_varval_list) export(backquote) +export(contains_vars) export(convert_dtm_to_dtc) export(dataset_vignette) -export(desc) export(dquote) export(enumerate) export(expect_dfs_equal) @@ -44,37 +48,24 @@ export(get_new_tmp_var) export(get_source_vars) export(inner_join) export(is_auto) -export(is_date) export(is_named) export(is_order_vars) -export(is_timeunit) -export(is_valid_date_entry) -export(is_valid_day) export(is_valid_dtc) -export(is_valid_hour) -export(is_valid_month) -export(is_valid_sec_min) -export(is_valid_time_entry) export(left_join) -export(negate_vars) export(quo_c) export(quo_not_missing) export(remove_tmp_vars) +export(replace_symbol_in_quo) export(replace_values_by_names) -export(set_dataset) export(squote) export(suppress_warning) export(valid_time_units) -export(vars) export(vars2chr) export(warn_if_incomplete_dtc) export(warn_if_inconsistent_list) export(warn_if_invalid_dtc) export(warn_if_vars_exist) export(what_is_it) -importFrom(assertthat,"on_failure<-") -importFrom(assertthat,assert_that) -importFrom(assertthat,is.number) importFrom(dplyr,arrange) importFrom(dplyr,bind_cols) importFrom(dplyr,bind_rows) @@ -172,6 +163,7 @@ importFrom(rlang,is_logical) importFrom(rlang,is_quosure) importFrom(rlang,is_quosures) importFrom(rlang,is_symbol) +importFrom(rlang,missing_arg) importFrom(rlang,new_formula) importFrom(rlang,parse_expr) importFrom(rlang,parse_exprs) @@ -195,6 +187,7 @@ importFrom(stringr,str_c) importFrom(stringr,str_detect) importFrom(stringr,str_extract) importFrom(stringr,str_glue) +importFrom(stringr,str_match) importFrom(stringr,str_remove) importFrom(stringr,str_remove_all) importFrom(stringr,str_replace) diff --git a/NEWS.md b/NEWS.md index 6a65d04c..f3e0a739 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,32 @@ +# admiraldev 0.2.0 + +## New Features + - Developer addin for formatting tests to admiral programming standards (#73) + - New functions `replace_symbol_in_quo()` and `add_suffix_to_vars()` (#106) + - New function `assert_atomic_vector()` (#98) + - New keyword/family `create_aux` for functions creating auxiliary datasets (#126) + - New function `assert_date_vector()` (#129) + - New function `assert_same_type()` (#176) + - Remove dependency on `{assertthat}` (#149) + - Test coverage for `admiraldev` have increased from 45% to approximately 100% (#94, #95, #96, #98, #101, #103) + - _Environment_ objects were consolidated into a single `admiraldev_environment` object under `R/admiraldev_environment.R`. (#179) + +## Updates of Existing Functions + - `expect_names` argument added to `assert_vars()` to check if all variables are named (#117) + - Remove `dplyr` function exports and migration of user facing function `negate_vars()` to admiral (#83) + +## Breaking Changes + - No longer compatible with admiral (<0.9) + +## Documentation + - 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) + # admiraldev 0.1.0 ## New Features @@ -7,18 +36,14 @@ - New `{admiraldev}` website created ## Updates of Existing Functions - - NA - + ## Breaking Changes - - NA ## Documentation - - NA ## Various - - NA diff --git a/R/addin_format_testthat.R b/R/addin_format_testthat.R index 7fd34971..6de0674c 100644 --- a/R/addin_format_testthat.R +++ b/R/addin_format_testthat.R @@ -19,7 +19,7 @@ prepare_test_that_file <- function(path) { } # parse the name of the testing function - testing_fun <- sub("^test-", "", sub(".R$", "", basename(path))) + testing_file <- sub("^test-", "", sub(".R$", "", basename(path))) # get file content file_content <- readLines(path) @@ -47,13 +47,21 @@ prepare_test_that_file <- function(path) { ) test_that_desc_cleaned <- stringr::str_remove( string = test_that_desc_parsed, - pattern = paste0(testing_fun, ", ", "test \\d{1,}: ") + pattern = paste0("([\\w\\.]+,? )?[Tt]est \\d{1,} ?: ") ) + # determine name of function which is tested + # the function name can be specified by # function_name ---- comments + function_name <- str_match(file_content, "# ([\\w\\.]+) ----")[, 2] + if (is.na(function_name[1])) { + function_name[1] <- testing_file + } + function_name <- tidyr::fill(data.frame(name = function_name), name)$name + function_name <- function_name[test_that_loc] + # formulate new test descriptions (update only those that don't include test_title) new_desc <- paste0( - testing_fun, ", ", - "test ", seq_along(test_that_loc), ": ", + "Test ", seq_along(test_that_loc), ": ", test_that_desc_cleaned ) @@ -61,7 +69,7 @@ prepare_test_that_file <- function(path) { test_that_lines_updated <- stringr::str_replace( string = test_that_lines, pattern = '(?<=test_that\\(").*"', - replacement = paste0(new_desc, '"') + replacement = paste0(function_name, " ", new_desc, '"') ) # modify the file content @@ -72,10 +80,10 @@ prepare_test_that_file <- function(path) { #### # formulate headers according to RStudio editor functionality - headers <- paste0("# ---- ", new_desc, " ----") + headers <- paste0("## ", new_desc, " ----") # get locations of headers created by this function - header_loc_lgl <- grepl(paste0("^# ---- ", testing_fun, ", ", "test \\d{1,}: "), file_content) + header_loc_lgl <- grepl(paste0("^##?( ----)?( \\w+)?,? [tT]est \\d{1,} ?: "), file_content) # remove those headers file_content <- file_content[!header_loc_lgl] diff --git a/R/admiraldev-package.R b/R/admiraldev-package.R index e4b2e9eb..38b31500 100644 --- a/R/admiraldev-package.R +++ b/R/admiraldev-package.R @@ -6,7 +6,7 @@ #' @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 +#' 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 @@ -15,10 +15,9 @@ #' @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 -#' @importFrom stringr str_c str_detect str_extract str_remove str_remove_all -#' str_replace str_trim str_to_lower str_subset str_to_title str_to_upper -#' str_glue -#' @importFrom assertthat assert_that is.number on_failure<- +#' @importFrom stringr str_c str_detect str_extract str_glue str_match +#' str_remove str_remove_all str_replace str_trim str_to_lower str_subset +#' str_to_title str_to_upper #' @importFrom lubridate as_datetime ceiling_date date days duration floor_date is.Date is.instant #' time_length %--% ymd ymd_hms weeks years hours minutes #' @importFrom tidyr drop_na nest pivot_longer pivot_wider unnest diff --git a/R/admiraldev_environment.R b/R/admiraldev_environment.R new file mode 100644 index 00000000..28176315 --- /dev/null +++ b/R/admiraldev_environment.R @@ -0,0 +1,23 @@ +#' Environment Objects +#' +#' @details +#' Once in a while, we may encounter "locked binding for 'xxx'." errors +#' during the development process while building out functions. This may arise because +#' we want to create dynamic data/objects based on user-inputs that need modification +#' at points in time after the package has been loaded. To manage such data or objects, +#' R has a data structure known as an 'environment'. These environment objects are created +#' at build time, but can be populated with values after the package has been loaded and +#' update those values over the course of an R session. For more details how environments work, +#' see relevant sections on environments in R Packages and Advanced R textbooks for more details. +#' @noRd +admiraldev_environment <- new.env(parent = emptyenv()) +# See respective ...R page for usage + +# assertions.R ---- +## assert_one_to_one +admiraldev_environment$many_to_one <- NULL +admiraldev_environment$one_to_many <- NULL + +# datasets.R ---- +## get_dataset +# Function above is used to retrieve many_to_one and one_to_many diff --git a/R/assertions.R b/R/assertions.R index 550c4fb2..8ef8288e 100644 --- a/R/assertions.R +++ b/R/assertions.R @@ -23,6 +23,7 @@ #' #' @examples #' library(admiral.test) +#' library(dplyr, warn.conflicts = FALSE) #' data(admiral_dm) #' #' example_fun <- function(dataset) { @@ -31,7 +32,7 @@ #' #' example_fun(admiral_dm) #' -#' try(example_fun(dplyr::select(admiral_dm, -STUDYID))) +#' try(example_fun(select(admiral_dm, -STUDYID))) #' #' try(example_fun("Not a dataset")) assert_data_frame <- function(arg, @@ -86,7 +87,8 @@ assert_data_frame <- function(arg, #' one of the provided `values`. #' #' @param arg A function argument to be checked -#' @param values A `character` vector of valid values for `arg` +#' @param values A `character` vector of valid values for `arg`. +#' Values is converted to a lower case vector if case_sensitive = FALSE is used. #' @param case_sensitive Should the argument be handled case-sensitive? #' If set to `FALSE`, the argument is converted to lower case for checking the #' permitted values and returning the argument. @@ -157,11 +159,30 @@ assert_character_scalar <- function(arg, abort(err_msg) } - if (!case_sensitive) { - arg <- tolower(arg) + # Create case_adjusted_arg and case_adjusted_values for the following purpose: + # + # 1. To simplify the comparison of arg and values; i.e. the "case_adjusted_" + # variables take into consideration whether `case_sensitive = TRUE`, or + # `case_sensitive = FALSE`. + # + # 2. To avoid overwriting the original "arg" and "values", so that subsequent + # code can refer directly to the initial function arguments: this is + # required whilst generating an error message if "arg" is not one of the + # user-specified valid values. + + if (case_sensitive) { + case_adjusted_arg <- arg + if (!is.null(values)) { + case_adjusted_values <- values + } + } else { + case_adjusted_arg <- tolower(arg) + if (!is.null(values)) { + case_adjusted_values <- tolower(values) + } } - if (!is.null(values) && arg %notin% values) { + if (!is.null(values) && case_adjusted_arg %notin% case_adjusted_values) { err_msg <- sprintf( "`%s` must be one of %s but is '%s'", arg_name(substitute(arg)), @@ -171,7 +192,7 @@ assert_character_scalar <- function(arg, abort(err_msg) } - invisible(arg) + invisible(case_adjusted_arg) } #' Is an Argument a Character Vector? @@ -303,11 +324,13 @@ assert_logical_scalar <- function(arg, optional = FALSE) { #' @family assertion #' @examples #' library(admiral.test) +#' library(dplyr, warn.conflicts = FALSE) +#' library(rlang) #' data(admiral_dm) #' #' example_fun <- function(dat, var) { -#' var <- assert_symbol(rlang::enquo(var)) -#' dplyr::select(dat, !!var) +#' var <- assert_symbol(enquo(var)) +#' select(dat, !!var) #' } #' #' example_fun(admiral_dm, USUBJID) @@ -395,12 +418,14 @@ assert_expr <- function(arg, optional = FALSE) { #' #' @examples #' library(admiral.test) +#' library(dplyr, warn.conflicts = FALSE) +#' library(rlang) #' data(admiral_dm) #' #' # typical usage in a function as a parameter check #' example_fun <- function(dat, x) { -#' x <- assert_filter_cond(rlang::enquo(x)) -#' dplyr::filter(dat, !!x) +#' x <- assert_filter_cond(enquo(x)) +#' filter(dat, !!x) #' } #' #' example_fun(admiral_dm, AGE == 64) @@ -437,9 +462,13 @@ assert_filter_cond <- function(arg, optional = FALSE) { #' Checks if an argument is a valid list of variables created using `vars()` #' #' @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 #' +#' @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 @@ -451,18 +480,29 @@ assert_filter_cond <- function(arg, optional = FALSE) { #' @keywords assertion #' @family assertion #' @examples +#' library(dplyr, warn.conflicts = FALSE) +#' library(rlang) +#' #' example_fun <- function(by_vars) { #' assert_vars(by_vars) #' } #' #' example_fun(vars(USUBJID, PARAMCD)) #' -#' try(example_fun(rlang::exprs(USUBJID, PARAMCD))) +#' try(example_fun(exprs(USUBJID, PARAMCD))) #' #' try(example_fun(c("USUBJID", "PARAMCD", "VISIT"))) #' #' try(example_fun(vars(USUBJID, toupper(PARAMCD), desc(AVAL)))) -assert_vars <- function(arg, optional = FALSE) { +#' +#' example_fun_name <- function(by_vars) { +#' assert_vars(by_vars, expect_names = TRUE) +#' } +#' +#' example_fun_name(vars(APERSDT = APxxSDT, APEREDT = APxxEDT)) +#' +#' try(example_fun_name(vars(APERSDT = APxxSDT, APxxEDT))) +assert_vars <- function(arg, optional = FALSE, expect_names = FALSE) { assert_logical_scalar(optional) default_err_msg <- sprintf( @@ -493,6 +533,18 @@ assert_vars <- function(arg, optional = FALSE) { 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) } @@ -515,6 +567,8 @@ assert_vars <- function(arg, optional = FALSE) { #' @keywords assertion #' @family assertion #' @examples +#' library(dplyr, warn.conflicts = FALSE) +#' library(rlang) #' #' example_fun <- function(by_vars) { #' assert_order_vars(by_vars) @@ -522,7 +576,7 @@ assert_vars <- function(arg, optional = FALSE) { #' #' example_fun(vars(USUBJID, PARAMCD, desc(AVISITN))) #' -#' try(example_fun(rlang::exprs(USUBJID, PARAMCD))) +#' try(example_fun(exprs(USUBJID, PARAMCD))) #' #' try(example_fun(c("USUBJID", "PARAMCD", "VISIT"))) #' @@ -532,7 +586,7 @@ assert_order_vars <- function(arg, optional = FALSE) { default_err_msg <- paste( backquote(arg_name(substitute(arg))), - "must be a a list of unquoted variable names or `desc()` calls,", + "must be a list of unquoted variable names or `desc()` calls,", "e.g. `vars(USUBJID, desc(VISITNUM))`" ) @@ -548,7 +602,9 @@ assert_order_vars <- function(arg, optional = FALSE) { abort(default_err_msg) } - assert_that(is_order_vars(arg)) + if (isFALSE(is_order_vars(arg))) { + abort(default_err_msg) + } invisible(arg) } @@ -656,6 +712,48 @@ assert_numeric_vector <- function(arg, optional = FALSE) { } } +#' Is an Argument an Atomic Vector? +#' +#' Checks if an argument is an atomic vector +#' +#' @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 Ania Golab +#' +#' @return +#' The function throws an error if `arg` is not an atomic vector. +#' Otherwise, the input is returned invisibly. +#' +#' @export +#' +#' @keywords assertion +#' @family assertion +#' @examples +#' example_fun <- function(x) { +#' assert_atomic_vector(x) +#' } +#' +#' example_fun(1:10) +#' +#' try(example_fun(list(1, 2))) +assert_atomic_vector <- function(arg, optional = FALSE) { + assert_logical_scalar(optional) + + if (optional && is.null(arg)) { + return(invisible(arg)) + } + + if (!is.atomic(arg)) { + err_msg <- sprintf( + "`%s` must be an atomic vector but is %s", + arg_name(substitute(arg)), + what_is_it(arg) + ) + abort(err_msg) + } +} #' Is an Argument an Object of a Specific S3 Class? #' @@ -1095,6 +1193,8 @@ assert_param_does_not_exist <- function(dataset, param) { #' @export #' #' @examples +#' library(dplyr, warn.conflicts = FALSE) +#' #' example_fun <- function(vars) { #' assert_varval_list(vars) #' } @@ -1308,7 +1408,7 @@ assert_one_to_one <- function(dataset, vars1, vars2) { filter(n() > 1) %>% arrange(!!!vars1) if (nrow(one_to_many) > 0) { - set_dataset(one_to_many, "one_to_many") + admiraldev_environment$one_to_many <- one_to_many abort( paste0( "For some values of ", @@ -1324,7 +1424,7 @@ assert_one_to_one <- function(dataset, vars1, vars2) { filter(n() > 1) %>% arrange(!!!vars2) if (nrow(many_to_one) > 0) { - set_dataset(many_to_one, "many_to_one") + admiraldev_environment$many_to_one <- many_to_one abort( paste0( "There is more than one value of ", @@ -1424,3 +1524,99 @@ assert_date_var <- function(dataset, var, dataset_name = NULL, var_name = NULL) )) } } + +#' Is an object a date or datetime vector? +#' +#' Check if an object/vector is a date or datetime variable without needing a dataset as input +#' +#' @param arg The function argument to be checked +#' +#' @param optional Is the checked parameter optional? If set to `FALSE` +#' and `arg` is `NULL` then the function `assert_date_vector` exits early and throw and error. +#' +#' @return +#' The function returns an error if `arg` is missing, or not a date or datetime variable +#' but otherwise returns an invisible output. +#' +#' @export +#' +#' @author Sadchla Mascary +#' +#' @keywords assertion +#' +#' @family assertion +#' +#' @examples +#' example_fun <- function(arg) { +#' assert_date_vector(arg) +#' } +#' +#' example_fun( +#' as.Date("2022-01-30", tz = "UTC") +#' ) +#' try(example_fun("1993-07-14")) +assert_date_vector <- function(arg, optional = TRUE) { + assert_logical_scalar(optional) + + if (optional && is.null(arg)) { + return(invisible(arg)) + } + + if (!is.instant(arg)) { + abort(paste0( + deparse(substitute(arg)), + " must be a date or datetime variable but it's ", + friendly_type_of(arg) + )) + } +} + +#' Are All Argument of the Same Type? +#' +#' +#' Checks if all arguments are of the same type. +#' +#' @param ... Arguments to be checked +#' +#' @author Stefan Bundfuss +#' +#' @return The function throws an error if not all arguments are of the same type. +#' +#' @export +#' +#' @keywords assertion +#' @family assertion +#' +#' @examples +#' example_fun <- function(true_value, false_value, missing_value) { +#' assert_same_type(true_value, false_value, missing_value) +#' } +#' +#' example_fun( +#' true_value = "Y", +#' false_value = "N", +#' missing_value = NA_character_ +#' ) +#' +#' try(example_fun( +#' true_value = 1, +#' false_value = 0, +#' missing_value = "missing" +#' )) +assert_same_type <- function(...) { + args <- rlang::dots_list(..., .named = TRUE) + arg_names <- lapply(args, function(x) deparse(substitute(x))) + types <- lapply(args, typeof) + + if (length(unique(types)) > 1) { + abort( + paste( + "All arguments must be of the same type.", + "Argument: Type", + "--------------", + paste0(names(args), ": ", types, collapse = "\n"), + sep = "\n" + ) + ) + } +} diff --git a/R/datasets.R b/R/datasets.R index a0371214..0b4a84b5 100644 --- a/R/datasets.R +++ b/R/datasets.R @@ -1,31 +1,4 @@ -.datasets <- new.env(parent = emptyenv()) - -#' Set a Dataset in the `.datasets` environment -#' -#' @param dataset A `data.frame` -#' @param name A name for `dataset` -#' -#' @return -#' No return value, called for side effects -#' -#' @author Thomas Neitmann -#' -#' @keywords datasets -#' @family datasets -#' -#' @details -#' The object passed to the `dataset` argument will be assigned to `name` in -#' the `.datasets` environment. It can be retrieved later on using [get_dataset()] -#' -#' @export -set_dataset <- function(dataset, name) { - assert_data_frame(dataset, check_is_grouped = FALSE) - assert_character_scalar(name) - - .datasets[[name]] <- dataset -} - -#' Retrieve a Dataset from the `.datasets` environment +#' Retrieve a Dataset from the `admiraldev_environment` environment #' #' @param name The name of the dataset to retrieve #' @@ -38,7 +11,7 @@ set_dataset <- function(dataset, name) { #' #' @export get_dataset <- function(name) { - assert_character_scalar(name) + assert_character_scalar(name, values = c("one_to_many", "many_to_one")) - .datasets[[name]] + admiraldev_environment[[name]] } diff --git a/R/dev_utilities.R b/R/dev_utilities.R index e34fc0bc..91fc9314 100644 --- a/R/dev_utilities.R +++ b/R/dev_utilities.R @@ -95,7 +95,6 @@ extract_vars <- function(x, side = "lhs") { } } - #' Or #' #' @param lhs Any valid R expression @@ -116,31 +115,6 @@ extract_vars <- function(x, side = "lhs") { tryCatch(lhs, error = function(e) rhs) } -#' Replace Quosure Value with Name -#' -#' @param quosures A list of quosures -#' -#' @author Thomas Neitmann -#' -#' @keywords dev_utility -#' @family dev_utility -#' -#' -#' @return A list of quosures -#' @export -replace_values_by_names <- function(quosures) { - vars <- map2(quosures, names(quosures), function(q, n) { - if (n == "") { - return(q) - } - quo_set_env( - quo(!!as.symbol(n)), - quo_get_env(q) - ) - }) - structure(vars, class = "quosures", names = NULL) -} - #' Turn a Quosure into a String #' @@ -165,6 +139,8 @@ as_name <- function(x) { #' Valid Time Units #' +#' Contains the acceptable character vector of valid time units +#' #' @return A `character` vector of valid time units #' #' @export @@ -175,6 +151,17 @@ 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 +#' +#' @param arg A function argument to be checked +#' +#' @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) != "") } @@ -193,6 +180,8 @@ contains_vars <- function(arg) { #' @family dev_utility #' #' @examples +#' library(dplyr, warn.conflicts = FALSE) +#' #' vars2chr(vars(USUBJID, AVAL)) vars2chr <- function(quosures) { rlang::set_names( @@ -201,35 +190,6 @@ vars2chr <- function(quosures) { ) } -#' Negate List of Variables -#' -#' The function adds a minus sign as prefix to each variable. -#' -#' This is useful if a list of variables should be removed from a dataset, -#' e.g., `select(!!!negate_vars(by_vars))` removes all by variables. -#' -#' @param vars List of variables created by `vars()` -#' -#' @return A list of `quosures` -#' -#' @author Stefan Bundfuss -#' -#' @export -#' -#' @keywords dev_utility -#' @family dev_utility -#' -#' @examples -#' negate_vars(vars(USUBJID, STUDYID)) -negate_vars <- function(vars = NULL) { - assert_vars(vars, optional = TRUE) - if (is.null(vars)) { - NULL - } else { - lapply(vars, function(var) expr(-!!quo_get_expr(var))) - } -} - #' Optional Filter #' #' Filters the input dataset if the provided expression is not `NULL` @@ -248,9 +208,8 @@ negate_vars <- function(vars = NULL) { #' @family dev_utility #' filter_if <- function(dataset, filter) { - assert_data_frame(dataset) + assert_data_frame(dataset, check_is_grouped = FALSE) assert_filter_cond(filter, optional = TRUE) - if (quo_is_null(filter)) { dataset } else { diff --git a/R/expect_dfs_equal.R b/R/expect_dfs_equal.R index 191f2407..0e83c0b3 100644 --- a/R/expect_dfs_equal.R +++ b/R/expect_dfs_equal.R @@ -1,6 +1,7 @@ #' Expectation: Are Two Datasets Equal? #' -#' Uses [diffdf::diffdf()] to compares 2 datasets for any differences +#' Uses [diffdf::diffdf()] to compares 2 datasets for any differences. This function can be +#' thought of as an R-equivalent of SAS proc compare and a useful tool for unit testing as well. #' #' @param base Input dataset #' @param compare Comparison dataset @@ -15,6 +16,38 @@ #' @keywords test_helper #' @family test_helper #' +#' @examples +#' library(dplyr, warn.conflicts = FALSE) +#' library(tibble) +#' +#' tbl1 <- tribble( +#' ~USUBJID, ~AGE, ~SEX, +#' "1001", 18, "M", +#' "1002", 19, "F", +#' "1003", 20, "M", +#' "1004", 18, "F" +#' ) +#' +#' tbl2 <- tribble( +#' ~USUBJID, ~AGE, ~SEX, +#' "1001", 18, "M", +#' "1002", 18.9, "F", +#' "1003", 20, NA +#' ) +#' +#' try(expect_dfs_equal(tbl1, tbl2, keys = "USUBJID")) +#' +#' tlb3 <- tribble( +#' ~USUBJID, ~AGE, ~SEX, +#' "1004", 18, "F", +#' "1003", 20, "M", +#' "1002", 19, "F", +#' "1001", 18, "M", +#' ) +#' +#' # Note the sorting order of the keys is not required +#' expect_dfs_equal(tbl1, tlb3, keys = "USUBJID") +#' #' @export expect_dfs_equal <- function(base, compare, keys, ...) { diff <- diffdf::diffdf(base, compare, keys, suppress_warnings = TRUE, ...) diff --git a/R/get.R b/R/get.R index 1438b8f9..53a78a6b 100644 --- a/R/get.R +++ b/R/get.R @@ -19,6 +19,10 @@ #' @return Variable vector. #' @export get_constant_vars <- function(dataset, by_vars, ignore_vars = NULL) { + assert_data_frame(dataset, optional = FALSE) + assert_vars(by_vars, optional = FALSE) + assert_vars(ignore_vars, optional = TRUE) + non_by_vars <- setdiff(names(dataset), vars2chr(by_vars)) if (!is.null(ignore_vars)) { @@ -63,6 +67,8 @@ get_constant_vars <- function(dataset, by_vars, ignore_vars = NULL) { #' #' get_duplicates(c("a", "a", "b", "c", "d", "d")) get_duplicates <- function(x) { + assert_atomic_vector(x) + unique(x[duplicated(x)]) } @@ -78,5 +84,7 @@ get_duplicates <- function(x) { #' @return A list of quosures #' @export get_source_vars <- function(quosures) { + assert_varval_list(quosures, optional = TRUE) + quo_c(quosures)[lapply(quo_c(quosures), quo_is_symbol) == TRUE] } diff --git a/R/global.R b/R/global.R index 56d5fae8..7e73db53 100644 --- a/R/global.R +++ b/R/global.R @@ -4,5 +4,6 @@ globalVariables(c( "_unit", "auto", + "name", "PARAMCD" )) diff --git a/R/is.R b/R/is.R index f557f10b..d74799d9 100644 --- a/R/is.R +++ b/R/is.R @@ -28,244 +28,13 @@ is_auto <- function(arg) { is_quosure(arg) && quo_is_symbol(arg) && quo_get_expr(arg) == expr(auto) } -#' Is Date/Date-time? -#' -#' Checks if a date or date-time vector was specified -#' -#' @param arg The argument to check -#' -#' @author Stefan Bundfuss -#' -#' @return `TRUE` if the argument is a date or date-time, `FALSE` otherwise -#' -#' @keywords is -#' @family is -#' @export -is_date <- function(arg) { - is.instant(arg) -} -on_failure(is_date) <- function(call, env) { - evld <- eval(call$arg, envir = env) - len <- length(evld) - msg <- if (len == 0) { - deparse(evld) - } else if (len == 1) { - evld - } else { - paste0("c(", paste(head(evld, 5), collapse = ", "), `if`(len > 5, ", ..."), ")") - } - paste0( - "Argument ", - deparse(call$arg), - " = ", - msg, - " is not a lubridate date." - ) -} - -#' Is Time Unit? -#' -#' Checks if a string is a time unit, i.e., 'years', 'months', 'days', 'hours', -#' 'minutes', or 'seconds'. -#' -#' @param arg The argument to check -#' -#' @author Stefan Bundfuss -#' -#' @return `TRUE` if the argument is a time unit, `FALSE` otherwise -#' -#' @keywords is -#' @family is -#' @export -is_timeunit <- function(arg) { - arg %in% c("years", "months", "days", "hours", "minutes", "seconds") -} -on_failure(is_timeunit) <- function(call, env) { - paste0( - "Argument ", - deparse(call$arg), - " = ", - eval(call$arg, envir = env), - " is not a valid time unit.", - " Valid time units are 'years', 'months', 'days', 'hours', 'minutes', and 'seconds'." - ) -} - -#' Check Validity of the Date Imputation Input -#' -#' Date_imputation format should be specified as "dd-mm" (e.g. "01-01") -#' or as a keyword: "FIRST", "MID", "LAST" -#' -#' @param arg The argument to check -#' -#' @author Samia Kabi -#' -#' @return `TRUE` if the argument is a valid date_imputation input, `FALSE` otherwise -#' -#' @keywords is -#' @family is -#' @export -is_valid_date_entry <- function(arg) { - pattern <- "^(01|02|03|04|05|06|07|08|09|10|11|12)-([0-9]{2})$" - grepl(pattern, arg) | str_to_upper(arg) %in% c("FIRST", "MID", "LAST") -} -on_failure(is_valid_date_entry) <- function(call, env) { - paste0( - "Argument ", - deparse(call$arg), - " = ", - eval(call$arg, envir = env), - " is not a valid date entry.\n", - "date_imputation should be specified as 'mm-dd' (e.g. '01-21') or ", - "'FIRST', 'MID', 'LAST' to get the first/mid/last day/month" - ) -} - -#' Check Validity of the Time Imputation Input -#' -#' Time_imputation format should be specified as "hh:mm:ss" (e.g. "00:00:00") -#' or as a keyword: "FIRST", "LAST" -#' -#' @param arg The argument to check -#' -#' @author Samia Kabi -#' -#' @return `TRUE` if the argument is a valid time_imputation input, `FALSE` otherwise -#' -#' @keywords is -#' @family is -#' @export -is_valid_time_entry <- function(arg) { - pattern <- "^([0-9]{2}):([0-9]{2}):([0-9]{2})$" - grepl(pattern, arg) | str_to_upper(arg) %in% c("FIRST", "LAST") -} -on_failure(is_valid_time_entry) <- function(call, env) { - paste0( - "Argument ", - deparse(call$arg), - " = ", - eval(call$arg, envir = env), - " is not a valid time entry.\n", - "time_imputation should be specified as 'hh:mm:ss' (e.g. '00:00:00') or ", - "'FIRST', 'LAST' to get the first/last time of the day" - ) -} - -#' Check Validity of the Minute/Second Portion of the Time Input -#' -#' Minutes and seconds are expected to range from 0 to 59 -#' -#' @param arg The argument to check -#' -#' @author Samia Kabi -#' -#' @return `TRUE` if the argument is a valid min/sec input, `FALSE` otherwise -#' -#' @keywords is -#' @family is -#' @export -is_valid_sec_min <- function(arg) { - arg %in% 0:59 -} -on_failure(is_valid_sec_min) <- function(call, env) { - paste0( - "Argument ", - deparse(call$arg), - " = ", - eval(call$arg, envir = env), - " is not a valid min/sec.\n", - "Values must be between between 0-59" - ) -} - -#' Check Validity of the Hour Portion in the Time Input -#' -#' Hours are expected to range from 0 to 23 -#' -#' @param arg The argument to check -#' -#' @author Samia Kabi -#' -#' @return `TRUE` if the argument is a valid hour input, `FALSE` otherwise -#' -#' @keywords is -#' @family is -#' @export -is_valid_hour <- function(arg) { - arg %in% 0:23 -} -on_failure(is_valid_hour) <- function(call, env) { - paste0( - "Argument ", - deparse(call$arg), - "=", - eval(call$arg, envir = env), - " is not a valid hour.\n", - "Values must be between 0-23" - ) -} - -#' Check Validity of the Day Portion in the Date Input -#' -#' Days are expected to range from 1 to 31 -#' -#' @param arg The argument to check -#' -#' @author Samia Kabi -#' -#' @return `TRUE` if the argument is a day input, `FALSE` otherwise -#' -#' @keywords is -#' @family is -#' @export -is_valid_day <- function(arg) { - arg %in% 1:31 -} -on_failure(is_valid_day) <- function(call, env) { - paste0( - "Argument ", - deparse(call$arg), - " = ", - eval(call$arg, envir = env), - " is not a valid day.\n", - "Values must be between 1-31" - ) -} - -#' Check Validity of the Month Portion in the Date Input -#' -#' Days are expected to range from 1 to 12 -#' -#' @param arg The argument to check -#' -#' @author Samia Kabi -#' -#' @return `TRUE` if the argument is a month input, `FALSE` otherwise -#' -#' @keywords is -#' @family is -#' -#' @export -is_valid_month <- function(arg) { - arg %in% 1:12 -} -on_failure(is_valid_month) <- function(call, env) { - paste0( - "Argument ", - deparse(call$arg), - " = ", - eval(call$arg, envir = env), - " is not a valid month.\n", - "Values for month must be between 1-12. ", - "Please check the date_imputation input: it should be sepcified as 'dd-mm'" - ) -} - #' Is order vars? #' -#' @param arg A)` function calls +#' created by `vars()`, e.g., `vars(ADT, desc(AVAL))` +#' +#' @param vars Variables to change +#' +#' *Permitted Values*: list of variables created by `vars()` +#' +#' @param suffix Suffix +#' +#' *Permitted Values*: A character scalar +#' +#' @author Stefan Bundfuss +#' +#' @return The list of quosures where for each element the suffix (`suffix`) is +#' added to every symbol specified for `vars` +#' +#' @keywords quo +#' @family quo +#' +#' @export +#' +#' @examples +#' library(dplyr, warn.conflicts = FALSE) +#' +#' add_suffix_to_vars(vars(ADT, desc(AVAL), AVALC), vars = vars(AVAL), suffix = ".join") +add_suffix_to_vars <- function(order, + vars, + suffix) { + assert_order_vars(order) + assert_vars(vars) + assert_character_scalar(suffix) + 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)) + ) + } + class(order) <- c("quosures", "list") + order } diff --git a/R/reexports.R b/R/reexports.R deleted file mode 100644 index 9d41576a..00000000 --- a/R/reexports.R +++ /dev/null @@ -1,5 +0,0 @@ -#' @export -dplyr::vars - -#' @export -dplyr::desc diff --git a/R/tmp_vars.R b/R/tmp_vars.R index b0f37315..72deb84a 100644 --- a/R/tmp_vars.R +++ b/R/tmp_vars.R @@ -68,7 +68,7 @@ get_new_tmp_var <- function(dataset, prefix = "tmp_var") { #' The input dataset with temporary variables removed #' #' @examples -#' library(dplyr) +#' library(dplyr, warn.conflicts = FALSE) #' library(admiral.test) #' data(admiral_dm) #' dm <- select(admiral_dm, USUBJID) diff --git a/R/warnings.R b/R/warnings.R index 960c9a72..279d1973 100644 --- a/R/warnings.R +++ b/R/warnings.R @@ -149,6 +149,8 @@ warn_if_incomplete_dtc <- function(dtc, n) { #' @export #' #' @examples +#' library(dplyr, warn.conflicts = FALSE) +#' #' # no warning #' warn_if_inconsistent_list( #' base = vars(DTHDOM = "DM", DTHSEQ = DMSEQ), diff --git a/README.Rmd b/README.Rmd index 42559d0b..44daca01 100644 --- a/README.Rmd +++ b/README.Rmd @@ -47,7 +47,7 @@ Tools for developing functions and maintaining a healthy code base within the fa ## Installation -The package is available from CRAN and can be installed by running install.packages("admiraldev"). +The package is available from CRAN and can be installed by running `install.packages("admiraldev")`. To install the latest development version of the package directly from GitHub use the following code: @@ -61,10 +61,4 @@ remotes::install_github("pharmaverse/admiraldev", ref = "devel") ## Release Schedule -`{admiraldev}` is to be officially released to CRAN one week before an official release of `{admiral}`. You can find the release schedule for `{admiral}` packages [here](https://github.com/pharmaverse/admiral/tree/devel#release-schedule). - - - - - - +`{admiraldev}` is to be officially released to CRAN one week before an official release of `{admiral}`. You can find the release schedule for `{admiral}` packages [here](https://pharmaverse.github.io/admiral/#release-schedule). diff --git a/README.md b/README.md index b42b2472..69eaf654 100644 --- a/README.md +++ b/README.md @@ -5,6 +5,7 @@ ADaM in R Asset Library Development Utilities + ## Purpose @@ -13,26 +14,29 @@ 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. -**NOTE:** Use of this package as a standalone package is currently not -recommended. +__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 ## Installation The package is available from CRAN and can be installed by running -install.packages(“admiraldev”). +`install.packages("admiraldev")`. To install the latest development version of the package directly from GitHub use the following code: - if (!requireNamespace("remotes", quietly = TRUE)) { - install.packages("remotes") - } +``` +if (!requireNamespace("remotes", quietly = TRUE)) { + install.packages("remotes") +} - remotes::install_github("pharmaverse/admiraldev", ref = "devel") +remotes::install_github("pharmaverse/admiraldev", ref = "devel") +``` ## Release Schedule -`{admiraldev}` is to be official released to CRAN one week before the -release of `{admiral}`. You can find the release schedule for +`{admiraldev}` is to be officially released to CRAN one week before an +official release of `{admiral}`. You can find the release schedule for `{admiral}` packages -[here](https://github.com/pharmaverse/admiral/tree/devel#release-schedule). +[here](https://pharmaverse.github.io/admiral/#release-schedule). diff --git a/_pkgdown.yml b/_pkgdown.yml index d8e9b8e9..0d231f0a 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -1,11 +1,9 @@ -url: https://pharmaverse.github.io/admiraldev +url: https://pharmaverse.github.io/admiraldev/devel/ template: + bootstrap: 5 params: bootswatch: flatly - docsearch: - api_key: 2d4895759f79e89d6eb1c3b990bca6d8 - index_name: pharmaverse repo: url: home: https://github.com/pharmaverse/admiraldev @@ -51,8 +49,8 @@ reference: contents: - has_keyword('tmp_vars') -- title: Getting and Setting Datasets - desc: Assign or retrieve a dataset into/from the `.datasets` enironment +- title: Getting Datasets + desc: Retrieve a dataset from the `admiraldev_environment` enironment contents: - has_keyword('datasets') @@ -79,7 +77,7 @@ reference: navbar: components: reference: - text: Functions + text: Reference href: reference/index.html articles: text: Developer Guides @@ -96,3 +94,5 @@ navbar: href: articles/git_usage.html - text: Pull Request Review Guidance href: articles/pr_review_guidance.html + - text: Release Strategy + href: articles/release_strategy.html diff --git a/docs/pkgdown.yml b/docs/pkgdown.yml index 62e3a507..7edab153 100644 --- a/docs/pkgdown.yml +++ b/docs/pkgdown.yml @@ -1,4 +1,4 @@ -pandoc: 2.11.4 +pandoc: '2.18' pkgdown: 2.0.3 pkgdown_sha: ~ articles: @@ -7,10 +7,11 @@ articles: git_usage: git_usage.html pr_review_guidance: pr_review_guidance.html programming_strategy: programming_strategy.html + release_strategy: release_strategy.html unit_test_guidance: unit_test_guidance.html writing_vignettes: writing_vignettes.html -last_built: 2022-08-17T11:24Z +last_built: 2022-11-08T06:16Z urls: - reference: https://pharmaverse.github.io/admiraldev/reference - article: https://pharmaverse.github.io/admiraldev/articles + 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 109227fb..50b14099 100644 --- a/inst/WORDLIST +++ b/inst/WORDLIST @@ -17,6 +17,7 @@ Template’ USUBJIDs adam adamig +addin admiraltemplate admiralxxx admiraldev @@ -30,5 +31,6 @@ onboarding pharmaverse renv repo +roxygen www th diff --git a/man/add_suffix_to_vars.Rd b/man/add_suffix_to_vars.Rd new file mode 100644 index 00000000..2f9a591a --- /dev/null +++ b/man/add_suffix_to_vars.Rd @@ -0,0 +1,46 @@ +% Generated by roxygen2: do not edit by hand +% 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} +\usage{ +add_suffix_to_vars(order, vars, suffix) +} +\arguments{ +\item{order}{List of quosures + +\emph{Permitted Values}: list of variables or \verb{desc()} function calls +created by \code{vars()}, e.g., \code{vars(ADT, desc(AVAL))}} + +\item{vars}{Variables to change + +\emph{Permitted Values}: list of variables created by \code{vars()}} + +\item{suffix}{Suffix + +\emph{Permitted Values}: A character scalar} +} +\value{ +The list of quosures 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 +} +\examples{ +library(dplyr, warn.conflicts = FALSE) + +add_suffix_to_vars(vars(ADT, desc(AVAL), AVALC), vars = vars(AVAL), suffix = ".join") +} +\seealso{ +Helpers for working with Quosures: +\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/admiraldev-package.Rd b/man/admiraldev-package.Rd index f8c998cf..ce0bf3bc 100644 --- a/man/admiraldev-package.Rd +++ b/man/admiraldev-package.Rd @@ -8,7 +8,7 @@ \description{ \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} -Utility functions to check data, variables and conditions for functions used in 'admiral' and 'admiral' extension packages. Additional utility helper functions to to assist developers with maintaining documentation, testing and general upkeep of 'admiral' and 'admiral' extension packages. +Utility functions to check data, variables and conditions for functions used in 'admiral' and 'admiral' extension packages. Additional utility helper functions to assist developers with maintaining documentation, testing and general upkeep of 'admiral' and 'admiral' extension packages. } \seealso{ Useful links: @@ -28,6 +28,11 @@ Authors: \item Samia Kabi \item Pooja Kumari \item Syed Mubasheer + \item Ross Farrugia + \item Sadchla Mascary + \item Zelos Zhu + \item Jeffrey Dickinson + \item Ania Golab } Other contributors: diff --git a/man/arg_name.Rd b/man/arg_name.Rd index 981ce05d..d9bed423 100644 --- a/man/arg_name.Rd +++ b/man/arg_name.Rd @@ -20,11 +20,10 @@ 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}()}, \code{\link{filter_if}()}, -\code{\link{negate_vars}()}, -\code{\link{replace_values_by_names}()}, \code{\link{valid_time_units}()}, \code{\link{vars2chr}()} } diff --git a/man/as_name.Rd b/man/as_name.Rd index 0560c69a..7cc604de 100644 --- a/man/as_name.Rd +++ b/man/as_name.Rd @@ -24,11 +24,10 @@ 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{negate_vars}()}, -\code{\link{replace_values_by_names}()}, \code{\link{valid_time_units}()}, \code{\link{vars2chr}()} } diff --git a/man/assert_atomic_vector.Rd b/man/assert_atomic_vector.Rd new file mode 100644 index 00000000..9dc6ae85 --- /dev/null +++ b/man/assert_atomic_vector.Rd @@ -0,0 +1,62 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/assertions.R +\name{assert_atomic_vector} +\alias{assert_atomic_vector} +\title{Is an Argument an Atomic Vector?} +\usage{ +assert_atomic_vector(arg, optional = FALSE) +} +\arguments{ +\item{arg}{A function argument to be checked} + +\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 an atomic vector. +Otherwise, the input is returned invisibly. +} +\description{ +Checks if an argument is an atomic vector +} +\examples{ +example_fun <- function(x) { + assert_atomic_vector(x) +} + +example_fun(1:10) + +try(example_fun(list(1, 2))) +} +\seealso{ +Checks for valid input and returns warning or errors messages: +\code{\link{assert_character_scalar}()}, +\code{\link{assert_character_vector}()}, +\code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, +\code{\link{assert_expr}()}, +\code{\link{assert_filter_cond}()}, +\code{\link{assert_function_param}()}, +\code{\link{assert_function}()}, +\code{\link{assert_has_variables}()}, +\code{\link{assert_integer_scalar}()}, +\code{\link{assert_list_element}()}, +\code{\link{assert_list_of}()}, +\code{\link{assert_logical_scalar}()}, +\code{\link{assert_named_exprs}()}, +\code{\link{assert_numeric_vector}()}, +\code{\link{assert_one_to_one}()}, +\code{\link{assert_order_vars}()}, +\code{\link{assert_param_does_not_exist}()}, +\code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, +\code{\link{assert_symbol}()}, +\code{\link{assert_unit}()}, +\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 06e7c7e1..a312669c 100644 --- a/man/assert_character_scalar.Rd +++ b/man/assert_character_scalar.Rd @@ -14,7 +14,8 @@ assert_character_scalar( \arguments{ \item{arg}{A function argument to be checked} -\item{values}{A \code{character} vector of valid values for \code{arg}} +\item{values}{A \code{character} vector of valid values for \code{arg}. +Values is converted to a lower case vector if case_sensitive = FALSE is used.} \item{case_sensitive}{Should the argument be handled case-sensitive? If set to \code{FALSE}, the argument is converted to lower case for checking the @@ -59,8 +60,10 @@ example_fun2("Warning") } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -76,6 +79,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, diff --git a/man/assert_character_vector.Rd b/man/assert_character_vector.Rd index eb8405a8..8927ad57 100644 --- a/man/assert_character_vector.Rd +++ b/man/assert_character_vector.Rd @@ -33,8 +33,10 @@ try(example_fun(1:10)) } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -50,6 +52,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, diff --git a/man/assert_data_frame.Rd b/man/assert_data_frame.Rd index 8147f1b0..a2faa0d2 100644 --- a/man/assert_data_frame.Rd +++ b/man/assert_data_frame.Rd @@ -32,6 +32,7 @@ a set of required variables } \examples{ library(admiral.test) +library(dplyr, warn.conflicts = FALSE) data(admiral_dm) example_fun <- function(dataset) { @@ -40,14 +41,16 @@ example_fun <- function(dataset) { example_fun(admiral_dm) -try(example_fun(dplyr::select(admiral_dm, -STUDYID))) +try(example_fun(select(admiral_dm, -STUDYID))) try(example_fun("Not a dataset")) } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -63,6 +66,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, diff --git a/man/assert_date_vector.Rd b/man/assert_date_vector.Rd new file mode 100644 index 00000000..442afa65 --- /dev/null +++ b/man/assert_date_vector.Rd @@ -0,0 +1,63 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/assertions.R +\name{assert_date_vector} +\alias{assert_date_vector} +\title{Is an object a date or datetime vector?} +\usage{ +assert_date_vector(arg, optional = TRUE) +} +\arguments{ +\item{arg}{The function argument to be checked} + +\item{optional}{Is the checked parameter optional? If set to \code{FALSE} +and \code{arg} is \code{NULL} then the function \code{assert_date_vector} exits early and throw and error.} +} +\value{ +The function returns an error if \code{arg} is missing, or not a date or datetime variable +but otherwise returns an invisible output. +} +\description{ +Check if an object/vector is a date or datetime variable without needing a dataset as input +} +\examples{ +example_fun <- function(arg) { + assert_date_vector(arg) +} + +example_fun( + as.Date("2022-01-30", tz = "UTC") +) +try(example_fun("1993-07-14")) +} +\seealso{ +Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, +\code{\link{assert_character_scalar}()}, +\code{\link{assert_character_vector}()}, +\code{\link{assert_data_frame}()}, +\code{\link{assert_expr}()}, +\code{\link{assert_filter_cond}()}, +\code{\link{assert_function_param}()}, +\code{\link{assert_function}()}, +\code{\link{assert_has_variables}()}, +\code{\link{assert_integer_scalar}()}, +\code{\link{assert_list_element}()}, +\code{\link{assert_list_of}()}, +\code{\link{assert_logical_scalar}()}, +\code{\link{assert_named_exprs}()}, +\code{\link{assert_numeric_vector}()}, +\code{\link{assert_one_to_one}()}, +\code{\link{assert_order_vars}()}, +\code{\link{assert_param_does_not_exist}()}, +\code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, +\code{\link{assert_symbol}()}, +\code{\link{assert_unit}()}, +\code{\link{assert_vars}()}, +\code{\link{assert_varval_list}()} +} +\author{ +Sadchla Mascary +} +\concept{assertion} +\keyword{assertion} diff --git a/man/assert_expr.Rd b/man/assert_expr.Rd index 143fd8c6..5dba5c09 100644 --- a/man/assert_expr.Rd +++ b/man/assert_expr.Rd @@ -21,9 +21,11 @@ Assert Argument is an Expression } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, \code{\link{assert_function}()}, @@ -38,6 +40,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, diff --git a/man/assert_filter_cond.Rd b/man/assert_filter_cond.Rd index a8a38864..5abd7f69 100644 --- a/man/assert_filter_cond.Rd +++ b/man/assert_filter_cond.Rd @@ -24,12 +24,14 @@ functions like \code{subset} or \code{dplyr::filter}. } \examples{ library(admiral.test) +library(dplyr, warn.conflicts = FALSE) +library(rlang) data(admiral_dm) # typical usage in a function as a parameter check example_fun <- function(dat, x) { - x <- assert_filter_cond(rlang::enquo(x)) - dplyr::filter(dat, !!x) + x <- assert_filter_cond(enquo(x)) + filter(dat, !!x) } example_fun(admiral_dm, AGE == 64) @@ -38,9 +40,11 @@ try(example_fun(admiral_dm, USUBJID)) } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_function_param}()}, \code{\link{assert_function}()}, @@ -55,6 +59,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, diff --git a/man/assert_function.Rd b/man/assert_function.Rd index edf3424b..1f82f577 100644 --- a/man/assert_function.Rd +++ b/man/assert_function.Rd @@ -40,9 +40,11 @@ try(example_fun(sum)) } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -57,6 +59,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, diff --git a/man/assert_function_param.Rd b/man/assert_function_param.Rd index a8ecc413..8c7fcf2b 100644 --- a/man/assert_function_param.Rd +++ b/man/assert_function_param.Rd @@ -29,9 +29,11 @@ try(assert_function_param("hello", "surname")) } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function}()}, @@ -46,6 +48,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, diff --git a/man/assert_has_variables.Rd b/man/assert_has_variables.Rd index 8c7d4363..578653af 100644 --- a/man/assert_has_variables.Rd +++ b/man/assert_has_variables.Rd @@ -28,9 +28,11 @@ try(assert_has_variables(admiral_dm, "AVAL")) } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -45,6 +47,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, diff --git a/man/assert_integer_scalar.Rd b/man/assert_integer_scalar.Rd index 4f5df811..5014f8c6 100644 --- a/man/assert_integer_scalar.Rd +++ b/man/assert_integer_scalar.Rd @@ -38,9 +38,11 @@ try(example_fun("2", 0)) } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -55,6 +57,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, diff --git a/man/assert_list_element.Rd b/man/assert_list_element.Rd index da7423db..f93386a4 100644 --- a/man/assert_list_element.Rd +++ b/man/assert_list_element.Rd @@ -41,9 +41,11 @@ fulfilling the condition are listed. } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -58,6 +60,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, diff --git a/man/assert_list_of.Rd b/man/assert_list_of.Rd index 4c301055..8c1e3826 100644 --- a/man/assert_list_of.Rd +++ b/man/assert_list_of.Rd @@ -35,9 +35,11 @@ try(example_fun(c(TRUE, FALSE))) } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -52,6 +54,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, diff --git a/man/assert_logical_scalar.Rd b/man/assert_logical_scalar.Rd index c0c2ccdf..b89908fc 100644 --- a/man/assert_logical_scalar.Rd +++ b/man/assert_logical_scalar.Rd @@ -36,9 +36,11 @@ try(example_fun(1:10)) } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -53,6 +55,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, diff --git a/man/assert_named_exprs.Rd b/man/assert_named_exprs.Rd index da0860e7..45b2a907 100644 --- a/man/assert_named_exprs.Rd +++ b/man/assert_named_exprs.Rd @@ -21,9 +21,11 @@ Assert Argument is a Named List of Expressions } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -38,6 +40,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, diff --git a/man/assert_numeric_vector.Rd b/man/assert_numeric_vector.Rd index 2ef5b08c..c037a952 100644 --- a/man/assert_numeric_vector.Rd +++ b/man/assert_numeric_vector.Rd @@ -30,9 +30,11 @@ try(example_fun(letters)) } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -47,6 +49,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, diff --git a/man/assert_one_to_one.Rd b/man/assert_one_to_one.Rd index f3390305..a1608838 100644 --- a/man/assert_one_to_one.Rd +++ b/man/assert_one_to_one.Rd @@ -23,9 +23,11 @@ Checks if there is a one to one mapping between two lists of variables. } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -40,6 +42,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, diff --git a/man/assert_order_vars.Rd b/man/assert_order_vars.Rd index 30f762d1..52cd087a 100644 --- a/man/assert_order_vars.Rd +++ b/man/assert_order_vars.Rd @@ -20,6 +20,8 @@ calls created using \code{vars()} and returns the input invisibly otherwise. Checks if an argument is a valid list of order variables created using \code{vars()} } \examples{ +library(dplyr, warn.conflicts = FALSE) +library(rlang) example_fun <- function(by_vars) { assert_order_vars(by_vars) @@ -27,7 +29,7 @@ example_fun <- function(by_vars) { example_fun(vars(USUBJID, PARAMCD, desc(AVISITN))) -try(example_fun(rlang::exprs(USUBJID, PARAMCD))) +try(example_fun(exprs(USUBJID, PARAMCD))) try(example_fun(c("USUBJID", "PARAMCD", "VISIT"))) @@ -35,9 +37,11 @@ try(example_fun(vars(USUBJID, toupper(PARAMCD), -AVAL))) } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -52,6 +56,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_one_to_one}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, diff --git a/man/assert_param_does_not_exist.Rd b/man/assert_param_does_not_exist.Rd index 019ef509..3f0d0d3e 100644 --- a/man/assert_param_does_not_exist.Rd +++ b/man/assert_param_does_not_exist.Rd @@ -30,9 +30,11 @@ try(assert_param_does_not_exist(advs, param = "WEIGHT")) } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -47,6 +49,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_one_to_one}()}, \code{\link{assert_order_vars}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, diff --git a/man/assert_s3_class.Rd b/man/assert_s3_class.Rd index 577e4960..cf5e3bb4 100644 --- a/man/assert_s3_class.Rd +++ b/man/assert_s3_class.Rd @@ -34,9 +34,11 @@ try(example_fun(1:10)) } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -51,6 +53,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_one_to_one}()}, \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, diff --git a/man/assert_same_type.Rd b/man/assert_same_type.Rd new file mode 100644 index 00000000..34683f76 --- /dev/null +++ b/man/assert_same_type.Rd @@ -0,0 +1,66 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/assertions.R +\name{assert_same_type} +\alias{assert_same_type} +\title{Are All Argument of the Same Type?} +\usage{ +assert_same_type(...) +} +\arguments{ +\item{...}{Arguments to be checked} +} +\value{ +The function throws an error if not all arguments are of the same type. +} +\description{ +Checks if all arguments are of the same type. +} +\examples{ +example_fun <- function(true_value, false_value, missing_value) { + assert_same_type(true_value, false_value, missing_value) +} + +example_fun( + true_value = "Y", + false_value = "N", + missing_value = NA_character_ +) + +try(example_fun( + true_value = 1, + false_value = 0, + missing_value = "missing" +)) +} +\seealso{ +Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, +\code{\link{assert_character_scalar}()}, +\code{\link{assert_character_vector}()}, +\code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, +\code{\link{assert_expr}()}, +\code{\link{assert_filter_cond}()}, +\code{\link{assert_function_param}()}, +\code{\link{assert_function}()}, +\code{\link{assert_has_variables}()}, +\code{\link{assert_integer_scalar}()}, +\code{\link{assert_list_element}()}, +\code{\link{assert_list_of}()}, +\code{\link{assert_logical_scalar}()}, +\code{\link{assert_named_exprs}()}, +\code{\link{assert_numeric_vector}()}, +\code{\link{assert_one_to_one}()}, +\code{\link{assert_order_vars}()}, +\code{\link{assert_param_does_not_exist}()}, +\code{\link{assert_s3_class}()}, +\code{\link{assert_symbol}()}, +\code{\link{assert_unit}()}, +\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 ac228057..dd1a8a52 100644 --- a/man/assert_symbol.Rd +++ b/man/assert_symbol.Rd @@ -21,11 +21,13 @@ Checks if an argument is a symbol } \examples{ library(admiral.test) +library(dplyr, warn.conflicts = FALSE) +library(rlang) data(admiral_dm) example_fun <- function(dat, var) { - var <- assert_symbol(rlang::enquo(var)) - dplyr::select(dat, !!var) + var <- assert_symbol(enquo(var)) + select(dat, !!var) } example_fun(admiral_dm, USUBJID) @@ -38,9 +40,11 @@ try(example_fun(admiral_dm, toupper(PARAMCD))) } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -56,6 +60,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} diff --git a/man/assert_unit.Rd b/man/assert_unit.Rd index e6c04a48..4821819a 100644 --- a/man/assert_unit.Rd +++ b/man/assert_unit.Rd @@ -36,9 +36,11 @@ assert_unit(advs, param = "WEIGHT", required_unit = "kg", get_unit_expr = VSSTRE } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -54,6 +56,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_vars}()}, \code{\link{assert_varval_list}()} diff --git a/man/assert_vars.Rd b/man/assert_vars.Rd index 66b852a5..99dc150f 100644 --- a/man/assert_vars.Rd +++ b/man/assert_vars.Rd @@ -4,13 +4,16 @@ \alias{assert_vars} \title{Is an Argument a List of Variables?} \usage{ -assert_vars(arg, optional = FALSE) +assert_vars(arg, optional = FALSE, expect_names = FALSE) } \arguments{ \item{arg}{A function argument to be checked} \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()} @@ -20,23 +23,36 @@ and returns the input invisibly otherwise. Checks if an argument is a valid list of variables created using \code{vars()} } \examples{ +library(dplyr, warn.conflicts = FALSE) +library(rlang) + example_fun <- function(by_vars) { assert_vars(by_vars) } example_fun(vars(USUBJID, PARAMCD)) -try(example_fun(rlang::exprs(USUBJID, PARAMCD))) +try(example_fun(exprs(USUBJID, PARAMCD))) try(example_fun(c("USUBJID", "PARAMCD", "VISIT"))) try(example_fun(vars(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)) + +try(example_fun_name(vars(APERSDT = APxxSDT, APxxEDT))) } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -52,6 +68,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_varval_list}()} diff --git a/man/assert_varval_list.Rd b/man/assert_varval_list.Rd index 18f4d165..104da0e4 100644 --- a/man/assert_varval_list.Rd +++ b/man/assert_varval_list.Rd @@ -35,6 +35,8 @@ 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) + example_fun <- function(vars) { assert_varval_list(vars) } @@ -44,9 +46,11 @@ try(example_fun(vars("AE", DTSEQ = AESEQ))) } \seealso{ Checks for valid input and returns warning or errors messages: +\code{\link{assert_atomic_vector}()}, \code{\link{assert_character_scalar}()}, \code{\link{assert_character_vector}()}, \code{\link{assert_data_frame}()}, +\code{\link{assert_date_vector}()}, \code{\link{assert_expr}()}, \code{\link{assert_filter_cond}()}, \code{\link{assert_function_param}()}, @@ -62,6 +66,7 @@ Checks for valid input and returns warning or errors messages: \code{\link{assert_order_vars}()}, \code{\link{assert_param_does_not_exist}()}, \code{\link{assert_s3_class}()}, +\code{\link{assert_same_type}()}, \code{\link{assert_symbol}()}, \code{\link{assert_unit}()}, \code{\link{assert_vars}()} diff --git a/man/contains_vars.Rd b/man/contains_vars.Rd new file mode 100644 index 00000000..6fc77eb7 --- /dev/null +++ b/man/contains_vars.Rd @@ -0,0 +1,33 @@ +% Generated by roxygen2: do not edit by hand +% 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} +\usage{ +contains_vars(arg) +} +\arguments{ +\item{arg}{A function argument to be checked} +} +\value{ +A 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 +} +\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}()}, +\code{\link{valid_time_units}()}, +\code{\link{vars2chr}()} +} +\concept{dev_utility} +\keyword{dev_utility} diff --git a/man/convert_dtm_to_dtc.Rd b/man/convert_dtm_to_dtc.Rd index b1a807a6..b901d050 100644 --- a/man/convert_dtm_to_dtc.Rd +++ b/man/convert_dtm_to_dtc.Rd @@ -23,10 +23,9 @@ Developer Utility Functions: \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{negate_vars}()}, -\code{\link{replace_values_by_names}()}, \code{\link{valid_time_units}()}, \code{\link{vars2chr}()} } diff --git a/man/expect_dfs_equal.Rd b/man/expect_dfs_equal.Rd index 17d8d261..75eba41a 100644 --- a/man/expect_dfs_equal.Rd +++ b/man/expect_dfs_equal.Rd @@ -20,7 +20,41 @@ expect_dfs_equal(base, compare, keys, ...) An error if \code{base} and \code{compare} do not match or \code{NULL} invisibly if they do } \description{ -Uses \code{\link[diffdf:diffdf]{diffdf::diffdf()}} to compares 2 datasets for any differences +Uses \code{\link[diffdf:diffdf]{diffdf::diffdf()}} to compares 2 datasets for any differences. This function can be +thought of as an R-equivalent of SAS proc compare and a useful tool for unit testing as well. +} +\examples{ +library(dplyr, warn.conflicts = FALSE) +library(tibble) + +tbl1 <- tribble( + ~USUBJID, ~AGE, ~SEX, + "1001", 18, "M", + "1002", 19, "F", + "1003", 20, "M", + "1004", 18, "F" +) + +tbl2 <- tribble( + ~USUBJID, ~AGE, ~SEX, + "1001", 18, "M", + "1002", 18.9, "F", + "1003", 20, NA +) + +try(expect_dfs_equal(tbl1, tbl2, keys = "USUBJID")) + +tlb3 <- tribble( + ~USUBJID, ~AGE, ~SEX, + "1004", 18, "F", + "1003", 20, "M", + "1002", 19, "F", + "1001", 18, "M", +) + +# Note the sorting order of the keys is not required +expect_dfs_equal(tbl1, tlb3, keys = "USUBJID") + } \author{ Thomas Neitmann diff --git a/man/extract_vars.Rd b/man/extract_vars.Rd index 755d0b09..26b23cda 100644 --- a/man/extract_vars.Rd +++ b/man/extract_vars.Rd @@ -23,10 +23,9 @@ 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{filter_if}()}, -\code{\link{negate_vars}()}, -\code{\link{replace_values_by_names}()}, \code{\link{valid_time_units}()}, \code{\link{vars2chr}()} } diff --git a/man/filter_if.Rd b/man/filter_if.Rd index d807f855..806ae844 100644 --- a/man/filter_if.Rd +++ b/man/filter_if.Rd @@ -24,10 +24,9 @@ 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}()}, -\code{\link{negate_vars}()}, -\code{\link{replace_values_by_names}()}, \code{\link{valid_time_units}()}, \code{\link{vars2chr}()} } diff --git a/man/get_dataset.Rd b/man/get_dataset.Rd index 75b52e21..d9795738 100644 --- a/man/get_dataset.Rd +++ b/man/get_dataset.Rd @@ -2,7 +2,7 @@ % Please edit documentation in R/datasets.R \name{get_dataset} \alias{get_dataset} -\title{Retrieve a Dataset from the \code{.datasets} environment} +\title{Retrieve a Dataset from the \code{admiraldev_environment} environment} \usage{ get_dataset(name) } @@ -13,11 +13,7 @@ get_dataset(name) A \code{data.frame} } \description{ -Retrieve a Dataset from the \code{.datasets} environment -} -\seealso{ -Other datasets: -\code{\link{set_dataset}()} +Retrieve a Dataset from the \code{admiraldev_environment} environment } \author{ Thomas Neitmann diff --git a/man/grapes-notin-grapes.Rd b/man/grapes-notin-grapes.Rd index 47fc55ee..fa366364 100644 --- a/man/grapes-notin-grapes.Rd +++ b/man/grapes-notin-grapes.Rd @@ -23,11 +23,10 @@ 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}()}, \code{\link{filter_if}()}, -\code{\link{negate_vars}()}, -\code{\link{replace_values_by_names}()}, \code{\link{valid_time_units}()}, \code{\link{vars2chr}()} } diff --git a/man/grapes-or-grapes.Rd b/man/grapes-or-grapes.Rd index 56bd7e42..0a83b302 100644 --- a/man/grapes-or-grapes.Rd +++ b/man/grapes-or-grapes.Rd @@ -27,11 +27,10 @@ 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}()}, \code{\link{filter_if}()}, -\code{\link{negate_vars}()}, -\code{\link{replace_values_by_names}()}, \code{\link{valid_time_units}()}, \code{\link{vars2chr}()} } diff --git a/man/is_auto.Rd b/man/is_auto.Rd index cd5c72a7..e007bae9 100644 --- a/man/is_auto.Rd +++ b/man/is_auto.Rd @@ -18,17 +18,9 @@ Checks if the argument equals the auto keyword } \seealso{ Identifies type of Object with return of TRUE/FALSE: -\code{\link{is_date}()}, \code{\link{is_named}()}, \code{\link{is_order_vars}()}, -\code{\link{is_timeunit}()}, -\code{\link{is_valid_date_entry}()}, -\code{\link{is_valid_day}()}, -\code{\link{is_valid_dtc}()}, -\code{\link{is_valid_hour}()}, -\code{\link{is_valid_month}()}, -\code{\link{is_valid_sec_min}()}, -\code{\link{is_valid_time_entry}()} +\code{\link{is_valid_dtc}()} } \author{ Stefan Bundfuss diff --git a/man/is_date.Rd b/man/is_date.Rd deleted file mode 100644 index eb228380..00000000 --- a/man/is_date.Rd +++ /dev/null @@ -1,36 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/is.R -\name{is_date} -\alias{is_date} -\title{Is Date/Date-time?} -\usage{ -is_date(arg) -} -\arguments{ -\item{arg}{The argument to check} -} -\value{ -\code{TRUE} if the argument is a date or date-time, \code{FALSE} otherwise -} -\description{ -Checks if a date or date-time vector was specified -} -\seealso{ -Identifies type of Object with return of TRUE/FALSE: -\code{\link{is_auto}()}, -\code{\link{is_named}()}, -\code{\link{is_order_vars}()}, -\code{\link{is_timeunit}()}, -\code{\link{is_valid_date_entry}()}, -\code{\link{is_valid_day}()}, -\code{\link{is_valid_dtc}()}, -\code{\link{is_valid_hour}()}, -\code{\link{is_valid_month}()}, -\code{\link{is_valid_sec_min}()}, -\code{\link{is_valid_time_entry}()} -} -\author{ -Stefan Bundfuss -} -\concept{is} -\keyword{is} diff --git a/man/is_named.Rd b/man/is_named.Rd index 9b5e3700..5e51c09e 100644 --- a/man/is_named.Rd +++ b/man/is_named.Rd @@ -18,16 +18,8 @@ Is a named argument \seealso{ Identifies type of Object with return of TRUE/FALSE: \code{\link{is_auto}()}, -\code{\link{is_date}()}, \code{\link{is_order_vars}()}, -\code{\link{is_timeunit}()}, -\code{\link{is_valid_date_entry}()}, -\code{\link{is_valid_day}()}, -\code{\link{is_valid_dtc}()}, -\code{\link{is_valid_hour}()}, -\code{\link{is_valid_month}()}, -\code{\link{is_valid_sec_min}()}, -\code{\link{is_valid_time_entry}()} +\code{\link{is_valid_dtc}()} } \concept{is} \keyword{is} diff --git a/man/is_order_vars.Rd b/man/is_order_vars.Rd index f3d54257..1943487a 100644 --- a/man/is_order_vars.Rd +++ b/man/is_order_vars.Rd @@ -7,27 +7,19 @@ is_order_vars(arg) } \arguments{ -\item{arg}{A% group_by(ARMCD) + data <- tibble::tribble( + ~STUDYID, ~USUBJID, ~ARMCD, + "xyz", "1", "PLACEBO", + "xyz", "2", "ACTIVE" + ) %>% group_by(ARMCD) expect_error( - example_fun(admiral_dm) + example_fun(data) ) }) -test_that("Test 8 : `assert_character_scalar` throws an error if not a character scaler string", { +# 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", { example_fun2 <- function(msg_type) { msg_type <- assert_character_scalar(msg_type, values = c("warning", "error"), case_sensitive = FALSE @@ -84,7 +96,8 @@ test_that("Test 8 : `assert_character_scalar` throws an error if not a character expect_error(example_fun2(2)) }) -test_that("Test 9 : `assert_character_scalar` throws an error if input is a vector", { +## Test 7: error if input is a vector ---- +test_that("assert_character_scalar Test 7: 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 @@ -97,12 +110,909 @@ test_that("Test 9 : `assert_character_scalar` throws an error if input is a vect expect_error(example_fun2(c("admiral", "admiralonco"))) }) -test_that("Test 10 : `assert_order_vars` returns invisible if used correctly", { - expect_invisible(assert_order_vars(vars(USUBJID, PARAMCD, desc(AVISITN)))) +# 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))) + expect_invisible(assert_vars( + vars(APERSDT = APxxSDT, APEREDT = APxxEDT), + expect_names = TRUE + )) +}) + +## Test 9: error if unexpected input ---- +test_that("assert_vars Test 9: error if unexpected input", { + expect_error(assert_vars(AVAL + 1)) + expect_error(assert_vars(rlang::exprs(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)) +}) + +# 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", { + example_fun <- function(dataset) { + assert_data_frame(dataset, required_vars = vars(STUDYID, USUBJID), optional = TRUE) + } + + expect_invisible( + example_fun(NULL) + ) +}) + +## Test 11: error if required variables are missing ---- +test_that("assert_data_frame Test 11: error if required variables are missing", { + example_fun <- function(dataset) { + assert_data_frame(dataset, required_vars = vars(STUDYID, USUBJID)) + } + + admiral_dm <- admiral.test::admiral_dm %>% select(-c(STUDYID, USUBJID)) + + expect_error( + example_fun(admiral_dm) + ) +}) + +## Test 12: error if required variable is missing ---- +test_that("assert_data_frame Test 12: error if required variable is missing", { + example_fun <- function(dataset) { + assert_data_frame(dataset, required_vars = vars(STUDYID, USUBJID)) + } + + admiral_dm <- admiral.test::admiral_dm %>% select(-c(USUBJID)) + + expect_error( + example_fun(admiral_dm) + ) +}) + +# 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", { + example_fun <- function(character) { + assert_character_scalar(character, optional = TRUE) + } + + expect_invisible( + example_fun(NULL) + ) +}) + +## Test 14: no error, case_sensitive = FALSE ---- +test_that("assert_character_scalar Test 14: no error, case_sensitive = FALSE", { + example_fun <- function(character) { + assert_character_scalar(character, values = c("test"), case_sensitive = FALSE) + } + + out <- expect_invisible(example_fun(character = "TEST")) + expect_equal(out, "test") + + check_unit <- function(duration_unit) { + assert_character_scalar( + duration_unit, + values = c("years", "months", "weeks", "days", "hours", "minutes", "seconds"), + case_sensitive <- FALSE + ) + } + + out <- expect_invisible(check_unit("months")) + expect_equal(out, "months") + + out <- expect_invisible(check_unit("MONTHS")) + expect_equal(out, "months") + + check_unit2 <- function(duration_unit) { + assert_character_scalar( + duration_unit, + values = c("YEARS", "MONTHS", "WEEKS", "DAYS", "HOURS", "MINUTES", "SECONDS"), + case_sensitive <- FALSE + ) + } + + out <- expect_invisible(check_unit2("months")) + expect_equal(out, "months") + + out <- expect_invisible(check_unit2("MONTHS")) + 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", { + example_fun <- function(character) { + assert_character_scalar(character, values = c("test")) + } + + expect_error( + example_fun(character = "oak") + ) + + check_unit <- function(duration_unit) { + assert_character_scalar( + duration_unit, + values = c("years", "months", "weeks", "days", "hours", "minutes", "seconds"), + case_sensitive <- FALSE + ) + } + + expect_error( + check_unit("month"), + paste0( + "`duration_unit` must be one of 'years', 'months', 'weeks', 'days', ", + "'hours', 'minutes' or 'seconds' but is 'month'" + ) + ) + + expect_error( + check_unit("MONTH"), + paste0( + "`duration_unit` must be one of 'years', 'months', 'weeks', 'days', ", + "'hours', 'minutes' or 'seconds' but is 'MONTH'" + ) + ) + + check_unit2 <- function(duration_unit) { + assert_character_scalar( + duration_unit, + values = c("YEARS", "MONTHS", "WEEKS", "DAYS", "HOURS", "MINUTES", "SECONDS"), + case_sensitive <- FALSE + ) + } + + expect_error( + check_unit2("month"), + paste0( + "`duration_unit` must be one of 'YEARS', 'MONTHS', 'WEEKS', 'DAYS', ", + "'HOURS', 'MINUTES' or 'SECONDS' but is 'month'" + ) + ) + + expect_error( + check_unit2("MONTH"), + paste0( + "`duration_unit` must be one of 'YEARS', 'MONTHS', 'WEEKS', 'DAYS', ", + "'HOURS', 'MINUTES' or 'SECONDS' but is 'MONTH'" + ) + ) +}) + +## Test 16: error if `arg` not a character vector ---- +test_that("assert_character_scalar Test 16: error if `arg` not a character vector", { + arg <- c(1, 2, 3) + + expect_error( + assert_character_vector(arg) + ) +}) + +## Test 17: error if `arg` is not in values ---- +test_that("assert_character_scalar Test 17: error if `arg` is not in values", { + example_fun <- function(character) { + assert_character_vector(character, values = c("test", "oak")) + } + + expect_error( + example_fun(character = c("oak", "mint")) + ) +}) + +# 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", { + example_fun <- function(arg) { + assert_logical_scalar(arg, optional = TRUE) + } + + expect_invisible( + example_fun(NULL) + ) +}) + +## 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", { + example_fun <- function(arg) { + assert_logical_scalar(arg) + } + arg <- c() + expect_error(example_fun(NA)) + expect_error(example_fun(arg)) + expect_error(example_fun("test")) +}) + +# 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", { + f <- function(var) { + v <- enquo(var) + } + + example_fun <- function(arg) { + assert_symbol(arg, optional = TRUE) + } + + expect_invisible( + example_fun( + f(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", { + f <- function(var) { + v <- enquo(var) + } + + example_fun <- function(arg) { + assert_symbol(arg) + } + + expect_error( + example_fun( + f() + ) + ) +}) + +## 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", { + f <- function(var) { + v <- enquo(var) + } + + example_fun <- function(arg) { + assert_symbol(arg) + } + + expect_error( + example_fun( + f(NULL) + ) + ) +}) + +## 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", { + f <- function(var) { + v <- enquo(var) + } + + admiral_dm <- admiral.test::admiral_dm + + example_fun <- function(arg) { + assert_symbol(arg) + } + + expect_invisible( + example_fun( + f(admiral_dm) + ) + ) +}) + +# 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", { + f <- function(var) { + v <- enquo(var) + } + + example_fun <- function(arg) { + assert_expr(arg) + } + + expect_invisible( + example_fun( + f(admiral.test::admiral_dm) + ) + ) +}) + +## 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", { + f <- function(var) { + v <- enquo(var) + } + + example_fun <- function(arg) { + assert_expr(arg, optional = TRUE) + } + + expect_invisible( + example_fun( + f(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", { + f <- function(var) { + v <- enquo(var) + } + + example_fun <- function(arg) { + assert_expr(arg) + } + + expect_error( + example_fun(f()) + ) +}) + +## 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", { + f <- function(var) { + v <- enquo(var) + } + + example_fun <- function(arg) { + assert_expr(arg) + } + + expect_error( + example_fun( + f(NULL) + ) + ) +}) + +# 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", { + example_fun <- function(arg) { + assert_vars(arg) + } + + expect_error( + example_fun(c("USUBJID", "PARAMCD", "VISIT")) + ) + expect_error( + example_fun(TRUE) + ) +}) + +## 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", { + example_fun <- function(arg) { + assert_vars(arg) + } + + expect_error( + example_fun(vars(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()`", { + example_fun <- function(arg) { + assert_order_vars(arg) + } + + expect_error( + example_fun(TRUE) + ) + expect_error( + example_fun(1) + ) +}) + +## 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", { + example_fun <- function(arg) { + assert_order_vars(arg, optional = TRUE) + } + + expect_invisible( + example_fun(NULL) + ) +}) + +# 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", { + example_fun <- function(arg) { + assert_integer_scalar(arg, optional = TRUE) + } + + expect_invisible( + example_fun(NULL) + ) +}) + +## Test 33: error if chosen subset not in subsets ---- +test_that("assert_integer_scalar Test 33: error if chosen subset not in subsets", { + example_fun <- function(arg) { + assert_integer_scalar(arg, subset = "infinity") + } + + expect_error( + example_fun(1) + ) +}) + +## 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", { + example_fun <- function(arg) { + assert_integer_scalar(arg, subset = "positive") + } + + expect_invisible( + example_fun(1) + ) +}) + +## 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", { + example_fun <- function(arg) { + assert_integer_scalar(arg) + } + + arg <- c() + + expect_error(example_fun(TRUE)) + expect_error(example_fun(arg)) + expect_error(example_fun(Inf)) + expect_error(example_fun(1.5)) +}) + +# 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", { + example_fun <- function(arg) { + assert_numeric_vector(arg, optional = TRUE) + } + + expect_invisible( + example_fun(NULL) + ) +}) + +# 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", { + example_fun <- function(arg) { + assert_numeric_vector(arg) + } + + arg <- c() + + expect_error(example_fun(TRUE)) + expect_error(example_fun(arg)) + expect_error(example_fun("1.5")) +}) + +# 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", { + example_fun <- function(arg) { + assert_s3_class(arg, "factor") + } + + 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", { + example_fun <- function(arg) { + assert_s3_class(arg, class = "factor", optional = TRUE) + } + + expect_invisible( + example_fun(NULL) + ) +}) + +## 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", { + example_fun <- function(arg) { + assert_s3_class(arg, "factor") + } + + expect_invisible(example_fun(as.factor("test"))) +}) + +# 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", { + example_fun <- function(arg) { + assert_list_of(arg, "factor") + } + + 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", { + example_fun <- function(arg) { + assert_list_of(arg, class = "factor", optional = TRUE) + } + + expect_invisible( + example_fun(NULL) + ) +}) + +## 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", { + example_fun <- function(arg) { + assert_list_of(arg, "factor") + } + + expect_invisible( + example_fun( + list(as.factor("test"), as.factor(1)) + ) + ) }) -test_that("Test 11 : `assert_order_vars` returns errors if used incorrectly", { - expect_error(assert_order_vars(rlang::exprs(USUBJID, PARAMCD))) - expect_error(assert_order_vars(c("USUBJID", "PARAMCD", "VISIT"))) - expect_error(assert_order_vars(vars(USUBJID, toupper(PARAMCD), -AVAL))) +# 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", { + example_fun <- function(arg) { + assert_named_exprs(arg) + } + + arg <- list("test") + names(arg) <- c("") + + expect_error(example_fun(5)) + expect_error(example_fun(admiral.test::admiral_dm)) + expect_error(example_fun(list(1, 2, TRUE))) + 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", { + example_fun <- function(arg) { + assert_named_exprs(arg, optional = TRUE) + } + + expect_invisible( + example_fun(NULL) + ) +}) + +## 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", { + example_fun <- function(arg) { + assert_named_exprs(arg) + } + + expect_invisible( + example_fun( + rlang::exprs() + ) + ) +}) + +# assert_function ---- +## Test 47: error if `arg` is not a function ---- +test_that("assert_function Test 47: error if `arg` is not a function", { + example_fun <- function(arg) { + assert_function(arg) + } + + expect_error(example_fun(5)) + 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", { + example_fun <- function(arg) { + assert_function(arg, optional = TRUE) + } + + expect_invisible( + example_fun(NULL) + ) +}) + +## 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", { + example_fun <- function(arg) { + assert_function(arg, params = c("x")) + } + + 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", { + example_fun <- function(arg) { + assert_function(arg, params = c("x")) + } + + expect_error(example_fun(sum)) + + example_fun <- function(arg) { + assert_function(arg, params = c("x", "y")) + } + + expect_error(example_fun(sum)) +}) + + +# 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", { + hello <- function(name) { + print(sprintf("Hello %s", name)) + } + + 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", { + hello <- function(name) { + print(sprintf("Hello %s", name)) + } + + expect_error(assert_function_param("hello", "surname")) + expect_error(assert_function_param("hello", params = c("surname", "firstname"))) +}) + +# 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", { + advs <- tibble::tribble( + ~USUBJID, ~VSTESTCD, ~VSTRESN, ~VSSTRESU, ~PARAMCD, ~AVAL, + "P01", "WEIGHT", 80.1, "kg", "WEIGHT", 80.1, + "P02", "WEIGHT", 85.7, "kg", "WEIGHT", 85.7 + ) + + expect_invisible( + assert_unit(advs, param = "WEIGHT", required_unit = "kg", get_unit_expr = VSSTRESU) + ) +}) + +## 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", { + advs <- tibble::tribble( + ~USUBJID, ~VSTESTCD, ~VSTRESN, ~VSSTRESU, ~PARAMCD, ~AVAL, + "P01", "WEIGHT", 80.1, "kg", "WEIGHT", 80.1, + "P02", "WEIGHT", 85.7, "lb", "WEIGHT", 85.7 + ) + + expect_error( + assert_unit(advs, param = "WEIGHT", required_unit = "kg", get_unit_expr = VSSTRESU) + ) +}) + +## Test 55: error if unexpected unit in the input dataset ---- +test_that("assert_unit Test 55: 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, + "P02", "WEIGHT", 85.7, "kg", "WEIGHT", 85.7 + ) + + expect_error( + assert_unit(advs, param = "WEIGHT", required_unit = "lb", get_unit_expr = VSSTRESU) + ) +}) + +# 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", { + advs <- tibble::tribble( + ~USUBJID, ~VSTESTCD, ~VSTRESN, ~VSSTRESU, ~PARAMCD, ~AVAL, + "P01", "WEIGHT", 80.1, "kg", "WEIGHT", 80.1, + "P02", "WEIGHT", 85.7, "kg", "WEIGHT", 85.7 + ) + + expect_error( + assert_param_does_not_exist(advs, param = "WEIGHT") + ) +}) + +## 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", { + advs <- tibble::tribble( + ~USUBJID, ~VSTESTCD, ~VSTRESN, ~VSSTRESU, ~PARAMCD, ~AVAL, + "P01", "WEIGHT", 80.1, "kg", "WEIGHT", 80.1, + "P02", "WEIGHT", 85.7, "kg", "WEIGHT", 85.7 + ) + + expect_invisible( + assert_param_does_not_exist(advs, param = "HR") + ) +}) + +# 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", { + example_fun <- function(arg) { + assert_varval_list(arg, accept_var = FALSE) + } + + expect_error( + example_fun(c("USUBJID", "PARAMCD", "VISIT")) + ) +}) + +## 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", { + example_fun <- function(arg) { + assert_varval_list(arg, accept_var = TRUE) + } + + expect_error( + example_fun(vars(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`", { + example_fun <- function(arg) { + assert_varval_list(arg, required_elements = "DTHDOM") + } + + expect_error( + example_fun(vars(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", { + example_fun <- function(arg) { + assert_varval_list(arg, optional = TRUE) + } + + expect_invisible( + example_fun(NULL) + ) +}) + +## 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", { + example_fun <- function(arg) { + assert_varval_list(arg, accept_expr = TRUE) + } + + expect_error( + example_fun(vars(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", { + example_fun <- function(arg) { + assert_varval_list(arg, accept_expr = FALSE) + } + + expect_error( + example_fun(vars(DTHSEQ = vars())) + ) +}) + +## 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", { + example_fun <- function(arg) { + assert_varval_list(arg) + } + + expect_invisible( + example_fun(vars(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 = "") + ) + expect_invisible( + assert_list_element(vars(DTHDOM = "AE", DTHSEQ = admiral.test::admiral_dm), "DTHSEQ", + (admiral.test::admiral_dm)$DOMAIN == "DM", + 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", { + expect_error( + assert_list_element(vars(DTHDOM = "AE", DTHSEQ = admiral.test::admiral_dm), "DTHSEQ", + (admiral.test::admiral_dm)$DOMAIN == "GM", + message_text = "" + ) + ) +}) + +# 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", { + expect_error( + assert_one_to_one(admiral.test::admiral_dm, vars(DOMAIN), vars(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", { + expect_error( + assert_one_to_one(admiral.test::admiral_dm, vars(USUBJID), vars(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", { + example_fun <- function(dataset, var) { + var <- assert_symbol(enquo(var)) + assert_date_var(dataset = dataset, var = !!var) + } + + my_data <- tibble::tribble( + ~USUBJID, ~ADT, + "1", ymd("2020-12-06"), + "2", ymd("") + ) + + expect_error( + example_fun( + dataset = my_data, + var = USUBJID + ) + ) +}) + +# 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", { + 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", { + 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", { + example_fun <- function(arg) { + assert_date_vector(arg, optional = TRUE) + } + + expect_invisible( + example_fun(NULL) + ) +}) + +# 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", { + 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", { + 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", { + true_value <- "Y" + false_value <- "N" + missing_value <- 0 + expect_error( + assert_same_type(true_value, false_value, missing_value), + regexp = paste( + "All arguments must be of the same type.", + "Argument: Type", + "--------------", + "true_value: character", + "false_value: character", + "missing_value: double", + sep = "\n" + ), + fixed = TRUE + ) }) diff --git a/tests/testthat/test-compat_friendly_type.R b/tests/testthat/test-compat_friendly_type.R index 5c775ce2..a7600e1f 100644 --- a/tests/testthat/test-compat_friendly_type.R +++ b/tests/testthat/test-compat_friendly_type.R @@ -1,9 +1,12 @@ -test_that("friendly_type_of() supports objects", { +# friendly_type_of ---- +## Test 1: friendly_type_of() supports objects ---- +test_that("friendly_type_of Test 1: friendly_type_of() supports objects", { expect_equal(friendly_type_of(mtcars), "a object") expect_equal(friendly_type_of(quo(1)), "a object") }) -test_that("friendly_type_of() supports matrices and arrays (#141)", { +## Test 2: friendly_type_of() supports matrices and arrays ---- +test_that("friendly_type_of Test 2: friendly_type_of() supports matrices and arrays", { expect_equal(friendly_type_of(list()), "an empty list") expect_equal(friendly_type_of(matrix(list(1, 2))), "a list matrix") expect_equal(friendly_type_of(array(list(1, 2, 3), dim = 1:3)), "a list array") @@ -15,8 +18,8 @@ test_that("friendly_type_of() supports matrices and arrays (#141)", { expect_equal(friendly_type_of(array(letters[1:3], dim = 1:3)), "a character array") }) - -test_that("friendly_type_of() handles scalars", { +## Test 3: friendly_type_of() handles scalars ---- +test_that("friendly_type_of Test 3: friendly_type_of() handles scalars", { expect_equal(friendly_type_of(NA), "`NA`") expect_equal(friendly_type_of(TRUE), "`TRUE`") @@ -35,3 +38,58 @@ test_that("friendly_type_of() handles scalars", { expect_equal(friendly_type_of(matrix(NA)), "a logical matrix") expect_equal(friendly_type_of(matrix(1)), "a double matrix") }) + +## Test 4: friendly_type_of() edge cases ---- +test_that("friendly_type_of Test 4: friendly_type_of() edge cases", { + expect_equal(friendly_type_of(), "absent") + expect_equal(friendly_type_of(1:2, length = TRUE), "an integer vector of length 2") + + expect_equal(friendly_type_of(list(test = 1:3)), "a list") + expect_equal(friendly_type_of(NULL), "NULL") + expect_equal(friendly_type_of(new.env(parent = emptyenv())), "an environment") + + # If we go through with adding xml2 into namespace this should work, xml2 is in renv.lock + # 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") + ) + expect_equal(friendly_type_of(test_weakref), "a weak reference") + + # Skip name + expect_equal(friendly_type_of(sym("test symbol")), "a symbol") + expect_equal(friendly_type_of(expr(1 + 1)), "a call") + expect_equal(friendly_type_of(pairlist(x = 1, y = 2)), "a pairlist node") + expect_equal(friendly_type_of(expression(x <- 4, x)), "an expression vector") + + # Unsure what char is in compat_friendly_type.R line 118 + # Promise seems impossible because it stops being a promise at evaluation? + # Unsure how to check for `...` + # Unsure how to check for `any` + + expect_equal(friendly_type_of(compiler::compile(quote(1 + 3))), "an internal bytecode object") + + # Skip primitive + # Skip builtin + expect_equal(friendly_type_of(switch), "a primitive function") + expect_equal(friendly_type_of(mean), "a function") +}) +# .rlang_as_friendly_type ---- +## Test 5: .rlang_as_friendly_type() works ---- +test_that(".rlang_as_friendly_type Test 5: .rlang_as_friendly_type() works", { + setClass("person", slots = c(name = "character", age = "numeric")) + john <- new("person", name = "John", age = 18) + expect_equal(.rlang_as_friendly_type(typeof(john)), "an S4 object") +}) + +# .rlang_stop_unexpected_typeof ---- +## Test 6: .rlang_stop_unexpected_typeof() works ---- +test_that(".rlang_stop_unexpected_typeof Test 6: .rlang_stop_unexpected_typeof() works", { + expect_error(.rlang_stop_unexpected_typeof("test"), "Unexpected type .") +}) + +# stop_input_type ---- +## Test 7: stop_input_type() works ---- +test_that("stop_input_type Test 7: stop_input_type() works", { + expect_error(stop_input_type(1, what = "character")) +}) diff --git a/tests/testthat/test-dataset_vignette.R b/tests/testthat/test-dataset_vignette.R index 26c082c1..03806c6c 100644 --- a/tests/testthat/test-dataset_vignette.R +++ b/tests/testthat/test-dataset_vignette.R @@ -1,23 +1,48 @@ -library(admiral.test) +# dataset_vignette ---- +## Test 1: A 'knitr_kable' object is outputted when run outside pkgdown ---- +test_that("dataset_vignette Test 1: A 'knitr_kable' object is outputted when run outside pkgdown", { + Sys.setenv(IN_PKGDOWN = "false") + on.exit(Sys.setenv(IN_PKGDOWN = "")) + + dm <- tibble::tribble( + ~STUDYID, ~USUBJID, ~COUNTRY, + "STUDY1", "1", "USA", + "STUDY1", "2", "USA", + "STUDY1", "3", "USA", + "STUDY1", "4", "USA" + ) -# ---- dataset_vignette, test 1: a 'knitr_kable' object is output when run outside pkgdown ---- -test_that("dataset_vignette, test 1: a 'knitr_kable' object is output when run outside pkgdown", { - expect_s3_class(dataset_vignette(head(admiral_dm)), "knitr_kable") + expect_s3_class(dataset_vignette(dm), "knitr_kable") + expect_s3_class(dataset_vignette(dm, display_vars = vars(STUDYID, USUBJID)), "knitr_kable") }) -# ---- dataset_vignette, test 2: a 'datatables' object is output when run inside pkgdown ---- -test_that("dataset_vignette, test 2: a 'datatables' object is output when run inside pkgdown", { +## 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", { Sys.setenv(IN_PKGDOWN = "true") on.exit(Sys.setenv(IN_PKGDOWN = "")) - expect_s3_class(dataset_vignette(head(admiral_dm)), "datatables") + + dm <- tibble::tribble( + ~STUDYID, ~USUBJID, ~COUNTRY, + "STUDY1", "1", "USA", + "STUDY1", "2", "USA", + "STUDY1", "3", "USA", + "STUDY1", "4", "USA" + ) + + + expect_s3_class(dataset_vignette(dm), "datatables") + expect_s3_class(dataset_vignette(dm, display_vars = vars(STUDYID, USUBJID)), "datatables") }) -# ---- dataset_vignette, test 3: a 'knitr_kable' object is output when run outside pkgdown ---- -test_that("dataset_vignette, test 3: a 'knitr_kable' object is output when run outside pkgdown", { - Sys.setenv(IN_PKGDOWN = "false") - on.exit(Sys.setenv(IN_PKGDOWN = "")) - expect_s3_class( - dataset_vignette(head(admiral_dm), display_vars = vars(STUDYID, USUBJID)), - "knitr_kable" +## Test 3: An error is outputted when calling variable not in dataset ---- +test_that("dataset_vignette Test 3: An error is outputted when calling variable not in dataset", { + dm <- tibble::tribble( + ~STUDYID, ~USUBJID, ~COUNTRY, + "STUDY1", "1", "USA", + "STUDY1", "2", "USA", + "STUDY1", "3", "USA", + "STUDY1", "4", "USA" ) + + expect_error(dataset_vignette(dm, display_vars = vars(AGE))) }) diff --git a/tests/testthat/test-dev_utilities.R b/tests/testthat/test-dev_utilities.R index 3d9d5ead..6457e8d8 100644 --- a/tests/testthat/test-dev_utilities.R +++ b/tests/testthat/test-dev_utilities.R @@ -1,20 +1,70 @@ -test_that("arg_name works", { +# arg_name ---- +## Test 1: arg_name works ---- +test_that("arg_name Test 1: arg_name works", { expect_equal(arg_name(sym("a")), "a") expect_equal(arg_name(call("enquo", sym("a"))), "a") expect_error(arg_name("a"), "Could not extract argument name from") }) -test_that("`convert_dtm_to_dtc` is in correct format", { +# convert_dtm_to_dtc ---- +## Test 2: works if dtm is in correct format ---- +test_that("convert_dtm_to_dtc Test 2: works if dtm is in correct format", { expect_equal( convert_dtm_to_dtc(as.POSIXct("2022-04-05 15:34:07 UTC")), "2022-04-05T15:34:07" ) }) -test_that("`convert_dtm_to_dtc` Error is thrown if dtm is not in correct format", { +## Test 3: Error is thrown if dtm is not in correct format ---- +test_that("convert_dtm_to_dtc Test 3: Error is thrown if dtm is not in correct format", { expect_error( convert_dtm_to_dtc("2022-04-05T15:26:14"), "lubridate::is.instant(dtm) is not TRUE", fixed = TRUE ) }) + +## 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", { + input <- tibble::tribble( + ~USUBJID, ~VSTESTCD, ~VSSTRESN, + "P01", "WEIGHT", 80.9, + "P01", "HEIGHT", 189.2 + ) + + expected_output <- input + + expect_dfs_equal( + expected_output, + filter_if(input, quo(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", { + input <- tibble::tribble( + ~USUBJID, ~VSTESTCD, ~VSSTRESN, + "P01", "WEIGHT", 80.9, + "P01", "HEIGHT", 189.2 + ) + + expected_output <- input[1L, ] + + expect_dfs_equal( + expected_output, + filter_if(input, quo(VSTESTCD == "WEIGHT")), + keys = c("USUBJID", "VSTESTCD") + ) +}) + +# 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))) +}) + +## Test 7: returns TRUE for valid arguments ---- +test_that("contains_vars Test 7: returns TRUE for valid arguments", { + expect_error(contains_vars(USUBJID)) +}) diff --git a/tests/testthat/test-get.R b/tests/testthat/test-get.R index ae1515ce..1ec91228 100644 --- a/tests/testthat/test-get.R +++ b/tests/testthat/test-get.R @@ -1,3 +1,5 @@ +# get_constant_vars ---- +## Test 1: without ignore_vars ---- test_that("get_constant_vars Test 1: without ignore_vars", { data <- tibble::tribble( ~USUBJID, ~AGE, ~AVISIT, @@ -13,6 +15,7 @@ test_that("get_constant_vars Test 1: without ignore_vars", { ) }) +## Test 2: with ignore_vars ---- test_that("get_constant_vars Test 2: with ignore_vars", { data <- tibble::tribble( ~USUBJID, ~AGE, ~WGTBL, ~HGTBL, ~AVISIT, @@ -27,3 +30,33 @@ test_that("get_constant_vars Test 2: with ignore_vars", { vars(USUBJID, AGE) ) }) + +# get_duplicates ---- +## Test 3: x atomic vector ---- +test_that("get_duplicates Test 3: x atomic vector", { + x <- c("a", "a", "b", "c", "d", "d", 1, 1, 4) + + expect_equal( + get_duplicates(x), + c("a", "d", 1) + ) +}) + +# 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) + + expect_equal( + get_source_vars(x), + x[2] + ) +}) + +## Test 5: quosures is NULL ---- +test_that("get_source_vars Test 5: quosures is NULL", { + expect_equal( + get_source_vars(NULL), + quo_c(NULL) + ) +}) diff --git a/tests/testthat/test-is.R b/tests/testthat/test-is.R index ea019820..75f146a3 100644 --- a/tests/testthat/test-is.R +++ b/tests/testthat/test-is.R @@ -1,25 +1,26 @@ - - -test_that("negate_vars returns list of negated variables", { - expect_identical(negate_vars(vars(var1, var2)), rlang::exprs(-var1, -var2)) +# is_order_vars ---- +## Test 1: returns error if input were created incorrectly ---- +test_that("is_order_vars Test 1: returns error if input were created incorrectly", { + expect_error(is_order_vars(STUDYID)) }) -test_that("negate_vars returns NULL if input is NULL", { - expect_identical(negate_vars(NULL), NULL) +## 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)))) }) - -test_that("`convert_dtm_to_dtc` is in correct format", { - expect_equal( - convert_dtm_to_dtc(as.POSIXct("2022-04-05 15:34:07 UTC")), - "2022-04-05T15:34:07" - ) +# is_valid_dtc ---- +## Test 3: returns TRUE if input are valid dtc ---- +test_that("is_valid_dtc Test 3: returns TRUE if input are valid dtc", { + expect_true(is_valid_dtc("2020")) + expect_true(is_valid_dtc("2022-09")) + expect_true(is_valid_dtc("2021-04-06")) + expect_true(is_valid_dtc("2003-12-15T13:15")) + expect_true(is_valid_dtc("2021-03-09T01:20:30")) }) -test_that("`convert_dtm_to_dtc` Error is thrown if dtm is not in correct format", { - expect_error( - convert_dtm_to_dtc("2022-04-05T15:26:14"), - "lubridate::is.instant(dtm) is not TRUE", - fixed = TRUE - ) +# is_valid_dtc ---- +## Test 4: returns error if input if input are NOT valid dtc ---- +test_that("is_valid_dtc Test 4: returns error if input if input are NOT valid dtc ", { + expect_false(is_valid_dtc("2021-03-T01:20:30")) }) diff --git a/tests/testthat/test-quo.R b/tests/testthat/test-quo.R index 88171777..78c4b7c2 100644 --- a/tests/testthat/test-quo.R +++ b/tests/testthat/test-quo.R @@ -1,15 +1,132 @@ -test_that("Test 10 : `quo_not_missing` returns TRUE if no missing argument", { +# 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", { + x <- quo(USUBJID) + y <- quo(STUDYID) + + expect_equal( + expected = quo(USUBJID), + object = quo_c(x, NULL, y)[[1]] + ) + expect_equal( + expected = quo(STUDYID), + object = quo_c(x, NULL, y)[[2]] + ) +}) + +## 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", { + USUBJID <- "01-701-1015" # nolint + + expect_error( + object = quo_c(quo(USUBJID), USUBJID) + ) +}) + +# 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_fun <- function(x) { - x <- rlang::enquo(x) - assertthat::assert_that(quo_not_missing(x)) + x <- enquo(x) + !isTRUE(quo_not_missing(x)) } expect_true(test_fun(my_variable)) }) -test_that("Test 11 : `quo_not_missing` throws and Error if missing argument", { +## 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_fun <- function(x) { - x <- rlang::enquo(x) - assertthat::assert_that(quo_not_missing(x)) + x <- enquo(x) + isTrue(quo_not_missing(x)) } expect_error(test_fun()) # missing argument -> throws error }) + +# 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) + + z_noname <- replace_values_by_names(z) + + names(z) <- c("Unique Subject Identifier", "Study Identifier") + z_named <- replace_values_by_names(z) + + expect_equal( + expected = quo(USUBJID), + object = z_noname[[1]] + ) + expect_equal( + expected = quo(STUDYID), + object = z_noname[[2]] + ) + + expect_equal( + expected = quo(`Unique Subject Identifier`), + object = z_named[[1]] + ) + expect_equal( + expected = quo(`Study Identifier`), + object = z_named[[2]] + ) +}) + +# replace_symbol_in_quo ---- +## Test 6: symbol is replaced ---- +test_that("replace_symbol_in_quo Test 6: symbol is replaced", { + expect_equal( + expected = quo(AVAL.join), + object = replace_symbol_in_quo( + quo(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", { + expect_equal( + expected = quo(AVALC), + object = replace_symbol_in_quo( + quo(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", { + expect_equal( + expected = quo(desc(AVAL.join)), + object = replace_symbol_in_quo( + quo(desc(AVAL)), + target = AVAL, + replace = AVAL.join + ) + ) +}) + +# add_suffix_to_vars ---- +## Test 9: with single variable ---- +test_that("add_suffix_to_vars Test 9: 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") + ) +}) + +## Test 10: with more than one variable ---- +test_that("add_suffix_to_vars Test 10: with more than one variable", { + expect_equal( + expected = vars(ADT, desc(AVAL.join), AVALC.join), + object = add_suffix_to_vars( + vars(ADT, desc(AVAL), AVALC), + vars = vars(AVAL, AVALC), + suffix = ".join" + ) + ) +}) diff --git a/tests/testthat/test-quote.R b/tests/testthat/test-quote.R index fabc6dd5..58922aa3 100644 --- a/tests/testthat/test-quote.R +++ b/tests/testthat/test-quote.R @@ -1,14 +1,20 @@ -test_that("Test 1: enumerate works", { +# enumerate ---- +## Test 1: enumerate works ---- +test_that("enumerate Test 1: enumerate works", { expect_equal(enumerate(letters[1]), "`a`") expect_equal(enumerate(letters[1:3]), "`a`, `b` and `c`") }) -test_that("Test 2: squote works", { +# squote ---- +## Test 2: squote works ---- +test_that("squote Test 2: squote works", { expect_equal(squote(letters[1]), "'a'") expect_equal(squote(letters[1:3]), c("'a'", "'b'", "'c'")) }) -test_that("Test 3: squote works", { +# dquote ---- +## Test 3: dquote works ---- +test_that("dquote Test 3: dquote works", { expect_equal(dquote(letters[1]), "\"a\"") expect_equal(dquote(letters[1:3]), c("\"a\"", "\"b\"", "\"c\"")) x <- NULL diff --git a/tests/testthat/test-test_helpers.R b/tests/testthat/test-test_helpers.R index c8b8a193..07ff21f1 100644 --- a/tests/testthat/test-test_helpers.R +++ b/tests/testthat/test-test_helpers.R @@ -1,4 +1,6 @@ -test_that("expect_dfs_equal works", { +# expect_dfs_equal ---- +## Test 1: expect_dfs_equal works ---- +test_that("expect_dfs_equal Test 1: expect_dfs_equal works", { a <- data.frame(x = 1:3, y = 4:6) b <- data.frame(x = 1:3, y = 5:7) diff --git a/tests/testthat/test-tmp_vars.R b/tests/testthat/test-tmp_vars.R index 7acd2423..321ad6c1 100644 --- a/tests/testthat/test-tmp_vars.R +++ b/tests/testthat/test-tmp_vars.R @@ -1,6 +1,4 @@ -library(admiral.test) -data(admiral_dm) -dm <- select(admiral_dm, USUBJID) +dm <- select(admiral.test::admiral_dm, USUBJID) # get_new_tmp_var ---- ## Test 1: creating temporary variables works ---- @@ -24,7 +22,7 @@ test_that("get_new_tmp_var Test 3: the temporary variable counter is increased c }) # remove_tmp_vars ---- -## Test 4: no variables are removed when no tmp vars are present ---- +## Test 4: no variables are removed when no tmp vars are present ---- test_that("remove_tmp_vars Test 4: no variables are removed when no tmp vars are present", { expect_identical(dm, remove_tmp_vars(dm)) }) @@ -55,3 +53,10 @@ test_that("remove_tmp_vars Test 6: removing temp variables works with the pipe o } expect_identical(colnames(dm), colnames(do_something_with_pipe(dm))) }) + + +## Test 7: running get_new_tmp_var on NULL dataset creates generic variable ---- +test_that("running get_new_tmp_var on NULL dataset creates generic variable", { + df <- NULL + expect_identical(get_new_tmp_var(df), sym("tmp_var_1")) +}) diff --git a/tests/testthat/test-warnings.R b/tests/testthat/test-warnings.R index d786325c..d443b0e2 100644 --- a/tests/testthat/test-warnings.R +++ b/tests/testthat/test-warnings.R @@ -1,39 +1,45 @@ -library(admiral.test) - -test_that("A warning is issued when a variable to be derived already exists in the input dataset", { - data(admiral_dm) +# warn_if_vars_exist ---- +## Test 1: warning if a variable already exists in the input dataset ---- +test_that("warn_if_vars_exist Test 1: warning if a variable already exists in the input dataset", { + dm <- admiral.test::admiral_dm expect_warning( - warn_if_vars_exist(admiral_dm, "AGE"), + warn_if_vars_exist(dm, "AGE"), "Variable `AGE` already exists in the dataset" ) expect_warning( - warn_if_vars_exist(admiral_dm, c("AGE", "AGEU", "ARM")), + warn_if_vars_exist(dm, c("AGE", "AGEU", "ARM")), "Variables `AGE`, `AGEU` and `ARM` already exist in the dataset" ) expect_warning( - warn_if_vars_exist(admiral_dm, c("AAGE", "AGEU", "ARM")), + warn_if_vars_exist(dm, c("AAGE", "AGEU", "ARM")), "Variables `AGEU` and `ARM` already exist in the dataset" ) expect_warning( - warn_if_vars_exist(admiral_dm, "AAGE"), + warn_if_vars_exist(dm, "AAGE"), NA ) }) -test_that("A warning is issued when a vector contain unknown datetime format", { +# warn_if_invalud_dtc ---- +## Test 2: Warning if vector contains unknown datetime format ---- +test_that("warn_if_invalud_dtc Test 2: Warning if vector contains unknown datetime format", { expect_warning( warn_if_invalid_dtc(dtc = "20210406T12:30:30") ) }) -test_that("A warning is issued when a vector contain an incomplete dtc", { +# 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", { expect_warning( warn_if_incomplete_dtc("2021-04-06", n = 19) ) }) -test_that("A warning is issued when two lists are inconsistent", { +# 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", { expect_warning( warn_if_inconsistent_list( base = vars(DTHDOM = "DM", DTHSEQ = DMSEQ, DTHVAR = "text"), diff --git a/tests/testthat/test-what.R b/tests/testthat/test-what.R index 40255acd..496034c4 100644 --- a/tests/testthat/test-what.R +++ b/tests/testthat/test-what.R @@ -1,4 +1,6 @@ -test_that("atomic vectors of length 1", { +# what_is_it ---- +## Test 1: atomic vectors of length 1 ---- +test_that("what_is_it Test 1: atomic vectors of length 1", { expect_identical(what_is_it(NULL), "`NULL`") expect_identical(what_is_it(TRUE), "`TRUE`") expect_identical(what_is_it(NA), "`NA`") @@ -8,7 +10,8 @@ test_that("atomic vectors of length 1", { expect_identical(what_is_it(2.42), "`2.42`") }) -test_that("vectors", { +## Test 2: vectors ---- +test_that("what_is_it Test 2: vectors", { expect_identical(what_is_it(letters), "a character vector") expect_identical(what_is_it(1:10), "an integer vector") expect_identical(what_is_it(c(1.2, 3)), "a double vector") @@ -16,7 +19,8 @@ test_that("vectors", { expect_identical(what_is_it(list(1, letters, TRUE)), "a list") }) -test_that("S3 objects", { +## Test 3: S3 objects ---- +test_that("what_is_it Test 3: S3 objects", { expect_identical(what_is_it(mtcars), "a data frame") expect_identical(what_is_it(factor(letters)), "a factor") expect_identical(what_is_it(lm(hp ~ mpg, data = mtcars)), "an object of class 'lm'") @@ -24,10 +28,12 @@ test_that("S3 objects", { }) -test_that("S4 objects", { +## Test 4: S4 objects ---- +test_that("what_is_it Test 4: S4 objects", { expect_identical(what_is_it(lubridate::days(1)), "a S4 object of class 'Period'") }) -test_that("symbols", { +## Test 5: symbols ---- +test_that("what_is_it Test 5: symbols", { expect_identical(what_is_it(quote(USUBJID)), "a symbol") }) diff --git a/vignettes/admiraldev.Rmd b/vignettes/admiraldev.Rmd index f6a24000..a2962768 100644 --- a/vignettes/admiraldev.Rmd +++ b/vignettes/admiraldev.Rmd @@ -56,11 +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 onoclogy needs, then it should remain in `{admiralonco}`. -1. The `assert` custom checking functions should always live within `{admiraldev}` to stay with the family of `assertion` functions. - - - - - - +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 `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/git_usage.Rmd b/vignettes/git_usage.Rmd index 55405536..df704911 100644 --- a/vignettes/git_usage.Rmd +++ b/vignettes/git_usage.Rmd @@ -27,8 +27,8 @@ This article will give you an overview of how the `{admiral}` project is utilizi - The `main` branch contains the latest **released** version and should not be used for development. You can find the released versions [here](https://GitHub.com/pharmaverse/admiral/releases) - The `devel` branch contains the latest development version of the package. You will always be branching off and pulling into the `devel` branch. - The `gh-pages` branches contains the code used to render this website you are looking at right now! -- The `patch` branch is reserved for special hot fixes to address bugs. More info in [ Hot Fix Release](#hot-fix-release) -- The `pre-release` branch is used to as an intermediate step to releasing the package from `main`. More info in [Quarterly Release section](#quarterly-release) +- The `patch` branch is reserved for special hot fixes to address bugs. More info in [Hot Fix Release](release_strategy.html#hot-fix-release) +- The `pre-release` branch is used to as an intermediate step to releasing the package from `main`. More info in [Quarterly Release section](release_strategy.html#quarterly-release) - The `main`, `devel`, `gh-pages`, `patch` and `pre-release` branches are under protection. If you try and push changes to these branches you will get an error unless you are an administrator. - **Feature** branches are where actual development related to a specific issue happens. Feature branches are merged into `devel` once a pull request is merged. Check out the [Pull Request Review Guidance](pr_review_guidance.html). @@ -179,38 +179,3 @@ knitr::include_graphics("github_conflicts.png", dpi = 144) * [GitHub and RStudio](https://resources.github.com/whitepapers/github-and-rstudio/) * [Happy Git and GitHub for the useR](https://happygitwithr.com/) - -# Package Release - -## Quarterly Release - -A package release is done in five parts: - -1) Create a Pull Request from `devel` into the `pre-release` branch. Issues identified in this Pull Request should have work done in separate branches and merged into the `pre-release` branch and **NOT** `devel`. -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`. - -**Quarterly Release:** `devel >> pre-release >> main` - -## Hot Fix Release - -Occasionally we will need to release a hot fix to address a package breaking bug. A hot fix release is done in 6 parts: - -1) Identify all the bugs that need to be fixed for this hot fix release and label with hot fix label. -1) Branches addressing the bugs should have Pull Requests merged into the `patch` branch **NOT** the `devel` branch. -1) Create a Pull Request from `patch` into the `pre-release` branch. Verify that all CI/CD checks are passing, merge and bundle up and send off to CRAN. -1) Once package is approved and available on CRAN, another Pull Request is created for merging the `pre-release` branch into the `main` branch. This will trigger the action to rebuild the `{admiral}` website with all the updates for this hot fix 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) These hot fixes should then be merged into the `devel` branch through an additional Pull Request. - -**Hot Fix Release**: `patch >> pre-release >> main >> devel` - -## Release Schedule - -A release schedule is maintained on the [homepage](../index.html#release-schedule). - - - - diff --git a/vignettes/pr_review_guidance.Rmd b/vignettes/pr_review_guidance.Rmd index 6742ed4d..d8ca399c 100644 --- a/vignettes/pr_review_guidance.Rmd +++ b/vignettes/pr_review_guidance.Rmd @@ -21,53 +21,49 @@ knitr::opts_chunk$set( This document is intended to be guidance for creators and reviewers of pull requests (PRs) in the `{admiral}` package. PR authors will benefit from shorter review times by closely following the guidance provided here. -A pull request into the `devel` branch signifies that an issue that has been "addressed". This issue might be a bug, a feature request or a documentation update. For transparency, we keep the issue open until the `devel` branch is merged into the `main` branch, which usually coincides with a release of `{admiral}` to CRAN. This ensures that repeat issues are not raised and if they are raised are quickly marked as duplicates and closed. +A pull request into the `devel` branch signifies that an issue that has been "addressed". This issue might be a bug, a feature request or a documentation update. For transparency, we keep the issue open until the `devel` branch is merged into the `main` branch, which usually coincides with a release of `{admiral}` to CRAN. This ensures that repeat issues are not raised and if they are raised are quickly marked as duplicates and closed. -Closely following the below guidance will ensure that our all our "addressed" issues auto-close once we merge `devel` into `main`. +Closely following the below guidance will ensure that our all our "addressed" issues auto-close once we merge `devel` into `main`. # Review Criteria -For a pull request to be merged into `devel` it needs to pass the automated `R CMD check`, `lintr`, and `task-list-completed` workflows on GitHub at a minimum. The first two checks can be run locally using the `devtools::check()` and `lintr::lint_package()` commands and are recommended to be done before pushing to GitHub. The `task-list-completed` workflow is exclusive to GitHub and will be discussed later. In addition, the PR creator and reviewer should make sure that +For a pull request to be merged into `devel` it needs to pass the automated `R CMD check`, `lintr`, and `task-list-completed` workflows on GitHub at a minimum. The first two checks can be run locally using the `devtools::check()` and `lintr::lint_package()` commands and are recommended to be done before pushing to GitHub. The `task-list-completed` workflow is exclusive to GitHub and will be discussed later. In addition, the PR creator and reviewer should make sure that -- the [Programming Strategy](programming_strategy.html) and [Development Process](development_process.html) are followed +- the [Programming Strategy](programming_strategy.html) and [Development Process](development_process.html) are followed -- the function is ADaM IG compliant +- the function is ADaM IG compliant -- the function does what is intended for (as described in the header and corresponding issue) +- the function does what is intended for (as described in the header and corresponding issue) -- the function header properly explains the intention of the function, the expected inputs (incl. permitted values of parameters) and the output produced; after reading the documentation the reader should be able to predict the output of the function without having to read the source code +- the function header properly explains the intention of the function, the expected inputs (incl. permitted values of parameters) and the output produced; after reading the documentation the reader should be able to predict the output of the function without having to read the source code -- the function has an accompanying set of unit tests; for derivations these unit test should have a code coverage of at least 90%; the whole package should have a coverage of >= 80% +- the function has an accompanying set of unit tests; for derivations these unit test should have a code coverage of at least 90%; the whole package should have a coverage of \>= 80% -- the implemented derivation is in the scope of `{admiral}`, e.g. does not expect company specific input or hard-code company-specific rules +- the implemented derivation is in the scope of `{admiral}`, e.g. does not expect company specific input or hard-code company-specific rules -- meaningful error or warning messages are issued if the input is invalid +- meaningful error or warning messages are issued if the input is invalid -- documentation is created/updated by running `devtools::document()` +- documentation is created/updated by running `devtools::document()` -- functions which are supposed to be exported are listed in the `NAMESPACE` file; this requires an `@export` tag in the function header +- functions which are supposed to be exported are listed in the `NAMESPACE` file; this requires an `@export` tag in the function header -- examples print relevant source variables and newly created variables and/or records in their output +- examples print relevant source variables and newly created variables and/or records in their output -- the `NEWS.md` file is updated with an entry that explains the new features or changes +- the `NEWS.md` file is updated with an entry that explains the new features or changes -- the author of a function is listed in the `DESCRIPTION` file - -- all files affected by the implemented changes, e.g. vignettes and templates, are updated +- the author of a function is listed in the `DESCRIPTION` file +- all files affected by the implemented changes, e.g. vignettes and templates, are updated # So much Red Tape! -The `{admiral}` development team is aware and sympathetic to the great many checks, processes and -documents needed to work through in order to do a compliant Pull Request. The `task-list-completed` GitHub -workflow was created to help reduce this burden on contributors by providing a standardized checklist that compiles information from the Pull Request Review Guidance, [Programming Strategy](programming_strategy.html) and [Development Process](development_process.html) vignettes. +The `{admiral}` development team is aware and sympathetic to the great many checks, processes and documents needed to work through in order to do a compliant Pull Request. The `task-list-completed` GitHub workflow was created to help reduce this burden on contributors by providing a standardized checklist that compiles information from the Pull Request Review Guidance, [Programming Strategy](programming_strategy.html) and [Development Process](development_process.html) vignettes. The next three sections give a high-level overview of what a contributor faces in opening a PR, and how a contributor interacts with the `task-list-completed` workflow in their PR. ## Open a Pull Request -When a contributor opens a PR a lengthy standard text will be inserted into the comment section. Please do not alter any of the automated text. You will need to manually add `Closes #` into the title of the Pull Request. You can use the Edit button in the top right if you forget this step at the start of your Pull Request. Besides that you are free to add in additional textual information, screenshots, etc. at the bottom of the automated text if needed to clarify or contribute to the discussion around your PR. - +When a contributor opens a PR a lengthy standard text will be inserted into the comment section. Please do not alter any of the automated text. You will need to manually add `Closes #` into the title of the Pull Request. You can use the Edit button in the top right if you forget this step at the start of your Pull Request. Besides that you are free to add in additional textual information, screenshots, etc. at the bottom of the automated text if needed to clarify or contribute to the discussion around your PR. ```{r echo=FALSE, out.width='120%'} knitr::include_graphics("./pr_review_checklist.png") @@ -75,13 +71,13 @@ knitr::include_graphics("./pr_review_checklist.png") ## Create a Pull Request -After you click the green `Create pull request` button the automated text that was inserted will be turned into a checklist in your Pull Request. Each check box has been drawn from the previously mentioned vignettes and presented in the recommended sequence. These check boxes are meant to be a helpful aid in ensuring that you have created a compliant Pull Request. +After you click the green `Create pull request` button the automated text that was inserted will be turned into a checklist in your Pull Request. Each check box has been drawn from the previously mentioned vignettes and presented in the recommended sequence. These check boxes are meant to be a helpful aid in ensuring that you have created a compliant Pull Request. ```{r echo=FALSE, out.width='120%'} knitr::include_graphics("./pr_review_checkbox.png") ``` -## Complete the Pull Request checklist +## Complete the Pull Request checklist The check boxes are linked to the `task-list-completed` workflow. You need to check off each box in acknowledgment that you have done you due diligence in creating a compliant Pull Request. GitHub will refresh the Pull Request and trigger `task-list-completed` workflow that you have completed the task. The PR can not be merged into `devel` until the contributor has checked off each of the check box items. @@ -89,27 +85,27 @@ The check boxes are linked to the `task-list-completed` workflow. You need to ch knitr::include_graphics("./pr_review_actions.png") ``` -Please don't hesitate to reach out to the `{admiral}` team on [Slack](https://app.slack.com/client/T028PB489D3/C02M8KN8269) or through the [GitHub Issues](https://github.com/pharmaverse/admiral/issues) tracker if you think this checklist needs to be amended or further clarity is needed on a check box item. +Please don't hesitate to reach out to the `{admiral}` team on [Slack](https://app.slack.com/client/T028PB489D3/C02M8KN8269) or through the [GitHub Issues](https://github.com/pharmaverse/admiral/issues) tracker if you think this checklist needs to be amended or further clarity is needed on a check box item. # GitHub Actions/Workflows -The `task-list-completed` workflow is one of the several workflows/actions used within `{admiral}`. These workflows live in the `.github/workflows` folder and it is important to understand their use and how to remedy if the workflow fails. Workflows defined here are responsible for assuring high package quality standards without compromising performance, security, or reproducibility. +The `task-list-completed` workflow is one of the several workflows/actions used within `{admiral}`. These workflows live in the `.github/workflows` folder and it is important to understand their use and how to remedy if the workflow fails. Workflows defined here are responsible for assuring high package quality standards without compromising performance, security, or reproducibility. ## A synopsis of admiral's workflows Most workflows have a `BEGIN boilerplate steps` and `END boilerplate steps` section within them which define some standard steps required for installing system dependencies, R version and R packages which serve as dependencies for the package. -The underlying mechanisms for installing R and Pandoc are defined in `r-lib/actions`, while the installation of system dependencies and R package dependencies is managed via the Staged Dependencies GitHub Action]. The latter is used in conjunction with the `staged_dependencies.yaml` file in order to install dependencies that are in the _same stage of development_ as the current package. +The underlying mechanisms for installing R and Pandoc are defined in `r-lib/actions`, while the installation of system dependencies and R package dependencies is managed via the Staged Dependencies GitHub Action]. The latter is used in conjunction with the `staged_dependencies.yaml` file in order to install dependencies that are in the *same stage of development* as the current package. Following the installation of system dependencies, R, and package dependencies, each workflow checks the integrity of a specific component of the admiral codebase. ### `check-templates.yml` -This workflow checks for issues within template scripts. For example, in the admiral package there are several template scripts with admiral-based functions showing how to build certain ADaM datasets. As we update the admiral functions, we want to make sure these template scripts execute appropriately. Functions in the template scripts that are deprecated or used inappropriately will cause this workflow to fail. Click on the details button on a failing action provides information on the where the template is failing. +This workflow checks for issues within template scripts. For example, in the admiral package there are several template scripts with admiral-based functions showing how to build certain ADaM datasets. As we update the admiral functions, we want to make sure these template scripts execute appropriately. Functions in the template scripts that are deprecated or used inappropriately will cause this workflow to fail. Click on the details button on a failing action provides information on the where the template is failing. ### `code-coverage.yml` -This workflow measures code coverage for unit tests and reports the code coverage as a percentage of the _total number of lines covered by unit tests_ vs. the _total number of lines in the codebase_. +This workflow measures code coverage for unit tests and reports the code coverage as a percentage of the *total number of lines covered by unit tests* vs. the *total number of lines in the codebase*. The `{covr}` R package is used to calculate the coverage. @@ -117,11 +113,11 @@ Report summaries and badges for coverage are generated using a series of other G ### `links.yml` -This workflow checks whether URLs embedded in code and documentation are valid. Invalid URLs results in workflow failures. This workflow uses `lychee` to detect broken links. Occasionally this check will detect false positives of urls that look like urls. To remedy, please add this false positive to the `.lycheeignore` file. +This workflow checks whether URLs embedded in code and documentation are valid. Invalid URLs results in workflow failures. This workflow uses `lychee` to detect broken links. Occasionally this check will detect false positives of urls that look like urls. To remedy, please add this false positive to the `.lycheeignore` file. ### `lintr.yml` -Static code analysis is performed by this workflow, which in turn uses the `{lintr}` R package. The `.lintr` configurations in the repository will be by this workflow. +Static code analysis is performed by this workflow, which in turn uses the `{lintr}` R package. The `.lintr` configurations in the repository will be by this workflow. ### `man-pages.yml` @@ -149,11 +145,11 @@ If your codebase uses a [`README.Rmd` file](../../README.Rmd), then this workflo ### `spellcheck.yml` -Spellchecks are performed by this workflow, and the `{spelling}` R package is used to detect spelling mistakes. Failed workflows typically indicate misspelled words. In the `inst/WORDLIST` file, you can add words and or acronyms that you want the spell check to ignore, for example occds is not an English word but a common acronym used within Pharma. The workflow will flag this until a user adds it to the `inst/WORDLIST`. +Spellchecks are performed by this workflow, and the `{spelling}` R package is used to detect spelling mistakes. Failed workflows typically indicate misspelled words. In the `inst/WORDLIST` file, you can add words and or acronyms that you want the spell check to ignore, for example occds is not an English word but a common acronym used within Pharma. The workflow will flag this until a user adds it to the `inst/WORDLIST`. ### `style.yml` -Code style is enforced via the `styler` R package. Custom style configurations, if any, will be honored by this workflow. Failed workflows are indicative of unstyled code. +Code style is enforced via the `styler` R package. Custom style configurations, if any, will be honored by this workflow. Failed workflows are indicative of unstyled code. # Common R CMD Check Issues @@ -165,7 +161,7 @@ If the `R CMD check` workflow fails only on one or two R versions it can be help To reproduce a particular R version environment open the `{admiral}` project in the corresponding R version, comment the line `source("renv/activate.R")` in the `.Rprofile` file, restart the R session and then run the following commands in the R console. -```r +``` r Sys.setenv(R_REMOTES_NO_ERRORS_FROM_WARNINGS = "true") if (!dir.exists(".library")) { @@ -181,10 +177,12 @@ for (pkg in base_recommended_pkgs) { assign(".lib.loc", ".library", envir = environment(.libPaths)) r_version <- getRversion() -if (grepl("^3.6", r_version)) { - options(repos = "https://cran.microsoft.com/snapshot/2020-02-29") -} else if (grepl("^4.0", r_version)) { +if (grepl("^4.0", r_version)) { options(repos = "https://cran.microsoft.com/snapshot/2021-03-31") +} else if (grepl("^4.1", r_version)) { + options(repos = "https://cran.microsoft.com/snapshot/2022-03-10") +} else if (grepl("release", r_version)) { + options(repos = "https://cran.microsoft.com/snapshot/2022-06-23") } else { options(repos = "https://cran.rstudio.com") } @@ -193,8 +191,8 @@ if (!requireNamespace("remotes", quietly = TRUE)) { install.packages("remotes") } remotes::install_deps(dependencies = TRUE) -remotes::install_github("pharamaverse/admiral.test", ref = "devel") - +remotes::install_github("pharmaverse/admiral.test", ref = "devel") +remotes::install_github("pharmaverse/admiraldev", ref = "devel") rcmdcheck::rcmdcheck() ``` @@ -202,44 +200,36 @@ This will ensure that the exact package versions we use in the workflow are inst ## Package Dependencies -``` -> checking package dependencies ... ERROR - Namespace dependency not required: ‘pkg’ -``` + > checking package dependencies ... ERROR + Namespace dependency not required: ‘pkg’ Add `pkg` to the `Imports` or `Suggests` field in the `DESCRIPTION` file. In general, dependencies should be listed in the `Imports` field. However, if a package is only used inside vignettes or unit tests it should be listed in `Suggests` because all `{admiral}` functions would work without these "soft" dependencies being installed. ## Global Variables -``` -❯ checking R code for possible problems ... NOTE - function_xyz: no visible binding for global variable ‘some_var’ -``` + ❯ checking R code for possible problems ... NOTE + function_xyz: no visible binding for global variable ‘some_var’ Add `some_var` to the list of "global" variables in `R/globals.R`. ## Undocumented Function Parameter -``` -❯ checking Rd \usage sections ... WARNING - Undocumented arguments in documentation object 'function_xyz' - ‘some_param’ -``` + ❯ checking Rd \usage sections ... WARNING + Undocumented arguments in documentation object 'function_xyz' + ‘some_param’ Add an `@param some_param` section in the header of `function_xyz()` and run `devtools::document()` afterwards. ## Outdated Documentation -``` -❯ checking for code/documentation mismatches ... WARNING - Codoc mismatches from documentation object 'function_xyz': - ... - Argument names in code not in docs: - new_param_name - Argument names in docs not in code: - old_param_name - Mismatches in argument names: - Position: 6 Code: new_param_name Docs: old_param_name -``` + ❯ checking for code/documentation mismatches ... WARNING + Codoc mismatches from documentation object 'function_xyz': + ... + Argument names in code not in docs: + new_param_name + Argument names in docs not in code: + old_param_name + Mismatches in argument names: + Position: 6 Code: new_param_name Docs: old_param_name The name of a parameter has been changed in the function code but not yet in the header. Change `@param old_param_name` to `@param new_param_name` and run `devtools::document()`. diff --git a/vignettes/programming_strategy.Rmd b/vignettes/programming_strategy.Rmd index 2b12307a..f50f8253 100644 --- a/vignettes/programming_strategy.Rmd +++ b/vignettes/programming_strategy.Rmd @@ -100,7 +100,13 @@ i.e. all input like datasets, variable names, options, … must be provided to t * 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. -* The function must not have any side-effects like creating or modifying global objects, printing, writing files, ... +* 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()`. ## Function Names @@ -114,6 +120,21 @@ variables must start with `temp_` and must be removed from the output dataset. | `derive_vars_` (e.g. `derive_vars_dt`) | Functions which add multiple variables | | `derive_param_` (e.g. `derive_param_os`) | Functions which add a single parameter | | `compute_` / `calculate_` / ... | Functions that take vectors as input and return a vector | +| `create_` / `consolidate_` | Functions that create datasets without keeping the original observations | +| `get_` | Usually utility functions that return very specific objects that get passed through other functions | +| `filter_` | Functions that filter observations based on conditions associated with common clinical trial syntax | + +| Function Name Suffix | Description | +|----------------------------------------------|-----------------------------------------------------------------------------------------------------| +| `_derivation` (suffix) | High order functions that call a user specified derivation | +| `_date` / `_time` / `_dt` / `_dtc` / `_dtm` | Functions associated with dates, times, datetimes, and their character equivalents. | +| `_source` | Functions that create source datasets that usually will be passed through other `derive_` functions.| + +| Other Common Function Name Terms | Description | +|----------------------------------------------|-----------------------------------------------------------------------------------------------------| +| `_merged_` / `_joined_` / `_extreme_` | Functions that follow the generic function user-guide. | + + Please note that the appropriate *var*/*vars* prefix should be used for all cases in which the function creates any variable(s), regardless of the presence of a `new_var` parameter in the function call. @@ -203,10 +224,11 @@ Parameters which expect a boolean or boolean vector must start with a verb, e.g. | `filter` | Expression to filter a dataset, e.g., `PARAMCD == "TEMP"`. | | `start_date` | The start date of an event/interval. Expects a date object. | | `end_date` | The end date of an event/interval. Expects a date object. | -| `start_dtc` | (Partial) start date/datetime in ISO 8601 format. | +| `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")` | ## Source Code Formatting @@ -223,7 +245,7 @@ and, if there’s an invalid input, the function should stop immediately with an An exception is the case where a variable to be added by a function already exists in the input dataset: here only a warning should be displayed and the function should continue executing. -Inputs should be checked either using `asserthat::assert_that()` or custom assertion functions defined in [`R/assertions.R`](https://github.com/pharmaverse/admiral/blob/main/R/assertions.R). +Inputs should be checked using custom assertion functions defined in [`R/assertions.R`](https://github.com/pharmaverse/admiraldev/blob/main/R/assertions.R). These custom assertion functions should either return an error in case of an invalid input or return nothing. For the most common types of input parameters like a single variable, a list of @@ -295,7 +317,7 @@ An example is given below: #' #' @examples #' library(lubridate) -#' library(dplyr) +#' library(dplyr, warn.conflicts = FALSE) #' library(tibble) #' #' datain <- tribble( @@ -330,7 +352,8 @@ Any newly added variable(-s) should be mentioned here. * `@examples`: A fully self-contained example of how to use the function. Self-contained means that, if this code is executed in a new R session, it will run without errors. That means any packages need to be loaded with `library()` and any datasets needed either to be created directly inside the example code or loaded using `data()`. -If a dataset is created in the example, it should be done so using the function `tribble()` (specify `library(tibble)` before calling this function). +If a dataset is created in the example, it should be done so using the function `tribble()` (specify `library(tibble)` before calling this function). +If other functions are called in the example, please specify `library(pkg_name)` then refer to the respective function `fun()` as opposed to the preferred `pkg_name::fun()` notation as specified in [Unit Test Guidance](unit_test_guidance.html#set-up-the-test-script). Make sure to align columns as this ensures quick code readability. Copying descriptions should be avoided as it makes the documentation hard to @@ -388,6 +411,7 @@ add an issue in GitHub for discussion. |-----------------------------------------------------------------------------------|--------------------------------------------------------------------------------------------------------------------------| | `com_date_time` | Date/Time Computation Functions that returns a vector | | `com_bds_findings` | BDS-Findings Functions that returns a vector | +| `create_aux` | Functions for Creating Auxiliary Datasets | | `datasets` | Example datasets used within admiral | | `der_gen` | General Derivation Functions that can be used for any ADaM. | | `der_date_time` | Date/Time Derivation Function | @@ -398,15 +422,15 @@ add an issue in GitHub for discussion. | `der_tte` | Function used only for creating a Time to Event (TTE) Dataset | | `der_occds` | OCCDS specific derivation of helper Functions | | `der_prm_tte` | TTE Functions for adding Parameters to TTE Dataset | -| `deprecated` | Function which will be removed from admiral after next release. See [Deprecation Guidance](https://pharmaverse.github.io/admiral/articles/programming_strategy.html#deprecation). | +| `deprecated` | Function which will be removed from admiral after next release. See [Deprecation Guidance](#deprecation). | +| `metadata` | Auxiliary datasets providing definitions as input for derivations, e.g. grading criteria or dose frequencies | | `utils_ds_chk` | Utilities for Dataset Checking | | `utils_fil` | Utilities for Filtering Observations | | `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 | -| `high_order_function` | Higher Order Functions | -| `move_adm_dev` | Functions moved to `admiraldev` package [Link TBA] | +| `high_order_function` | Higher Order Functions | | | `internal` | Internal functions only available to admiral developers | | | | | `assertion`* | Asserts a certain type and gives warning, error to user | @@ -452,6 +476,12 @@ 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: + +``` +#' @export +pkg_name::fun +``` # Metadata @@ -488,7 +518,7 @@ The documentation will be updated at: + the description level for a function, + the keywords will be replaced with `deprecated` -+ the @family roxygen tag will be removed ++ the @family roxygen tag will become `deprecated` ```{r, eval=FALSE} #' Title of the function @@ -498,6 +528,8 @@ The documentation will be updated at: #' #' This function is *deprecated*, please use `new_fun()` instead. #' . +#' @family deprecated +#' #' @keywords deprecated #' . ``` @@ -578,7 +610,36 @@ will need to be quoted. ## Unit Testing Unit tests for deprecated functions and parameters must be added to -`tests/testthat/test-deprecation.R` to ensure that a warning or error is issued. +`tests/testthat/test-deprecation.R` to ensure that a warning or error is issued. + +When writing the unit test, check that the error or warning has the right class, i.e. "lifecycle_error_deprecated" or "lifecycle_warning_deprecated", respectively. The unit-test should follow the corresponding format, per the [unit test guidance](unit_test_guidance.html#writing-unit-tests-in-admiral-): + +``` +# For deprecated functions that issues error + +## Test #: An error is thrown if `derive_var_example()` is called ---- +test_that("deprecation Test #: derive_var_example() An error is thrown if + `derive_var_example()` is called", { + expect_error( + derive_var_example(), + class = "lifecycle_error_deprecated" + ) +}) +``` + +``` +# For deprecated functions that issues warning + +## Test #: A warning is thrown if `derive_var_example()` is called ---- +test_that("deprecation Test #: derive_var_example() A warning is thrown if + `derive_var_example()` is called", { + expect_warning( + derive_var_example(), + class = "lifecycle_warning_deprecated" + ) +}) +``` + Other unit tests of deprecated functions must be removed. @@ -666,8 +727,8 @@ If meaningful, comments can cover multiple variables within a piece of code # 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 R Version 3.6.3, but that will change as we move forward with `{admiral}`. This need for a common development environment also carries over for our choice of package versions. -* GitHub allows us through the Actions/Workflows to test `{admiral}` under several versions of R as well as several versions of dependent R packages needed for `{admiral}`. Currently we test `{admiral}` against 3.6.3 with a CRAN package snapshot from 2020-02-29, 4.0 with a CRAN package snapshot from 2021-03-31 and the latest R version with the latest snapshots of packages. You can view this workflow on our [GitHub Repository](https://github.com/pharmaverse/admiral/blob/main/.github/workflows/R-CMD-check.yml) +* 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. +* GitHub allows us through the Actions/Workflows to test `{admiral}` under several versions of R as well as several versions of dependent R packages needed for `{admiral}`. Currently we test `{admiral}` against the three latest R Versions and the closest snapshots of packages to those R versions. You can view this workflow and others on our [admiralci GitHub Repository](https://github.com/pharmaverse/admiralci). * This common development allows us to easily re-create bugs and provide solutions to each other issues that developers will encounter. * Reviewers of Pull Requests when running code will know that their environment is identical to the initiator of the Pull Request. This ensures faster review times and higher quality Pull Request reviews. * We achieve this common development environment by using a **lockfile** created from the [`renv`](https://rstudio.github.io/renv/) package. New developers will encounter a suggested `renv::restore()` in the console to revert or move forward your R version and package versions. diff --git a/vignettes/release_strategy.Rmd b/vignettes/release_strategy.Rmd new file mode 100644 index 00000000..cad575b5 --- /dev/null +++ b/vignettes/release_strategy.Rmd @@ -0,0 +1,70 @@ +--- +title: "Release Strategy" +output: + rmarkdown::html_vignette: + toc: true + toc_depth: 6 +vignette: > + %\VignetteIndexEntry{Release Strategy} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +# Introduction + +This article explains how we do package releases for `{admiral}` and across all our +package extensions. This includes details around planned/scheduled releases, as well +as hotfixes. + +# Release Schedule + +A release schedule is maintained on the [homepage](https://pharmaverse.github.io/admiral/#release-schedule). + +# Planning Releases + +Whenever we start looking towards a future release, we create a new release issue +label on GitHub of the form `release Q4-2022` for example. This then can be added +to all the issues we plan to cover in the release and these can be moved to the +Priority column of our project board. + +We should share in advance with our users a high level summary of expected package +updates via the community meetings, especially any anticipated breaking changes. + +# Package Release Process + +## Quarterly Release + +A package release is done in five parts: + +1) Create a Pull Request from `devel` into the `pre-release` branch. Issues identified in this Pull Request should have work done in separate branches and merged into the `pre-release` branch and **NOT** `devel`. +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`. + +**Quarterly Release:** `devel >> pre-release >> main` + +## Hot Fix Release + +Occasionally we will need to release a hot fix to address a package breaking bug. A hot fix release is done in 6 parts: + +1) Identify all the bugs that need to be fixed for this hot fix release and label with hot fix label. +1) Branches addressing the bugs should have Pull Requests merged into the `patch` branch **NOT** the `devel` branch. +1) When naming the branch follow the [naming conventions](git_usage.html#implementing-an-issue) guide but use the `@main` suffix +1) Create a Pull Request from `patch` into the `pre-release` branch. Verify that all CI/CD checks are passing, merge and bundle up and send off to CRAN. +1) Once package is approved and available on CRAN, another Pull Request is created for merging the `pre-release` branch into the `main` branch. This will trigger the action to rebuild the `{admiral}` website with all the updates for this hot fix 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) These hot fixes should then be merged into the `devel` branch through an additional Pull Request. + +**Hot Fix Release**: `patch >> pre-release >> main >> devel` + +# Communications + +After the release, we raise awareness via our Slack channel and LinkedIn. diff --git a/vignettes/unit_test_format_tests.png b/vignettes/unit_test_format_tests.png new file mode 100755 index 00000000..8d2c4336 Binary files /dev/null and b/vignettes/unit_test_format_tests.png differ diff --git a/vignettes/unit_test_guidance.Rmd b/vignettes/unit_test_guidance.Rmd index c307c4f8..b85a3287 100644 --- a/vignettes/unit_test_guidance.Rmd +++ b/vignettes/unit_test_guidance.Rmd @@ -123,9 +123,9 @@ Don’t forget to add a unit test for each exported function. ## Set up the Test Script -Within {admiral} folder https://github.com/pharmaverse/admiral/tree/main/tests/testthat, -add a script with the naming convention “test-\.R”., -the unit test script can be created from the console also, as follows: +Within the `tests/testthat` folder of the project, add a script with the naming +convention `test-.R`., the unit test script can be +created from the console also, as follows: ``` usethis::use_test("") @@ -133,10 +133,10 @@ usethis::use_test("") the testing framework used is testthat and has the following format : ``` +## Test 1: ---- test_that(" Test 1: ", { - library(tibble) - input <- tribble( + input <- tibble::tribble( ~inputvar1, ~inputvar2, ... ... @@ -149,20 +149,21 @@ test_that(" Test 1: ", { }) ``` -For example, if you are testing a function called my_new_func that is contained -in script all_funcs.R then from console use: +For example, if you are testing a function called `my_new_func` that is contained +in script `all_funcs.R` then from console use: ``` usethis::use_test("all_funcs") ``` -Open the newly created file "test-all_funcs.R" and use the following format: +Open the newly created file `test-all_funcs.R` and use the following format: ``` +# my_new_func ---- +## Test 1: ---- test_that("my_new_func Test 1: ", { - library(tibble) - input <- tribble( + input <- tibble::tribble( ~inputvar1, ~inputvar2, ... ... @@ -173,7 +174,7 @@ test_that("my_new_func Test 1: ", { expect_dfs_equal((input), expected_output) }) ``` -**Note**: When comparing datasets in {admiral} we use function `expect_dfs_equal()`. +**Note**: When comparing datasets in `{admiral}` we use function `expect_dfs_equal()`. The input and expected output for the unit tests must follow the following rules: @@ -181,13 +182,101 @@ The input and expected output for the unit tests must follow the following rules * Values should be hard-coded whenever possible. * If values need to be derived, only unit tested functions can be used. -If a dataset needs to be created for testing purpose, it should be done so using the function `tribble()` (specify `library(tibble)` before calling this function). +In contrast to the [Programming Strategy](programming_strategy.html#function-header-documentation) documentation for function examples, test files should not include `library(pkg_name)` calls. +If a dataset needs to be created for testing purposes, it should be done so using the function `tribble()` from the `tibble` package with the following command `tibble::tribble()`. +Furthermore, if other functions need to be called, it should also be done using `pkg_name::fun()`notation. Make sure to align columns as well. This ensures quick code readability. Ensure you give a meaningful explanation of the test in the testthat call, as these will be compiled in the package validation report. Having the name of the function and test ID included in title will also help with traceability. +The comments ending with `----` create entries in the TOC in RStudio. + +```{r echo=FALSE, out.width='120%'} +knitr::include_graphics("./unit_test_toc.png") +``` + + +## Addin `admiraldev::format_test_that_file()` + +To ease the burden on developers for writing and adding tests we have developed an Addin for formatting test_that test files according to admiral programming standards. The Addin will add and update comments as well as number or re-numbers the tests. Just use the Addin button and select the "Format +test_that test file" as seen in the image. Be sure to have the test-file open and selected when calling the Addin. + +```{r echo=FALSE, out.width='120%'} +knitr::include_graphics("./unit_test_format_tests.png") +``` + +The Addin will perform the following: + +- Updates or adds the number of the tests in the comments and in the +`test_that()` call +- Updates the comments based on the description provided in the `test_that()` +call +- Updates the function name in the `test_that()` call. The function name is +extracted from the last `# ----` comment before the +`test_that()` call. If a test file tests more than one function, such comments +should be added before the first test of each function. If a test files tests a +single function only, the comments can be omitted. In this case the addin +determines the function name from the file name by stripping of the "test-" +prefix and the ".R" suffix. + +When writing new unit tests, just provide a description in the `test_that()` +call and if necessary the function name in a `# ----` comment: +``` +# arg_name ---- +test_that("arg_name works", { + expect_equal(arg_name(sym("a")), "a") + expect_equal(arg_name(call("enquo", sym("a"))), "a") + expect_error(arg_name("a"), "Could not extract argument name from") +}) + +# convert_dtm_to_dtc ---- +test_that("works if dtm is in correct format", { + expect_equal( + convert_dtm_to_dtc(as.POSIXct("2022-04-05 15:34:07 UTC")), + "2022-04-05T15:34:07" + ) +}) + +test_that("Error is thrown if dtm is not in correct format", { + expect_error( + convert_dtm_to_dtc("2022-04-05T15:26:14"), + "lubridate::is.instant(dtm) is not TRUE", + fixed = TRUE + ) +}) +``` + +Call the addin and get: +``` +# arg_name ---- +## Test 1: arg_name works ---- +test_that("arg_name Test 1: arg_name works", { + expect_equal(arg_name(sym("a")), "a") + expect_equal(arg_name(call("enquo", sym("a"))), "a") + expect_error(arg_name("a"), "Could not extract argument name from") +}) + +# convert_dtm_to_dtc ---- +## Test 2: works if dtm is in correct format ---- +test_that("convert_dtm_to_dtc Test 2: works if dtm is in correct format", { + expect_equal( + convert_dtm_to_dtc(as.POSIXct("2022-04-05 15:34:07 UTC")), + "2022-04-05T15:34:07" + ) +}) + +## Test 3: Error is thrown if dtm is not in correct format ---- +test_that("convert_dtm_to_dtc Test 3: Error is thrown if dtm is not in correct format", { + expect_error( + convert_dtm_to_dtc("2022-04-05T15:26:14"), + "lubridate::is.instant(dtm) is not TRUE", + fixed = TRUE + ) +}) +``` + Once you have tested your unit test program, you can run all unit tests from the console, as follows. @@ -195,6 +284,12 @@ the console, as follows. devtools::test() ``` +For running just the tests of the current file call + +``` +devtools::test_file() +``` + ## Automation of Unit Tests When a user actions a pull request in {admiral} GitHub repo, the unit tests are diff --git a/vignettes/unit_test_toc.png b/vignettes/unit_test_toc.png new file mode 100755 index 00000000..03e62be1 Binary files /dev/null and b/vignettes/unit_test_toc.png differ