test_that("compare_ard identifies stat mismatches", { ard_base <- ard_summary(ADSL, variables = AGE) ard_modified <- ard_summary(dplyr::mutate(ADSL, AGE = AGE + 1), variables = AGE) expect_silent( result <- compare_ard(ard_base, ard_modified) ) expect_s3_class(result, "compare_ard") expect_true("stat" %in% names(result$comparison)) expect_gt(nrow(result$comparison$stat), 0L) mean_row <- result$comparison$stat |> dplyr::filter(stat_name == "mean") expect_equal(nrow(mean_row), 1L) expect_false(identical(mean_row$stat.x[[1]], mean_row$stat.y[[1]])) }) test_that("compare_ard returns empty data frames when ARDs are identical", { ard <- ard_tabulate(ADSL, variables = AGEGR1) expect_silent(result <- compare_ard(ard, ard)) expect_s3_class(result, "compare_ard") expect_equal(nrow(result$rows_in_x_not_y), 0L) expect_equal(nrow(result$rows_in_y_not_x), 0L) expect_true(all(vapply(result$comparison, nrow, integer(1)) == 0L)) }) test_that("compare_ard validates duplicates in keys", { ard <- ard_tabulate(ADSL, variables = AGEGR1) ard_dup <- dplyr::bind_rows(ard, ard) expect_error( suppressMessages(compare_ard(ard_dup, ard)), "Duplicate key combinations" ) }) test_that("compare_ard supports custom keys", { ard <- ard_summary(ADSL, variables = AGE) ard_modified <- ard_summary(dplyr::mutate(ADSL, AGE = AGE + 1), variables = AGE) expect_silent( result <- compare_ard(ard, ard_modified, keys = c("variable", "stat_name")) ) expect_gt(nrow(result$comparison$stat), 0L) expect_true(all(c("variable", "stat_name") %in% names(result$comparison$stat))) }) test_that("compare_ard supports custom compare columns", { ard <- ard_summary(ADSL, variables = AGE) # Modify stat_label ard_modified <- ard ard_modified$stat_label[1] <- "Modified Label" expect_silent( result <- compare_ard(ard, ard_modified, columns = "stat_label") ) expect_true("stat_label" %in% names(result$comparison)) expect_equal(nrow(result$comparison$stat_label), 1L) }) test_that("compare_ard handles ARDs with different grouping structures", { ard_with_group <- ard_summary(ADSL, variables = AGE, by = ARM) |> dplyr::filter(group1_level == "Placebo") ard_without_group <- ard_summary(ADSL, variables = AGE) # Should use intersection of keys expect_error( compare_ard(ard_with_group, ard_without_group), "do not match" ) }) test_that("compare_ard detects rows in x not in y", { ard_base <- ard_summary(ADSL, variables = AGE) ard_subset <- ard_base |> dplyr::filter(stat_name != "mean") expect_silent(result <- compare_ard(ard_base, ard_subset)) expect_equal(nrow(result$rows_in_x_not_y), 1L) expect_equal(result$rows_in_x_not_y$stat_name, "mean") expect_equal(nrow(result$rows_in_y_not_x), 0L) }) test_that("compare_ard detects rows in y not in x", { ard_base <- ard_summary(ADSL, variables = AGE) ard_subset <- ard_base |> dplyr::filter(stat_name != "mean") expect_silent(result <- compare_ard(ard_subset, ard_base)) expect_equal(nrow(result$rows_in_x_not_y), 0L) expect_equal(nrow(result$rows_in_y_not_x), 1L) expect_equal(result$rows_in_y_not_x$stat_name, "mean") }) test_that("compare_ard errors when keys are empty", { ard1 <- ard_summary(ADSL, variables = AGE) |> dplyr::select(-variable, -stat_name) ard2 <- ard_summary(ADSL, variables = BMIBL) |> dplyr::select(-variable, -stat_name) # Error comes from cards_select, not our check expect_error( compare_ard(ard1, ard2, keys = "nonexistent_col") ) }) test_that("compare_ard errors when compare columns are empty", { ard <- ard_summary(ADSL, variables = AGE) # Error comes from cards_select, not our check expect_error( compare_ard(ard, ard, columns = "nonexistent_col") ) }) test_that("compare_ard handles missing columns gracefully", { ard <- ard_summary(ADSL, variables = AGE) ard_no_stat_fmt <- ard |> dplyr::select(-any_of("stat_fmt")) # stat_fmt not in either, but stat and stat_label are expect_silent( result <- compare_ard(ard_no_stat_fmt, ard_no_stat_fmt, columns = any_of(c("stat", "stat_label"))) ) expect_true(all(vapply(result$comparison, nrow, integer(1)) == 0L)) }) test_that("compare_ard works with by variables", { ard1 <- ard_tabulate(ADSL, by = ARM, variables = AGEGR1) ard2 <- ard1 # Modify one value ard2$stat[1] <- list(999L) expect_silent(result <- compare_ard(ard1, ard2)) expect_equal(nrow(result$comparison$stat), 1L) expect_true("group1" %in% names(result$comparison$stat)) expect_true("group1_level" %in% names(result$comparison$stat)) }) test_that("compare_ard validates input classes", { expect_error(compare_ard(data.frame(), ard_summary(ADSL, variables = AGE)), class = "check_class") expect_error(compare_ard(ard_summary(ADSL, variables = AGE), data.frame()), class = "check_class") }) test_that("compare_ard returns compare_ard class", { ard <- ard_summary(ADSL, variables = AGE) expect_silent(result <- compare_ard(ard, ard)) expect_s3_class(result, "compare_ard") expect_true("rows_in_x_not_y" %in% names(result)) expect_true("rows_in_y_not_x" %in% names(result)) expect_true("comparison" %in% names(result)) expect_true(is.list(result$comparison)) }) test_that("check_ard_equal() returns error with unequal ARDs", { expect_error( compare_ard( ard_summary(ADSL[1:10, ], variables = AGE), ard_summary(ADSL[1:20, ], variables = AGE) ) |> check_ard_equal(), "ARDs are not equal" ) }) # --- is_ard_equal() ----------------------------------------------------------- test_that("is_ard_equal() returns TRUE for identical ARDs", { ard <- ard_summary(ADSL, variables = AGE) result <- compare_ard(ard, ard) expect_true(is_ard_equal(result)) }) test_that("is_ard_equal() returns FALSE when rows differ", { ard_base <- ard_summary(ADSL, variables = AGE) ard_subset <- ard_base |> dplyr::filter(stat_name != "mean") result <- compare_ard(ard_base, ard_subset) expect_false(is_ard_equal(result)) }) test_that("is_ard_equal() returns FALSE when stat values differ", { ard_base <- ard_summary(ADSL, variables = AGE) ard_modified <- ard_summary(dplyr::mutate(ADSL, AGE = AGE + 1), variables = AGE) result <- compare_ard(ard_base, ard_modified) expect_false(is_ard_equal(result)) }) test_that("is_ard_equal() errors on wrong input class", { expect_error(is_ard_equal(list()), class = "check_class") expect_error(is_ard_equal(data.frame()), class = "check_class") }) # --- check_ard_equal() -------------------------------------------------------- test_that("check_ard_equal() returns invisible TRUE for equal ARDs", { ard <- ard_summary(ADSL, variables = AGE) result <- compare_ard(ard, ard) expect_true(check_ard_equal(result)) expect_invisible(check_ard_equal(result)) }) # --- tolerance parameter ------------------------------------------------------ test_that("compare_ard(tolerance) controls numeric comparison sensitivity", { ard_base <- ard_summary(ADSL, variables = AGE) ard_modified <- ard_base # add a tiny perturbation to the mean stat mean_idx <- which(ard_modified$stat_name == "mean") original_val <- ard_modified$stat[[mean_idx]] ard_modified$stat[[mean_idx]] <- original_val + 1e-10 # with default tolerance, the tiny difference is ignored result_default <- compare_ard(ard_base, ard_modified) mean_diffs <- result_default$comparison$stat |> dplyr::filter(stat_name == "mean") expect_equal(nrow(mean_diffs), 0L) # with very strict tolerance, the difference is detected result_strict <- compare_ard(ard_base, ard_modified, tolerance = 0) mean_diffs_strict <- result_strict$comparison$stat |> dplyr::filter(stat_name == "mean") expect_equal(nrow(mean_diffs_strict), 1L) }) # --- check.attributes parameter ---------------------------------------------- test_that("compare_ard(check.attributes) controls attribute comparison", { ard_base <- ard_summary(ADSL, variables = AGE) ard_modified <- ard_base # add a name attribute to one stat value mean_idx <- which(ard_modified$stat_name == "mean") val <- ard_modified$stat[[mean_idx]] ard_modified$stat[[mean_idx]] <- stats::setNames(val, "mean_val") # with check.attributes = TRUE (default), the attribute difference is detected result_attrs <- compare_ard(ard_base, ard_modified, check.attributes = TRUE) mean_diffs <- result_attrs$comparison$stat |> dplyr::filter(stat_name == "mean") expect_equal(nrow(mean_diffs), 1L) # with check.attributes = FALSE, the attribute difference is ignored result_no_attrs <- compare_ard(ard_base, ard_modified, check.attributes = FALSE) mean_diffs_no <- result_no_attrs$comparison$stat |> dplyr::filter(stat_name == "mean") expect_equal(nrow(mean_diffs_no), 0L) }) # --- duplicate keys in y ----------------------------------------------------- test_that("compare_ard validates duplicates in y", { ard <- ard_tabulate(ADSL, variables = AGEGR1) ard_dup <- dplyr::bind_rows(ard, ard) expect_error( suppressMessages(compare_ard(ard, ard_dup)), "Duplicate key combinations" ) }) # --- columns mismatch error --------------------------------------------------- test_that("compare_ard errors when columns argument selects mismatched columns", { ard1 <- ard_summary(ADSL, variables = AGE) ard2 <- ard1 |> dplyr::select(-stat_label) # stat_label exists in ard1 but not ard2, so cards_select errors expect_error( compare_ard(ard1, ard2, columns = "stat_label") ) }) # --- print.compare_ard() ----------------------------------------------------- test_that("print.compare_ard() works for equal ARDs", { ard <- ard_summary(ADSL, variables = AGE) result <- compare_ard(ard, ard) # print method uses cli messaging; capture both stdout and messages expect_message(print(result), "No differences") }) test_that("print.compare_ard() works for ARDs with differences", { ard_base <- ard_summary(ADSL, variables = AGE) ard_modified <- ard_summary(dplyr::mutate(ADSL, AGE = AGE + 1), variables = AGE) result <- compare_ard(ard_base, ard_modified) expect_message(print(result), "Differences found") }) test_that("print.compare_ard() works for ARDs with mismatched rows", { ard_base <- ard_summary(ADSL, variables = AGE) ard_subset <- ard_base |> dplyr::filter(stat_name != "mean") result <- compare_ard(ard_base, ard_subset) expect_message(print(result), "do not appear") }) # --- result metadata ---------------------------------------------------------- test_that("compare_ard() stores actual keys in result when custom keys supplied", { ard <- ard_summary(ADSL, variables = AGE) result <- compare_ard(ard, ard, keys = c("variable", "stat_name")) expect_equal(result$keys, c("variable", "stat_name")) expect_true(is_ard_equal(result)) }) test_that("compare_ard() default keys contain expected column names", { ard <- ard_summary(ADSL, variables = AGE) result <- compare_ard(ard, ard) expect_true("stat_name" %in% result$keys) expect_true("variable" %in% result$keys) }) test_that("compare_ard() stores actual columns in result when custom columns supplied", { ard_base <- ard_summary(ADSL, variables = AGE) ard_modified <- ard_base ard_modified$stat_label[1] <- "Changed" result <- compare_ard(ard_base, ard_modified, columns = "stat_label") expect_equal(result$columns, "stat_label") expect_gt(nrow(result$comparison$stat_label), 0L) }) test_that("compare_ard() duplicate key error message contains formatted key values", { ard <- ard_tabulate(ADSL, variables = AGEGR1) ard_dup <- dplyr::bind_rows(ard, ard) expect_error( suppressMessages(compare_ard(ard, ard_dup)), "variable" ) }) # --- result structure --------------------------------------------------------- test_that("compare_ard result contains keys and columns metadata", { ard <- ard_summary(ADSL, variables = AGE) result <- compare_ard(ard, ard) expect_true("keys" %in% names(result)) expect_true("columns" %in% names(result)) expect_type(result$keys, "character") expect_type(result$columns, "character") expect_true("stat_name" %in% result$keys) expect_true("stat" %in% result$columns) }) # --- comparison difference column --------------------------------------------- test_that("compare_ard comparison includes difference descriptions", { ard_base <- ard_summary(ADSL, variables = AGE) ard_modified <- ard_summary(dplyr::mutate(ADSL, AGE = AGE + 1), variables = AGE) result <- compare_ard(ard_base, ard_modified) # the difference column should contain all.equal() output strings expect_true("difference" %in% names(result$comparison$stat)) expect_type(result$comparison$stat$difference, "list") expect_true(all(vapply(result$comparison$stat$difference, is.character, logical(1)))) }) # --- multiple comparison columns at once -------------------------------------- test_that("compare_ard compares multiple columns simultaneously", { ard_base <- ard_summary(ADSL, variables = AGE) ard_modified <- ard_base ard_modified$stat[1] <- list(999L) ard_modified$stat_label[1] <- "Changed" result <- compare_ard(ard_base, ard_modified, columns = any_of(c("stat", "stat_label"))) expect_true("stat" %in% names(result$comparison)) expect_true("stat_label" %in% names(result$comparison)) expect_gt(nrow(result$comparison$stat), 0L) expect_gt(nrow(result$comparison$stat_label), 0L) }) # --- rows in both x and y not in other ---------------------------------------- test_that("compare_ard detects rows missing from both sides", { ard_base <- ard_summary(ADSL, variables = AGE) ard_other <- ard_summary(ADSL, variables = BMIBL) result <- compare_ard(ard_base, ard_other) # all rows differ since variables are different expect_gt(nrow(result$rows_in_x_not_y), 0L) expect_gt(nrow(result$rows_in_y_not_x), 0L) }) # --- ARD edge cases ----------------------------------------------------------- test_that("compare_ard works with two by variables (4 group columns)", { ard1 <- ard_summary(ADSL, by = c(ARM, SEX), variables = AGE) ard2 <- ard_summary(dplyr::mutate(ADSL, AGE = AGE + 1), by = c(ARM, SEX), variables = AGE) result <- compare_ard(ard1, ard2) expect_true(all(c("group1", "group1_level", "group2", "group2_level") %in% result$keys)) expect_gt(nrow(result$comparison$stat), 0L) expect_true(is_ard_equal(compare_ard(ard1, ard1))) }) test_that("compare_ard handles NULL stat values", { ard_base <- ard_tabulate(ADSL, by = ARM, variables = SEX) ard_modified <- ard_base ard_modified$stat[1L] <- list(NULL) result_diff <- compare_ard(ard_base, ard_modified) expect_gt(nrow(result_diff$comparison$stat), 0L) result_same <- compare_ard(ard_base, ard_base) expect_true(is_ard_equal(result_same)) }) test_that("compare_ard ignores warning/error columns by default", { ard_base <- ard_summary(ADSL, variables = AGE) ard_warn <- ard_base ard_warn$warning[[1L]] <- "a warning message" result <- compare_ard(ard_base, ard_warn) expect_true(is_ard_equal(result)) }) test_that("compare_ard can compare warning column explicitly", { ard_base <- ard_summary(ADSL, variables = AGE) ard_warn <- ard_base ard_warn$warning[[1L]] <- "a warning message" result <- compare_ard(ard_base, ard_warn, columns = "warning") expect_false(is_ard_equal(result)) expect_gt(nrow(result$comparison$warning), 0L) }) test_that("compare_ard handles complex stat values from ard_identity()", { ard <- t.test(ADSL$AGE)[c("statistic", "p.value")] |> ard_identity(variable = "AGE") result <- compare_ard(ard, ard) expect_true(is_ard_equal(result)) }) test_that("compare_ard detects differences in complex stat values from ard_identity()", { ard_base <- t.test(ADSL$AGE)[c("statistic", "p.value")] |> ard_identity(variable = "AGE") ard_modified <- t.test(ADSL$AGE + 1)[c("statistic", "p.value")] |> ard_identity(variable = "AGE") result <- compare_ard(ard_base, ard_modified) expect_false(is_ard_equal(result)) })