From 3dcf6fb6c5dd53d1ca59e5258619107f43aefb8f Mon Sep 17 00:00:00 2001 From: EeethB Date: Tue, 14 Nov 2023 15:15:17 +0000 Subject: [PATCH 01/10] Add `verbose` option to metadata --- R/metadata.R | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index 1fdabc28..8d831369 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -37,7 +37,10 @@ #' xportr_type() %>% #' xportr_order() #' } -xportr_metadata <- function(.df, metadata, domain = NULL) { +xportr_metadata <- function(.df, + metadata, + domain = NULL, + verbose = getOption("xportr.type_verbose", "none")) { ## Common section to detect domain from argument or pipes df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) @@ -46,5 +49,7 @@ xportr_metadata <- function(.df, metadata, domain = NULL) { ## End of common section - structure(.df, `_xportr.df_metadata_` = metadata) + structure(.df, + `_xportr.df_metadata_` = metadata, + `_xportr.df_verbose_` = verbose) } From 26bbc8e291c2778098493344a5fd0ad082a20785 Mon Sep 17 00:00:00 2001 From: EeethB Date: Tue, 28 Nov 2023 16:09:20 +0000 Subject: [PATCH 02/10] Add verbose to metadata --- R/metadata.R | 2 +- R/type.R | 8 +++++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index 8d831369..4dc7a9c3 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -40,7 +40,7 @@ xportr_metadata <- function(.df, metadata, domain = NULL, - verbose = getOption("xportr.type_verbose", "none")) { + verbose = NULL) { ## Common section to detect domain from argument or pipes df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) diff --git a/R/type.R b/R/type.R index 78cf6dca..84866c79 100644 --- a/R/type.R +++ b/R/type.R @@ -79,7 +79,7 @@ xportr_type <- function(.df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.type_verbose", "none"), + verbose = NULL, metacore = deprecated()) { if (!missing(metacore)) { lifecycle::deprecate_warn( @@ -148,6 +148,12 @@ xportr_type <- function(.df, type.y = if_else(type.y %in% numericTypes, "_numeric", type.y) ) + # 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.type_verbose", "none") + # It is possible that a variable exists in the table that isn't in the metadata # it will be silently ignored here. This may happen depending on what a user # passes and the options they choose. The check_core function is the place From f4a4b4d4e43ab9657b0b909bbd0987d6667289d6 Mon Sep 17 00:00:00 2001 From: EeethB Date: Tue, 5 Dec 2023 21:55:13 +0000 Subject: [PATCH 03/10] 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`") }) From f5346807a392eebef33971bb1bbf93be95503c43 Mon Sep 17 00:00:00 2001 From: EeethB Date: Wed, 6 Dec 2023 22:24:17 +0000 Subject: [PATCH 04/10] Update docs --- R/metadata.R | 5 +++-- man/xportr_label.Rd | 2 +- man/xportr_length.Rd | 2 +- man/xportr_order.Rd | 2 +- 4 files changed, 6 insertions(+), 5 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index 4dc7a9c3..1e8a5dc9 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -50,6 +50,7 @@ xportr_metadata <- function(.df, ## End of common section structure(.df, - `_xportr.df_metadata_` = metadata, - `_xportr.df_verbose_` = verbose) + `_xportr.df_metadata_` = metadata, + `_xportr.df_verbose_` = verbose + ) } diff --git a/man/xportr_label.Rd b/man/xportr_label.Rd index a74137ed..a3c5dc90 100644 --- a/man/xportr_label.Rd +++ b/man/xportr_label.Rd @@ -8,7 +8,7 @@ xportr_label( .df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.label_verbose", "none"), + verbose = NULL, metacore = deprecated() ) } diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index 89fb5703..c9f63ff4 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -8,7 +8,7 @@ xportr_length( .df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.length_verbose", "none"), + verbose = NULL, metacore = deprecated() ) } diff --git a/man/xportr_order.Rd b/man/xportr_order.Rd index e8ea269c..12b0dcb7 100644 --- a/man/xportr_order.Rd +++ b/man/xportr_order.Rd @@ -8,7 +8,7 @@ xportr_order( .df, metadata = NULL, domain = NULL, - verbose = getOption("xportr.order_verbose", "none"), + verbose = NULL, metacore = deprecated() ) } From a0d83b71a285ef737b492b0fddcd73156d3d7090 Mon Sep 17 00:00:00 2001 From: EeethB Date: Wed, 6 Dec 2023 22:31:52 +0000 Subject: [PATCH 05/10] Update news and README --- NEWS.md | 2 ++ README.Rmd | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 27f14385..11f4bfee 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,8 @@ ## New Features and Bug Fixes +* `xportr_metadata()` can set `verbose` for a whole pipeline + ## Documentation ## Deprecation and Breaking Changes diff --git a/README.Rmd b/README.Rmd index 7af50e6d..c060960d 100644 --- a/README.Rmd +++ b/README.Rmd @@ -139,7 +139,7 @@ The `xportr_metadata()` function can reduce duplication by setting the variable ```{r, message=FALSE, eval=FALSE} adsl %>% - xportr_metadata(var_spec, "ADSL") %>% + xportr_metadata(var_spec, "ADSL", verbose = "warn") %>% xportr_type() %>% xportr_length() %>% xportr_label() %>% From ce6fc724a5e488ee80adfab1eb89145bc5b6a185 Mon Sep 17 00:00:00 2001 From: Ethan Brockmann <59264453+EeethB@users.noreply.github.com> Date: Tue, 19 Dec 2023 12:12:44 -0600 Subject: [PATCH 06/10] Update NEWS.md Co-authored-by: Ben Straub --- NEWS.md | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 9d49d848..e49bde65 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,9 @@ ## New Features and Bug Fixes -* `xportr_metadata()` can set `verbose` for a whole pipeline +* `xportr_metadata()` can set `verbose` for a whole pipeline, i.e. setting `verbose` in `xportr_metadata()` will populate to all `xportr` functions. (#151) + +* All `xportr` functions now have `verbose = NULL` as the default (#151) ## Documentation From 3f79aaa02e351291ffd0587dea48bc201516e6d2 Mon Sep 17 00:00:00 2001 From: EeethB Date: Thu, 4 Jan 2024 09:26:02 -0600 Subject: [PATCH 07/10] Move metadata tests all to a single file --- tests/testthat/test-length.R | 13 ----- tests/testthat/test-metadata.R | 90 ++++++++++++++++++++++++++++++++++ tests/testthat/test-order.R | 13 ----- tests/testthat/test-type.R | 57 --------------------- 4 files changed, 90 insertions(+), 83 deletions(-) diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index d77ecd50..e749684d 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -128,13 +128,6 @@ 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", { @@ -151,12 +144,6 @@ 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-metadata.R b/tests/testthat/test-metadata.R index b232ea2d..1d3ea94e 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -543,6 +543,96 @@ test_that("xportr_length: Expect error if domain is not a character", { ) }) +test_that("xportr_metadata: Impute character lengths based on class", { + adsl <- minimal_table(30, cols = c("x", "b")) + metadata <- minimal_metadata( + dataset = TRUE, length = TRUE, var_names = colnames(adsl) + ) %>% + mutate(length = length - 1) + + adsl <- adsl %>% + mutate( + new_date = as.Date(.data$x, origin = "1970-01-01"), + new_char = as.character(.data$b), + new_num = as.numeric(.data$x) + ) + + 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_metadata: Throws message when variables not present in metadata", { + adsl <- minimal_table(30, cols = c("x", "y")) + metadata <- minimal_metadata(dataset = TRUE, length = TRUE, var_names = c("x")) + + # Test that message is given which indicates that variable is not present + 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_metadata: Variable ordering messaging is correct", { + skip_if_not_installed("haven") + skip_if_not_installed("readxl") + + require(haven, quietly = TRUE) + require(readxl, quietly = TRUE) + + df <- data.frame(c = 1:5, a = "a", d = 5:1, b = LETTERS[1:5]) + df2 <- data.frame(a = "a", z = "z") + df_meta <- data.frame( + dataset = "df", + variable = letters[1:4], + order = 1:4 + ) + + # 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_type: Variable types are coerced as expected and can raise messages", { + df <- data.frame( + Subj = as.character(c(123, 456, 789, "", NA, NA_integer_)), + Different = c("a", "b", "c", "", NA, NA_character_), + Val = c("1", "2", "3", "", NA, NA_character_), + Param = c("param1", "param2", "param3", "", NA, NA_character_) + ) + meta_example <- data.frame( + dataset = "df", + variable = c("Subj", "Param", "Val", "NotUsed"), + type = c("numeric", "character", "numeric", "character"), + format = NA + ) + + # Metadata version of the last statement + df %>% + xportr_metadata(meta_example, verbose = "warn") %>% + xportr_type() %>% + expect_warning() + + # Metadata version + df %>% + xportr_metadata(meta_example, verbose = "message") %>% + xportr_type() %>% + expect_message("Variable type\\(s\\) in dataframe don't match metadata") +}) + # many tests here are more like qualification/domain testing - this section adds # tests for `xportr_metadata()` basic functionality # start diff --git a/tests/testthat/test-order.R b/tests/testthat/test-order.R index 5f666cce..801108c4 100644 --- a/tests/testthat/test-order.R +++ b/tests/testthat/test-order.R @@ -136,19 +136,6 @@ 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 9d5bde9c..79534365 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -66,12 +66,6 @@ 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" @@ -83,57 +77,6 @@ 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" - )) -}) - -test_that("xportr_metadata: Var types coerced as expected and raise messages", { - # Remove empty lines in cli theme - local_cli_theme() - - ( - df2 <- xportr_metadata(df, meta_example) %>% - xportr_type() - ) %>% - expect_message("Variable type mismatches found.") %>% - expect_message("[0-9+] variables coerced") - - expect_equal(purrr::map_chr(df2, class), c( - Subj = "numeric", Different = "character", - Val = "numeric", Param = "character" - )) - - suppressMessages( - xportr_metadata(df, meta_example, verbose = "stop") %>% xportr_type() - ) %>% - expect_error() - - suppressMessages( - df3 <- xportr_metadata(df, meta_example, verbose = "warn") %>% xportr_type() - ) %>% - expect_warning() - - expect_equal(purrr::map_chr(df3, class), c( - Subj = "numeric", Different = "character", - Val = "numeric", Param = "character" - )) - - suppressMessages({ - ( - df4 <- xportr_metadata(df, meta_example, verbose = "message") %>% - xportr_type() - ) %>% - expect_message("Variable type\\(s\\) in dataframe don't match metadata: `Subj` and `Val`") - }) - expect_equal(purrr::map_chr(df4, class), c( Subj = "numeric", Different = "character", Val = "numeric", Param = "character" From ef704445f4f8d160f00df94e85b504ef7ab5fdc8 Mon Sep 17 00:00:00 2001 From: EeethB Date: Tue, 16 Jan 2024 17:43:46 -0600 Subject: [PATCH 08/10] Fix failing test by specifying domain --- R/metadata.R | 5 ++++- man/metadata.Rd | 6 +++++- tests/testthat/test-metadata.R | 2 +- 3 files changed, 10 insertions(+), 3 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index c8f3cf93..bf24ecd3 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -40,7 +40,10 @@ #' xportr_type() %>% #' xportr_order() #' } -xportr_metadata <- function(.df, metadata = NULL, domain = NULL) { +xportr_metadata <- function(.df, + metadata = NULL, + domain = NULL, + verbose = NULL) { if (is.null(metadata) && is.null(domain)) { stop("Must provide either metadata or domain argument") } diff --git a/man/metadata.Rd b/man/metadata.Rd index 658fe0a4..da5de14c 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -4,7 +4,7 @@ \alias{xportr_metadata} \title{Set variable specifications and domain} \usage{ -xportr_metadata(.df, metadata = NULL, domain = NULL) +xportr_metadata(.df, metadata = NULL, domain = NULL, verbose = NULL) } \arguments{ \item{.df}{A data frame of CDISC standard.} @@ -15,6 +15,10 @@ xportr_metadata(.df, metadata = NULL, domain = NULL) \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset the metadata object. If none is passed, then \code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an attribute of \code{.df}.} + +\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/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index 4265ed01..d4dbc9af 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -600,7 +600,7 @@ test_that("xportr_metadata: Variable ordering messaging is correct", { 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_metadata(df2, df_meta, domain = "df2", 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`") %>% From 3f5d9e0149534d970523965c2ba6fc190062814d Mon Sep 17 00:00:00 2001 From: EeethB Date: Thu, 18 Jan 2024 16:23:37 -0600 Subject: [PATCH 09/10] Add integration test for metadata --- tests/testthat/test-metadata.R | 48 ++++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index d4dbc9af..0864fe00 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -741,3 +741,51 @@ test_that("xportr_*: Domain is kept in between calls", { expect_equal(attr(df5, "_xportr.df_arg_"), "adsl") }) # end + +test_that("`xportr_metadata()` results match traditional results", { + if (require(magrittr, quietly = TRUE)) { + test_dir <- tempdir() + + trad_path <- file.path(test_dir, "adsltrad.xpt") + metadata_path <- file.path(test_dir, "adslmeta.xpt") + + dataset_spec_low <- setNames(dataset_spec, tolower(names(dataset_spec))) + names(dataset_spec_low)[[2]] <- "label" + + var_spec_low <- setNames(var_spec, tolower(names(var_spec))) + names(var_spec_low)[[5]] <- "type" + + metadata_df <- adsl %>% + xportr_metadata(var_spec_low, "ADSL", verbose = "none") %>% + xportr_type() %>% + xportr_length() %>% + xportr_label() %>% + xportr_order() %>% + xportr_format() %>% + xportr_df_label(dataset_spec_low) %>% + xportr_write(metadata_path) + + trad_df <- adsl %>% + xportr_type(var_spec_low, "ADSL", verbose = "none") %>% + xportr_length(var_spec_low, "ADSL", verbose = "none") %>% + xportr_label(var_spec_low, "ADSL", verbose = "none") %>% + xportr_order(var_spec_low, "ADSL", verbose = "none") %>% + xportr_format(var_spec_low, "ADSL") %>% + xportr_df_label(dataset_spec_low, "ADSL") %>% + xportr_write(trad_path) + + expect_identical( + metadata_df, + structure( + trad_df, + `_xportr.df_metadata_` = var_spec_low, + `_xportr.df_verbose_` = "none" + ) + ) + + expect_identical( + haven::read_xpt(metadata_path), + haven::read_xpt(trad_path) + ) + } +}) From 50aa32443345e7d3badf3534de5793372eef4bf3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Thu, 25 Jan 2024 18:14:03 +0100 Subject: [PATCH 10/10] fix: move verbose inferrence to common section --- R/label.R | 12 ++++++------ R/length.R | 12 ++++++------ R/metadata.R | 1 + R/order.R | 12 ++++++------ R/type.R | 12 ++++++------ 5 files changed, 25 insertions(+), 24 deletions(-) diff --git a/R/label.R b/R/label.R index df003275..113d216e 100644 --- a/R/label.R +++ b/R/label.R @@ -76,6 +76,12 @@ xportr_label <- function(.df, metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + # 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") + ## End of common section assert_data_frame(.df) @@ -101,12 +107,6 @@ 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 9e3f7293..d329d664 100644 --- a/R/length.R +++ b/R/length.R @@ -83,6 +83,12 @@ xportr_length <- function(.df, metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + # 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") + ## End of common section assert_data_frame(.df) @@ -107,12 +113,6 @@ 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/metadata.R b/R/metadata.R index 5e09f44e..e6060ece 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -58,6 +58,7 @@ xportr_metadata <- function(.df, assert_data_frame(.df) assert_metadata(metadata, include_fun_message = FALSE, null.ok = TRUE) assert_string(domain, null.ok = TRUE) + assert_choice(verbose, choices = .internal_verbose_choices, null.ok = TRUE) structure(.df, `_xportr.df_metadata_` = metadata, diff --git a/R/order.R b/R/order.R index dc156606..39b4d528 100644 --- a/R/order.R +++ b/R/order.R @@ -79,6 +79,12 @@ xportr_order <- function(.df, metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + # 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") + ## End of common section assert_data_frame(.df) @@ -122,12 +128,6 @@ 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/R/type.R b/R/type.R index d3a916d5..df2264b0 100644 --- a/R/type.R +++ b/R/type.R @@ -97,6 +97,12 @@ xportr_type <- function(.df, metadata <- metadata %||% attr(.df, "_xportr.df_metadata_") + # 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.type_verbose", "none") + ## End of common section assert_data_frame(.df) @@ -148,12 +154,6 @@ xportr_type <- function(.df, type.y = if_else(type.y %in% numericTypes, "_numeric", type.y) ) - # 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.type_verbose", "none") - # It is possible that a variable exists in the table that isn't in the metadata # it will be silently ignored here. This may happen depending on what a user # passes and the options they choose. The check_core function is the place