From acfe7ba12c629601c668af89d1b7ea2c30e3dc28 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Llu=C3=ADs=20Revilla?= Date: Fri, 22 May 2026 10:54:51 +0200 Subject: [PATCH 01/11] Add tests without snapshots. Remove apply_fmt_fun() on add_calculated_row tests. --- tests/testthat/_snaps/add_calculated_row.md | 63 ++++++++++----------- tests/testthat/test-add_calculated_row.R | 57 +++++++++++-------- 2 files changed, 63 insertions(+), 57 deletions(-) diff --git a/tests/testthat/_snaps/add_calculated_row.md b/tests/testthat/_snaps/add_calculated_row.md index caf300268..2c11b4646 100644 --- a/tests/testthat/_snaps/add_calculated_row.md +++ b/tests/testthat/_snaps/add_calculated_row.md @@ -1,51 +1,47 @@ # add_calculated_row(x) Code - apply_fmt_fun(add_calculated_row(ard_summary(mtcars, variables = mpg), expr = max - - min, stat_name = "range")) + out Message - {cards} data frame: 9 x 9 + {cards} data frame: 9 x 8 Output - variable context stat_name stat_label stat stat_fmt - 1 mpg summary N N 32 32 - 2 mpg summary mean Mean 20.091 20.1 - 3 mpg summary sd SD 6.027 6.0 - 4 mpg summary median Median 19.2 19.2 - 5 mpg summary p25 Q1 15.35 15.4 - 6 mpg summary p75 Q3 22.8 22.8 - 7 mpg summary min Min 10.4 10.4 - 8 mpg summary max Max 33.9 33.9 - 9 mpg summary range range 23.5 23.5 + variable context stat_name stat_label stat fmt_fun + 1 mpg summary N N 32 0 + 2 mpg summary mean Mean 20.091 1 + 3 mpg summary sd SD 6.027 1 + 4 mpg summary median Median 19.2 1 + 5 mpg summary p25 Q1 15.35 1 + 6 mpg summary p75 Q3 22.8 1 + 7 mpg summary min Min 10.4 1 + 8 mpg summary max Max 33.9 1 + 9 mpg summary range range 23.5 1 Message - i 3 more variables: fmt_fun, warning, error + i 2 more variables: warning, error --- Code - apply_fmt_fun(add_calculated_row(ard_summary(mtcars, variables = mpg), expr = dplyr::case_when( - mean > median ~ "Right Skew", mean < median ~ "Left Skew", .default = "Symmetric"), - stat_name = "skew")) + out2 Message - {cards} data frame: 9 x 9 + {cards} data frame: 9 x 8 Output - variable context stat_name stat_label stat stat_fmt - 1 mpg summary N N 32 32 - 2 mpg summary mean Mean 20.091 20.1 - 3 mpg summary sd SD 6.027 6.0 - 4 mpg summary median Median 19.2 19.2 - 5 mpg summary p25 Q1 15.35 15.4 - 6 mpg summary p75 Q3 22.8 22.8 - 7 mpg summary min Min 10.4 10.4 - 8 mpg summary max Max 33.9 33.9 - 9 mpg summary skew skew Right Sk… Right Skew + variable context stat_name stat_label stat fmt_fun + 1 mpg summary N N 32 0 + 2 mpg summary mean Mean 20.091 1 + 3 mpg summary sd SD 6.027 1 + 4 mpg summary median Median 19.2 1 + 5 mpg summary p25 Q1 15.35 1 + 6 mpg summary p75 Q3 22.8 1 + 7 mpg summary min Min 10.4 1 + 8 mpg summary max Max 33.9 1 + 9 mpg summary skew skew Right Sk… Message - i 3 more variables: fmt_fun, warning, error + i 2 more variables: warning, error -# add_calculated_row(expr) messaging +# add_calculated_row(expr) errors when a variable is not present Code - add_calculated_row(ard_summary(mtcars, variables = mpg), expr = not_a_stat * 2, - stat_name = "this_doesnt_work") + add_calculated_row(tbl, expr = not_a_stat * 2, stat_name = "this_doesnt_work") Condition Error in `add_calculated_row()`: ! There was an error calculating the new statistic. See below: @@ -54,8 +50,7 @@ # add_calculated_row(by) messaging Code - add_calculated_row(ard_summary(mtcars, variables = mpg, by = cyl), expr = max - - min, stat_name = "range", by = "context") + add_calculated_row(tbl, expr = max - min, stat_name = "range", by = "context") Condition Error in `add_calculated_row()`: ! Duplicate statistics present within `by` groups: "N", "mean", "sd", "median", "p25", "p75", "min", "max", "N", "mean", "sd", "median", "p25", "p75", "min", and "max" diff --git a/tests/testthat/test-add_calculated_row.R b/tests/testthat/test-add_calculated_row.R index 464bbfef6..174977680 100644 --- a/tests/testthat/test-add_calculated_row.R +++ b/tests/testthat/test-add_calculated_row.R @@ -1,38 +1,49 @@ test_that("add_calculated_row(x)", { - expect_snapshot( - ard_summary(mtcars, variables = mpg) |> - add_calculated_row(expr = max - min, stat_name = "range") |> - apply_fmt_fun() - ) + tbl <- ard_summary(mtcars, variables = mpg) + out <- add_calculated_row(tbl, expr = max - min, stat_name = "range") + expect_named(out, c("variable", "context", "stat_name", "stat_label", "stat", "fmt_fun", + "warning", "error")) + expect_s3_class(out, "card") - expect_snapshot( - ard_summary(mtcars, variables = mpg) |> - add_calculated_row( - expr = - dplyr::case_when( - mean > median ~ "Right Skew", - mean < median ~ "Left Skew", - .default = "Symmetric" - ), - stat_name = "skew" - ) |> - apply_fmt_fun() + expect_setequal(out$stat_label, + c("N", "Mean", "SD", "Median", "Q1", "Q3", "Min", "Max", "range" + )) + + expect_snapshot(out) + out2 <- add_calculated_row( + tbl, + expr = + dplyr::case_when( + mean > median ~ "Right Skew", + mean < median ~ "Left Skew", + .default = "Symmetric" + ), + stat_name = "skew" ) -}) + expect_setequal(out2$stat_label, + c("N", "Mean", "SD", "Median", "Q1", "Q3", "Min", "Max", "skew" + )) + + expect_snapshot(out2) +}) -test_that("add_calculated_row(expr) messaging", { +test_that("add_calculated_row(expr) errors when a variable is not present", { + tbl <- ard_summary(mtcars, variables = mpg) + expect_error(add_calculated_row(tbl, expr = not_a_stat * 2, stat_name = "this_doesnt_work"), + "calculating the new statistic") expect_snapshot( - ard_summary(mtcars, variables = mpg) |> - add_calculated_row(expr = not_a_stat * 2, stat_name = "this_doesnt_work"), + add_calculated_row(tbl, expr = not_a_stat * 2, stat_name = "this_doesnt_work"), error = TRUE ) }) test_that("add_calculated_row(by) messaging", { + tbl <- ard_summary(mtcars, variables = mpg, by = cyl) + expect_error(add_calculated_row(tbl, expr = max - min, stat_name = "range", by = "context"), + "Duplicate statistics") expect_snapshot( - ard_summary(mtcars, variables = mpg, by = cyl) |> - add_calculated_row(expr = max - min, stat_name = "range", by = "context"), + add_calculated_row(tbl, expr = max - min, stat_name = "range", by = "context"), error = TRUE ) }) From cac441ac89e4cd9f6da178879a7bb7695e62a3c7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Llu=C3=ADs=20Revilla?= Date: Fri, 22 May 2026 10:58:13 +0200 Subject: [PATCH 02/11] Add some test that are not snapshots --- tests/testthat/test-ard_tabulate_rows.R | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/tests/testthat/test-ard_tabulate_rows.R b/tests/testthat/test-ard_tabulate_rows.R index 021bffa1f..f638c8a99 100644 --- a/tests/testthat/test-ard_tabulate_rows.R +++ b/tests/testthat/test-ard_tabulate_rows.R @@ -1,4 +1,13 @@ test_that("ard_tabulate_rows() works", { + + out <- ard_tabulate_rows(ADSL, by = TRTA) + expect_named(out, + c("group1", "group1_level", "variable", "variable_level", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" + ) + ) + expect_all_equal(NROW(out), length(unique(ADSL$TRTA))) + expect_snapshot( ard_tabulate_rows(ADSL, by = TRTA) ) From a7c326a7c60f265634f04b3644e0cf792b4ee7e6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Llu=C3=ADs=20Revilla?= Date: Fri, 22 May 2026 11:02:05 +0200 Subject: [PATCH 03/11] Add tests that are not snapshots --- tests/testthat/_snaps/as_nested_list.md | 2 +- tests/testthat/test-as_nested_list.R | 8 ++++++-- 2 files changed, 7 insertions(+), 3 deletions(-) diff --git a/tests/testthat/_snaps/as_nested_list.md b/tests/testthat/_snaps/as_nested_list.md index 0ae2c248f..0dbab30d2 100644 --- a/tests/testthat/_snaps/as_nested_list.md +++ b/tests/testthat/_snaps/as_nested_list.md @@ -1,7 +1,7 @@ # as_nested_list() works Code - as_nested_list(ard_summary(mtcars, by = "cyl", variables = "hp")) + as_nested_list(tbl) Output $variable $variable$hp diff --git a/tests/testthat/test-as_nested_list.R b/tests/testthat/test-as_nested_list.R index 0fd925697..94b83bd91 100644 --- a/tests/testthat/test-as_nested_list.R +++ b/tests/testthat/test-as_nested_list.R @@ -1,6 +1,10 @@ test_that("as_nested_list() works", { + tbl <- ard_summary(mtcars, by = "cyl", variables = "hp") + out <- as_nested_list(tbl) + expect_type(out, "list") + expect_named(out, "variable") + expect_snapshot( - ard_summary(mtcars, by = "cyl", variables = "hp") |> - as_nested_list() + as_nested_list(tbl) ) }) From d0c2875bcf4f1966cff380d9d15cca3b8cc01c98 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Llu=C3=ADs=20Revilla?= Date: Fri, 22 May 2026 12:06:35 +0200 Subject: [PATCH 04/11] Do not skip this package on CRAN or CI: it works --- tests/testthat/test-filter_ard_hierarchical.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/tests/testthat/test-filter_ard_hierarchical.R b/tests/testthat/test-filter_ard_hierarchical.R index 048958678..0a988585a 100644 --- a/tests/testthat/test-filter_ard_hierarchical.R +++ b/tests/testthat/test-filter_ard_hierarchical.R @@ -1,5 +1,3 @@ -skip_on_cran() - ADAE_subset <- cards::ADAE |> dplyr::filter(AETERM %in% unique(cards::ADAE$AETERM)[1:5]) From 8b08f4a64a3266381c50929d5fa6a7f78a118d79 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Llu=C3=ADs=20Revilla?= Date: Fri, 22 May 2026 12:14:54 +0200 Subject: [PATCH 05/11] Simplify testing mocked functions --- tests/testthat/_snaps/mock.md | 132 +++++++++++++++++----------------- tests/testthat/test-mock.R | 87 ++++++++++++++-------- 2 files changed, 122 insertions(+), 97 deletions(-) diff --git a/tests/testthat/_snaps/mock.md b/tests/testthat/_snaps/mock.md index bd986d9c7..9af7e20e0 100644 --- a/tests/testthat/_snaps/mock.md +++ b/tests/testthat/_snaps/mock.md @@ -1,22 +1,21 @@ # mock_categorical() Code - apply_fmt_fun(mock_categorical(variables = list(AGEGR1 = factor(c("<65", "65-80", ">80"), levels = c("<65", "65-80", ">80"))), - by = list(TRTA = c("Placebo", "Xanomeline High Dose", "Xanomeline Low Dose")))) + out Message - {cards} data frame: 27 x 12 + {cards} data frame: 27 x 11 Output - group1 group1_level variable variable_level stat_name stat_label stat stat_fmt - 1 TRTA Placebo AGEGR1 <65 n n xx - 2 TRTA Placebo AGEGR1 <65 p % xx.x - 3 TRTA Placebo AGEGR1 <65 N N xx - 4 TRTA Placebo AGEGR1 65-80 n n xx - 5 TRTA Placebo AGEGR1 65-80 p % xx.x - 6 TRTA Placebo AGEGR1 65-80 N N xx - 7 TRTA Placebo AGEGR1 >80 n n xx - 8 TRTA Placebo AGEGR1 >80 p % xx.x - 9 TRTA Placebo AGEGR1 >80 N N xx - 10 TRTA Xanomeli… AGEGR1 <65 n n xx + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo AGEGR1 <65 n n + 2 TRTA Placebo AGEGR1 <65 p % + 3 TRTA Placebo AGEGR1 <65 N N + 4 TRTA Placebo AGEGR1 65-80 n n + 5 TRTA Placebo AGEGR1 65-80 p % + 6 TRTA Placebo AGEGR1 65-80 N N + 7 TRTA Placebo AGEGR1 >80 n n + 8 TRTA Placebo AGEGR1 >80 p % + 9 TRTA Placebo AGEGR1 >80 N N + 10 TRTA Xanomeli… AGEGR1 <65 n n Message i 17 more rows i Use `print(n = ...)` to see more rows @@ -34,29 +33,29 @@ # mock_continuous() Code - apply_fmt_fun(mock_continuous(variables = c("AGE", "BMIBL"))) + out Message - {cards} data frame: 16 x 9 + {cards} data frame: 16 x 8 Output - variable context stat_name stat_label stat stat_fmt - 1 AGE continuo… N N xx - 2 AGE continuo… mean Mean xx.x - 3 AGE continuo… sd SD xx.x - 4 AGE continuo… median Median xx.x - 5 AGE continuo… p25 Q1 xx.x - 6 AGE continuo… p75 Q3 xx.x - 7 AGE continuo… min Min xx.x - 8 AGE continuo… max Max xx.x - 9 BMIBL continuo… N N xx - 10 BMIBL continuo… mean Mean xx.x - 11 BMIBL continuo… sd SD xx.x - 12 BMIBL continuo… median Median xx.x - 13 BMIBL continuo… p25 Q1 xx.x - 14 BMIBL continuo… p75 Q3 xx.x - 15 BMIBL continuo… min Min xx.x - 16 BMIBL continuo… max Max xx.x + variable context stat_name stat_label stat fmt_fun + 1 AGE continuo… N N + 2 AGE continuo… mean Mean + 3 AGE continuo… sd SD + 4 AGE continuo… median Median + 5 AGE continuo… p25 Q1 + 6 AGE continuo… p75 Q3 + 7 AGE continuo… min Min + 8 AGE continuo… max Max + 9 BMIBL continuo… N N + 10 BMIBL continuo… mean Mean + 11 BMIBL continuo… sd SD + 12 BMIBL continuo… median Median + 13 BMIBL continuo… p25 Q1 + 14 BMIBL continuo… p75 Q3 + 15 BMIBL continuo… min Min + 16 BMIBL continuo… max Max Message - i 3 more variables: fmt_fun, warning, error + i 2 more variables: warning, error # mock_continuous() messaging @@ -69,21 +68,20 @@ # mock_dichotomous() Code - apply_fmt_fun(mock_dichotomous(variables = list(AGEGR1 = factor("65-80", levels = c("<65", "65-80", ">80"))), by = list(TRTA = c( - "Placebo", "Xanomeline High Dose", "Xanomeline Low Dose")))) + out Message - {cards} data frame: 9 x 12 + {cards} data frame: 9 x 11 Output - group1 group1_level variable variable_level stat_name stat_label stat stat_fmt - 1 TRTA Placebo AGEGR1 65-80 n n xx - 2 TRTA Placebo AGEGR1 65-80 p % xx.x - 3 TRTA Placebo AGEGR1 65-80 N N xx - 4 TRTA Xanomeli… AGEGR1 65-80 n n xx - 5 TRTA Xanomeli… AGEGR1 65-80 p % xx.x - 6 TRTA Xanomeli… AGEGR1 65-80 N N xx - 7 TRTA Xanomeli… AGEGR1 65-80 n n xx - 8 TRTA Xanomeli… AGEGR1 65-80 p % xx.x - 9 TRTA Xanomeli… AGEGR1 65-80 N N xx + group1 group1_level variable variable_level stat_name stat_label stat + 1 TRTA Placebo AGEGR1 65-80 n n + 2 TRTA Placebo AGEGR1 65-80 p % + 3 TRTA Placebo AGEGR1 65-80 N N + 4 TRTA Xanomeli… AGEGR1 65-80 n n + 5 TRTA Xanomeli… AGEGR1 65-80 p % + 6 TRTA Xanomeli… AGEGR1 65-80 N N + 7 TRTA Xanomeli… AGEGR1 65-80 n n + 8 TRTA Xanomeli… AGEGR1 65-80 p % + 9 TRTA Xanomeli… AGEGR1 65-80 N N Message i 4 more variables: context, fmt_fun, warning, error @@ -100,23 +98,23 @@ # mock_missing() Code - apply_fmt_fun(mock_missing(variables = c("AGE", "BMIBL"))) + out Message - {cards} data frame: 10 x 9 + {cards} data frame: 10 x 8 Output - variable context stat_name stat_label stat stat_fmt - 1 AGE missing N_obs Vector L… xx - 2 AGE missing N_miss N Missing xx - 3 AGE missing N_nonmiss N Non-mi… xx - 4 AGE missing p_miss % Missing xx.x - 5 AGE missing p_nonmiss % Non-mi… xx.x - 6 BMIBL missing N_obs Vector L… xx - 7 BMIBL missing N_miss N Missing xx - 8 BMIBL missing N_nonmiss N Non-mi… xx - 9 BMIBL missing p_miss % Missing xx.x - 10 BMIBL missing p_nonmiss % Non-mi… xx.x + variable context stat_name stat_label stat fmt_fun + 1 AGE missing N_obs Vector L… + 2 AGE missing N_miss N Missing + 3 AGE missing N_nonmiss N Non-mi… + 4 AGE missing p_miss % Missing + 5 AGE missing p_nonmiss % Non-mi… + 6 BMIBL missing N_obs Vector L… + 7 BMIBL missing N_miss N Missing + 8 BMIBL missing N_nonmiss N Non-mi… + 9 BMIBL missing p_miss % Missing + 10 BMIBL missing p_nonmiss % Non-mi… Message - i 3 more variables: fmt_fun, warning, error + i 2 more variables: warning, error # mock_missing() messaging @@ -129,7 +127,7 @@ # mock_attributes() Code - mock_attributes(label = list(AGE = "Age", BMIBL = "Baseline BMI")) + out Message {cards} data frame: 4 x 8 Output @@ -152,12 +150,12 @@ # mock_total_n() Code - apply_fmt_fun(mock_total_n()) + out Message - {cards} data frame: 1 x 9 + {cards} data frame: 1 x 8 Output - variable context stat_name stat_label stat stat_fmt - 1 ..ard_total_n.. total_n N N xx + variable context stat_name stat_label stat fmt_fun + 1 ..ard_total_n.. total_n N N Message - i 3 more variables: fmt_fun, warning, error + i 2 more variables: warning, error diff --git a/tests/testthat/test-mock.R b/tests/testthat/test-mock.R index e293914a9..58441220a 100644 --- a/tests/testthat/test-mock.R +++ b/tests/testthat/test-mock.R @@ -1,16 +1,24 @@ test_that("mock_categorical()", { withr::local_options(list(width = 130)) - expect_snapshot( - mock_categorical( - variables = list(AGEGR1 = factor(c("<65", "65-80", ">80"), levels = c("<65", "65-80", ">80"))), - by = list(TRTA = c("Placebo", "Xanomeline High Dose", "Xanomeline Low Dose")) - ) |> - apply_fmt_fun() + out <- mock_categorical( + variables = list(AGEGR1 = factor(c("<65", "65-80", ">80"), levels = c("<65", "65-80", ">80"))), + by = list(TRTA = c("Placebo", "Xanomeline High Dose", "Xanomeline Low Dose")) ) + expect_s3_class(out, "card") + expect_named(out, + c("group1", "group1_level", "variable", "variable_level", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" + )) + expect_snapshot(out) }) test_that("mock_categorical() messaging", { # incorrect specification of the statistic argument + + expect_error(mock_categorical( + variables = list(AGEGR1 = factor(c("<65", "65-80", ">80"), levels = c("<65", "65-80", ">80"))), + statistic = ~ c("NOTASTATISTIC") + ), "must be vector with one or more of") expect_snapshot( error = TRUE, mock_categorical( @@ -23,12 +31,16 @@ test_that("mock_categorical() messaging", { test_that("mock_continuous()", { withr::local_options(list(width = 130)) - expect_snapshot( - mock_continuous( - variables = c("AGE", "BMIBL") - ) |> - apply_fmt_fun() + + out <- mock_continuous( + variables = c("AGE", "BMIBL") ) + expect_s3_class(out, "card") + expect_named(out, + c("group1", "group1_level", "variable", "variable_level", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" + )) + expect_snapshot(out) }) test_that("mock_continuous() messaging", { @@ -44,13 +56,16 @@ test_that("mock_continuous() messaging", { test_that("mock_dichotomous()", { withr::local_options(list(width = 130)) - expect_snapshot( - mock_dichotomous( - variables = list(AGEGR1 = factor("65-80", levels = c("<65", "65-80", ">80"))), - by = list(TRTA = c("Placebo", "Xanomeline High Dose", "Xanomeline Low Dose")) - ) |> - apply_fmt_fun() + out <- mock_dichotomous( + variables = list(AGEGR1 = factor("65-80", levels = c("<65", "65-80", ">80"))), + by = list(TRTA = c("Placebo", "Xanomeline High Dose", "Xanomeline Low Dose")) ) + expect_s3_class(out, "card") + expect_named(out, + c("group1", "group1_level", "variable", "variable_level", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" + )) + expect_snapshot(out) }) test_that("mock_dichotomous() messaging", { @@ -66,12 +81,15 @@ test_that("mock_dichotomous() messaging", { test_that("mock_missing()", { withr::local_options(list(width = 130)) - expect_snapshot( - mock_missing( - variables = c("AGE", "BMIBL") - ) |> - apply_fmt_fun() + out <- mock_missing( + variables = c("AGE", "BMIBL") ) + expect_s3_class(out, "card") + expect_named(out, + c("group1", "group1_level", "variable", "variable_level", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" + )) + expect_snapshot(out) }) test_that("mock_missing() messaging", { @@ -87,11 +105,16 @@ test_that("mock_missing() messaging", { test_that("mock_attributes()", { withr::local_options(list(width = 130)) - expect_snapshot( - mock_attributes( - label = list(AGE = "Age", BMIBL = "Baseline BMI") - ) + + out <- mock_attributes( + label = list(AGE = "Age", BMIBL = "Baseline BMI") ) + expect_s3_class(out, "card") + expect_named(out, + c("group1", "group1_level", "variable", "variable_level", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" + )) + expect_snapshot(out) }) test_that("mock_attributes() messaging", { @@ -104,8 +127,12 @@ test_that("mock_attributes() messaging", { test_that("mock_total_n()", { withr::local_options(list(width = 130)) - expect_snapshot( - mock_total_n() |> - apply_fmt_fun() - ) + + out <- mock_total_n() + expect_s3_class(out, "card") + expect_named(out, + c("group1", "group1_level", "variable", "variable_level", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" + )) + expect_snapshot(out) }) From f95f55c57900ac8a1aeb562b22987ca21be77833 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Llu=C3=ADs=20Revilla?= Date: Fri, 22 May 2026 12:35:57 +0200 Subject: [PATCH 06/11] Use some expectations outside snapshots --- tests/testthat/_snaps/print_ard_conditions.md | 36 +--- tests/testthat/test-print_ard_conditions.R | 173 ++++++++++-------- 2 files changed, 104 insertions(+), 105 deletions(-) diff --git a/tests/testthat/_snaps/print_ard_conditions.md b/tests/testthat/_snaps/print_ard_conditions.md index 1fa6055fe..56a1daa80 100644 --- a/tests/testthat/_snaps/print_ard_conditions.md +++ b/tests/testthat/_snaps/print_ard_conditions.md @@ -1,17 +1,12 @@ # print_ard_conditions() works Code - print_ard_conditions(ard_summary(ADSL, variables = AGE)) + print_ard_conditions(ard) --- Code - print_ard_conditions(ard_summary(ADSL, variables = AGE, statistic = ~ list( - mean = function(x) mean(x), mean_warning = function(x) { - warning("warn1") - warning("warn2") - mean(x) - }, err_fn = function(x) stop("'tis an error")))) + print_ard_conditions(ard) Message The following errors were returned during `print_ard_conditions()`: x For variable `AGE` and "err_fn" statistic: 'tis an error @@ -22,12 +17,7 @@ --- Code - print_ard_conditions(ard_summary(ADSL, variables = AGE, by = ARM, statistic = ~ - list(mean = function(x) mean(x), mean_warning = function(x) { - warning("warn1") - warning("warn2") - mean(x) - }, err_fn = function(x) stop("'tis an error")))) + print_ard_conditions(ard) Message The following errors were returned during `print_ard_conditions()`: x For variable `AGE` (`ARM = "Placebo"`) and "err_fn" statistic: 'tis an error @@ -53,12 +43,6 @@ --- Code - tbl_summary <- (function() { - set_cli_abort_call() - ard <- ard_summary(ADSL, variables = AGE, statistic = ~ list(err_fn = function( - x) stop("'tis an error"))) - print_ard_conditions(ard) - }) tbl_summary() Message The following errors were returned during `tbl_summary()`: @@ -67,12 +51,7 @@ # print_ard_conditions(condition_type) Code - print_ard_conditions(ard_summary(ADSL, variables = AGE, statistic = ~ list( - mean_warning = function(x) { - warning("warn1") - warning("warn2") - mean(x) - })), condition_type = "identity") + print_ard_conditions(ard, condition_type = "identity") Message The following warnings were returned during `print_ard_conditions()`: Condition @@ -84,9 +63,7 @@ --- Code - print_ard_conditions(ard_summary(ADSL, variables = AGE, statistic = ~ list( - mean = function(x) mean(x), err_fn = function(x) stop("'tis an error"))), - condition_type = "identity") + print_ard_conditions(ard, condition_type = "identity") Message The following errors were returned during `print_ard_conditions()`: Condition @@ -96,8 +73,7 @@ # print_ard_conditions() no error when 'error'/'warning' columns not present Code - print_ard_conditions(dplyr::select(ard_summary(ADSL, variables = AGE), -warning, - -error)) + print_ard_conditions(ard) # print_ard_conditions() no error when factors are present diff --git a/tests/testthat/test-print_ard_conditions.R b/tests/testthat/test-print_ard_conditions.R index 1214b4242..420bfb819 100644 --- a/tests/testthat/test-print_ard_conditions.R +++ b/tests/testthat/test-print_ard_conditions.R @@ -1,46 +1,55 @@ test_that("print_ard_conditions() works", { # nothing prints with no errors/warnings - expect_snapshot( - ard_summary(ADSL, variables = AGE) |> - print_ard_conditions() - ) + + ard <- ard_summary(ADSL, variables = AGE) + expect_null(print_ard_conditions(ard)) + expect_snapshot(print_ard_conditions(ard)) # expected messaging without by variable - expect_snapshot( - ard_summary( - ADSL, - variables = AGE, - statistic = ~ list( - mean = \(x) mean(x), - mean_warning = \(x) { - warning("warn1") - warning("warn2") - mean(x) - }, - err_fn = \(x) stop("'tis an error") - ) - ) |> - print_ard_conditions() + ard <- ard_summary( + ADSL, + variables = AGE, + statistic = ~ list( + mean = \(x) mean(x), + mean_warning = \(x) { + warning("warn1") + warning("warn2") + mean(x) + }, + err_fn = \(x) stop("'tis an error") + ) ) + expect_no_error(ard) + expect_message( + expect_message( + expect_message(print_ard_conditions(ard), + "were returned during"), + "tis an error"), + "were returned during") + expect_snapshot(print_ard_conditions(ard)) # expected messaging with by variable - expect_snapshot( - ard_summary( - ADSL, - variables = AGE, - by = ARM, - statistic = ~ list( - mean = \(x) mean(x), - mean_warning = \(x) { - warning("warn1") - warning("warn2") - mean(x) - }, - err_fn = \(x) stop("'tis an error") - ) - ) |> - print_ard_conditions() + ard <- ard_summary( + ADSL, + variables = AGE, + by = ARM, + statistic = ~ list( + mean = \(x) mean(x), + mean_warning = \(x) { + warning("warn1") + warning("warn2") + mean(x) + }, + err_fn = \(x) stop("'tis an error") + ) ) + expect_no_error(ard) + expect_message( + expect_message( + print_ard_conditions(ard), + "were returned during"), + "were returned during") + expect_snapshot(print_ard_conditions(ard)) # expected messaging when the same error appears for all stats (consolidated correctly) expect_snapshot( @@ -50,61 +59,74 @@ test_that("print_ard_conditions() works", { ) # calling function name prints correctly - expect_snapshot({ - tbl_summary <- function() { - set_cli_abort_call() + tbl_summary <- function() { - ard <- ard_summary( - ADSL, - variables = AGE, - statistic = ~ list(err_fn = \(x) stop("'tis an error")) - ) + set_cli_abort_call() + + ard <- ard_summary( + ADSL, + variables = AGE, + statistic = ~ list(err_fn = \(x) stop("'tis an error")) + ) - print_ard_conditions(ard) - } - tbl_summary() - }) + print_ard_conditions(ard) + } + expect_message(tbl_summary(), "tbl_summary") + expect_snapshot(tbl_summary()) }) test_that("print_ard_conditions(condition_type)", { # expected warnings as warnings - expect_snapshot( - ard_summary( - ADSL, - variables = AGE, - statistic = ~ list(mean_warning = \(x) { - warning("warn1") - warning("warn2") - mean(x) - }) - ) |> - print_ard_conditions(condition_type = "identity") + ard <- ard_summary( + ADSL, + variables = AGE, + statistic = ~ list(mean_warning = \(x) { + warning("warn1") + warning("warn2") + mean(x) + }) ) + expect_warning( + expect_warning( + expect_message( + print_ard_conditions(ard, condition_type = "identity"), + "print_ard_conditions()"), + "warn1"), + "warn2") + expect_snapshot(print_ard_conditions(ard, condition_type = "identity")) # expected warnings as warnings + ard <- ard_summary( + ADSL, + variables = AGE, + statistic = ~ list( + mean = \(x) mean(x), + err_fn = \(x) stop("'tis an error") + ) + ) + expect_error( + expect_message( + print_ard_conditions(ard, condition_type = "identity"), + "print_ard_conditions()"), + "tis an error") expect_snapshot( error = TRUE, - ard_summary( - ADSL, - variables = AGE, - statistic = ~ list( - mean = \(x) mean(x), - err_fn = \(x) stop("'tis an error") - ) - ) |> - print_ard_conditions(condition_type = "identity") + print_ard_conditions(ard, condition_type = "identity") ) }) test_that("print_ard_conditions() no error when 'error'/'warning' columns not present", { - expect_snapshot( - ard_summary( - ADSL, - variables = AGE - ) |> - dplyr::select(-warning, -error) |> - print_ard_conditions() - ) + ard <- ard_summary( + ADSL, + variables = AGE, + statistic = ~ list( + mean = \(x) mean(x), + err_fn = \(x) stop("'tis an error") + ) + ) |> + dplyr::select(-warning, -error) + expect_no_error(print_ard_conditions(ard)) + expect_snapshot(print_ard_conditions(ard)) }) test_that("print_ard_conditions() no error when factors are present", { @@ -128,6 +150,7 @@ test_that("print_ard_conditions() no error when factors are present", { "card", "tbl_df", "tbl", "data.frame" )) + expect_snapshot( print_ard_conditions(ard) ) From 3b1071e465c65e1c4f1c7d10f55240e51c5bb072 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Llu=C3=ADs=20Revilla?= Date: Fri, 22 May 2026 12:43:50 +0200 Subject: [PATCH 07/11] Further testing without snapshots --- tests/testthat/_snaps/tidy_as_ard.md | 173 ++++++++++----------------- tests/testthat/test-tidy_as_ard.R | 63 +++++----- 2 files changed, 96 insertions(+), 140 deletions(-) diff --git a/tests/testthat/_snaps/tidy_as_ard.md b/tests/testthat/_snaps/tidy_as_ard.md index 94a427c44..801a03726 100644 --- a/tests/testthat/_snaps/tidy_as_ard.md +++ b/tests/testthat/_snaps/tidy_as_ard.md @@ -1,128 +1,77 @@ -# tidy_as_ard() works +# tidy_as_ard() works / with standard use Code - as.data.frame(tidy_as_ard(lst_tidy = eval_capture_conditions(dplyr::as_tibble( - stats::fisher.test(x = mtcars[["am"]], y = mtcars[["vs"]])[c("estimate", - "p.value", "method")])), tidy_result_names = c("estimate", "p.value", - "method"), fun_args_to_record = c("workspace", "hybrid", "hybridPars", - "control", "or", "conf.int", "conf.level", "simulate.p.value", "B"), formals = formals( - stats::fisher.test), passed_args = list(), lst_ard_columns = list(context = "fishertest", - group1 = "am", variable = "vs"))) + ard + Message + {cards} data frame: 12 x 8 Output - group1 variable context stat_name - 1 am vs fishertest estimate - 2 am vs fishertest p.value - 3 am vs fishertest method - 4 am vs fishertest workspace - 5 am vs fishertest hybrid - 6 am vs fishertest hybridPars - 7 am vs fishertest control - 8 am vs fishertest or - 9 am vs fishertest conf.int - 10 am vs fishertest conf.level - 11 am vs fishertest simulate.p.value - 12 am vs fishertest B - stat fmt_fun warning error - 1 1.956055 1 NULL NULL - 2 0.4726974 1 NULL NULL - 3 Fisher's Exact Test for Count Data NULL NULL NULL - 4 2e+05 1 NULL NULL - 5 FALSE NULL NULL NULL - 6 c(expect = 5, percent = 80, Emin = 1) NULL NULL NULL - 7 list() NULL NULL NULL - 8 1 1 NULL NULL - 9 TRUE NULL NULL NULL - 10 0.95 1 NULL NULL - 11 FALSE NULL NULL NULL - 12 2000 1 NULL NULL + group1 variable context stat_name stat fmt_fun + 1 am vs fisherte… estimate 1.956 1 + 2 am vs fisherte… p.value 0.473 1 + 3 am vs fisherte… method Fisher's… NULL + 4 am vs fisherte… workspace 2e+05 1 + 5 am vs fisherte… hybrid FALSE NULL + 6 am vs fisherte… hybridPars c, 5, 80, 1 NULL + 7 am vs fisherte… control list NULL + 8 am vs fisherte… or 1 1 + 9 am vs fisherte… conf.int TRUE NULL + 10 am vs fisherte… conf.level 0.95 1 + 11 am vs fisherte… simulate.p.value FALSE NULL + 12 am vs fisherte… B 2000 1 + Message + i 2 more variables: warning, error ---- +# tidy_as_ard() works / when primary stats function errors Code - as.data.frame(tidy_as_ard(lst_tidy = eval_capture_conditions(stop( - "Planned unit testing error!")), tidy_result_names = c("estimate", "p.value", - "conf.low", "conf.high", "method", "alternative"), fun_args_to_record = c( - "workspace", "hybrid", "hybridPars", "control", "or", "conf.int", - "conf.level", "simulate.p.value", "B"), formals = formals(stats::fisher.test), - passed_args = list(), lst_ard_columns = list(context = "fishertest", group1 = "am", - variable = "vs"))) + ard + Message + {cards} data frame: 15 x 8 Output - group1 variable context stat_name - 1 am vs fishertest estimate - 2 am vs fishertest p.value - 3 am vs fishertest conf.low - 4 am vs fishertest conf.high - 5 am vs fishertest method - 6 am vs fishertest alternative - 7 am vs fishertest workspace - 8 am vs fishertest hybrid - 9 am vs fishertest hybridPars - 10 am vs fishertest control - 11 am vs fishertest or - 12 am vs fishertest conf.int - 13 am vs fishertest conf.level - 14 am vs fishertest simulate.p.value - 15 am vs fishertest B - stat fmt_fun warning - 1 NULL NULL NULL - 2 NULL NULL NULL - 3 NULL NULL NULL - 4 NULL NULL NULL - 5 NULL NULL NULL - 6 NULL NULL NULL - 7 2e+05 1 NULL - 8 FALSE NULL NULL - 9 c(expect = 5, percent = 80, Emin = 1) NULL NULL - 10 list() NULL NULL - 11 1 1 NULL - 12 TRUE NULL NULL - 13 0.95 1 NULL - 14 FALSE NULL NULL - 15 2000 1 NULL - error - 1 Planned unit testing error! - 2 Planned unit testing error! - 3 Planned unit testing error! - 4 Planned unit testing error! - 5 Planned unit testing error! - 6 Planned unit testing error! - 7 Planned unit testing error! - 8 Planned unit testing error! - 9 Planned unit testing error! - 10 Planned unit testing error! - 11 Planned unit testing error! - 12 Planned unit testing error! - 13 Planned unit testing error! - 14 Planned unit testing error! - 15 Planned unit testing error! + group1 variable context stat_name stat error + 1 am vs fisherte… estimate Planned … + 2 am vs fisherte… p.value Planned … + 3 am vs fisherte… conf.low Planned … + 4 am vs fisherte… conf.high Planned … + 5 am vs fisherte… method Planned … + 6 am vs fisherte… alternative Planned … + 7 am vs fisherte… workspace 2e+05 Planned … + 8 am vs fisherte… hybrid FALSE Planned … + 9 am vs fisherte… hybridPars c, 5, 80, 1 Planned … + 10 am vs fisherte… control list Planned … + 11 am vs fisherte… or 1 Planned … + 12 am vs fisherte… conf.int TRUE Planned … + 13 am vs fisherte… conf.level 0.95 Planned … + 14 am vs fisherte… simulate.p.value FALSE Planned … + 15 am vs fisherte… B 2000 Planned … + Message + i 2 more variables: fmt_fun, warning ---- +# tidy_as_ard() works / when `fun_args_to_record` argument is not passed Code - dplyr::select(as.data.frame(tidy_as_ard(lst_tidy = eval_capture_conditions( - dplyr::as_tibble(stats::fisher.test(x = mtcars[["am"]], y = mtcars[["vs"]])[c( - "estimate", "p.value", "method")])), tidy_result_names = c("estimate", - "p.value", "conf.low", "conf.high", "method", "alternative"), formals = formals( - stats::fisher.test), passed_args = list(), lst_ard_columns = list(context = "fishertest", - group1 = "am", variable = "vs"))), c(group1, variable, stat)) + ard + Message + {cards} data frame: 3 x 8 Output - group1 variable stat - 1 am vs 1.956055 - 2 am vs 0.4726974 - 3 am vs Fisher's Exact Test for Count Data + group1 variable context stat_name stat fmt_fun + 1 am vs fisherte… estimate 1.956 1 + 2 am vs fisherte… p.value 0.473 1 + 3 am vs fisherte… method Fisher's… NULL + Message + i 2 more variables: warning, error ---- +# tidy_as_ard() works / when `formals` argument is not passed. Code - dplyr::select(as.data.frame(tidy_as_ard(lst_tidy = eval_capture_conditions( - dplyr::as_tibble(stats::fisher.test(x = mtcars[["am"]], y = mtcars[["vs"]])[c( - "estimate", "p.value", "method")])), tidy_result_names = c("estimate", - "p.value", "conf.low", "conf.high", "method", "alternative"), passed_args = list(), - lst_ard_columns = list(context = "fishertest", group1 = "am", variable = "vs"))), - c(group1, variable, stat)) + ard + Message + {cards} data frame: 3 x 8 Output - group1 variable stat - 1 am vs 1.956055 - 2 am vs 0.4726974 - 3 am vs Fisher's Exact Test for Count Data + group1 variable context stat_name stat fmt_fun + 1 am vs fisherte… estimate 1.956 1 + 2 am vs fisherte… p.value 0.473 1 + 3 am vs fisherte… method Fisher's… NULL + Message + i 2 more variables: warning, error diff --git a/tests/testthat/test-tidy_as_ard.R b/tests/testthat/test-tidy_as_ard.R index c5a4f2433..9ef3e7efa 100644 --- a/tests/testthat/test-tidy_as_ard.R +++ b/tests/testthat/test-tidy_as_ard.R @@ -1,7 +1,8 @@ -test_that("tidy_as_ard() works", { - # function works with standard use - expect_snapshot( - tidy_as_ard( +describe("tidy_as_ard() works", { + it("with standard use", { + # function works + + ard <- tidy_as_ard( lst_tidy = eval_capture_conditions( # this mimics a tidier @@ -18,13 +19,15 @@ test_that("tidy_as_ard() works", { formals = formals(stats::fisher.test), passed_args = list(), lst_ard_columns = list(context = "fishertest", group1 = "am", variable = "vs") - ) |> - as.data.frame() - ) + ) + expect_s3_class(ard, "card") + expect_named(ard, c("group1", "variable", "context", "stat_name", "stat", "fmt_fun", + "warning", "error")) + expect_snapshot(ard) + }) - # function works when primary stats function errors - expect_snapshot( - tidy_as_ard( + it("when primary stats function errors", { + ard <- tidy_as_ard( lst_tidy = eval_capture_conditions( stop("Planned unit testing error!") @@ -39,13 +42,14 @@ test_that("tidy_as_ard() works", { formals = formals(stats::fisher.test), passed_args = list(), lst_ard_columns = list(context = "fishertest", group1 = "am", variable = "vs") - ) |> - as.data.frame() - ) - - # function works when `fun_args_to_record` argument is not passed. - expect_snapshot( - tidy_as_ard( + ) + expect_s3_class(ard, "card") + expect_named(ard, c("group1", "variable", "context", "stat_name", "stat", "fmt_fun", + "warning", "error")) + expect_snapshot(ard) +}) + it("when `fun_args_to_record` argument is not passed", { + ard <- tidy_as_ard( lst_tidy = eval_capture_conditions( stats::fisher.test(x = mtcars[["am"]], y = mtcars[["vs"]])[c("estimate", "p.value", "method")] |> @@ -56,14 +60,15 @@ test_that("tidy_as_ard() works", { formals = formals(stats::fisher.test), passed_args = list(), lst_ard_columns = list(context = "fishertest", group1 = "am", variable = "vs") - ) |> - as.data.frame() |> - dplyr::select(c(group1, variable, stat)) - ) + ) + expect_s3_class(ard, "card") + expect_named(ard, c("group1", "variable", "context", "stat_name", "stat", "fmt_fun", + "warning", "error")) + expect_snapshot(ard) + }) - # function works when `formals` argument is not passed. - expect_snapshot( - tidy_as_ard( + it("when `formals` argument is not passed.", { + ard <- tidy_as_ard( lst_tidy = eval_capture_conditions( stats::fisher.test(x = mtcars[["am"]], y = mtcars[["vs"]])[c("estimate", "p.value", "method")] |> @@ -73,8 +78,10 @@ test_that("tidy_as_ard() works", { c("estimate", "p.value", "conf.low", "conf.high", "method", "alternative"), passed_args = list(), lst_ard_columns = list(context = "fishertest", group1 = "am", variable = "vs") - ) |> - as.data.frame() |> - dplyr::select(c(group1, variable, stat)) - ) + ) + expect_s3_class(ard, "card") + expect_named(ard, c("group1", "variable", "context", "stat_name", "stat", "fmt_fun", + "warning", "error")) + expect_snapshot(ard) + }) }) From 7b20a3537a82dffefc8f76aa7a5a6bcd14daa64c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Llu=C3=ADs=20Revilla?= Date: Fri, 22 May 2026 12:55:59 +0200 Subject: [PATCH 08/11] Fix some minor issues with documentation for CRAN --- R/data.R | 6 ++++++ R/shuffle_ard.R | 5 ++--- man/adam.Rd | 9 +++++++++ man/deprecated.Rd | 2 +- man/dot-detect_msgs.Rd | 3 +++ 5 files changed, 21 insertions(+), 4 deletions(-) diff --git a/R/data.R b/R/data.R index af196b1c8..aa19133b7 100644 --- a/R/data.R +++ b/R/data.R @@ -3,6 +3,12 @@ #' Data frame imported from the [CDISC SDTM/ADaM Pilot Project](https://github.com/cdisc-org/sdtm-adam-pilot-project) #' @name adam #' @keywords datasets +#' @returns Datasets in tibble format. +#' @examples +#' head(ADSL) +#' head(ADAE) +#' head(ADTTE) +#' head(ADLB) "ADSL" #' @rdname adam diff --git a/R/shuffle_ard.R b/R/shuffle_ard.R index cd43834c4..781375ab6 100644 --- a/R/shuffle_ard.R +++ b/R/shuffle_ard.R @@ -13,10 +13,9 @@ #' logical representing whether or not to trim away statistic-level metadata and filter #' only on numeric statistic values. #' -#' @return a tibble +#' @returns A tibble. #' @rdname deprecated #' @export -#' #' @examples #' bind_ard( #' ard_tabulate(ADSL, by = "ARM", variables = "AGEGR1"), @@ -145,7 +144,7 @@ shuffle_ard <- function(x, trim = TRUE) { #' @param ... ([`dynamic-dots`][rlang::dyn-dots])\cr #' columns to search within #' @keywords internal -#' +#' @returns A list with the warnings and errors. #' @examples #' ard <- ard_summary( #' ADSL, diff --git a/man/adam.Rd b/man/adam.Rd index f4475d8cb..79eedd0e2 100644 --- a/man/adam.Rd +++ b/man/adam.Rd @@ -26,7 +26,16 @@ ADTTE ADLB } +\value{ +Datasets in tibble format. +} \description{ Data frame imported from the \href{https://github.com/cdisc-org/sdtm-adam-pilot-project}{CDISC SDTM/ADaM Pilot Project} } +\examples{ +head(ADSL) +head(ADAE) +head(ADTTE) +head(ADLB) +} \keyword{datasets} diff --git a/man/deprecated.Rd b/man/deprecated.Rd index 8ddcbb5a1..e2005231b 100644 --- a/man/deprecated.Rd +++ b/man/deprecated.Rd @@ -51,7 +51,7 @@ logical representing whether or not to trim away statistic-level metadata and fi only on numeric statistic values.} } \value{ -a tibble +A tibble. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}\cr diff --git a/man/dot-detect_msgs.Rd b/man/dot-detect_msgs.Rd index d74d23af2..a48893107 100644 --- a/man/dot-detect_msgs.Rd +++ b/man/dot-detect_msgs.Rd @@ -13,6 +13,9 @@ a data frame} \item{...}{(\code{\link[rlang:dyn-dots]{dynamic-dots}})\cr columns to search within} } +\value{ +A list with the warnings and errors. +} \description{ Function looks for non-null contents in requested columns and notifies user before removal. Specifically used for detecting messages. From d137c0bac59b33e2b43d27a7980a33ab6b0e6b86 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Llu=C3=ADs=20Revilla?= Date: Fri, 22 May 2026 13:04:54 +0200 Subject: [PATCH 09/11] Fix tests about names --- tests/testthat/test-mock.R | 68 ++++++++++++++++++++++++-------------- 1 file changed, 43 insertions(+), 25 deletions(-) diff --git a/tests/testthat/test-mock.R b/tests/testthat/test-mock.R index 58441220a..11ffc0ffa 100644 --- a/tests/testthat/test-mock.R +++ b/tests/testthat/test-mock.R @@ -5,10 +5,13 @@ test_that("mock_categorical()", { by = list(TRTA = c("Placebo", "Xanomeline High Dose", "Xanomeline Low Dose")) ) expect_s3_class(out, "card") - expect_named(out, - c("group1", "group1_level", "variable", "variable_level", "context", - "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" - )) + expect_named( + out, + c( + "group1", "group1_level", "variable", "variable_level", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" + ) + ) expect_snapshot(out) }) @@ -36,10 +39,13 @@ test_that("mock_continuous()", { variables = c("AGE", "BMIBL") ) expect_s3_class(out, "card") - expect_named(out, - c("group1", "group1_level", "variable", "variable_level", "context", - "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" - )) + expect_named( + out, + c( + "variable", "context", "stat_name", "stat_label", "stat", + "fmt_fun", "warning", "error" + ) + ) expect_snapshot(out) }) @@ -56,15 +62,18 @@ test_that("mock_continuous() messaging", { test_that("mock_dichotomous()", { withr::local_options(list(width = 130)) - out <- mock_dichotomous( + out <- mock_dichotomous( variables = list(AGEGR1 = factor("65-80", levels = c("<65", "65-80", ">80"))), by = list(TRTA = c("Placebo", "Xanomeline High Dose", "Xanomeline Low Dose")) ) expect_s3_class(out, "card") - expect_named(out, - c("group1", "group1_level", "variable", "variable_level", "context", - "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" - )) + expect_named( + out, + c( + "group1", "group1_level", "variable", "variable_level", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" + ) + ) expect_snapshot(out) }) @@ -85,10 +94,13 @@ test_that("mock_missing()", { variables = c("AGE", "BMIBL") ) expect_s3_class(out, "card") - expect_named(out, - c("group1", "group1_level", "variable", "variable_level", "context", - "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" - )) + expect_named( + out, + c( + "variable", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" + ) + ) expect_snapshot(out) }) @@ -110,10 +122,13 @@ test_that("mock_attributes()", { label = list(AGE = "Age", BMIBL = "Baseline BMI") ) expect_s3_class(out, "card") - expect_named(out, - c("group1", "group1_level", "variable", "variable_level", "context", - "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" - )) + expect_named( + out, + c( + "variable", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" + ) + ) expect_snapshot(out) }) @@ -130,9 +145,12 @@ test_that("mock_total_n()", { out <- mock_total_n() expect_s3_class(out, "card") - expect_named(out, - c("group1", "group1_level", "variable", "variable_level", "context", - "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" - )) + expect_named( + out, + c( + "variable", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" + ) + ) expect_snapshot(out) }) From bd2f1ab5a5692fe7c2232622d4ffa51d98c20a10 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Llu=C3=ADs=20Revilla?= Date: Fri, 22 May 2026 13:06:18 +0200 Subject: [PATCH 10/11] Fix style --- tests/testthat/test-add_calculated_row.R | 37 ++++++++++-------- tests/testthat/test-ard_tabulate_rows.R | 11 +++--- tests/testthat/test-as_nested_list.R | 2 +- tests/testthat/test-print_ard_conditions.R | 44 +++++++++++++--------- tests/testthat/test-tidy_as_ard.R | 26 ++++++++----- 5 files changed, 73 insertions(+), 47 deletions(-) diff --git a/tests/testthat/test-add_calculated_row.R b/tests/testthat/test-add_calculated_row.R index 174977680..a52e58e95 100644 --- a/tests/testthat/test-add_calculated_row.R +++ b/tests/testthat/test-add_calculated_row.R @@ -1,13 +1,16 @@ test_that("add_calculated_row(x)", { tbl <- ard_summary(mtcars, variables = mpg) out <- add_calculated_row(tbl, expr = max - min, stat_name = "range") - expect_named(out, c("variable", "context", "stat_name", "stat_label", "stat", "fmt_fun", - "warning", "error")) + expect_named(out, c( + "variable", "context", "stat_name", "stat_label", "stat", "fmt_fun", + "warning", "error" + )) expect_s3_class(out, "card") - expect_setequal(out$stat_label, - c("N", "Mean", "SD", "Median", "Q1", "Q3", "Min", "Max", "range" - )) + expect_setequal( + out$stat_label, + c("N", "Mean", "SD", "Median", "Q1", "Q3", "Min", "Max", "range") + ) expect_snapshot(out) out2 <- add_calculated_row( @@ -20,30 +23,34 @@ test_that("add_calculated_row(x)", { ), stat_name = "skew" ) - expect_setequal(out2$stat_label, - c("N", "Mean", "SD", "Median", "Q1", "Q3", "Min", "Max", "skew" - )) + expect_setequal( + out2$stat_label, + c("N", "Mean", "SD", "Median", "Q1", "Q3", "Min", "Max", "skew") + ) expect_snapshot(out2) - }) test_that("add_calculated_row(expr) errors when a variable is not present", { tbl <- ard_summary(mtcars, variables = mpg) - expect_error(add_calculated_row(tbl, expr = not_a_stat * 2, stat_name = "this_doesnt_work"), - "calculating the new statistic") + expect_error( + add_calculated_row(tbl, expr = not_a_stat * 2, stat_name = "this_doesnt_work"), + "calculating the new statistic" + ) expect_snapshot( - add_calculated_row(tbl, expr = not_a_stat * 2, stat_name = "this_doesnt_work"), + add_calculated_row(tbl, expr = not_a_stat * 2, stat_name = "this_doesnt_work"), error = TRUE ) }) test_that("add_calculated_row(by) messaging", { tbl <- ard_summary(mtcars, variables = mpg, by = cyl) - expect_error(add_calculated_row(tbl, expr = max - min, stat_name = "range", by = "context"), - "Duplicate statistics") + expect_error( + add_calculated_row(tbl, expr = max - min, stat_name = "range", by = "context"), + "Duplicate statistics" + ) expect_snapshot( - add_calculated_row(tbl, expr = max - min, stat_name = "range", by = "context"), + add_calculated_row(tbl, expr = max - min, stat_name = "range", by = "context"), error = TRUE ) }) diff --git a/tests/testthat/test-ard_tabulate_rows.R b/tests/testthat/test-ard_tabulate_rows.R index f638c8a99..67226cbb6 100644 --- a/tests/testthat/test-ard_tabulate_rows.R +++ b/tests/testthat/test-ard_tabulate_rows.R @@ -1,10 +1,11 @@ test_that("ard_tabulate_rows() works", { - out <- ard_tabulate_rows(ADSL, by = TRTA) - expect_named(out, - c("group1", "group1_level", "variable", "variable_level", "context", - "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" - ) + expect_named( + out, + c( + "group1", "group1_level", "variable", "variable_level", "context", + "stat_name", "stat_label", "stat", "fmt_fun", "warning", "error" + ) ) expect_all_equal(NROW(out), length(unique(ADSL$TRTA))) diff --git a/tests/testthat/test-as_nested_list.R b/tests/testthat/test-as_nested_list.R index 94b83bd91..ccd056581 100644 --- a/tests/testthat/test-as_nested_list.R +++ b/tests/testthat/test-as_nested_list.R @@ -5,6 +5,6 @@ test_that("as_nested_list() works", { expect_named(out, "variable") expect_snapshot( - as_nested_list(tbl) + as_nested_list(tbl) ) }) diff --git a/tests/testthat/test-print_ard_conditions.R b/tests/testthat/test-print_ard_conditions.R index 420bfb819..413d1752f 100644 --- a/tests/testthat/test-print_ard_conditions.R +++ b/tests/testthat/test-print_ard_conditions.R @@ -22,10 +22,14 @@ test_that("print_ard_conditions() works", { expect_no_error(ard) expect_message( expect_message( - expect_message(print_ard_conditions(ard), - "were returned during"), - "tis an error"), - "were returned during") + expect_message( + print_ard_conditions(ard), + "were returned during" + ), + "tis an error" + ), + "were returned during" + ) expect_snapshot(print_ard_conditions(ard)) # expected messaging with by variable @@ -45,10 +49,12 @@ test_that("print_ard_conditions() works", { ) expect_no_error(ard) expect_message( - expect_message( - print_ard_conditions(ard), - "were returned during"), - "were returned during") + expect_message( + print_ard_conditions(ard), + "were returned during" + ), + "were returned during" + ) expect_snapshot(print_ard_conditions(ard)) # expected messaging when the same error appears for all stats (consolidated correctly) @@ -60,7 +66,6 @@ test_that("print_ard_conditions() works", { # calling function name prints correctly tbl_summary <- function() { - set_cli_abort_call() ard <- ard_summary( @@ -88,11 +93,14 @@ test_that("print_ard_conditions(condition_type)", { ) expect_warning( expect_warning( - expect_message( - print_ard_conditions(ard, condition_type = "identity"), - "print_ard_conditions()"), - "warn1"), - "warn2") + expect_message( + print_ard_conditions(ard, condition_type = "identity"), + "print_ard_conditions()" + ), + "warn1" + ), + "warn2" + ) expect_snapshot(print_ard_conditions(ard, condition_type = "identity")) # expected warnings as warnings @@ -107,11 +115,13 @@ test_that("print_ard_conditions(condition_type)", { expect_error( expect_message( print_ard_conditions(ard, condition_type = "identity"), - "print_ard_conditions()"), - "tis an error") + "print_ard_conditions()" + ), + "tis an error" + ) expect_snapshot( error = TRUE, - print_ard_conditions(ard, condition_type = "identity") + print_ard_conditions(ard, condition_type = "identity") ) }) diff --git a/tests/testthat/test-tidy_as_ard.R b/tests/testthat/test-tidy_as_ard.R index 9ef3e7efa..63ba80ef6 100644 --- a/tests/testthat/test-tidy_as_ard.R +++ b/tests/testthat/test-tidy_as_ard.R @@ -21,8 +21,10 @@ describe("tidy_as_ard() works", { lst_ard_columns = list(context = "fishertest", group1 = "am", variable = "vs") ) expect_s3_class(ard, "card") - expect_named(ard, c("group1", "variable", "context", "stat_name", "stat", "fmt_fun", - "warning", "error")) + expect_named(ard, c( + "group1", "variable", "context", "stat_name", "stat", "fmt_fun", + "warning", "error" + )) expect_snapshot(ard) }) @@ -44,10 +46,12 @@ describe("tidy_as_ard() works", { lst_ard_columns = list(context = "fishertest", group1 = "am", variable = "vs") ) expect_s3_class(ard, "card") - expect_named(ard, c("group1", "variable", "context", "stat_name", "stat", "fmt_fun", - "warning", "error")) + expect_named(ard, c( + "group1", "variable", "context", "stat_name", "stat", "fmt_fun", + "warning", "error" + )) expect_snapshot(ard) -}) + }) it("when `fun_args_to_record` argument is not passed", { ard <- tidy_as_ard( lst_tidy = @@ -62,8 +66,10 @@ describe("tidy_as_ard() works", { lst_ard_columns = list(context = "fishertest", group1 = "am", variable = "vs") ) expect_s3_class(ard, "card") - expect_named(ard, c("group1", "variable", "context", "stat_name", "stat", "fmt_fun", - "warning", "error")) + expect_named(ard, c( + "group1", "variable", "context", "stat_name", "stat", "fmt_fun", + "warning", "error" + )) expect_snapshot(ard) }) @@ -80,8 +86,10 @@ describe("tidy_as_ard() works", { lst_ard_columns = list(context = "fishertest", group1 = "am", variable = "vs") ) expect_s3_class(ard, "card") - expect_named(ard, c("group1", "variable", "context", "stat_name", "stat", "fmt_fun", - "warning", "error")) + expect_named(ard, c( + "group1", "variable", "context", "stat_name", "stat", "fmt_fun", + "warning", "error" + )) expect_snapshot(ard) }) }) From db11d1fe2eeab251b293388cafeb0d7939155894 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Llu=C3=ADs=20Revilla?= Date: Mon, 25 May 2026 11:43:58 +0200 Subject: [PATCH 11/11] More comprehensive tests for ard_formals --- tests/testthat/_snaps/ard_formals.md | 5 ++--- tests/testthat/test-ard_formals.R | 23 ++++++++++++++--------- 2 files changed, 16 insertions(+), 12 deletions(-) diff --git a/tests/testthat/_snaps/ard_formals.md b/tests/testthat/_snaps/ard_formals.md index 0bba398f3..5f65bd791 100644 --- a/tests/testthat/_snaps/ard_formals.md +++ b/tests/testthat/_snaps/ard_formals.md @@ -1,7 +1,7 @@ # ard_formals() works Code - ard_formals(fun = mcnemar.test, arg_names = "correct") + out Message {cards} data frame: 1 x 3 Output @@ -11,8 +11,7 @@ --- Code - ard_formals(fun = asNamespace("stats")[["t.test.default"]], arg_names = c("mu", - "paired", "var.equal", "conf.level"), passed_args = list(conf.level = 0.9)) + out Message {cards} data frame: 4 x 3 Output diff --git a/tests/testthat/test-ard_formals.R b/tests/testthat/test-ard_formals.R index 749df0a24..ff03c35c2 100644 --- a/tests/testthat/test-ard_formals.R +++ b/tests/testthat/test-ard_formals.R @@ -1,13 +1,18 @@ test_that("ard_formals() works", { - expect_snapshot( - ard_formals(fun = mcnemar.test, arg_names = "correct") - ) + out <- ard_formals(fun = mcnemar.test, arg_names = "correct") + expect_s3_class(out, "card") + expect_named(out, c("stat_name", "stat_label", "stat")) + expect_true(nrow(out) == 1L) + expect_snapshot(out) + - expect_snapshot( - ard_formals( - fun = asNamespace("stats")[["t.test.default"]], - arg_names = c("mu", "paired", "var.equal", "conf.level"), - passed_args = list(conf.level = 0.90) - ) + out <- ard_formals( + fun = asNamespace("stats")[["t.test.default"]], + arg_names = c("mu", "paired", "var.equal", "conf.level"), + passed_args = list(conf.level = 0.90) ) + expect_s3_class(out, "card") + expect_named(out, c("stat_name", "stat_label", "stat")) + expect_true(nrow(out) == 4L) + expect_snapshot(out) })