adding test filter verbose

insightsengineering · Dec 5, 2024 · 70be90e · 70be90e
1 parent b25bf15
commit 70be90e
Show file tree

Hide file tree

Showing 3 changed files with 125 additions and 0 deletions.
diff --git 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
@@ -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
@@ -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))
+})