Merge branch 'devel' into issue_142_dates

.github/workflows/spellcheck.yml

@@ -61,5 +61,5 @@ jobs:
       - name: Run Spellcheck 👟
         uses: insightsengineering/r-spellcheck-action@v3
         with:
-          exclude: data/*,**/*.Rd,**/*.Rmd,**/*.md,*.md
+          exclude: data/*,**/*.Rd,**/*.md,*.md
           additional_options: ""

DESCRIPTION

@@ -78,7 +78,6 @@ Suggests:
     spelling,
     usethis,
     lintr,
-    styler,
     metacore
 Config/testthat/edition: 3
 VignetteBuilder: knitr

NEWS.md

@@ -10,6 +10,7 @@
 * `xpt_validate` updated to accept iso8601 date formats. (#76)
 * Added function `xportr_metadata()` to explicitly set metadata at the start of a pipeline (#44)
 * Metadata order columns are now coerced to numeric by default in `xportr_order()` to prevent character sorting (#149)
+* Message is shown on `xportr_*` functions when the metadata being used has multiple variables with the same name in the same domain (#128)
 
 ## Documentation
 
@@ -18,7 +19,9 @@
 ## Deprecation and Breaking Changes
 
 * The `metacore` argument has been renamed to `metadata` in the following six xportr functions: `xportr_df_label()`, `xportr_format()`, `xportr_label()`, `xportr_length()`, `xportr_order()`, and `xportr_type()`. Please update your code to use the new `metadata` argument in place of `metacore`.
+
 # xportr 0.2.0
+
 * Added a new validation test that errors when users pass invalid formats (#60 #64). Thanks to @zdz2101!
 * Fixed an issue where xportr_format could pass invalid formats to haven::write_xpt.
 

R/format.R

@@ -65,13 +65,13 @@ xportr_format <- function(.df,
     metadata <- metadata %>%
       dplyr::filter(!!sym(domain_name) == domain & !is.na(!!sym(format_name)))
   } else {
-    metadata <- metadata
+    # Common check for multiple variables name
+    check_multiple_var_specs(metadata, variable_name)
   }
 
   filtered_metadata <- metadata %>%
     filter(!!sym(variable_name) %in% names(.df))
 
-
   format <- filtered_metadata %>%
     select(!!sym(format_name)) %>%
     unlist() %>%

R/label.R

@@ -67,7 +67,8 @@ xportr_label <- function(.df,
     metadata <- metadata %>%
       dplyr::filter(!!sym(domain_name) == domain)
   } else {
-    metadata <- metadata
+    # Common check for multiple variables name
+    check_multiple_var_specs(metadata, variable_name)
   }
 
 

R/length.R

@@ -65,7 +65,8 @@ xportr_length <- function(.df,
     metadata <- metadata %>%
       filter(!!sym(domain_name) == domain)
   } else {
-    metadata <- metadata
+    # Common check for multiple variables name
+    check_multiple_var_specs(metadata, variable_name)
   }
 
 

R/order.R

@@ -64,6 +64,8 @@ xportr_order <- function(.df,
   } else {
     metadata <- metadata %>%
       dplyr::filter(!is.na(!!sym(order_name)))
+    # Common check for multiple variables name
+    check_multiple_var_specs(metadata, variable_name)
   }
 
   # Grabs vars from Spec and inputted dataset

R/support-test.R

@@ -106,3 +106,71 @@ minimal_metadata <- function(dataset = FALSE,
 cli_theme_tests <- list(
   h2 = list(`margin-top` = 0, `margin-bottom` = 0)
 )
+
+#' Test if multiple vars in spec will result in warning message
+#' @noRd
+#' @examples
+#' multiple_vars_in_spec_helper(xportr_order)
+multiple_vars_in_spec_helper <- function(FUN) {
+  adsl <- minimal_table(30)
+  metadata <- minimal_metadata(
+    dataset = TRUE,
+    order = TRUE,
+    length = TRUE,
+    type = TRUE,
+    format = TRUE,
+    label = TRUE,
+    var_names = colnames(adsl)
+  )
+
+  metadata <- metadata %>%
+    mutate(dataset = "adtte") %>%
+    dplyr::bind_rows(metadata) %>%
+    dplyr::rename(Dataset = "dataset")
+
+  # Setup temporary options with active verbose and Remove empty lines in cli theme
+  withr::local_options(list(cli.user_theme = cli_theme_tests, xportr.length_verbose = "message"))
+  app <- cli::start_app(output = "message", .auto_close = FALSE)
+  withr::defer(cli::stop_app(app))
+
+  adsl %>%
+    FUN(metadata) %>%
+    testthat::expect_message("There are multiple specs for the same variable name")
+}
+
+#' Test if multiple vars in spec with appropriate
+#' @noRd
+#' @examples
+#' multiple_vars_in_spec_helper2(xportr_order)
+#'
+multiple_vars_in_spec_helper2 <- function(FUN) {
+  adsl <- minimal_table(30)
+  metadata <- minimal_metadata(
+    dataset = TRUE,
+    order = TRUE,
+    length = TRUE,
+    type = TRUE,
+    format = TRUE,
+    label = TRUE,
+    var_names = colnames(adsl)
+  )
+
+  metadata <- metadata %>%
+    mutate(dataset = "adtte") %>%
+    dplyr::bind_rows(metadata) %>%
+    dplyr::rename(Dataset = "dataset")
+
+  # Setup temporary options with active verbose and Remove empty lines in cli theme
+  withr::local_options(list(
+    cli.user_theme = cli_theme_tests,
+    xportr.length_verbose = "message",
+    xportr.domain_name = "Dataset"
+  ))
+
+  app <- cli::start_app(output = "message", .auto_close = FALSE)
+  withr::defer(cli::stop_app(app))
+
+  adsl %>%
+    FUN(metadata) %>%
+    testthat::expect_no_message(message = "There are multiple specs for the same variable name")
+}

R/type.R

@@ -79,6 +79,9 @@ xportr_type <- function(.df,
   metacore <- metadata %>%
     select(!!sym(variable_name), !!sym(type_name), !!sym(format_name))
 
+  # Common check for multiple variables name
+  check_multiple_var_specs(metadata, variable_name)
+
   # Current class of table variables
   table_cols_types <- map(.df, first_class)
 

R/utils-xportr.R

@@ -345,3 +345,30 @@ first_class <- function(x) {
     class_
   }
 }
+
+#' Check for multiple var name specs
+#'
+#' Detects cases where the domain name is not correctly defined and the full
+#' specification is used.
+#' This can lead to multiple warnings for the same variable. For instance, in
+#' the FDA pilot 3 submission the column has variable name with uppercase
+#' `Variable`, where the defaults for xportr is for lowercase `variable`.
+#'
+#' @param metadata  A data frame containing variable level metadata.
+#' @param variable_name string with `getOption('xportr.variable_name')`
+#' @noRd
+check_multiple_var_specs <- function(
+    metadata,
+    variable_name = getOption("xportr.variable_name")) {
+  variable_len <- pluck(metadata, variable_name) %||% c()
+  if (NROW(variable_len) != NROW(unique(variable_len))) {
+    cli_alert_info(
+      glue(
+        .sep = " ",
+        "There are multiple specs for the same variable name.",
+        "Check the metadata and variable name option",
+        "`getOption('xportr.variable_name')`"
+      )
+    )
+  }
+}

inst/WORDLIST

@@ -1,92 +1,34 @@
-ADaM
 ADAE
-ADCM
-ADDV
-ADEC
-ADEG
-ADEX
-ADLB
-ADMH
 ADSL
-ADVS
-AE
-analytics
-ATC
+ADaM
 Atorus
-Bazett
-Bazett's
-BDS
-Biologics
-BMI
-Biologics
 CDISC
-Changelog
-censorings
-codebase
-CRF
-CQ
-cyclomatic
-datepart
-datetime
-developers’
-dtc
-DTC
-DuBois
-durations
-EMA
-FACM
-Fridericia
-Fridericia's
-Fujimoto
-functions’
-funder
-Gehan
-GitHub
-GlaxoSmithKline
-groupwise
+CDSIC
+DM
 GSK
-Guillain
-GUILLAIN
-GxP
-Hoffmann
-https
-IG
-knitr
+JPT
 Lifecycle
-linter
-LLC
-MedDRA
-metacore
-metatools
-mmHg
-modularized
-Mosteller
-msec
-OCCDS
-optionality
+ORCID
 Pharma
-pharmaverse
-PHUSE
-quosure
-quosures
-README
-RStudio
-Sagie
-Sagie's
+Repostiory
+SASformat
+SASlength
+SAStype
 SDTM
-SDQ
-SMQ
-SMQs
-stylesheet
-summarization
-Takahira
-tidyverse
-timepart
-timepoint
-ungrouped
-unmerged
+Vignesh
+XPT
+bootswatch
+chr
+cli
+df
+magrittr
+metacore
+metatdata
+pre
+sas
 validator
-validator's
-xpt
+validators
+visability
 xportr's
-YAML
+xportr’s
+xpt

tests/testthat/test-format.R

@@ -9,3 +9,13 @@ test_that("xportr_format: error when metadata is not set", {
     regexp = "Metadata must be set with `metadata` or `xportr_metadata\\(\\)`"
   )
 })
+
+test_that("xportr_format: Gets warning when metadata has multiple rows with same variable", {
+  # This test uses the (2) functions below to reduce code duplication
+  # All `expect_*` are being called inside the functions
+  #
+  # Checks that message appears when xportr.domain_name is invalid
+  multiple_vars_in_spec_helper(xportr_format)
+  # Checks that message doesn't appear when xportr.domain_name is valid
+  multiple_vars_in_spec_helper2(xportr_format)
+})

tests/testthat/test-label.R

@@ -11,3 +11,13 @@ test_that("xportr_label: error when metadata is not set", {
     regexp = "Metadata must be set with `metadata` or `xportr_metadata\\(\\)`"
   )
 })
+
+test_that("xportr_label: Gets warning when metadata has multiple rows with same variable", {
+  # This test uses the (2) functions below to reduce code duplication
+  # All `expect_*` are being called inside the functions
+  #
+  # Checks that message appears when xportr.domain_name is invalid
+  multiple_vars_in_spec_helper(xportr_label)
+  # Checks that message doesn't appear when xportr.domain_name is valid
+  multiple_vars_in_spec_helper2(xportr_label)
+})

tests/testthat/test-length.R

@@ -221,3 +221,13 @@ test_that("xportr_length: error when metadata is not set", {
     regexp = "Metadata must be set with `metadata` or `xportr_metadata\\(\\)`"
   )
 })
+
+test_that("xportr_length: Gets warning when metadata has multiple rows with same variable", {
+  # This test uses the (2) functions below to reduce code duplication
+  # All `expect_*` are being called inside the functions
+  #
+  # Checks that message appears when xportr.domain_name is invalid
+  multiple_vars_in_spec_helper(xportr_length)
+  # Checks that message doesn't appear when xportr.domain_name is valid
+  multiple_vars_in_spec_helper2(xportr_length)
+})

tests/testthat/test-order.R

@@ -150,3 +150,20 @@ test_that("xportr_order: Metadata order columns are coersed to numeric", {
 
   expect_equal(names(ordered_df), df_meta$variable)
 })
+
+test_that("xportr_order: Gets warning when metadata has multiple rows with same variable", {
+  # This test uses the (2) functions below to reduce code duplication
+  # All `expect_*` are being called inside the functions
+  #
+  # Checks that message appears when xportr.domain_name is invalid
+  multiple_vars_in_spec_helper(xportr_order) %>%
+    # expect_message() are being caught to provide clean test without output
+    expect_message("All variables in specification file are in dataset") %>%
+    expect_message("All variables in dataset are ordered")
+
+  # Checks that message doesn't appear when xportr.domain_name is valid
+  multiple_vars_in_spec_helper2(xportr_order) %>%
+    # expect_message() are being caught to provide clean test without output
+    expect_message("All variables in specification file are in dataset") %>%
+    expect_message("All variables in dataset are ordered")
+})

tests/testthat/test-type.R

@@ -227,5 +227,15 @@ test_that("xportr_type: date variables are not converted to numeric", {
   attr(adsl_original, "_xportr.df_arg_") <- "adsl_original"
 
   expect_equal(adsl_original, adsl_xpt2)
+
+})
 
+test_that("xportr_type: Gets warning when metadata has multiple rows with same variable", {
+  # This test uses the (2) functions below to reduce code duplication
+  # All `expect_*` are being called inside the functions
+  #
+  # Checks that message appears when xportr.domain_name is invalid
+  multiple_vars_in_spec_helper(xportr_type)
+  # Checks that message doesn't appear when xportr.domain_name is valid
+  multiple_vars_in_spec_helper2(xportr_type)
 })