diff --git a/R/compare_ard_helpers.R b/R/compare_ard_helpers.R index 38be66c70..9ddf756f9 100644 --- a/R/compare_ard_helpers.R +++ b/R/compare_ard_helpers.R @@ -8,8 +8,13 @@ #' @keywords internal #' @noRd .process_keys_arg <- function(x, y, keys) { - keys_x <- cards_select({{ keys }}, data = x) - keys_y <- cards_select({{ keys }}, data = y) + # defuse the selection once, so that it is evaluated against each ARD in turn. + # evaluating `{{ keys }}` twice resolves the selection against `x` and then + # re-uses those column positions on `y`. + keys <- enquo(keys) + + keys_x <- cards_select(expr = keys, data = x, arg_name = "keys") + keys_y <- cards_select(expr = keys, data = y, arg_name = "keys") .check_not_empty(keys_x) @@ -36,8 +41,11 @@ #' @keywords internal #' @noRd .process_compare_arg <- function(x, y, columns) { - columns_x <- cards_select({{ columns }}, data = x) - columns_y <- cards_select({{ columns }}, data = y) + # defused for the same reason as `keys` above + columns <- enquo(columns) + + columns_x <- cards_select(expr = columns, data = x, arg_name = "columns") + columns_y <- cards_select(expr = columns, data = y, arg_name = "columns") .check_not_empty(columns_x) if (!setequal(columns_x, columns_y)) { diff --git a/tests/testthat/test-compare_ard.R b/tests/testthat/test-compare_ard.R index 893f7d554..644ddb39d 100644 --- a/tests/testthat/test-compare_ard.R +++ b/tests/testthat/test-compare_ard.R @@ -463,3 +463,37 @@ test_that("compare_ard detects differences in complex stat values from ard_ident result <- compare_ard(ard_base, ard_modified) expect_false(is_ard_equal(result)) }) + +test_that("compare_ard() resolves keys and columns against each ARD", { + ard <- ard_tabulate(ADSL, variables = SEX) + + # the same ARD with its columns in a different order, as it may be returned + # from a source other than cards + ard_reordered <- dplyr::relocate(ard, "stat_label", .before = 1L) + + expect_silent(result <- compare_ard(ard, ard_reordered)) + + expect_equal(result$keys, c("variable", "variable_level", "stat_name")) + expect_equal(result$columns, c("stat_label", "stat")) + expect_true(is_ard_equal(result)) +}) + +test_that("compare_ard() accepts selectors combined with column names", { + # the same summary under two names for the treatment variable + ard_arm <- ard_summary(ADSL, by = ARM, variables = AGE) + ard_trt01a <- ard_summary(ADSL, by = TRT01A, variables = AGE) + + expect_silent( + result <- + compare_ard( + ard_arm, + ard_trt01a, + keys = c(all_ard_groups("levels"), all_ard_variables(), "stat_name"), + columns = c(any_of("stat_label"), "stat") + ) + ) + + expect_equal(result$keys, c("group1_level", "variable", "stat_name")) + expect_equal(result$columns, c("stat_label", "stat")) + expect_true(is_ard_equal(result)) +})