Closes #151 - Metadata includes verbose option

NEWS.md

@@ -2,6 +2,12 @@
 
 ## New Features and Bug Fixes
 
+* `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
+
 * `xportr_write()` now accepts `metadata` argument which can be used to set the dataset label to stay consistent with the other `xportr_*` functions. It is noteworthy that the dataset label set using the `xportr_df_label()` function will be retained during the `xportr_write()`.
 * Exporting a new dataset `dataset_spec` that contains the Dataset Specification for ADSL. (#179)
 

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_stop(
@@ -99,6 +99,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]]

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_stop(
@@ -106,6 +106,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]]

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")
   }
@@ -51,5 +54,8 @@ xportr_metadata <- function(.df, metadata = NULL, domain = NULL) {
 
   ## End of common section
 
-  structure(.df, `_xportr.df_metadata_` = metadata)
+  structure(.df,
+    `_xportr.df_metadata_` = metadata,
+    `_xportr.df_verbose_` = verbose
+  )
 }

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_stop(
@@ -120,6 +120,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)
 

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_stop(
@@ -146,6 +146,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

README.Rmd

@@ -145,7 +145,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() %>%

tests/testthat/test-metadata.R

@@ -544,6 +544,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, 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`") %>%
+    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