diff --git a/R/supp.R b/R/supp.R index 98017a3..a78687d 100644 --- a/R/supp.R +++ b/R/supp.R @@ -278,20 +278,22 @@ combine_supp_join <- function(dataset, supp) { # Add message for when there are rows in the supp that didn't get merged if (nrow(missing) > 0) { - missing_txt <- - capture.output( - missing %>% - select(USUBJID, all_of(current_idvar)) %>% - print() - ) %>% - paste0(collapse = "\n") - stop( - paste0( - "Not all rows of the Supp were merged. The following rows are missing:\n", - missing_txt - ), - call. = FALSE - ) + missing_display <- missing %>% + dplyr::transmute( + USUBJID, + !!current_idvar := IDVARVAL + ) + msg <- "Not all rows of SUPP were merged." + cli::cli_alert_warning(msg) + + cli::cli_text("") + cli::cli_text("The following rows are missing:") + cli::cli_rule() + + print(missing_display) + + cli::cli_rule() + warning(msg, call. = FALSE) } # join the data diff --git a/man/add_labels.Rd b/man/add_labels.Rd index b4149e6..573637f 100644 --- a/man/add_labels.Rd +++ b/man/add_labels.Rd @@ -19,9 +19,9 @@ This function allows a user to apply several labels to a dataframe at once. } \examples{ add_labels( - mtcars, - mpg = "Miles Per Gallon", - cyl = "Cylinders" - ) + mtcars, + mpg = "Miles Per Gallon", + cyl = "Cylinders" +) } diff --git a/man/add_variables.Rd b/man/add_variables.Rd index f14b202..8bbcf1d 100644 --- a/man/add_variables.Rd +++ b/man/add_variables.Rd @@ -35,6 +35,6 @@ library(dplyr) load(metacore_example("pilot_ADaM.rda")) spec <- metacore \%>\% select_dataset("ADSL") data <- read_xpt(metatools_example("adsl.xpt")) \%>\% - select(-TRTSDT, -TRT01P, -TRT01PN) + select(-TRTSDT, -TRT01P, -TRT01PN) add_variables(data, spec) } diff --git a/man/combine_supp.Rd b/man/combine_supp.Rd index 8c37758..ecd17eb 100644 --- a/man/combine_supp.Rd +++ b/man/combine_supp.Rd @@ -20,5 +20,5 @@ Combine the Domain and Supplemental Qualifier \examples{ library(safetyData) library(tibble) -combine_supp(sdtm_ae, sdtm_suppae) \%>\% as_tibble() +combine_supp(sdtm_ae, sdtm_suppae) \%>\% as_tibble() } diff --git a/man/create_var_from_codelist.Rd b/man/create_var_from_codelist.Rd index 446772b..7e1c03a 100644 --- a/man/create_var_from_codelist.Rd +++ b/man/create_var_from_codelist.Rd @@ -69,28 +69,30 @@ create_var_from_codelist(data, dm_spec, VAR1, SEX, decode_to_code = FALSE) # Example providing a custom codelist # This example also reverses the direction of translation -load(metacore_example('pilot_ADaM.rda')) +load(metacore_example("pilot_ADaM.rda")) adlb_spec <- select_dataset(metacore, "ADLBC", quiet = TRUE) adlb <- tibble(PARAMCD = c("ALB", "ALP", "ALT", "AST", "BILI", "BUN")) create_var_from_codelist( - adlb, - adlb_spec, - PARAMCD, - PARAM, - codelist = get_control_term(adlb_spec, PARAMCD), - decode_to_code = FALSE, - strict = FALSE) + adlb, + adlb_spec, + PARAMCD, + PARAM, + codelist = get_control_term(adlb_spec, PARAMCD), + decode_to_code = FALSE, + strict = FALSE +) \dontrun{ # Example expecting warning where `strict` == `TRUE` adlb <- tibble(PARAMCD = c("ALB", "ALP", "ALT", "AST", "BILI", "BUN", "DUMMY1", "DUMMY2")) create_var_from_codelist( - adlb, - adlb_spec, - PARAMCD, - PARAM, - codelist = get_control_term(adlb_spec, PARAMCD), - decode_to_code = FALSE, - strict = TRUE) + adlb, + adlb_spec, + PARAMCD, + PARAM, + codelist = get_control_term(adlb_spec, PARAMCD), + decode_to_code = FALSE, + strict = TRUE +) } } diff --git a/man/set_variable_labels.Rd b/man/set_variable_labels.Rd index 833bd7e..06d396a 100644 --- a/man/set_variable_labels.Rd +++ b/man/set_variable_labels.Rd @@ -41,9 +41,9 @@ labels to a data frame. \examples{ mc <- metacore::spec_to_metacore( - metacore::metacore_example("p21_mock.xlsx"), - quiet=TRUE - ) + metacore::metacore_example("p21_mock.xlsx"), + quiet = TRUE +) dm <- haven::read_xpt(metatools_example("dm.xpt")) set_variable_labels(dm, mc, dataset_name = "DM") } diff --git a/tests/testthat/test-supp.R b/tests/testthat/test-supp.R index 3a6894c..7a36b87 100644 --- a/tests/testthat/test-supp.R +++ b/tests/testthat/test-supp.R @@ -220,14 +220,18 @@ test_that("combine_supp works with without QEVAL", { expect_silent(combine_supp(pharmaversesdtm::tr_onco, pharmaversesdtm::supptr_onco)) }) -test_that("supp data that does not match the main data will raise a warning", { +test_that("supp data that does not match the main data will raise a warning but return a dataset", { sdtm_suppae_extra <- safetyData::sdtm_suppae sdtm_suppae_extra$IDVARVAL[1] <- 99 - expect_error( - combine_supp(safetyData::sdtm_ae, sdtm_suppae_extra) + + expect_warning( + out <- combine_supp(safetyData::sdtm_ae, sdtm_suppae_extra), + "Not all rows of SUPP were merged" ) + expect_s3_class(out, "data.frame") }) + test_that("Floating point correction works", { fp1 <- 0.1 + 0.1 + 0.1 + 0.1 + 0.1 + 0.1 + 0.1 + 0.1 + 0.1 + 0.1 sdtm_ae_fp <- safetyData::sdtm_ae %>% @@ -296,6 +300,105 @@ test_that("combine_supp() does not create an IDVARVAL column (#78)", { expect_false("IDVARVAL" %in% names(noidvarval)) }) +test_that("combine_supp: all SUPP rows merge cleanly (#98)", { + pc <- tibble::tibble( + STUDYID = "STUDY123", + DOMAIN = "PC", + USUBJID = c("01-001", "01-002", "01-003"), + PCSEQ = c(1, 2, 3), + PCTESTCD = "CONC", + PCTEST = "Concentration", + PCORRES = c("5.1", "7.3", "4.8"), + PCORRESU = "ng/mL", + PCSTRESC = c("5.1", "7.3", "4.8"), + PCSTRESN = c(5.1, 7.3, 4.8), + PCSTRESU = "ng/mL", + PCPOS = "PLASMA", + PCDTC = c("2025-07-15T08:00", "2025-07-15T09:00", "2025-07-15T10:00"), + VISITNUM = 1, + VISIT = "Visit 1", + ARM = "Drug A", + ACTARM = "Drug A" + ) + + supppc <- tibble::tibble( + STUDYID = "STUDY123", + RDOMAIN = "PC", + USUBJID = c("01-001", "01-002", "01-003"), + IDVAR = "PCSEQ", + IDVARVAL = c(1, 2, 3), + QNAM = "PCREASND", + QLABEL = "Reason Not Done", + QVAL = c("NA", "NA", "NA"), + QORIG = "SPONSOR", + QEVAL = "INVESTIGATOR" + ) + expect_no_warning( + out <- combine_supp(pc, supppc) + ) + + expect_s3_class(out, "data.frame") + expect_equal(nrow(out), nrow(pc)) + expect_true("PCREASND" %in% names(out)) + expect_equal( + unname(as.character(out$PCREASND)), + c("NA", "NA", "NA") + ) +}) + +test_that("combine_supp: extra SUPP rows that do not match core raise a warning but return a dataset(#98)", { + pc <- tibble::tibble( + STUDYID = "STUDY123", + DOMAIN = "PC", + USUBJID = c("01-001", "01-002", "01-003"), + PCSEQ = c(1, 2, 3), + PCTESTCD = "CONC", + PCTEST = "Concentration", + PCORRES = c("5.1", "7.3", "4.8"), + PCORRESU = "ng/mL", + PCSTRESC = c("5.1", "7.3", "4.8"), + PCSTRESN = c(5.1, 7.3, 4.8), + PCSTRESU = "ng/mL", + PCPOS = "PLASMA", + PCDTC = c("2025-07-15T08:00", "2025-07-15T09:00", "2025-07-15T10:00"), + VISITNUM = 1, + VISIT = "Visit 1", + ARM = "Drug A", + ACTARM = "Drug A" + ) + + supppc <- tibble::tibble( + STUDYID = "STUDY123", + RDOMAIN = "PC", + USUBJID = c("01-001", "01-002", "01-003"), + IDVAR = "PCSEQ", + IDVARVAL = c(1, 2, 3), + QNAM = "PCREASND", + QLABEL = "Reason Not Done", + QVAL = c("NA", "NA", "NA"), + QORIG = "SPONSOR", + QEVAL = "INVESTIGATOR" + ) + supppc_extra <- dplyr::bind_rows( + supppc, + dplyr::mutate(supppc[3, ], IDVARVAL = 99), + dplyr::mutate(supppc[3, ], IDVARVAL = 101) + ) + + expect_warning( + out <- combine_supp(pc, supppc_extra), + "Not all rows of SUPP were merged" + ) + expect_s3_class(out, "data.frame") + expect_equal(nrow(out), nrow(pc)) + expect_true("PCREASND" %in% names(out)) + expect_equal( + unname(as.character(out$PCREASND)), + c("NA", "NA", "NA") + ) + expect_false(any(out$PCSEQ %in% c(99, 101))) +}) + test_that("build_qnam verbose parameter", { # Create simple test data with a column that will be used as QNAM ae <- safetyData::sdtm_ae %>%