Skip to content

Commit

Permalink
Update tests
Browse files Browse the repository at this point in the history
  • Loading branch information
@edelarua
edelarua committed Feb 19, 2025
1 parent 0168a6d commit 73861f1
Show file tree
Hide file tree
Showing 2 changed files with 66 additions and 30 deletions.
19 changes: 19 additions & 0 deletions tests/testthat/_snaps/tbl_filter.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,6 +20,25 @@
14 ERYTHEMA 3 (10%) 5 (13%) 6 (18%)
15 APPLICATION SITE ERYTHEMA 1 (3.3%) 10 (25%) 7 (21%)

# tbl_filter.tbl_hierarchical() works with various different filter conditions

Code
as.data.frame(tbl_f)
Output
**Sex** \n    **Race** \n        **Reported Term for the Adverse Event** **Placebo** \nN = 86 **Xanomeline High Dose** \nN = 84 **Xanomeline Low Dose** \nN = 84
1 Number of patients with event 26 (30%) 42 (50%) 40 (48%)
2 F 13 (25%) 18 (45%) 23 (46%)
3 WHITE 10 (21%) 14 (41%) 20 (45%)
4 APPLICATION SITE PRURITUS 2 (4.2%) 8 (24%) 10 (23%)
5 ERYTHEMA 6 (13%) 6 (18%) 8 (18%)
6 APPLICATION SITE ERYTHEMA 2 (4.2%) 5 (15%) 5 (11%)
7 M 13 (39%) 24 (55%) 17 (50%)
8 WHITE 12 (40%) 22 (55%) 17 (50%)
9 APPLICATION SITE PRURITUS 1 (3.3%) 12 (30%) 10 (29%)
10 DIARRHOEA 6 (20%) 3 (7.5%) 2 (5.9%)
11 ERYTHEMA 3 (10%) 5 (13%) 6 (18%)
12 APPLICATION SITE ERYTHEMA 1 (3.3%) 10 (25%) 7 (21%)

# tbl_filter.tbl_hierarchical() error messaging works

Code
Expand Down
77 changes: 47 additions & 30 deletions tests/testthat/test-tbl_filter.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -17,28 +17,34 @@ test_that("tbl_filter.tbl_hierarchical() works", {

# no errors
expect_silent(tbl <- tbl_filter(tbl, sum(n) > 10))

# row order is retained
expect_snapshot(tbl |> as.data.frame())
expect_silent(tbl <- tbl_filter(tbl, p > 0.05))
})

test_that("tbl_filter.tbl_hierarchical(gt) works", {
# gt = TRUE
expect_silent(tbl_gt <- tbl_filter(tbl, sum(n) > 10))
test_that("tbl_filter.tbl_hierarchical(keep_empty_summary) works", {
tbl2 <- tbl_hierarchical(
data = ADAE_subset,
variables = c(SEX, RACE, AEBODSYS, AETERM),
by = TRTA,
denominator = cards::ADSL |> mutate(TRTA = ARM),
id = USUBJID
)

# gt = FALSE
expect_message(tbl_lt <- tbl_filter(tbl, sum(n) < 10))
# keep summary rows
expect_silent(tbl_f <- tbl_filter(tbl2, sum(n) > 10, keep_empty_summary = TRUE))
expect_equal(nrow(tbl_f$table_body), 29)

expect_equal(
dplyr::inner_join(
tbl_gt$table_body,
tbl_lt$table_body,
by = names(tbl_gt$table_body)
) |>
dplyr::filter(variable == "AETERM") |>
nrow(),
0
)
# remove summary rows
expect_silent(tbl_f <- tbl_filter(tbl2, sum(n) > 10, keep_empty_summary = FALSE))
expect_equal(nrow(tbl_f$table_body), 22)
})

test_that("tbl_filter.tbl_hierarchical() works with various different filter conditions", {
withr::local_options(width = 200)

expect_silent(tbl_gt <- tbl_filter(tbl, sum(n) > 10))
expect_silent(tbl_lt <- tbl_filter(tbl, sum(n) <= 10))
expect_equal(
sum(
tbl_gt$table_body |>
Expand All @@ -52,27 +58,38 @@ test_that("tbl_filter.tbl_hierarchical(gt) works", {
dplyr::filter(variable == "AETERM") |>
nrow()
)
})

test_that("tbl_filter.tbl_hierarchical(eq) works", {
# gt = TRUE, eq = FALSE
expect_silent(tbl_gt <- tbl_filter(tbl, sum(n) > 12))
expect_silent(tbl_f <- tbl_filter(tbl, n > 5))
expect_equal(nrow(tbl_f$table_body), 14)

# gt = TRUE, eq = TRUE
expect_silent(tbl_geq <- tbl_filter(tbl, sum(n) >= 12))
expect_gt(nrow(tbl_geq$table_body), nrow(tbl_gt$table_body))
expect_silent(tbl_f <- tbl_filter(tbl, p > 0.05))
expect_equal(nrow(tbl_f$table_body), 25)

# gt = FALSE, eq = FALSE
expect_silent(tbl_lt <- tbl_filter(tbl, sum(n) < 12))
expect_silent(tbl_f <- tbl_filter(tbl, n == 2 & p < 0.05))
expect_equal(nrow(tbl_f$table_body), 11)

# gt = TRUE, eq = TRUE
expect_silent(tbl_leq <- tbl_filter(tbl, sum(n) <= 12))
expect_lt(nrow(tbl_lt$table_body), nrow(tbl_leq$table_body))
expect_silent(tbl_f <- tbl_filter(tbl, mean(n) > 4 | n > 3))
expect_equal(nrow(tbl_f$table_body), 15)

expect_silent(tbl_f <- tbl_filter(tbl, any(n > 2 & TRTA == "Xanomeline High Dose"), keep_empty_summary = FALSE))
expect_snapshot(tbl_f |> as.data.frame())
})

test_that("tbl_filter.tbl_hierarchical() returns empty table when all rows filtered out", {
expect_silent(tbl <- tbl_filter(tbl, sum(n) > 200))
expect_equal(nrow(tbl$table_body), 0)
tbl2 <- tbl_hierarchical(
data = ADAE_subset,
variables = c(SEX, RACE, AETERM),
by = TRTA,
denominator = cards::ADSL |> mutate(TRTA = ARM),
id = USUBJID
)

expect_silent(tbl_f <- tbl_filter(tbl2, sum(n) > 200, keep_empty_summary = FALSE))
expect_equal(nrow(tbl_f$table_body), 0)

# overall row present
expect_silent(tbl_f <- tbl_filter(tbl, sum(n) > 200, keep_empty_summary = FALSE))
expect_equal(nrow(tbl_f$table_body), 1)
})

test_that("tbl_filter.tbl_hierarchical() works with only one variable in x", {
Expand Down

0 comments on commit 73861f1

Please sign in to comment.