From 70be90e8a72e1abba8cbebfb36f3918aac5b1408 Mon Sep 17 00:00:00 2001 From: "joe.zhu" Date: Thu, 5 Dec 2024 16:18:22 +0800 Subject: [PATCH] adding test filter verbose --- R/assert.R | 32 +++++++++ tests/testthat/_snaps/filter_spec-verbose.md | 76 ++++++++++++++++++++ tests/testthat/test-filter_spec-verbose.R | 17 +++++ 3 files changed, 125 insertions(+) create mode 100644 tests/testthat/_snaps/filter_spec-verbose.md create mode 100644 tests/testthat/test-filter_spec-verbose.R diff --git a/R/assert.R b/R/assert.R index 0e353aac..6bdbe0c6 100755 --- a/R/assert.R +++ b/R/assert.R @@ -13,3 +13,35 @@ assert_is_valid_version_label <- function(x) { abort("Version label must be 'DRAFT', 'APPROVED' or `NULL` but is '", x, "'.") } } + + +assert_exists_in_spec_or_calling_env <- function(vars, output) { + exist_in_spec <- vars %in% names(output) + exist_in_calling_env <- map_lgl(vars, exists, parent.frame(n = 2L)) + non_existing_vars <- vars[!(exist_in_spec | exist_in_calling_env)] + + + n <- length(non_existing_vars) + if (n >= 1L) { + err_msg <- sprintf( + paste( + "Cannot filter based upon the %s %s as %s not contained in", + "`spec` or the surrounding environment." + ), + if (n == 1L) "variable" else "variables", + enumerate(non_existing_vars), + if (n == 1L) "it is" else "they are" + ) + stop(err_msg, call. = FALSE) + } +} + +assert_is_valid_filter_result <- function(x) { + if (length(x) != 1L || is.na(x) || !is.logical(x)) { + stop( + "`filter_expr` must evaluate to a logical scalar but returned `", + deparse(x), "`.", + call. = FALSE + ) + } +} diff --git a/tests/testthat/_snaps/filter_spec-verbose.md b/tests/testthat/_snaps/filter_spec-verbose.md new file mode 100644 index 00000000..95710d10 --- /dev/null +++ b/tests/testthat/_snaps/filter_spec-verbose.md @@ -0,0 +1,76 @@ +# Listing print correctly + + Code + full_spec %>% filter_spec(., program %in% c("t_ds_slide", "t_ds_trt_slide"), + verbose = TRUE) + Output + v 2/47 outputs matched the filter condition `program %in% c("t_ds_slide", "t_ds_trt_slide")`. + $t_ds_slide_FAS + $t_ds_slide_FAS$program + [1] "t_ds_slide" + + $t_ds_slide_FAS$titles + [1] "Patient Disposition" + + $t_ds_slide_FAS$footnotes + [1] "t_ds footnotes" + + $t_ds_slide_FAS$paper + [1] "L6" + + $t_ds_slide_FAS$suffix + [1] "FAS" + + $t_ds_slide_FAS$output + [1] "t_ds_slide_FAS" + + + $t_ds_trt_slide_SE + $t_ds_trt_slide_SE$program + [1] "t_ds_trt_slide" + + $t_ds_trt_slide_SE$titles + [1] "Patients Who Discontinued From Study Treatment" + + $t_ds_trt_slide_SE$footnotes + [1] "ds trt footnotes" + + $t_ds_trt_slide_SE$paper + [1] "L6" + + $t_ds_trt_slide_SE$suffix + [1] "SE" + + $t_ds_trt_slide_SE$args + $t_ds_trt_slide_SE$args$arm + [1] "TRT01A" + + $t_ds_trt_slide_SE$args$colcount + [1] FALSE + + $t_ds_trt_slide_SE$args$drug_vars + [1] "A: Drug X" "B: Placebo" "C: Combination" + + $t_ds_trt_slide_SE$args$drug_names + [1] "Drug X" "Placebo" "Combination" + + $t_ds_trt_slide_SE$args$drug_sdt + [1] "TRTSDT" "TRTSDT" "TRTSDT" + + $t_ds_trt_slide_SE$args$drug_discfl + [1] "DTRFL" "DTRFL" "DTRFL" + + $t_ds_trt_slide_SE$args$drug_discst + [1] "EOTSTT" "EOTSTT" "EOTSTT" + + $t_ds_trt_slide_SE$args$drug_discrs + [1] "DCSREAS" "DCSREAS" "DCSREAS" + + + $t_ds_trt_slide_SE$output + [1] "t_ds_trt_slide_SE" + + + attr(,"class") + [1] "spec" "list" + diff --git a/tests/testthat/test-filter_spec-verbose.R b/tests/testthat/test-filter_spec-verbose.R new file mode 100644 index 00000000..22268248 --- /dev/null +++ b/tests/testthat/test-filter_spec-verbose.R @@ -0,0 +1,17 @@ +library(filters) + +test_that("Listing print correctly", { + # skip_if_too_deep(1) + load_filters(file.path(system.file(package = "autoslider.core"), "filters.yml"), overwrite = TRUE) + + spec_file <- file.path(system.file(package = "autoslider.core"), "spec.yml") + + full_spec <- spec_file %>% + read_spec() + + expect_snapshot(full_spec %>% + filter_spec(., program %in% c( + "t_ds_slide", + "t_ds_trt_slide" + ), verbose = TRUE)) +})