From 0bb0ef8756432aa9321c4327b0a2f1568e297969 Mon Sep 17 00:00:00 2001 From: EeethB <ethanbrockmann@gmail.com> Date: Tue, 5 Dec 2023 21:55:13 +0000 Subject: [PATCH] Add `verbose` option to metadata --- R/label.R | 8 +++++++- R/length.R | 8 +++++++- R/order.R | 8 +++++++- man/xportr_metadata.Rd | 6 +++++- man/xportr_type.Rd | 2 +- tests/testthat/test-length.R | 13 +++++++++++++ tests/testthat/test-order.R | 13 +++++++++++++ tests/testthat/test-type.R | 20 ++++++++++++++++---- 8 files changed, 69 insertions(+), 9 deletions(-) diff --git a/R/label.R b/R/label.R index e412e9fc..3409c091 100644 --- a/R/label.R +++ b/R/label.R @@ -59,7 +59,7 @@ xportr_label <- function(.df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.label_verbose", "none"), + verbose = NULL, metacore = deprecated()) { if (!missing(metacore)) { lifecycle::deprecate_warn( @@ -101,6 +101,12 @@ xportr_label <- function(.df, # Check any variables missed in metadata but present in input data --- miss_vars <- setdiff(names(.df), metadata[[variable_name]]) + # Verbose should use an explicit verbose option first, then the value set in + # metadata, and finally fall back to the option value + verbose <- verbose %||% + attr(.df, "_xportr.df_verbose_") %||% + getOption("xportr.label_verbose", "none") + label_log(miss_vars, verbose) label <- metadata[[variable_label]] diff --git a/R/length.R b/R/length.R index 17627268..e1fddefa 100644 --- a/R/length.R +++ b/R/length.R @@ -66,7 +66,7 @@ xportr_length <- function(.df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.length_verbose", "none"), + verbose = NULL, metacore = deprecated()) { if (!missing(metacore)) { lifecycle::deprecate_warn( @@ -108,6 +108,12 @@ xportr_length <- function(.df, # Check any variables missed in metadata but present in input data --- miss_vars <- setdiff(names(.df), metadata[[variable_name]]) + # Verbose should use an explicit verbose option first, then the value set in + # metadata, and finally fall back to the option value + verbose <- verbose %||% + attr(.df, "_xportr.df_verbose_") %||% + getOption("xportr.length_verbose", "none") + length_log(miss_vars, verbose) length <- metadata[[variable_length]] diff --git a/R/order.R b/R/order.R index 0f7e1b30..1b5b7ce8 100644 --- a/R/order.R +++ b/R/order.R @@ -62,7 +62,7 @@ xportr_order <- function(.df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.order_verbose", "none"), + verbose = NULL, metacore = deprecated()) { if (!missing(metacore)) { lifecycle::deprecate_warn( @@ -122,6 +122,12 @@ xportr_order <- function(.df, # Used in warning message for how many vars have been moved reorder_vars <- names(df_re_ord)[names(df_re_ord) != names(.df)] + # Verbose should use an explicit verbose option first, then the value set in + # metadata, and finally fall back to the option value + verbose <- verbose %||% + attr(.df, "_xportr.df_verbose_") %||% + getOption("xportr.order_verbose", "none") + # Function is located in messages.R var_ord_msg(reorder_vars, names(drop_vars), verbose) diff --git a/man/xportr_metadata.Rd b/man/xportr_metadata.Rd index 592c6f45..c8e7fc8b 100644 --- a/man/xportr_metadata.Rd +++ b/man/xportr_metadata.Rd @@ -4,7 +4,7 @@ \alias{xportr_metadata} \title{Set variable specifications and domain} \usage{ -xportr_metadata(.df, metadata, domain = NULL) +xportr_metadata(.df, metadata, domain = NULL, verbose = NULL) } \arguments{ \item{.df}{A data frame of CDISC standard.} @@ -15,6 +15,10 @@ xportr_metadata(.df, metadata, domain = NULL) \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset the metadata object. If none is passed, then name of the dataset passed as .df will be used.} + +\item{verbose}{The action this function takes when an action is taken on the +dataset or function validation finds an issue. See 'Messaging' section for +details. Options are 'stop', 'warn', 'message', and 'none'} } \value{ \code{.df} dataset with metadata and domain attributes set diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index abfa41d8..dd605ddc 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -8,7 +8,7 @@ xportr_type( .df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.type_verbose", "none"), + verbose = NULL, metacore = deprecated() ) } diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index e749684d..d77ecd50 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -128,6 +128,13 @@ test_that("xportr_length: Impute character lengths based on class", { expect_message("Variable lengths missing from metadata") %>% expect_message("lengths resolved") %>% expect_attr_width(c(7, 199, 200, 200, 8)) + + adsl %>% + xportr_metadata(metadata, verbose = "none") %>% + xportr_length() %>% + expect_message("Variable lengths missing from metadata") %>% + expect_message("lengths resolved") %>% + expect_attr_width(c(7, 199, 200, 200, 8)) }) test_that("xportr_length: Throws message when variables not present in metadata", { @@ -144,6 +151,12 @@ test_that("xportr_length: Throws message when variables not present in metadata" expect_message("Variable lengths missing from metadata") %>% expect_message("lengths resolved") %>% expect_message(regexp = "Problem with `y`") + + xportr_metadata(adsl, metadata, verbose = "message") %>% + xportr_length() %>% + expect_message("Variable lengths missing from metadata") %>% + expect_message("lengths resolved") %>% + expect_message(regexp = "Problem with `y`") }) test_that("xportr_length: Metacore instance can be used", { diff --git a/tests/testthat/test-order.R b/tests/testthat/test-order.R index 801108c4..5f666cce 100644 --- a/tests/testthat/test-order.R +++ b/tests/testthat/test-order.R @@ -136,6 +136,19 @@ test_that("xportr_order: Variable ordering messaging is correct", { expect_message("2 variables not in spec and moved to end") %>% expect_message("Variable moved to end in `.df`: `a` and `z`") %>% expect_message("All variables in dataset are ordered") + + # Metadata versions + xportr_metadata(df, df_meta, verbose = "message") %>% + xportr_order() %>% + expect_message("All variables in specification file are in dataset") %>% + expect_condition("4 reordered in dataset") %>% + expect_message("Variable reordered in `.df`: `a`, `b`, `c`, and `d`") + + xportr_metadata(df2, df_meta, verbose = "message") %>% + xportr_order() %>% + expect_message("2 variables not in spec and moved to end") %>% + expect_message("Variable moved to end in `.df`: `a` and `z`") %>% + expect_message("All variables in dataset are ordered") }) test_that("xportr_order: Metadata order columns are coersed to numeric", { diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index d5841a63..fa2ad2b6 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -66,6 +66,12 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes (df3 <- suppressMessages(xportr_type(df, meta_example, verbose = "warn"))) %>% expect_warning() + # Metadata version of the last statement + df %>% + xportr_metadata(meta_example, verbose = "warn") %>% + xportr_type() %>% + expect_warning() + expect_equal(purrr::map_chr(df3, class), c( Subj = "numeric", Different = "character", Val = "numeric", Param = "character" @@ -77,6 +83,12 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes expect_message("Variable type\\(s\\) in dataframe don't match metadata") ) + # Metadata version + df %>% + xportr_metadata(meta_example, verbose = "message") %>% + xportr_type() %>% + expect_message("Variable type\\(s\\) in dataframe don't match metadata") + expect_equal(purrr::map_chr(df4, class), c( Subj = "numeric", Different = "character", Val = "numeric", Param = "character" @@ -100,12 +112,12 @@ test_that("xportr_metadata: Var types coerced as expected and raise messages", { )) suppressMessages( - xportr_metadata(df, meta_example) %>% xportr_type(verbose = "stop") + xportr_metadata(df, meta_example, verbose = "stop") %>% xportr_type() ) %>% expect_error() suppressMessages( - df3 <- xportr_metadata(df, meta_example) %>% xportr_type(verbose = "warn") + df3 <- xportr_metadata(df, meta_example, verbose = "warn") %>% xportr_type() ) %>% expect_warning() @@ -116,8 +128,8 @@ test_that("xportr_metadata: Var types coerced as expected and raise messages", { suppressMessages({ ( - df4 <- xportr_metadata(df, meta_example) %>% - xportr_type(verbose = "message") + df4 <- xportr_metadata(df, meta_example, verbose = "message") %>% + xportr_type() ) %>% expect_message("Variable type\\(s\\) in dataframe don't match metadata: `Subj` and `Val`") })