From 251ac9a8fc4f0d81f385c3da3cc871dc24097522 Mon Sep 17 00:00:00 2001 From: elimillera Date: Mon, 27 Nov 2023 23:11:03 +0000 Subject: [PATCH 01/17] Remove dynamic domain determination --- NAMESPACE | 1 + R/df_label.R | 7 +-- R/format.R | 5 +- R/label.R | 5 +- R/length.R | 5 +- R/metadata.R | 22 +++++++- R/order.R | 5 +- R/support-test.R | 1 + R/type.R | 3 +- R/utils-xportr.R | 7 +-- man/{xportr_metadata.Rd => metadata.Rd} | 6 ++ man/xportr_df_label.Rd | 2 +- man/xportr_format.Rd | 2 +- man/xportr_label.Rd | 2 +- man/xportr_length.Rd | 2 +- man/xportr_order.Rd | 2 +- tests/testthat/test-depreciation.R | 22 ++++---- tests/testthat/test-length.R | 45 +++------------ tests/testthat/test-metadata.R | 73 ++++++++++--------------- tests/testthat/test-order.R | 11 ++-- tests/testthat/test-pipe.R | 44 ++++----------- tests/testthat/test-type.R | 26 +++++---- 22 files changed, 123 insertions(+), 175 deletions(-) rename man/{xportr_metadata.Rd => metadata.Rd} (91%) diff --git a/NAMESPACE b/NAMESPACE index 2b7d1412..723f0e11 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,6 +6,7 @@ export(type_log) export(var_names_log) export(var_ord_msg) export(xportr_df_label) +export(xportr_domain_name) export(xportr_format) export(xportr_label) export(xportr_length) diff --git a/R/df_label.R b/R/df_label.R index 932bbf58..5009335d 100644 --- a/R/df_label.R +++ b/R/df_label.R @@ -38,7 +38,7 @@ #' label = c("Subject-Level Analysis", "Adverse Events Analysis") #' ) #' -#' adsl <- xportr_df_label(adsl, metadata) +#' adsl <- xportr_df_label(adsl, metadata, domain = "adsl") xportr_df_label <- function(.df, metadata = NULL, domain = NULL, @@ -54,10 +54,9 @@ xportr_df_label <- function(.df, domain_name <- getOption("xportr.df_domain_name") label_name <- getOption("xportr.df_label") - ## Common section to detect domain from argument or pipes + ## Common section to detect domain from argument or attribute - df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) - domain <- get_domain(.df, df_arg, domain) + domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section diff --git a/R/format.R b/R/format.R index 17e15183..864faaf4 100644 --- a/R/format.R +++ b/R/format.R @@ -40,7 +40,7 @@ #' format = c(NA, "DATE9.") #' ) #' -#' adsl <- xportr_format(adsl, metadata) +#' adsl <- xportr_format(adsl, metadata, domain = "adsl") xportr_format <- function(.df, metadata = NULL, domain = NULL, @@ -59,8 +59,7 @@ xportr_format <- function(.df, ## Common section to detect domain from argument or pipes - df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) - domain <- get_domain(.df, df_arg, domain) + domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section diff --git a/R/label.R b/R/label.R index e412e9fc..3d422f1b 100644 --- a/R/label.R +++ b/R/label.R @@ -55,7 +55,7 @@ #' label = c("Unique Subject Identifier", "Study Site Identifier", "Age", "Sex") #' ) #' -#' adsl <- xportr_label(adsl, metadata) +#' adsl <- xportr_label(adsl, metadata, domain = "adsl") xportr_label <- function(.df, metadata = NULL, domain = NULL, @@ -75,8 +75,7 @@ xportr_label <- function(.df, ## Common section to detect domain from argument or pipes - df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) - domain <- get_domain(.df, df_arg, domain) + domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section diff --git a/R/length.R b/R/length.R index 17627268..81864c2b 100644 --- a/R/length.R +++ b/R/length.R @@ -62,7 +62,7 @@ #' length = c(10, 8) #' ) #' -#' adsl <- xportr_length(adsl, metadata) +#' adsl <- xportr_length(adsl, metadata, domain = "adsl") xportr_length <- function(.df, metadata = NULL, domain = NULL, @@ -82,8 +82,7 @@ xportr_length <- function(.df, ## Common section to detect domain from argument or pipes - df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) - domain <- get_domain(.df, df_arg, domain) + domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section diff --git a/R/metadata.R b/R/metadata.R index 1fdabc28..926de49e 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -10,6 +10,8 @@ #' @return `.df` dataset with metadata and domain attributes set #' @export #' +#' @rdname metadata +#' #' @examples #' #' metadata <- data.frame( @@ -33,6 +35,7 @@ #' library(magrittr) #' #' adlb %>% +#' xportr_domain_name("adlb") %>% #' xportr_metadata(metadata, "test") %>% #' xportr_type() %>% #' xportr_order() @@ -40,11 +43,26 @@ xportr_metadata <- function(.df, metadata, domain = NULL) { ## Common section to detect domain from argument or pipes - df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) - domain <- get_domain(.df, df_arg, domain) + domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section structure(.df, `_xportr.df_metadata_` = metadata) } + + +#' Update Metadata Domain Name +#' +#' @inheritParams xportr_length +#' +#' @return `.df` dataset with domain argument set +#' @export +#' +#' @rdname metadata +xportr_domain_name <- function(.df, domain) { + + attr(.df, "_xportr.df_arg_") <- domain + + .df +} diff --git a/R/order.R b/R/order.R index 0f7e1b30..43ea130d 100644 --- a/R/order.R +++ b/R/order.R @@ -58,7 +58,7 @@ #' order = 1:4 #' ) #' -#' adsl <- xportr_order(adsl, metadata) +#' adsl <- xportr_order(adsl, metadata, domain = "adsl") xportr_order <- function(.df, metadata = NULL, domain = NULL, @@ -78,8 +78,7 @@ xportr_order <- function(.df, ## Common section to detect domain from argument or pipes - df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) - domain <- get_domain(.df, df_arg, domain) + domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section diff --git a/R/support-test.R b/R/support-test.R index e12a6650..b81fba3d 100644 --- a/R/support-test.R +++ b/R/support-test.R @@ -180,6 +180,7 @@ multiple_vars_in_spec_helper2 <- function(FUN) { local_cli_theme() adsl %>% + xportr_domain_name("adsl") %>% FUN(metadata) %>% testthat::expect_no_message(message = "There are multiple specs for the same variable name") } diff --git a/R/type.R b/R/type.R index 0114309c..c04ac317 100644 --- a/R/type.R +++ b/R/type.R @@ -99,8 +99,7 @@ xportr_type <- function(.df, ## Common section to detect domain from argument or pipes - df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) - domain <- get_domain(.df, df_arg, domain) + domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section diff --git a/R/utils-xportr.R b/R/utils-xportr.R index 06e1684f..f97bb346 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -309,17 +309,14 @@ xpt_validate <- function(data) { #' #' @return A string representing the domain #' @noRd -get_domain <- function(.df, df_arg, domain) { +get_domain <- function(.df, domain) { if (!is.null(domain) && !is.character(domain)) { abort(c("`domain` must be a vector with type .", x = glue("Instead, it has type <{typeof(domain)}>.") )) } - if (identical(df_arg, ".")) { - df_arg <- get_pipe_call() - } - result <- domain %||% attr(.df, "_xportr.df_arg_") %||% df_arg + result <- domain %||% attr(.df, "_xportr.df_arg_") result } diff --git a/man/xportr_metadata.Rd b/man/metadata.Rd similarity index 91% rename from man/xportr_metadata.Rd rename to man/metadata.Rd index 592c6f45..d1f5d30b 100644 --- a/man/xportr_metadata.Rd +++ b/man/metadata.Rd @@ -2,9 +2,12 @@ % Please edit documentation in R/metadata.R \name{xportr_metadata} \alias{xportr_metadata} +\alias{xportr_domain_name} \title{Set variable specifications and domain} \usage{ xportr_metadata(.df, metadata, domain = NULL) + +xportr_domain_name(.df, domain) } \arguments{ \item{.df}{A data frame of CDISC standard.} @@ -18,6 +21,8 @@ the metadata object. If none is passed, then name of the dataset passed as } \value{ \code{.df} dataset with metadata and domain attributes set + +\code{.df} dataset with domain argument set } \description{ Sets metadata for a dataset in a way that can be accessed by other xportr @@ -48,6 +53,7 @@ if (rlang::is_installed("magrittr")) { library(magrittr) adlb \%>\% + xportr_domain_name("adlb") \%>\% xportr_metadata(metadata, "test") \%>\% xportr_type() \%>\% xportr_order() diff --git a/man/xportr_df_label.Rd b/man/xportr_df_label.Rd index e5adca40..691de990 100644 --- a/man/xportr_df_label.Rd +++ b/man/xportr_df_label.Rd @@ -55,5 +55,5 @@ metadata <- data.frame( label = c("Subject-Level Analysis", "Adverse Events Analysis") ) -adsl <- xportr_df_label(adsl, metadata) +adsl <- xportr_df_label(adsl, metadata, domain = "adsl") } diff --git a/man/xportr_format.Rd b/man/xportr_format.Rd index a4f06222..c6fd6e85 100644 --- a/man/xportr_format.Rd +++ b/man/xportr_format.Rd @@ -58,5 +58,5 @@ metadata <- data.frame( format = c(NA, "DATE9.") ) -adsl <- xportr_format(adsl, metadata) +adsl <- xportr_format(adsl, metadata, domain = "adsl") } diff --git a/man/xportr_label.Rd b/man/xportr_label.Rd index a74137ed..4cd7d18c 100644 --- a/man/xportr_label.Rd +++ b/man/xportr_label.Rd @@ -84,5 +84,5 @@ metadata <- data.frame( label = c("Unique Subject Identifier", "Study Site Identifier", "Age", "Sex") ) -adsl <- xportr_label(adsl, metadata) +adsl <- xportr_label(adsl, metadata, domain = "adsl") } diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index 89fb5703..4c4dd224 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -81,5 +81,5 @@ metadata <- data.frame( length = c(10, 8) ) -adsl <- xportr_length(adsl, metadata) +adsl <- xportr_length(adsl, metadata, domain = "adsl") } diff --git a/man/xportr_order.Rd b/man/xportr_order.Rd index e8ea269c..44f283cf 100644 --- a/man/xportr_order.Rd +++ b/man/xportr_order.Rd @@ -88,5 +88,5 @@ metadata <- data.frame( order = 1:4 ) -adsl <- xportr_order(adsl, metadata) +adsl <- xportr_order(adsl, metadata, domain = "adsl") } diff --git a/tests/testthat/test-depreciation.R b/tests/testthat/test-depreciation.R index 157f59b1..eb63cafe 100644 --- a/tests/testthat/test-depreciation.R +++ b/tests/testthat/test-depreciation.R @@ -3,10 +3,10 @@ test_that("xportr_df_label: deprecated metacore argument still works and gives w df <- data.frame(x = "a", y = "b") df_meta <- data.frame(dataset = "df", label = "Label") - df_spec_labeled_df <- xportr_df_label(df, metacore = df_meta) + df_spec_labeled_df <- xportr_df_label(df, metacore = df_meta, domain = "df") expect_equal(attr(df_spec_labeled_df, "label"), "Label") - xportr_df_label(df, metacore = df_meta) %>% + xportr_df_label(df, metacore = df_meta, domain = "df") %>% lifecycle::expect_deprecated("Please use the `metadata` argument instead.") }) @@ -19,10 +19,10 @@ test_that("xportr_format: deprecated metacore argument still works and gives war format = "date9." ) - formatted_df <- xportr_format(df, metacore = df_meta) + formatted_df <- xportr_format(df, metacore = df_meta, domain = "df") expect_equal(attr(formatted_df$x, "format.sas"), "DATE9.") - xportr_format(df, metacore = df_meta) %>% + xportr_format(df, metacore = df_meta, domain = "df") %>% lifecycle::expect_deprecated("Please use the `metadata` argument instead.") }) @@ -33,14 +33,14 @@ test_that("xportr_label: deprecated metacore argument still works and gives warn df_meta <- data.frame(dataset = "df", variable = "x", label = "foo") df_labeled_df <- suppressMessages( - xportr_label(df, metacore = df_meta) + xportr_label(df, metacore = df_meta, domain = "df") ) expect_equal(attr(df_labeled_df$x, "label"), "foo") # Note that only the deprecated message should be caught (others are ignored) suppressMessages( - xportr_label(df, metacore = df_meta) %>% + xportr_label(df, metacore = df_meta, domain = "df") %>% lifecycle::expect_deprecated("Please use the `metadata` argument instead.") ) }) @@ -55,11 +55,11 @@ test_that("xportr_length: deprecated metacore argument still works and gives war length = c(1, 2) ) - df_with_width <- xportr_length(df, metacore = df_meta) + df_with_width <- xportr_length(df, metacore = df_meta, domain = "df") expect_equal(c(x = 1, y = 2), map_dbl(df_with_width, attr, "width")) - xportr_length(df, metacore = df_meta) %>% + xportr_length(df, metacore = df_meta, domain = "df") %>% lifecycle::expect_deprecated("Please use the `metadata` argument instead.") }) @@ -81,7 +81,7 @@ test_that("xportr_order: deprecated metacore argument still works and gives warn # Note that only the deprecated message should be caught (others are ignored) suppressMessages( - xportr_order(df, metacore = df_meta) %>% + xportr_order(df, metacore = df_meta, domain = "df") %>% lifecycle::expect_deprecated("Please use the `metadata` argument instead.") ) }) @@ -102,12 +102,12 @@ test_that("xportr_type: deprecated metacore argument still works and gives warni ) df2 <- suppressMessages( - xportr_type(df, metacore = df_meta) + xportr_type(df, metacore = df_meta, domain = "df") ) # Note that only the deprecated message should be caught (others are ignored) suppressMessages( - xportr_type(df, metacore = df_meta) %>% + xportr_type(df, metacore = df_meta, domain = "df") %>% lifecycle::expect_deprecated("Please use the `metadata` argument instead.") ) }) diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index e749684d..dd8b531f 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -13,7 +13,9 @@ test_that("xportr_length: Accepts valid domain names in metadata object", { withr::local_options(list(xportr.length_verbose = "message")) # Test minimal call with valid data and without domain - xportr_length(adsl, metadata) %>% + adsl %>% + xportr_domain_name("adsl") %>% + xportr_length(metadata) %>% expect_silent() %>% expect_attr_width(metadata$length) @@ -27,7 +29,7 @@ test_that("xportr_length: Accepts valid domain names in metadata object", { # Test minimal call without datasets metadata_without_dataset <- metadata %>% select(-"dataset") - xportr_length(adsl, metadata_without_dataset) %>% + xportr_length(adsl, metadata_without_dataset, domain = "adsl") %>% expect_silent() %>% expect_attr_width(metadata_without_dataset$length) %>% NROW() %>% @@ -59,39 +61,6 @@ test_that("xportr_length: CDISC data frame is being piped after another xportr f expect_equal("adsl") }) -test_that("xportr_length: CDISC data frame domain is being recognized from pipe", { - adsl <- minimal_table(30) - metadata <- minimal_metadata(dataset = TRUE, length = TRUE, var_names = colnames(adsl)) - - # Setup temporary options with `verbose = "message"` - withr::local_options(list(xportr.length_verbose = "message")) - - # Remove empty lines in cli theme - local_cli_theme() - - # With domain manually set - not_adsl <- adsl - result <- not_adsl %>% - xportr_length(metadata) %>% - expect_message("Variable lengths missing from metadata") %>% - expect_message("lengths resolved") %>% - expect_message("Variable\\(s\\) present in dataframe but doesn't exist in `metadata`") - - suppressMessages({ - result <- not_adsl %>% - xportr_length(metadata, verbose = "none") - }) - - expect_no_match(attr(result, "_xportr.df_arg_"), "^adsl$") - - # Test results with piping - result <- adsl %>% - xportr_length(metadata) - - attr(result, "_xportr.df_arg_") %>% - expect_equal("adsl") -}) - test_that("xportr_length: Impute character lengths based on class", { adsl <- minimal_table(30, cols = c("x", "b")) metadata <- minimal_metadata( @@ -109,7 +78,7 @@ test_that("xportr_length: Impute character lengths based on class", { # Test length imputation of character and numeric (not valid character type) result <- adsl %>% - xportr_length(metadata) %>% + xportr_length(metadata, domain = "adsl") %>% expect_silent() expect_attr_width(result, c(7, 199)) @@ -124,7 +93,7 @@ test_that("xportr_length: Impute character lengths based on class", { ) adsl %>% - xportr_length(metadata) %>% + xportr_length(metadata, domain = "adsl") %>% expect_message("Variable lengths missing from metadata") %>% expect_message("lengths resolved") %>% expect_attr_width(c(7, 199, 200, 200, 8)) @@ -140,7 +109,7 @@ test_that("xportr_length: Throws message when variables not present in metadata" local_cli_theme() # Test that message is given which indicates that variable is not present - xportr_length(adsl, metadata) %>% + xportr_length(adsl, metadata, domain = "adsl") %>% expect_message("Variable lengths missing from metadata") %>% expect_message("lengths resolved") %>% expect_message(regexp = "Problem with `y`") diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index b232ea2d..c74f906e 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -14,7 +14,7 @@ test_that("xportr_label: Correctly applies label from data.frame spec", { df <- data.frame(x = "a", y = "b") df_meta <- data.frame(dataset = "df", variable = c("x", "y"), label = c("foo", "bar")) - df_labeled_df <- xportr_label(df, df_meta) + df_labeled_df <- xportr_label(df, df_meta, domain = "df") expect_equal(extract_var_label(df_labeled_df), c("foo", "bar")) @@ -36,7 +36,7 @@ test_that("xportr_label: Correctly applies label when data is piped", { df <- data.frame(x = "a", y = "b") df_meta <- data.frame(dataset = "df", variable = c("x", "y"), label = c("foo", "bar")) - df_labeled_df <- df %>% xportr_label(df_meta) + df_labeled_df <- df %>% xportr_label(df_meta, domain = "df") expect_equal(extract_var_label(df_labeled_df), c("foo", "bar")) expect_equal( @@ -92,7 +92,7 @@ test_that("xportr_label: Correctly applies label from metacore spec", { )) metacoes_labeled_df <- suppressMessages( - xportr_label(df, metacore_meta) + xportr_label(df, metacore_meta, domain = "df") ) expect_equal(extract_var_label(metacoes_labeled_df), c("X Label", "Y Label", "")) @@ -119,7 +119,7 @@ test_that("xportr_label: Expect error if any variable does not exist in metadata label = "foo" ) suppressMessages( - xportr_label(df, df_meta, verbose = "stop") + xportr_label(df, df_meta, verbose = "stop", domain = "df") ) %>% expect_error() }) @@ -132,7 +132,7 @@ test_that("xportr_label: Expect error if label exceeds 40 characters", { label = strrep("a", 41) ) - suppressMessages(xportr_label(df, df_meta)) %>% + suppressMessages(xportr_label(df, df_meta, domain = "df")) %>% expect_warning("variable label must be 40 characters or less") }) @@ -158,7 +158,7 @@ test_that("xportr_df_label: Correctly applies label from data.frame spec", { df <- data.frame(x = "a", y = "b") df_meta <- data.frame(dataset = "df", label = "Label") - df_spec_labeled_df <- xportr_df_label(df, df_meta) + df_spec_labeled_df <- xportr_df_label(df, df_meta, domain = "df") expect_equal(attr(df_spec_labeled_df, "label"), "Label") expect_equal( @@ -178,6 +178,7 @@ test_that("xportr_df_label: Correctly applies label when data is piped", { df_meta <- data.frame(dataset = "df", label = "Label") df_spec_labeled_df <- df %>% + xportr_domain_name("df") %>% xportr_df_label(df_meta) %>% xportr_df_label(df_meta) @@ -221,7 +222,7 @@ test_that("xportr_df_label: Correctly applies label from metacore spec", { ) )) - metacore_spec_labeled_df <- xportr_df_label(df, metacore_meta) + metacore_spec_labeled_df <- xportr_df_label(df, metacore_meta, domain = "df") expect_equal(attr(metacore_spec_labeled_df, "label"), "Label") expect_equal( @@ -243,7 +244,7 @@ test_that("xportr_df_label: Expect error if label exceeds 40 characters", { ) expect_error( - xportr_df_label(df, df_meta), + xportr_df_label(df, df_meta, domain = "df"), "dataset label must be 40 characters or less" ) }) @@ -273,7 +274,7 @@ test_that("xportr_format: Set formats as expected", { format = c("date9.", "datetime20.") ) - formatted_df <- xportr_format(df, df_meta) + formatted_df <- xportr_format(df, df_meta, domain = "df") expect_equal(extract_format(formatted_df), c("DATE9.", "DATETIME20.")) expect_equal(formatted_df, structure( @@ -293,7 +294,7 @@ test_that("xportr_format: Set formats as expected when data is piped", { format = c("date9.", "datetime20.") ) - formatted_df <- df %>% xportr_format(df_meta) + formatted_df <- df %>% xportr_format(df_meta, domain = "df") expect_equal(extract_format(formatted_df), c("DATE9.", "DATETIME20.")) expect_equal(formatted_df, structure( @@ -321,7 +322,7 @@ test_that("xportr_format: Set formats as expected for metacore spec", { ) )) - formatted_df <- xportr_format(df, metacore_meta) + formatted_df <- xportr_format(df, metacore_meta, domain = "df") expect_equal(extract_format(formatted_df), c("DATE9.", "DATETIME20.")) expect_equal(formatted_df, structure( @@ -361,7 +362,7 @@ test_that("xportr_format: Handle NA values without raising an error", { format = c("date9.", "datetime20.", NA, "text") ) - formatted_df <- xportr_format(df, df_meta) + formatted_df <- xportr_format(df, df_meta, domain = "df") expect_equal(extract_format(formatted_df), c("DATE9.", "DATETIME20.", "", "")) expect_equal(formatted_df, structure( @@ -402,7 +403,7 @@ test_that("xportr_length: Check if width attribute is set properly", { length = c(1, 2) ) - df_with_width <- xportr_length(df, df_meta) + df_with_width <- xportr_length(df, df_meta, domain = "df") expect_equal(c(x = 1, y = 2), map_dbl(df_with_width, attr, "width")) expect_equal(df_with_width, structure( @@ -423,7 +424,7 @@ test_that("xportr_length: Check if width attribute is set properly when data is length = c(1, 2) ) - df_with_width <- df %>% xportr_length(df_meta) + df_with_width <- df %>% xportr_length(df_meta, domain = "df") expect_equal(c(x = 1, y = 2), map_dbl(df_with_width, attr, "width")) expect_equal(df_with_width, structure( @@ -451,7 +452,7 @@ test_that("xportr_length: Check if width attribute is set properly for metacore ) )) - df_with_width <- xportr_length(df, metacore_meta) + df_with_width <- xportr_length(df, metacore_meta, domain = "df") expect_equal(c(x = 1, y = 2), map_dbl(df_with_width, attr, "width")) expect_equal(df_with_width, structure( @@ -494,7 +495,7 @@ test_that("xportr_length: Expect error when a variable is not present in metadat ) suppressMessages( - xportr_length(df, df_meta, verbose = "stop") + xportr_length(df, df_meta, domain = "df", verbose = "stop") ) %>% expect_error("doesn't exist") }) @@ -509,7 +510,7 @@ test_that("xportr_length: Check if length gets imputed when a new variable is pa ) df_with_width <- suppressMessages( - xportr_length(df, df_meta) + xportr_length(df, df_meta, domain = "df") ) # 200 is the imputed length for character and 8 for other data types as in impute_length() @@ -558,68 +559,50 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { rlang::set_names(tolower) expect_equal( - structure(xportr_type(adsl, var_spec), `_xportr.df_metadata_` = var_spec), + structure(xportr_type(adsl, var_spec, domain = "adsl"), `_xportr.df_metadata_` = var_spec), suppressMessages( - xportr_metadata(adsl, var_spec) %>% xportr_type() + xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_type() ) ) expect_equal( structure( - suppressMessages(xportr_length(adsl, var_spec)), + suppressMessages(xportr_length(adsl, var_spec, domain = "adsl")), `_xportr.df_metadata_` = var_spec ), suppressMessages( - xportr_metadata(adsl, var_spec) %>% xportr_length() + xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_length() ) ) expect_equal( structure( - suppressMessages(xportr_label(adsl, var_spec)), + suppressMessages(xportr_label(adsl, var_spec, domain = "adsl")), `_xportr.df_metadata_` = var_spec ), suppressMessages( - xportr_metadata(adsl, var_spec) %>% xportr_label() + xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_label() ) ) expect_equal( structure( - suppressMessages(xportr_order(adsl, var_spec)), + suppressMessages(xportr_order(adsl, var_spec, domain = "adsl")), `_xportr.df_metadata_` = var_spec ), suppressMessages( - xportr_metadata(adsl, var_spec) %>% xportr_order() + xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_order() ) ) expect_equal( structure( - suppressMessages(xportr_format(adsl, var_spec)), + suppressMessages(xportr_format(adsl, var_spec, domain = "adsl")), `_xportr.df_metadata_` = var_spec ), suppressMessages( - xportr_metadata(adsl, var_spec) %>% xportr_format() + xportr_metadata(adsl, var_spec, domain = "adsl") %>% xportr_format() ) ) }) - -test_that("xportr_metadata: Correctly extract domain from var name", { - metadata <- data.frame( - dataset = "adlb", - variable = c("Subj", "Param", "Val", "NotUsed"), - type = c("numeric", "character", "numeric", "character"), - order = c(1, 3, 4, 2) - ) - - adlb <- data.frame( - Subj = as.character(123, 456, 789), - Different = c("a", "b", "c"), - Val = c("1", "2", "3"), - Param = c("param1", "param2", "param3") - ) - - expect_equal(attr(xportr_metadata(adlb, metadata), "_xportr.df_arg_"), "adlb") -}) # end diff --git a/tests/testthat/test-order.R b/tests/testthat/test-order.R index 801108c4..941a7d04 100644 --- a/tests/testthat/test-order.R +++ b/tests/testthat/test-order.R @@ -6,7 +6,7 @@ test_that("xportr_order: Variable are ordered correctly for data.frame spec", { order = 1:4 ) - ordered_df <- suppressMessages(xportr_order(df, df_meta)) + ordered_df <- suppressMessages(xportr_order(df, df_meta, domain = "df")) expect_equal(names(ordered_df), df_meta$variable) }) @@ -21,6 +21,7 @@ test_that("xportr_order: Variable are ordered correctly when data is piped", { ordered_df <- suppressMessages( df %>% + xportr_domain_name("df") %>% xportr_order(df_meta) %>% xportr_order(df_meta) ) @@ -67,7 +68,7 @@ test_that("xportr_order: Variable are ordered correctly for metacore spec", { )) ordered_df <- suppressMessages( - xportr_order(df, metacore_meta) + xportr_order(df, metacore_meta, domain = "df") ) expect_equal(names(ordered_df), ordered_columns) @@ -127,12 +128,12 @@ test_that("xportr_order: Variable ordering messaging is correct", { # Remove empty lines in cli theme local_cli_theme() - xportr_order(df, df_meta, verbose = "message") %>% + xportr_order(df, df_meta, verbose = "message", domain = "df") %>% 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_order(df2, df_meta, verbose = "message") %>% + xportr_order(df2, df_meta, verbose = "message", domain = "df2") %>% 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") @@ -147,7 +148,7 @@ test_that("xportr_order: Metadata order columns are coersed to numeric", { ) ordered_df <- suppressMessages( - xportr_order(df, df_meta) + xportr_order(df, df_meta, domain = "df") ) expect_equal(names(ordered_df), df_meta$variable) diff --git a/tests/testthat/test-pipe.R b/tests/testthat/test-pipe.R index c4d18d83..6f9bafb5 100644 --- a/tests/testthat/test-pipe.R +++ b/tests/testthat/test-pipe.R @@ -1,36 +1,3 @@ -test_that("xportr_*: Domain is obtained from a call without pipe", { - adsl <- minimal_table(30) - - metadata <- minimal_metadata( - dataset = TRUE, length = TRUE, label = TRUE, type = TRUE, format = TRUE, - order = TRUE - ) - - # Divert all messages to tempfile, instead of printing them - # note: be aware as this should only be used in tests that don't track - # messages - withr::local_message_sink(tempfile()) - - xportr_metadata(adsl, metadata) %>% - attr("_xportr.df_arg_") %>% - expect_equal("adsl") - xportr_label(adsl, metadata) %>% - attr("_xportr.df_arg_") %>% - expect_equal("adsl") - xportr_length(adsl, metadata) %>% - attr("_xportr.df_arg_") %>% - expect_equal("adsl") - xportr_order(adsl, metadata) %>% - attr("_xportr.df_arg_") %>% - expect_equal("adsl") - xportr_format(adsl, metadata) %>% - attr("_xportr.df_arg_") %>% - expect_equal("adsl") - xportr_type(adsl, metadata) %>% - attr("_xportr.df_arg_") %>% - expect_equal("adsl") -}) - test_that("xportr_*: Domain is kept in between calls", { # Divert all messages to tempfile, instead of printing them @@ -46,6 +13,7 @@ test_that("xportr_*: Domain is kept in between calls", { ) df2 <- adsl %>% + xportr_domain_name("adsl") %>% xportr_type(metadata) df3 <- df2 %>% @@ -57,7 +25,7 @@ test_that("xportr_*: Domain is kept in between calls", { expect_equal(attr(df3, "_xportr.df_arg_"), "adsl") df4 <- adsl %>% - xportr_type(metadata) + xportr_type(metadata, domain = "adsl") df5 <- df4 %>% xportr_label(metadata) %>% @@ -83,6 +51,7 @@ test_that("xportr_*: Can use magrittr pipe and aquire domain from call", { non_standard_name <- adsl result <- non_standard_name %>% + xportr_domain_name("non_standard_name") %>% xportr_type(metadata) %>% xportr_label(metadata) %>% xportr_length(metadata) %>% @@ -94,6 +63,7 @@ test_that("xportr_*: Can use magrittr pipe and aquire domain from call", { # Different sequence call by moving first and last around result2 <- non_standard_name %>% + xportr_domain_name("non_standard_name") %>% xportr_label(metadata) %>% xportr_length(metadata) %>% xportr_order(metadata) %>% @@ -119,6 +89,7 @@ test_that("xportr_*: Can use magrittr pipe and aquire domain from call (metadata non_standard_name <- adsl result <- non_standard_name %>% + xportr_domain_name("non_standard_name") %>% xportr_metadata(metadata) %>% xportr_type() %>% xportr_label() %>% @@ -131,6 +102,7 @@ test_that("xportr_*: Can use magrittr pipe and aquire domain from call (metadata # Different sequence call by moving first and last around result2 <- non_standard_name %>% + xportr_domain_name("non_standard_name") %>% xportr_metadata(metadata) %>% xportr_label() %>% xportr_length() %>% @@ -162,6 +134,7 @@ test_that("xportr_*: Can use R native pipe (R>4.1) and aquire domain from call", non_standard_name_native <- adsl result <- non_standard_name_native |> + xportr_domain_name("non_standard_name_native") |> xportr_type(metadata) |> xportr_label(metadata) |> xportr_length(metadata) |> @@ -173,6 +146,7 @@ test_that("xportr_*: Can use R native pipe (R>4.1) and aquire domain from call", # Different sequence call by moving first and last around result2 <- non_standard_name_native |> + xportr_domain_name("non_standard_name_native") |> xportr_label(metadata) |> xportr_length(metadata) |> xportr_order(metadata) |> @@ -203,6 +177,7 @@ test_that("xportr_*: Can use R native pipe (R>4.1) and aquire domain from call ( non_standard_name_native <- adsl result <- non_standard_name_native |> + xportr_domain_name("non_standard_name_native") |> xportr_metadata(metadata) |> xportr_type() |> xportr_label() |> @@ -215,6 +190,7 @@ test_that("xportr_*: Can use R native pipe (R>4.1) and aquire domain from call ( # Different sequence call by moving first and last around result2 <- non_standard_name_native |> + xportr_domain_name("non_standard_name_native") |> xportr_metadata(metadata) |> xportr_label() |> xportr_length() |> diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index d5841a63..a865b6cb 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -29,7 +29,7 @@ test_that("xportr_type: NAs are handled as expected", { ) df2 <- suppressMessages( - xportr_type(df, meta_example) + xportr_type(df, meta_example, domain = "df") ) expect_equal( @@ -52,7 +52,7 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes # Remove empty lines in cli theme local_cli_theme() - (df2 <- xportr_type(df, meta_example)) %>% + (df2 <- xportr_type(df, meta_example, domain = "df")) %>% expect_message("Variable type mismatches found.") %>% expect_message("[0-9+] variables coerced") @@ -61,9 +61,9 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes Val = "numeric", Param = "character" )) - expect_error(xportr_type(df, meta_example, verbose = "stop")) + expect_error(xportr_type(df, meta_example, verbose = "stop", domain = "df")) - (df3 <- suppressMessages(xportr_type(df, meta_example, verbose = "warn"))) %>% + (df3 <- suppressMessages(xportr_type(df, meta_example, verbose = "warn", domain = "df"))) %>% expect_warning() expect_equal(purrr::map_chr(df3, class), c( @@ -73,7 +73,7 @@ test_that("xportr_type: Variable types are coerced as expected and can raise mes # Ignore other messages suppressMessages( - (df4 <- xportr_type(df, meta_example, verbose = "message")) %>% + (df4 <- xportr_type(df, meta_example, verbose = "message", domain = "df")) %>% expect_message("Variable type\\(s\\) in dataframe don't match metadata") ) @@ -88,7 +88,7 @@ test_that("xportr_metadata: Var types coerced as expected and raise messages", { local_cli_theme() ( - df2 <- xportr_metadata(df, meta_example) %>% + df2 <- xportr_metadata(df, meta_example, domain = "df") %>% xportr_type() ) %>% expect_message("Variable type mismatches found.") %>% @@ -100,12 +100,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, domain = "df") %>% xportr_type(verbose = "stop") ) %>% expect_error() suppressMessages( - df3 <- xportr_metadata(df, meta_example) %>% xportr_type(verbose = "warn") + df3 <- xportr_metadata(df, meta_example, domain = "df") %>% xportr_type(verbose = "warn") ) %>% expect_warning() @@ -116,7 +116,7 @@ test_that("xportr_metadata: Var types coerced as expected and raise messages", { suppressMessages({ ( - df4 <- xportr_metadata(df, meta_example) %>% + df4 <- xportr_metadata(df, meta_example, domain = "df") %>% xportr_type(verbose = "message") ) %>% expect_message("Variable type\\(s\\) in dataframe don't match metadata: `Subj` and `Val`") @@ -155,12 +155,14 @@ test_that("xportr_type: Variables retain column attributes, besides class", { withr::local_message_sink(tempfile()) df_type_label <- adsl %>% + xportr_domain_name("adsl") %>% xportr_type(metadata) %>% xportr_label(metadata) %>% xportr_length(metadata) %>% xportr_format(metadata) df_label_type <- adsl %>% + xportr_domain_name("adsl") %>% xportr_label(metadata) %>% xportr_length(metadata) %>% xportr_format(metadata) %>% @@ -200,7 +202,7 @@ test_that("xportr_type: works fine from metacore spec", { ) )) processed_df <- suppressMessages( - xportr_type(df, metacore_meta) + xportr_type(df, metacore_meta, domain = "df") ) expect_equal(processed_df$x, "1") }) @@ -228,7 +230,7 @@ test_that("xportr_type: date variables are not converted to numeric", { ) expect_message( { - processed_df <- xportr_type(df, metacore_meta) + processed_df <- xportr_type(df, metacore_meta, domain = "df") }, NA ) @@ -262,7 +264,7 @@ test_that("xportr_type: date variables are not converted to numeric", { adsl_original$RFICDTM <- as.POSIXct(adsl_original$RFICDTM) expect_message( - adsl_xpt2 <- adsl_original %>% xportr_type(metadata), + adsl_xpt2 <- adsl_original %>% xportr_type(metadata, domain = "adsl_original"), NA ) From 5f6e0dcb041f273eed7b4e0d06bd463e3bf0cb2e Mon Sep 17 00:00:00 2001 From: elimillera Date: Wed, 6 Dec 2023 13:52:58 +0000 Subject: [PATCH 02/17] Update docs and tests per review --- R/metadata.R | 2 ++ R/utils-xportr.R | 2 +- README.Rmd | 11 ++++++----- README.md | 12 ++++++------ man/metadata.Rd | 2 ++ tests/testthat/test-metadata.R | 3 +++ tests/testthat/test-type.R | 2 ++ 7 files changed, 22 insertions(+), 12 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index 926de49e..f6110574 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -54,6 +54,8 @@ xportr_metadata <- function(.df, metadata, domain = NULL) { #' Update Metadata Domain Name #' +#' Similar to `xportr_metadata`, but just added the domain and not the metadata. +#' #' @inheritParams xportr_length #' #' @return `.df` dataset with domain argument set diff --git a/R/utils-xportr.R b/R/utils-xportr.R index f97bb346..398617e8 100644 --- a/R/utils-xportr.R +++ b/R/utils-xportr.R @@ -305,7 +305,7 @@ xpt_validate <- function(data) { return(err_cnd) } -#' Get the domain from argument or from magrittr's pipe (`%>%`) +#' Get the domain from argument or from the existing domain attr #' #' @return A string representing the domain #' @noRd diff --git a/README.Rmd b/README.Rmd index 7af50e6d..385a2e01 100644 --- a/README.Rmd +++ b/README.Rmd @@ -127,11 +127,12 @@ Each `xportr_` function has been written in a way to take in a part of the speci ```{r, warning = FALSE, message=FALSE, eval=TRUE} adsl %>% - xportr_type(var_spec, "ADSL", verbose = "warn") %>% - xportr_length(var_spec, "ADSL", verbose = "warn") %>% - xportr_label(var_spec, "ADSL", verbose = "warn") %>% - xportr_order(var_spec, "ADSL", verbose = "warn") %>% - xportr_format(var_spec, "ADSL") %>% + xportr_domain_name("ADSL") %>% + xportr_type(var_spec, verbose = "warn") %>% + xportr_length(var_spec, verbose = "warn") %>% + xportr_label(var_spec, verbose = "warn") %>% + xportr_order(var_spec, verbose = "warn") %>% + xportr_format(var_spec) %>% xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset") ``` diff --git a/README.md b/README.md index bbd581f9..c1c5bd6f 100644 --- a/README.md +++ b/README.md @@ -5,7 +5,6 @@ -[](https://RValidationHub.slack.com) [![R build status](https://github.com/atorus-research/xportr/workflows/R-CMD-check/badge.svg)](https://github.com/atorus-research/xportr/actions?workflow=R-CMD-check) [](https://app.codecov.io/gh/atorus-research/xportr) @@ -135,11 +134,12 @@ We have suppressed the warning for the sake of brevity. ``` r adsl %>% - xportr_type(var_spec, "ADSL", verbose = "warn") %>% - xportr_length(var_spec, "ADSL", verbose = "warn") %>% - xportr_label(var_spec, "ADSL", verbose = "warn") %>% - xportr_order(var_spec, "ADSL", verbose = "warn") %>% - xportr_format(var_spec, "ADSL") %>% + xportr_domain_name("ADSL") %>% + xportr_type(var_spec, verbose = "warn") %>% + xportr_length(var_spec, verbose = "warn") %>% + xportr_label(var_spec, verbose = "warn") %>% + xportr_order(var_spec, verbose = "warn") %>% + xportr_format(var_spec) %>% xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset") ``` diff --git a/man/metadata.Rd b/man/metadata.Rd index d1f5d30b..2a7d0af0 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -29,6 +29,8 @@ Sets metadata for a dataset in a way that can be accessed by other xportr functions. If used at the start of an xportr pipeline, it removes the need to set metadata and domain at each step individually. For details on the format of the metadata, see the 'Metadata' section for each function in question. + +Similar to \code{xportr_metadata}, but just added the domain and not the metadata. } \examples{ diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index c74f906e..89ab1f11 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -548,6 +548,9 @@ test_that("xportr_length: Expect error if domain is not a character", { # tests for `xportr_metadata()` basic functionality # start test_that("xportr_metadata: Check metadata interaction with other functions", { + + skip_if_not_installed("admiral") + adsl <- admiral::admiral_adsl var_spec <- diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index a865b6cb..2a84cf16 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -215,6 +215,8 @@ test_that("xportr_type: error when metadata is not set", { }) test_that("xportr_type: date variables are not converted to numeric", { + skip_if_not_installed("metacore") + df <- data.frame(RFICDT = as.Date("2017-03-30"), RFICDTM = as.POSIXct("2017-03-30")) metacore_meta <- suppressWarnings( metacore::metacore( From c5edb1d1703d26fee5f0ca2058cf54db93de59a6 Mon Sep 17 00:00:00 2001 From: elimillera Date: Thu, 7 Dec 2023 14:57:30 +0000 Subject: [PATCH 03/17] update style --- R/metadata.R | 1 - tests/testthat/test-metadata.R | 1 - 2 files changed, 2 deletions(-) diff --git a/R/metadata.R b/R/metadata.R index f6110574..48bb65df 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -63,7 +63,6 @@ xportr_metadata <- function(.df, metadata, domain = NULL) { #' #' @rdname metadata xportr_domain_name <- function(.df, domain) { - attr(.df, "_xportr.df_arg_") <- domain .df diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index 89ab1f11..9841ae0d 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -548,7 +548,6 @@ test_that("xportr_length: Expect error if domain is not a character", { # tests for `xportr_metadata()` basic functionality # start test_that("xportr_metadata: Check metadata interaction with other functions", { - skip_if_not_installed("admiral") adsl <- admiral::admiral_adsl From c73780bcb3f24307973a8f9bb815f6bc5dee87f0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 8 Dec 2023 10:58:29 +0100 Subject: [PATCH 04/17] fix: updates comments --- R/format.R | 2 +- R/label.R | 2 +- R/length.R | 2 +- R/metadata.R | 2 +- R/order.R | 2 +- R/type.R | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/format.R b/R/format.R index 864faaf4..1249ac4e 100644 --- a/R/format.R +++ b/R/format.R @@ -57,7 +57,7 @@ xportr_format <- function(.df, format_name <- getOption("xportr.format_name") variable_name <- getOption("xportr.variable_name") - ## Common section to detect domain from argument or pipes + ## Common section to detect domain from argument or attribute domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain diff --git a/R/label.R b/R/label.R index 3d422f1b..ad6c339a 100644 --- a/R/label.R +++ b/R/label.R @@ -73,7 +73,7 @@ xportr_label <- function(.df, variable_name <- getOption("xportr.variable_name") variable_label <- getOption("xportr.label") - ## Common section to detect domain from argument or pipes + ## Common section to detect domain from argument or attribute domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain diff --git a/R/length.R b/R/length.R index 81864c2b..ec4e191a 100644 --- a/R/length.R +++ b/R/length.R @@ -80,7 +80,7 @@ xportr_length <- function(.df, variable_length <- getOption("xportr.length") variable_name <- getOption("xportr.variable_name") - ## Common section to detect domain from argument or pipes + ## Common section to detect domain from argument or attribute domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain diff --git a/R/metadata.R b/R/metadata.R index 48bb65df..325a3ff4 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -41,7 +41,7 @@ #' xportr_order() #' } xportr_metadata <- function(.df, metadata, domain = NULL) { - ## Common section to detect domain from argument or pipes + ## Common section to detect domain from argument or attribute domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain diff --git a/R/order.R b/R/order.R index 43ea130d..8f01ee78 100644 --- a/R/order.R +++ b/R/order.R @@ -76,7 +76,7 @@ xportr_order <- function(.df, order_name <- getOption("xportr.order_name") variable_name <- getOption("xportr.variable_name") - ## Common section to detect domain from argument or pipes + ## Common section to detect domain from argument or attribute domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain diff --git a/R/type.R b/R/type.R index c316373c..f75395f1 100644 --- a/R/type.R +++ b/R/type.R @@ -97,7 +97,7 @@ xportr_type <- function(.df, numericTypes <- c(getOption("xportr.numeric_types"), "_numeric") format_name <- getOption("xportr.format_name") - ## Common section to detect domain from argument or pipes + ## Common section to detect domain from argument or attribute domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain From 17c7f1405677a5006d0a4f7aea838dd450c3761a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Fri, 8 Dec 2023 11:00:31 +0100 Subject: [PATCH 05/17] style: rm extra empty line --- tests/testthat/test-pipe.R | 1 - 1 file changed, 1 deletion(-) diff --git a/tests/testthat/test-pipe.R b/tests/testthat/test-pipe.R index 6f9bafb5..90876763 100644 --- a/tests/testthat/test-pipe.R +++ b/tests/testthat/test-pipe.R @@ -1,4 +1,3 @@ - test_that("xportr_*: Domain is kept in between calls", { # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track From 49b44e834031de0b64d5e15080009463ee1fd29a Mon Sep 17 00:00:00 2001 From: elimillera Date: Mon, 18 Dec 2023 21:36:22 +0000 Subject: [PATCH 06/17] Add news entry --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index 27f14385..aa4049f2 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,10 @@ ## Deprecation and Breaking Changes +* The `domain` argument for xportr functions will no longer be dynamically +determined by the name of the data frame passed as the .df argument. This was +done to make the use of xportr functions more explicit. (#182) + # xportr 0.3.1 ## New Features and Bug Fixes From 9da5288947dd80197aec48c191158f6d21220674 Mon Sep 17 00:00:00 2001 From: elimillera Date: Mon, 18 Dec 2023 21:45:55 +0000 Subject: [PATCH 07/17] Remove unneeded tests --- tests/testthat/test-metadata.R | 37 ++++++ tests/testthat/test-pipe.R | 202 --------------------------------- 2 files changed, 37 insertions(+), 202 deletions(-) delete mode 100644 tests/testthat/test-pipe.R diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index 9841ae0d..20a4aa63 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -607,4 +607,41 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { ) ) }) + +test_that("xportr_*: Domain is kept in between calls", { + # Divert all messages to tempfile, instead of printing them + # note: be aware as this should only be used in tests that don't track + # messages + withr::local_message_sink(tempfile()) + + adsl <- minimal_table(30) + + metadata <- minimal_metadata( + dataset = TRUE, length = TRUE, label = TRUE, type = TRUE, format = TRUE, + order = TRUE + ) + + df2 <- adsl %>% + xportr_domain_name("adsl") %>% + xportr_type(metadata) + + df3 <- df2 %>% + xportr_label(metadata) %>% + xportr_length(metadata) %>% + xportr_order(metadata) %>% + xportr_format(metadata) + + expect_equal(attr(df3, "_xportr.df_arg_"), "adsl") + + df4 <- adsl %>% + xportr_type(metadata, domain = "adsl") + + df5 <- df4 %>% + xportr_label(metadata) %>% + xportr_length(metadata) %>% + xportr_order(metadata) %>% + xportr_format(metadata) + + expect_equal(attr(df5, "_xportr.df_arg_"), "adsl") +}) # end diff --git a/tests/testthat/test-pipe.R b/tests/testthat/test-pipe.R deleted file mode 100644 index 90876763..00000000 --- a/tests/testthat/test-pipe.R +++ /dev/null @@ -1,202 +0,0 @@ -test_that("xportr_*: Domain is kept in between calls", { - # Divert all messages to tempfile, instead of printing them - # note: be aware as this should only be used in tests that don't track - # messages - withr::local_message_sink(tempfile()) - - adsl <- minimal_table(30) - - metadata <- minimal_metadata( - dataset = TRUE, length = TRUE, label = TRUE, type = TRUE, format = TRUE, - order = TRUE - ) - - df2 <- adsl %>% - xportr_domain_name("adsl") %>% - xportr_type(metadata) - - df3 <- df2 %>% - xportr_label(metadata) %>% - xportr_length(metadata) %>% - xportr_order(metadata) %>% - xportr_format(metadata) - - expect_equal(attr(df3, "_xportr.df_arg_"), "adsl") - - df4 <- adsl %>% - xportr_type(metadata, domain = "adsl") - - df5 <- df4 %>% - xportr_label(metadata) %>% - xportr_length(metadata) %>% - xportr_order(metadata) %>% - xportr_format(metadata) - - expect_equal(attr(df5, "_xportr.df_arg_"), "adsl") -}) - -test_that("xportr_*: Can use magrittr pipe and aquire domain from call", { - # Divert all messages to tempfile, instead of printing them - # note: be aware as this should only be used in tests that don't track - # messages - withr::local_message_sink(tempfile()) - - adsl <- minimal_table(30) - - metadata <- minimal_metadata( - dataset = TRUE, length = TRUE, label = TRUE, type = TRUE, format = TRUE, - order = TRUE - ) - - non_standard_name <- adsl - result <- non_standard_name %>% - xportr_domain_name("non_standard_name") %>% - xportr_type(metadata) %>% - xportr_label(metadata) %>% - xportr_length(metadata) %>% - xportr_order(metadata) %>% - xportr_format(metadata) %>% - xportr_df_label(metadata) - - expect_equal(attr(result, "_xportr.df_arg_"), "non_standard_name") - - # Different sequence call by moving first and last around - result2 <- non_standard_name %>% - xportr_domain_name("non_standard_name") %>% - xportr_label(metadata) %>% - xportr_length(metadata) %>% - xportr_order(metadata) %>% - xportr_df_label(metadata) %>% - xportr_type(metadata) %>% - xportr_format(metadata) - - expect_equal(attr(result2, "_xportr.df_arg_"), "non_standard_name") -}) - -test_that("xportr_*: Can use magrittr pipe and aquire domain from call (metadata)", { - # Divert all messages to tempfile, instead of printing them - # note: be aware as this should only be used in tests that don't track - # messages - withr::local_message_sink(tempfile()) - - adsl <- minimal_table(30) - - metadata <- minimal_metadata( - dataset = TRUE, length = TRUE, label = TRUE, type = TRUE, format = TRUE, - order = TRUE - ) - - non_standard_name <- adsl - result <- non_standard_name %>% - xportr_domain_name("non_standard_name") %>% - xportr_metadata(metadata) %>% - xportr_type() %>% - xportr_label() %>% - xportr_length() %>% - xportr_order() %>% - xportr_format() %>% - xportr_df_label() - - expect_equal(attr(result, "_xportr.df_arg_"), "non_standard_name") - - # Different sequence call by moving first and last around - result2 <- non_standard_name %>% - xportr_domain_name("non_standard_name") %>% - xportr_metadata(metadata) %>% - xportr_label() %>% - xportr_length() %>% - xportr_order() %>% - xportr_df_label() %>% - xportr_type() %>% - xportr_format() - - expect_equal(attr(result2, "_xportr.df_arg_"), "non_standard_name") -}) - -test_that("xportr_*: Can use R native pipe (R>4.1) and aquire domain from call", { - skip_if( - compareVersion(glue("{R.version$major}.{R.version$minor}"), "4.1.0") < 0, - "R Version doesn't support native pipe (<4.1)" - ) - - # Divert all messages to tempfile, instead of printing them - # note: be aware as this should only be used in tests that don't track - # messages - withr::local_message_sink(tempfile()) - - adsl <- minimal_table(30) - - metadata <- minimal_metadata( - dataset = TRUE, length = TRUE, label = TRUE, type = TRUE, format = TRUE, - order = TRUE - ) - - non_standard_name_native <- adsl - result <- non_standard_name_native |> - xportr_domain_name("non_standard_name_native") |> - xportr_type(metadata) |> - xportr_label(metadata) |> - xportr_length(metadata) |> - xportr_order(metadata) |> - xportr_format(metadata) |> - xportr_df_label(metadata) - - expect_equal(attr(result, "_xportr.df_arg_"), "non_standard_name_native") - - # Different sequence call by moving first and last around - result2 <- non_standard_name_native |> - xportr_domain_name("non_standard_name_native") |> - xportr_label(metadata) |> - xportr_length(metadata) |> - xportr_order(metadata) |> - xportr_df_label(metadata) |> - xportr_type(metadata) |> - xportr_format(metadata) - - expect_equal(attr(result2, "_xportr.df_arg_"), "non_standard_name_native") -}) - -test_that("xportr_*: Can use R native pipe (R>4.1) and aquire domain from call (metadata)", { - skip_if( - compareVersion(glue("{R.version$major}.{R.version$minor}"), "4.1.0") < 0, - "R Version doesn't support native pipe (<4.1)" - ) - - # Divert all messages to tempfile, instead of printing them - # note: be aware as this should only be used in tests that don't track - # messages - withr::local_message_sink(tempfile()) - - adsl <- minimal_table(30) - - metadata <- minimal_metadata( - dataset = TRUE, length = TRUE, label = TRUE, type = TRUE, format = TRUE, - order = TRUE - ) - - non_standard_name_native <- adsl - result <- non_standard_name_native |> - xportr_domain_name("non_standard_name_native") |> - xportr_metadata(metadata) |> - xportr_type() |> - xportr_label() |> - xportr_length() |> - xportr_order() |> - xportr_format() |> - xportr_df_label() - - expect_equal(attr(result, "_xportr.df_arg_"), "non_standard_name_native") - - # Different sequence call by moving first and last around - result2 <- non_standard_name_native |> - xportr_domain_name("non_standard_name_native") |> - xportr_metadata(metadata) |> - xportr_label() |> - xportr_length() |> - xportr_order() |> - xportr_df_label() |> - xportr_type() |> - xportr_format() - - expect_equal(attr(result2, "_xportr.df_arg_"), "non_standard_name_native") -}) From e7d96c992b20614e2d0ab744bcd57d00f5f4dd8c Mon Sep 17 00:00:00 2001 From: elimillera Date: Mon, 18 Dec 2023 21:50:24 +0000 Subject: [PATCH 08/17] doc update for domain argument --- R/length.R | 5 +++-- man/metadata.Rd | 5 +++-- man/xportr_df_label.Rd | 5 +++-- man/xportr_format.Rd | 5 +++-- man/xportr_label.Rd | 5 +++-- man/xportr_length.Rd | 5 +++-- man/xportr_order.Rd | 5 +++-- man/xportr_type.Rd | 5 +++-- 8 files changed, 24 insertions(+), 16 deletions(-) diff --git a/R/length.R b/R/length.R index ec4e191a..46a6f7a7 100644 --- a/R/length.R +++ b/R/length.R @@ -9,8 +9,9 @@ #' @param metadata A data frame containing variable level metadata. See #' 'Metadata' section for details. #' @param 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. +#' the metadata object. If none is passed, then [xportr_domain()] or +#' [xportr_metadata()] must be called before hand to set the domain as an +#' attribute of `.df`. #' @param 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' diff --git a/man/metadata.Rd b/man/metadata.Rd index 2a7d0af0..e429b91d 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -16,8 +16,9 @@ xportr_domain_name(.df, domain) 'Metadata' section for details.} \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.} +the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an +attribute of \code{.df}.} } \value{ \code{.df} dataset with metadata and domain attributes set diff --git a/man/xportr_df_label.Rd b/man/xportr_df_label.Rd index 691de990..64c1aebb 100644 --- a/man/xportr_df_label.Rd +++ b/man/xportr_df_label.Rd @@ -13,8 +13,9 @@ xportr_df_label(.df, metadata = NULL, domain = NULL, metacore = deprecated()) details.} \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.} +the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an +attribute of \code{.df}.} \item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass metadata now renamed with \code{metadata}} diff --git a/man/xportr_format.Rd b/man/xportr_format.Rd index c6fd6e85..0bef1798 100644 --- a/man/xportr_format.Rd +++ b/man/xportr_format.Rd @@ -13,8 +13,9 @@ xportr_format(.df, metadata = NULL, domain = NULL, metacore = deprecated()) 'Metadata' section for details.} \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.} +the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an +attribute of \code{.df}.} \item{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass metadata now renamed with \code{metadata}} diff --git a/man/xportr_label.Rd b/man/xportr_label.Rd index 4cd7d18c..ecad5b4d 100644 --- a/man/xportr_label.Rd +++ b/man/xportr_label.Rd @@ -19,8 +19,9 @@ xportr_label( 'Metadata' section for details.} \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.} +the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +\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 diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index 4c4dd224..d4a0b252 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -19,8 +19,9 @@ xportr_length( 'Metadata' section for details.} \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.} +the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +\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 diff --git a/man/xportr_order.Rd b/man/xportr_order.Rd index 44f283cf..ef10eab0 100644 --- a/man/xportr_order.Rd +++ b/man/xportr_order.Rd @@ -19,8 +19,9 @@ xportr_order( 'Metadata' section for details.} \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.} +the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +\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 diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index abfa41d8..8dfdfa1e 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -19,8 +19,9 @@ xportr_type( 'Metadata' section for details.} \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.} +the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +\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 From a5bd5271e2c1c5e3e0ce9a2df32b1fd6358d1df3 Mon Sep 17 00:00:00 2001 From: Eli Miller Date: Tue, 19 Dec 2023 10:28:10 -0600 Subject: [PATCH 09/17] Update R/metadata.R Co-authored-by: Ben Straub --- R/metadata.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/metadata.R b/R/metadata.R index 325a3ff4..2db7d1b5 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -54,7 +54,7 @@ xportr_metadata <- function(.df, metadata, domain = NULL) { #' Update Metadata Domain Name #' -#' Similar to `xportr_metadata`, but just added the domain and not the metadata. +#' Similar to `xportr_metadata()`, but just adds the domain and not the metadata. #' #' @inheritParams xportr_length #' From dc832f3be650a5bcbd28a6fdf700fb90ed488635 Mon Sep 17 00:00:00 2001 From: elimillera Date: Tue, 19 Dec 2023 16:29:41 +0000 Subject: [PATCH 10/17] Update with PR comments --- R/length.R | 2 +- README.Rmd | 4 ++-- README.md | 3 ++- man/metadata.Rd | 2 +- man/xportr_df_label.Rd | 2 +- man/xportr_format.Rd | 2 +- man/xportr_label.Rd | 2 +- man/xportr_length.Rd | 2 +- man/xportr_order.Rd | 2 +- man/xportr_type.Rd | 2 +- 10 files changed, 12 insertions(+), 11 deletions(-) diff --git a/R/length.R b/R/length.R index 46a6f7a7..1b007970 100644 --- a/R/length.R +++ b/R/length.R @@ -9,7 +9,7 @@ #' @param metadata A data frame containing variable level metadata. See #' 'Metadata' section for details. #' @param domain Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -#' the metadata object. If none is passed, then [xportr_domain()] or +#' the metadata object. If none is passed, then [xportr_domain_name()] or #' [xportr_metadata()] must be called before hand to set the domain as an #' attribute of `.df`. #' @param verbose The action this function takes when an action is taken on the diff --git a/README.Rmd b/README.Rmd index 5f8431f5..1541a21b 100644 --- a/README.Rmd +++ b/README.Rmd @@ -137,8 +137,8 @@ adsl %>% xportr_label(var_spec, verbose = "warn") %>% xportr_order(var_spec, verbose = "warn") %>% xportr_format(var_spec) %>% - xportr_df_label(dataset_spec, "ADSL") %>% - xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset") + xportr_df_label(dataset_spec, "ADSL") %>% + xportr_write("adsl.xpt") ``` The `xportr_metadata()` function can reduce duplication by setting the variable specification and domain explicitly at the top of a pipeline. If you would like to use the `verbose` argument, you will need to set in each function call. diff --git a/README.md b/README.md index 646d0b45..cc83fae4 100644 --- a/README.md +++ b/README.md @@ -5,6 +5,7 @@ +[](https://RValidationHub.slack.com) [![R build status](https://github.com/atorus-research/xportr/workflows/R-CMD-check/badge.svg)](https://github.com/atorus-research/xportr/actions?workflow=R-CMD-check) [](https://app.codecov.io/gh/atorus-research/xportr) @@ -144,7 +145,7 @@ adsl %>% xportr_order(var_spec, verbose = "warn") %>% xportr_format(var_spec) %>% xportr_df_label(dataset_spec, "ADSL") %>% - xportr_write("adsl.xpt", label = "Subject-Level Analysis Dataset") + xportr_write("adsl.xpt") ``` The `xportr_metadata()` function can reduce duplication by setting the diff --git a/man/metadata.Rd b/man/metadata.Rd index e429b91d..d6171414 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -16,7 +16,7 @@ xportr_domain_name(.df, domain) 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or \code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an attribute of \code{.df}.} } diff --git a/man/xportr_df_label.Rd b/man/xportr_df_label.Rd index 64c1aebb..6d4764b4 100644 --- a/man/xportr_df_label.Rd +++ b/man/xportr_df_label.Rd @@ -13,7 +13,7 @@ xportr_df_label(.df, metadata = NULL, domain = NULL, metacore = deprecated()) details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or \code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an attribute of \code{.df}.} diff --git a/man/xportr_format.Rd b/man/xportr_format.Rd index 0bef1798..b7825fc4 100644 --- a/man/xportr_format.Rd +++ b/man/xportr_format.Rd @@ -13,7 +13,7 @@ xportr_format(.df, metadata = NULL, domain = NULL, metacore = deprecated()) 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or \code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an attribute of \code{.df}.} diff --git a/man/xportr_label.Rd b/man/xportr_label.Rd index ecad5b4d..87d648da 100644 --- a/man/xportr_label.Rd +++ b/man/xportr_label.Rd @@ -19,7 +19,7 @@ xportr_label( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or \code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an attribute of \code{.df}.} diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index d4a0b252..1d5100df 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -19,7 +19,7 @@ xportr_length( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or \code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an attribute of \code{.df}.} diff --git a/man/xportr_order.Rd b/man/xportr_order.Rd index ef10eab0..72bda30d 100644 --- a/man/xportr_order.Rd +++ b/man/xportr_order.Rd @@ -19,7 +19,7 @@ xportr_order( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or \code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an attribute of \code{.df}.} diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index 8dfdfa1e..3c67c4c7 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -19,7 +19,7 @@ xportr_type( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain]{xportr_domain()}} or +the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or \code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an attribute of \code{.df}.} From e378cbdcb80233a2e9605fcbe322d1f17ea15857 Mon Sep 17 00:00:00 2001 From: elimillera Date: Tue, 19 Dec 2023 16:46:30 +0000 Subject: [PATCH 11/17] passing R CMD Check --- R/write.R | 6 +++--- man/metadata.Rd | 2 +- man/xportr_write.Rd | 6 ++++-- tests/testthat/test-write.R | 8 ++++++-- 4 files changed, 14 insertions(+), 8 deletions(-) diff --git a/R/write.R b/R/write.R index 0dd13541..c9005471 100644 --- a/R/write.R +++ b/R/write.R @@ -37,6 +37,7 @@ #' var_spec <- data.frame(dataset = "adsl", label = "Subject-Level Analysis Dataset") #' xportr_write(adsl, #' path = paste0(tempdir(), "/adsl.xpt"), +#' domain = "adsl", #' metadata = var_spec, #' strict_checks = FALSE #' ) @@ -51,10 +52,9 @@ xportr_write <- function(.df, name <- tools::file_path_sans_ext(basename(path)) - ## Common section to detect domain from argument or pipes + ## Common section to detect domain from argument or attribute - df_arg <- tryCatch(as_name(enexpr(.df)), error = function(err) NULL) - domain <- get_domain(.df, df_arg, domain) + domain <- get_domain(.df, domain) if (!is.null(domain)) attr(.df, "_xportr.df_arg_") <- domain ## End of common section diff --git a/man/metadata.Rd b/man/metadata.Rd index d6171414..f3c497de 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -31,7 +31,7 @@ functions. If used at the start of an xportr pipeline, it removes the need to set metadata and domain at each step individually. For details on the format of the metadata, see the 'Metadata' section for each function in question. -Similar to \code{xportr_metadata}, but just added the domain and not the metadata. +Similar to \code{xportr_metadata()}, but just adds the domain and not the metadata. } \examples{ diff --git a/man/xportr_write.Rd b/man/xportr_write.Rd index b59e61bd..9ecbd3a4 100644 --- a/man/xportr_write.Rd +++ b/man/xportr_write.Rd @@ -23,8 +23,9 @@ used as \code{xpt} name.} 'Metadata' section for details.} \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.} +the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or +\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an +attribute of \code{.df}.} \item{strict_checks}{If TRUE, xpt validation will report errors and not write out the dataset. If FALSE, xpt validation will report warnings and continue @@ -60,6 +61,7 @@ adsl <- data.frame( var_spec <- data.frame(dataset = "adsl", label = "Subject-Level Analysis Dataset") xportr_write(adsl, path = paste0(tempdir(), "/adsl.xpt"), + domain = "adsl", metadata = var_spec, strict_checks = FALSE ) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index 4229c06e..e45abce0 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -16,7 +16,7 @@ test_that("xportr_write: exported data can still be saved to a file with a label on.exit(unlink(tmpdir)) - suppressWarnings(xportr_write(data_to_save, path = tmp, label = "Lorem ipsum dolor sit amet")) + suppressWarnings(xportr_write(data_to_save, path = tmp, label = "Lorem ipsum dolor sit amet", domain = "data_to_save")) expect_output(str(read_xpt(tmp)), "Lorem ipsum dolor sit amet") }) @@ -29,6 +29,7 @@ test_that("xportr_write: exported data can be saved to a file with a metadata", xportr_write( data_to_save, path = tmp, + domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", label = "Lorem ipsum dolor sit amet" @@ -45,13 +46,14 @@ test_that("xportr_write: exported data can be saved to a file with a existing me df <- xportr_df_label( data_to_save, + domain = "data_to_save", data.frame( dataset = "data_to_save", label = "Lorem ipsum dolor sit amet" ) ) - xportr_write(df, path = tmp) + xportr_write(df, path = tmp, domain = "data_to_save") expect_output(str(read_xpt(tmp)), "Lorem ipsum dolor sit amet") }) @@ -162,6 +164,7 @@ test_that("xportr_write: expect warning when an xpt validation fails with strict expect_warning( xportr_write( data_to_save, tmp, + domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", label = "label" @@ -184,6 +187,7 @@ test_that("xportr_write: Capture errors by haven and report them as such", { suppressWarnings( xportr_write( data_to_save, tmp, + domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", label = "label" From 8c5e0ceadd83c7e623c54f3ae359320ed2fa598e Mon Sep 17 00:00:00 2001 From: elimillera Date: Tue, 19 Dec 2023 16:57:39 +0000 Subject: [PATCH 12/17] fix coverage --- tests/testthat/test-write.R | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index e45abce0..e6e35ca5 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -16,7 +16,12 @@ test_that("xportr_write: exported data can still be saved to a file with a label on.exit(unlink(tmpdir)) - suppressWarnings(xportr_write(data_to_save, path = tmp, label = "Lorem ipsum dolor sit amet", domain = "data_to_save")) + suppressWarnings( + xportr_write(data_to_save, + path = tmp, + label = "Lorem ipsum dolor sit amet", + domain = "data_to_save") + ) expect_output(str(read_xpt(tmp)), "Lorem ipsum dolor sit amet") }) @@ -106,6 +111,7 @@ test_that("xportr_write: expect error when label contains non-ASCII symbols or s expect_error( xportr_write( data_to_save, + domain = "data_to_save", tmp, metadata = data.frame( dataset = "data_to_save", @@ -126,6 +132,7 @@ test_that("xportr_write: expect error when label is over 40 characters", { expect_error( xportr_write( data_to_save, + domain = "data_to_save", tmp, metadata = data.frame( dataset = "data_to_save", @@ -145,6 +152,7 @@ test_that("xportr_write: expect error when an xpt validation fails with strict_c expect_error( xportr_write( data_to_save, tmp, + domain = "data_to_save", metadata = data.frame( dataset = "data_to_save", label = "label" From 6138a14730f07cc6ec5e01c51b6dcdc106e218d0 Mon Sep 17 00:00:00 2001 From: elimillera Date: Fri, 29 Dec 2023 20:27:35 +0000 Subject: [PATCH 13/17] Updates with PR comment --- R/format.R | 2 +- R/label.R | 2 +- R/length.R | 2 +- R/order.R | 2 +- R/type.R | 2 +- _pkgdown.yml | 1 + tests/testthat/test-format.R | 15 +++++++++++++++ tests/testthat/test-label.R | 16 ++++++++++++++++ tests/testthat/test-length.R | 16 ++++++++++++++++ tests/testthat/test-order.R | 16 ++++++++++++++++ tests/testthat/test-type.R | 17 +++++++++++++++++ tests/testthat/test-write.R | 7 ++++--- 12 files changed, 90 insertions(+), 8 deletions(-) diff --git a/R/format.R b/R/format.R index 1249ac4e..798c7e18 100644 --- a/R/format.R +++ b/R/format.R @@ -72,7 +72,7 @@ xportr_format <- function(.df, metadata <- metadata$var_spec } - if (domain_name %in% names(metadata)) { + if (domain_name %in% names(metadata) && !is.null(domain)) { metadata <- metadata %>% dplyr::filter(!!sym(domain_name) == domain & !is.na(!!sym(format_name))) } else { diff --git a/R/label.R b/R/label.R index ad6c339a..15a386f4 100644 --- a/R/label.R +++ b/R/label.R @@ -88,7 +88,7 @@ xportr_label <- function(.df, metadata <- metadata$var_spec } - if (domain_name %in% names(metadata)) { + if (domain_name %in% names(metadata) && !is.null(domain)) { metadata <- metadata %>% dplyr::filter(!!sym(domain_name) == domain) } else { diff --git a/R/length.R b/R/length.R index 1b007970..5ee823b4 100644 --- a/R/length.R +++ b/R/length.R @@ -96,7 +96,7 @@ xportr_length <- function(.df, metadata <- metadata$var_spec } - if (domain_name %in% names(metadata)) { + if (domain_name %in% names(metadata) && !is.null(domain)) { metadata <- metadata %>% filter(!!sym(domain_name) == domain) } else { diff --git a/R/order.R b/R/order.R index 8f01ee78..e5f5a822 100644 --- a/R/order.R +++ b/R/order.R @@ -91,7 +91,7 @@ xportr_order <- function(.df, metadata <- metadata$ds_vars } - if (domain_name %in% names(metadata)) { + if (domain_name %in% names(metadata) && !is.null(domain)) { metadata <- metadata %>% dplyr::filter(!!sym(domain_name) == domain & !is.na(!!sym(order_name))) } else { diff --git a/R/type.R b/R/type.R index f75395f1..d01ad078 100644 --- a/R/type.R +++ b/R/type.R @@ -113,7 +113,7 @@ xportr_type <- function(.df, metadata <- metadata$var_spec } - if (domain_name %in% names(metadata)) { + if (domain_name %in% names(metadata) && !is.null(domain)) { metadata <- metadata %>% filter(!!sym(domain_name) == domain) } diff --git a/_pkgdown.yml b/_pkgdown.yml index dbeae1cc..8082901f 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -32,6 +32,7 @@ reference: - xportr_order - xportr_df_label - xportr_metadata + - xportr_domain_name - title: xportr helper functions desc: Utility functions called within core xportr functions diff --git a/tests/testthat/test-format.R b/tests/testthat/test-format.R index 76b65e1d..a311a8c4 100644 --- a/tests/testthat/test-format.R +++ b/tests/testthat/test-format.R @@ -19,3 +19,18 @@ test_that("xportr_format: Gets warning when metadata has multiple rows with same # Checks that message doesn't appear when xportr.domain_name is valid multiple_vars_in_spec_helper2(xportr_format) }) + +test_that("xportr_format: Works as expected with only one domain in metadata", { + adsl <- data.frame( + USUBJID = c(1001, 1002, 1003), + BRTHDT = c(1, 1, 2) + ) + + metadata <- data.frame( + dataset = c("adsl", "adsl"), + variable = c("USUBJID", "BRTHDT"), + format = c(NA, "DATE9.") + ) + + expect_silent(xportr_format(adsl, metadata)) +}) diff --git a/tests/testthat/test-label.R b/tests/testthat/test-label.R index 8030a826..cd0fc30b 100644 --- a/tests/testthat/test-label.R +++ b/tests/testthat/test-label.R @@ -21,3 +21,19 @@ test_that("xportr_label: Gets warning when metadata has multiple rows with same # Checks that message doesn't appear when xportr.domain_name is valid multiple_vars_in_spec_helper2(xportr_label) }) + + +test_that("xportr_label: Works as expected with only one domain in metadata", { + adsl <- data.frame( + USUBJID = c(1001, 1002, 1003), + BRTHDT = c(1, 1, 2) + ) + + metadata <- data.frame( + dataset = c("adsl", "adsl"), + variable = c("USUBJID", "BRTHDT"), + label = c("Hello", "Hello2") + ) + + expect_silent(xportr_label(adsl, metadata)) +}) diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index dd8b531f..f0045ead 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -193,3 +193,19 @@ test_that("xportr_length: Gets warning when metadata has multiple rows with same # Checks that message doesn't appear when xportr.domain_name is valid multiple_vars_in_spec_helper2(xportr_length) }) + + +test_that("xportr_length: Works as expected with only one domain in metadata", { + adsl <- data.frame( + USUBJID = c(1001, 1002, 1003), + BRTHDT = c(1, 1, 2) + ) + + metadata <- data.frame( + dataset = c("adsl", "adsl"), + variable = c("USUBJID", "BRTHDT"), + length = c(1, 1) + ) + + expect_silent(xportr_length(adsl, metadata)) +}) diff --git a/tests/testthat/test-order.R b/tests/testthat/test-order.R index 941a7d04..431db805 100644 --- a/tests/testthat/test-order.R +++ b/tests/testthat/test-order.R @@ -170,3 +170,19 @@ test_that("xportr_order: Gets warning when metadata has multiple rows with same expect_message("All variables in specification file are in dataset") %>% expect_message("All variables in dataset are ordered") }) + + +test_that("xportr_order: Works as expected with only one domain in metadata", { + adsl <- data.frame( + USUBJID = c(1001, 1002, 1003), + BRTHDT = c(1, 1, 2) + ) + + metadata <- data.frame( + dataset = c("adsl", "adsl"), + variable = c("USUBJID", "BRTHDT"), + order = c(1, 2) + ) + + expect_equal(xportr_order(adsl, metadata), adsl) +}) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index 2287198e..f53271cc 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -304,3 +304,20 @@ test_that("xportr_type: Drops factor levels", { expect_null(attributes(df2$Val)) }) + + +test_that("xportr_type: Works as expected with only one domain in metadata", { + adsl <- data.frame( + USUBJID = c(1001, 1002, 1003), + BRTHDT = c(1, 1, 2) + ) + + metadata <- data.frame( + dataset = c("adsl", "adsl"), + variable = c("USUBJID", "BRTHDT"), + type = c("numeric", "numeric"), + format = c(NA, "DATE9.") + ) + + expect_equal(xportr_type(adsl, metadata), adsl) +}) diff --git a/tests/testthat/test-write.R b/tests/testthat/test-write.R index e6e35ca5..44e4718a 100644 --- a/tests/testthat/test-write.R +++ b/tests/testthat/test-write.R @@ -18,10 +18,11 @@ test_that("xportr_write: exported data can still be saved to a file with a label suppressWarnings( xportr_write(data_to_save, - path = tmp, - label = "Lorem ipsum dolor sit amet", - domain = "data_to_save") + path = tmp, + label = "Lorem ipsum dolor sit amet", + domain = "data_to_save" ) + ) expect_output(str(read_xpt(tmp)), "Lorem ipsum dolor sit amet") }) From 8db698ee1b659141a0489d9cdfcb4397d6c49666 Mon Sep 17 00:00:00 2001 From: elimillera Date: Fri, 29 Dec 2023 20:48:07 +0000 Subject: [PATCH 14/17] Revert bad merge --- tests/testthat/test-depreciation.R | 53 ++++-------------------------- 1 file changed, 6 insertions(+), 47 deletions(-) diff --git a/tests/testthat/test-depreciation.R b/tests/testthat/test-depreciation.R index b967c27e..2679ecc9 100644 --- a/tests/testthat/test-depreciation.R +++ b/tests/testthat/test-depreciation.R @@ -3,11 +3,7 @@ test_that("xportr_df_label: deprecated metacore gives an error", { df <- data.frame(x = "a", y = "b") df_meta <- data.frame(dataset = "df", label = "Label") - df_spec_labeled_df <- xportr_df_label(df, metacore = df_meta, domain = "df") - - expect_equal(attr(df_spec_labeled_df, "label"), "Label") - xportr_df_label(df, metacore = df_meta, domain = "df") %>% - lifecycle::expect_deprecated("Please use the `metadata` argument instead.") + expect_error(xportr_df_label(df, metacore = df_meta)) }) test_that("xportr_format: deprecated metacore gives an error", { @@ -19,11 +15,7 @@ test_that("xportr_format: deprecated metacore gives an error", { format = "date9." ) - formatted_df <- xportr_format(df, metacore = df_meta, domain = "df") - - expect_equal(attr(formatted_df$x, "format.sas"), "DATE9.") - xportr_format(df, metacore = df_meta, domain = "df") %>% - lifecycle::expect_deprecated("Please use the `metadata` argument instead.") + expect_error(xportr_format(df, metacore = df_meta)) }) test_that("xportr_label: using the deprecated metacore argument gives an error", { @@ -32,17 +24,7 @@ test_that("xportr_label: using the deprecated metacore argument gives an error", df <- data.frame(x = "a", y = "b") df_meta <- data.frame(dataset = "df", variable = "x", label = "foo") - df_labeled_df <- suppressMessages( - xportr_label(df, metacore = df_meta, domain = "df") - ) - - expect_equal(attr(df_labeled_df$x, "label"), "foo") - - # Note that only the deprecated message should be caught (others are ignored) - suppressMessages( - xportr_label(df, metacore = df_meta, domain = "df") %>% - lifecycle::expect_deprecated("Please use the `metadata` argument instead.") - ) + expect_error(xportr_label(df, metacore = df_meta)) }) test_that("xportr_length: using the deprecated metacore argument gives an error", { @@ -55,12 +37,7 @@ test_that("xportr_length: using the deprecated metacore argument gives an error" length = c(1, 2) ) - df_with_width <- xportr_length(df, metacore = df_meta, domain = "df") - - expect_equal(c(x = 1, y = 2), map_dbl(df_with_width, attr, "width")) - - xportr_length(df, metacore = df_meta, domain = "df") %>% - lifecycle::expect_deprecated("Please use the `metadata` argument instead.") + expect_error(xportr_length(df, metacore = df_meta)) }) test_that("xportr_order: using the deprecated metacore argument gives an error", { @@ -73,17 +50,7 @@ test_that("xportr_order: using the deprecated metacore argument gives an error", order = 1:4 ) - ordered_df <- suppressMessages( - xportr_order(df, metacore = df_meta, domain = "DOMAIN") - ) - - expect_equal(names(ordered_df), df_meta$variable) - - # Note that only the deprecated message should be caught (others are ignored) - suppressMessages( - xportr_order(df, metacore = df_meta, domain = "df") %>% - lifecycle::expect_deprecated("Please use the `metadata` argument instead.") - ) + expect_error(xportr_order(df, metacore = df_meta, domain = "DOMAIN")) }) test_that("xportr_type: using the deprecated metacore argument gives an error", { @@ -101,13 +68,5 @@ test_that("xportr_type: using the deprecated metacore argument gives an error", format = NA ) - df2 <- suppressMessages( - xportr_type(df, metacore = df_meta, domain = "df") - ) - - # Note that only the deprecated message should be caught (others are ignored) - suppressMessages( - xportr_type(df, metacore = df_meta, domain = "df") %>% - lifecycle::expect_deprecated("Please use the `metadata` argument instead.") - ) + expect_error(xportr_type(df, metacore = df_meta)) }) From 466d7efe8c18e0444d68055ca26f22786f1edf2e Mon Sep 17 00:00:00 2001 From: elimillera Date: Wed, 10 Jan 2024 17:15:58 +0000 Subject: [PATCH 15/17] Remove function and update xportr_metadata to allow for domain setting --- NAMESPACE | 1 - R/length.R | 5 ++--- R/metadata.R | 32 +++++++++----------------------- R/support-test.R | 2 +- _pkgdown.yml | 1 - man/metadata.Rd | 24 ++++++++---------------- man/xportr_df_label.Rd | 5 ++--- man/xportr_format.Rd | 5 ++--- man/xportr_label.Rd | 5 ++--- man/xportr_length.Rd | 5 ++--- man/xportr_order.Rd | 5 ++--- man/xportr_type.Rd | 5 ++--- man/xportr_write.Rd | 5 ++--- tests/testthat/test-length.R | 2 +- tests/testthat/test-metadata.R | 4 ++-- tests/testthat/test-order.R | 2 +- tests/testthat/test-type.R | 4 ++-- 17 files changed, 40 insertions(+), 72 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index dd495905..d2f10378 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -6,7 +6,6 @@ export(type_log) export(var_names_log) export(var_ord_msg) export(xportr_df_label) -export(xportr_domain_name) export(xportr_format) export(xportr_label) export(xportr_length) diff --git a/R/length.R b/R/length.R index 3039218f..21ea95d4 100644 --- a/R/length.R +++ b/R/length.R @@ -9,9 +9,8 @@ #' @param metadata A data frame containing variable level metadata. See #' 'Metadata' section for details. #' @param domain Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -#' the metadata object. If none is passed, then [xportr_domain_name()] or -#' [xportr_metadata()] must be called before hand to set the domain as an -#' attribute of `.df`. +#' the metadata object. If none is passed, then [xportr_metadata()] must be +#' called before hand to set the domain as an attribute of `.df`. #' @param 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' diff --git a/R/metadata.R b/R/metadata.R index 2db7d1b5..df206ef2 100644 --- a/R/metadata.R +++ b/R/metadata.R @@ -1,9 +1,10 @@ #' Set variable specifications and domain #' -#' Sets metadata for a dataset in a way that can be accessed by other xportr -#' functions. If used at the start of an xportr pipeline, it removes the need to -#' set metadata and domain at each step individually. For details on the format -#' of the metadata, see the 'Metadata' section for each function in question. +#' Sets metadata and/or domain for a dataset in a way that can be accessed by +#' other xportr functions. If used at the start of an xportr pipeline, it +#' removes the need to set metadata and domain at each step individually. For +#' details on the format of the metadata, see the 'Metadata' section for each +#' function in question. #' #' @inheritParams xportr_length #' @@ -35,12 +36,14 @@ #' library(magrittr) #' #' adlb %>% -#' xportr_domain_name("adlb") %>% #' xportr_metadata(metadata, "test") %>% #' xportr_type() %>% #' xportr_order() #' } -xportr_metadata <- function(.df, metadata, domain = NULL) { +xportr_metadata <- function(.df, metadata = NULL, domain = NULL) { + if (is.null(metadata) && is.null(domain)) { + stop("Must provide either metadata or domain argument") + } ## Common section to detect domain from argument or attribute domain <- get_domain(.df, domain) @@ -50,20 +53,3 @@ xportr_metadata <- function(.df, metadata, domain = NULL) { structure(.df, `_xportr.df_metadata_` = metadata) } - - -#' Update Metadata Domain Name -#' -#' Similar to `xportr_metadata()`, but just adds the domain and not the metadata. -#' -#' @inheritParams xportr_length -#' -#' @return `.df` dataset with domain argument set -#' @export -#' -#' @rdname metadata -xportr_domain_name <- function(.df, domain) { - attr(.df, "_xportr.df_arg_") <- domain - - .df -} diff --git a/R/support-test.R b/R/support-test.R index b81fba3d..d223a6d6 100644 --- a/R/support-test.R +++ b/R/support-test.R @@ -180,7 +180,7 @@ multiple_vars_in_spec_helper2 <- function(FUN) { local_cli_theme() adsl %>% - xportr_domain_name("adsl") %>% + xportr_metadata(domain = "adsl") %>% FUN(metadata) %>% testthat::expect_no_message(message = "There are multiple specs for the same variable name") } diff --git a/_pkgdown.yml b/_pkgdown.yml index 8082901f..dbeae1cc 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -32,7 +32,6 @@ reference: - xportr_order - xportr_df_label - xportr_metadata - - xportr_domain_name - title: xportr helper functions desc: Utility functions called within core xportr functions diff --git a/man/metadata.Rd b/man/metadata.Rd index f3c497de..658fe0a4 100644 --- a/man/metadata.Rd +++ b/man/metadata.Rd @@ -2,12 +2,9 @@ % Please edit documentation in R/metadata.R \name{xportr_metadata} \alias{xportr_metadata} -\alias{xportr_domain_name} \title{Set variable specifications and domain} \usage{ -xportr_metadata(.df, metadata, domain = NULL) - -xportr_domain_name(.df, domain) +xportr_metadata(.df, metadata = NULL, domain = NULL) } \arguments{ \item{.df}{A data frame of CDISC standard.} @@ -16,22 +13,18 @@ xportr_domain_name(.df, domain) 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or -\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an -attribute of \code{.df}.} +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}.} } \value{ \code{.df} dataset with metadata and domain attributes set - -\code{.df} dataset with domain argument set } \description{ -Sets metadata for a dataset in a way that can be accessed by other xportr -functions. If used at the start of an xportr pipeline, it removes the need to -set metadata and domain at each step individually. For details on the format -of the metadata, see the 'Metadata' section for each function in question. - -Similar to \code{xportr_metadata()}, but just adds the domain and not the metadata. +Sets metadata and/or domain for a dataset in a way that can be accessed by +other xportr functions. If used at the start of an xportr pipeline, it +removes the need to set metadata and domain at each step individually. For +details on the format of the metadata, see the 'Metadata' section for each +function in question. } \examples{ @@ -56,7 +49,6 @@ if (rlang::is_installed("magrittr")) { library(magrittr) adlb \%>\% - xportr_domain_name("adlb") \%>\% xportr_metadata(metadata, "test") \%>\% xportr_type() \%>\% xportr_order() diff --git a/man/xportr_df_label.Rd b/man/xportr_df_label.Rd index 6d4764b4..363c59c4 100644 --- a/man/xportr_df_label.Rd +++ b/man/xportr_df_label.Rd @@ -13,9 +13,8 @@ xportr_df_label(.df, metadata = NULL, domain = NULL, metacore = deprecated()) details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or -\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an -attribute of \code{.df}.} +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{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass metadata now renamed with \code{metadata}} diff --git a/man/xportr_format.Rd b/man/xportr_format.Rd index b7825fc4..059fe168 100644 --- a/man/xportr_format.Rd +++ b/man/xportr_format.Rd @@ -13,9 +13,8 @@ xportr_format(.df, metadata = NULL, domain = NULL, metacore = deprecated()) 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or -\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an -attribute of \code{.df}.} +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{metacore}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} Previously used to pass metadata now renamed with \code{metadata}} diff --git a/man/xportr_label.Rd b/man/xportr_label.Rd index 87d648da..6af7ad9a 100644 --- a/man/xportr_label.Rd +++ b/man/xportr_label.Rd @@ -19,9 +19,8 @@ xportr_label( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or -\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an -attribute of \code{.df}.} +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 diff --git a/man/xportr_length.Rd b/man/xportr_length.Rd index 1d5100df..b7f3e818 100644 --- a/man/xportr_length.Rd +++ b/man/xportr_length.Rd @@ -19,9 +19,8 @@ xportr_length( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or -\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an -attribute of \code{.df}.} +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 diff --git a/man/xportr_order.Rd b/man/xportr_order.Rd index 72bda30d..de8ec9cd 100644 --- a/man/xportr_order.Rd +++ b/man/xportr_order.Rd @@ -19,9 +19,8 @@ xportr_order( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or -\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an -attribute of \code{.df}.} +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 diff --git a/man/xportr_type.Rd b/man/xportr_type.Rd index 3c67c4c7..440cf535 100644 --- a/man/xportr_type.Rd +++ b/man/xportr_type.Rd @@ -19,9 +19,8 @@ xportr_type( 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or -\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an -attribute of \code{.df}.} +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 diff --git a/man/xportr_write.Rd b/man/xportr_write.Rd index 9ecbd3a4..31c91c1e 100644 --- a/man/xportr_write.Rd +++ b/man/xportr_write.Rd @@ -23,9 +23,8 @@ used as \code{xpt} name.} 'Metadata' section for details.} \item{domain}{Appropriate CDSIC dataset name, e.g. ADAE, DM. Used to subset -the metadata object. If none is passed, then \code{\link[=xportr_domain_name]{xportr_domain_name()}} or -\code{\link[=xportr_metadata]{xportr_metadata()}} must be called before hand to set the domain as an -attribute of \code{.df}.} +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{strict_checks}{If TRUE, xpt validation will report errors and not write out the dataset. If FALSE, xpt validation will report warnings and continue diff --git a/tests/testthat/test-length.R b/tests/testthat/test-length.R index 7fa87f53..e3adce3f 100644 --- a/tests/testthat/test-length.R +++ b/tests/testthat/test-length.R @@ -14,7 +14,7 @@ test_that("xportr_length: Accepts valid domain names in metadata object", { # Test minimal call with valid data and without domain adsl %>% - xportr_domain_name("adsl") %>% + xportr_metadata(domain = "adsl") %>% xportr_length(metadata) %>% expect_silent() %>% expect_attr_width(metadata$length) diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index b3041018..fc4a3b74 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -178,7 +178,7 @@ test_that("xportr_df_label: Correctly applies label when data is piped", { df_meta <- data.frame(dataset = "df", label = "Label") df_spec_labeled_df <- df %>% - xportr_domain_name("df") %>% + xportr_metadata(domain = "df") %>% xportr_df_label(df_meta) %>% xportr_df_label(df_meta) @@ -621,7 +621,7 @@ test_that("xportr_*: Domain is kept in between calls", { ) df2 <- adsl %>% - xportr_domain_name("adsl") %>% + xportr_metadata(domain = "adsl") %>% xportr_type(metadata) df3 <- df2 %>% diff --git a/tests/testthat/test-order.R b/tests/testthat/test-order.R index 3450ba10..1c68feef 100644 --- a/tests/testthat/test-order.R +++ b/tests/testthat/test-order.R @@ -21,7 +21,7 @@ test_that("xportr_order: Variable are ordered correctly when data is piped", { ordered_df <- suppressMessages( df %>% - xportr_domain_name("df") %>% + xportr_metadata(domain = "df") %>% xportr_order(df_meta) %>% xportr_order(df_meta) ) diff --git a/tests/testthat/test-type.R b/tests/testthat/test-type.R index f53271cc..aa31baf1 100644 --- a/tests/testthat/test-type.R +++ b/tests/testthat/test-type.R @@ -155,14 +155,14 @@ test_that("xportr_type: Variables retain column attributes, besides class", { withr::local_message_sink(tempfile()) df_type_label <- adsl %>% - xportr_domain_name("adsl") %>% + xportr_metadata(domain = "adsl") %>% xportr_type(metadata) %>% xportr_label(metadata) %>% xportr_length(metadata) %>% xportr_format(metadata) df_label_type <- adsl %>% - xportr_domain_name("adsl") %>% + xportr_metadata(domain = "adsl") %>% xportr_label(metadata) %>% xportr_length(metadata) %>% xportr_format(metadata) %>% From e3a31b1e2e5dd76e87a66f702ff6807056fc307a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Tue, 16 Jan 2024 16:40:18 +0100 Subject: [PATCH 16/17] tests: add missing coverage --- tests/testthat/test-metadata.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/tests/testthat/test-metadata.R b/tests/testthat/test-metadata.R index fc4a3b74..e50a0741 100644 --- a/tests/testthat/test-metadata.R +++ b/tests/testthat/test-metadata.R @@ -607,6 +607,13 @@ test_that("xportr_metadata: Check metadata interaction with other functions", { ) }) +test_that("xportr_metadata: must throw error if both metadata and domain are null", { + expect_error( + xportr_metadata(data.frame(), metadata = NULL, domain = NULL), + "Must provide either metadata or domain argument" + ) +}) + test_that("xportr_*: Domain is kept in between calls", { # Divert all messages to tempfile, instead of printing them # note: be aware as this should only be used in tests that don't track From 601209fdb6d72725f50b53dd4d6f1aa746d1c8e1 Mon Sep 17 00:00:00 2001 From: elimillera Date: Tue, 16 Jan 2024 15:58:34 +0000 Subject: [PATCH 17/17] Update readme per comments --- README.Rmd | 12 ++++++------ README.md | 12 ++++++------ 2 files changed, 12 insertions(+), 12 deletions(-) diff --git a/README.Rmd b/README.Rmd index 1541a21b..2f422c1c 100644 --- a/README.Rmd +++ b/README.Rmd @@ -131,12 +131,12 @@ Each `xportr_` function has been written in a way to take in a part of the speci ```{r, warning = FALSE, message=FALSE, eval=TRUE} adsl %>% - xportr_domain_name("ADSL") %>% - xportr_type(var_spec, verbose = "warn") %>% - xportr_length(var_spec, verbose = "warn") %>% - xportr_label(var_spec, verbose = "warn") %>% - xportr_order(var_spec, verbose = "warn") %>% - xportr_format(var_spec) %>% + xportr_metadata(var_spec, "ADSL") %>% + xportr_type(verbose = "warn") %>% + xportr_length(verbose = "warn") %>% + xportr_label(verbose = "warn") %>% + xportr_order(verbose = "warn") %>% + xportr_format() %>% xportr_df_label(dataset_spec, "ADSL") %>% xportr_write("adsl.xpt") ``` diff --git a/README.md b/README.md index cc83fae4..bebb06c8 100644 --- a/README.md +++ b/README.md @@ -138,12 +138,12 @@ We have suppressed the warning for the sake of brevity. ``` r adsl %>% - xportr_domain_name("ADSL") %>% - xportr_type(var_spec, verbose = "warn") %>% - xportr_length(var_spec, verbose = "warn") %>% - xportr_label(var_spec, verbose = "warn") %>% - xportr_order(var_spec, verbose = "warn") %>% - xportr_format(var_spec) %>% + xportr_metadata(var_spec, "ADSL") %>% + xportr_type(verbose = "warn") %>% + xportr_length(verbose = "warn") %>% + xportr_label(verbose = "warn") %>% + xportr_order(verbose = "warn") %>% + xportr_format() %>% xportr_df_label(dataset_spec, "ADSL") %>% xportr_write("adsl.xpt") ```