From 5c9be5f953a612a92be372a2c66df98063748051 Mon Sep 17 00:00:00 2001
From: Dawid Kaledkowski <dawid.kaledkowski@gmail.com>
Date: Thu, 6 Nov 2025 10:54:05 +0100
Subject: [PATCH 1/9] - remove unused parameter choices_labeled(subset) -
 simplify assertions

---
 R/choices_labeled.R | 49 ++++-----------------------------------------
 1 file changed, 4 insertions(+), 45 deletions(-)

diff --git a/R/choices_labeled.R b/R/choices_labeled.R
index 57f795984..21464c62a 100644
--- a/R/choices_labeled.R
+++ b/R/choices_labeled.R
@@ -11,50 +11,16 @@
 #' @param choices (`character` or `numeric` or `logical`) vector
 #' @param labels (`character`) vector containing labels to be applied to `choices`. If `NA` then
 #' "Label Missing" will be used.
-#' @param subset a vector that is a subset of `choices`. This is useful if
-#'   only a few variables need to be named. If this argument is used, the returned vector will
-#'   match its order.
 #' @param types vector containing the types of the columns.
 #'
 #' @return A named character vector.
 #'
 #' @keywords internal
 #'
-choices_labeled <- function(choices, labels, subset = NULL, types = NULL) {
-  if (is.factor(choices)) {
-    choices <- as.character(choices)
-  }
-
-  stopifnot(
-    is.character(choices) ||
-      is.numeric(choices) ||
-      is.logical(choices) ||
-      (length(choices) == 1 && is.na(choices))
-  )
-
-  if (is.factor(labels)) {
-    labels <- as.character(labels)
-  }
-
-  checkmate::assert_character(labels[!is.na(labels)], any.missing = FALSE)
-  if (length(choices) != length(labels)) {
-    stop("length of choices must be the same as labels")
-  }
-  stopifnot(is.null(subset) || is.vector(subset))
-  stopifnot(is.null(types) || is.vector(types))
-
-  if (is.vector(types)) {
-    stopifnot(length(choices) == length(types))
-  }
-
-  if (!is.null(subset)) {
-    if (!all(subset %in% choices)) {
-      stop("all of subset variables must be in choices")
-    }
-    labels <- labels[choices %in% subset]
-    types <- types[choices %in% subset]
-    choices <- choices[choices %in% subset]
-  }
+choices_labeled <- function(choices, labels, types = NULL) {
+  checkmate::assert_character(choices)
+  checkmate::assert_character(labels[!is.na(labels)], len = length(choices))
+  checkmate::assert_character(types, len = length(choices), null.ok = TRUE)
 
   is_dupl <- duplicated(choices)
   choices <- choices[!is_dupl]
@@ -68,13 +34,6 @@ choices_labeled <- function(choices, labels, subset = NULL, types = NULL) {
     character(0)
   }
 
-  if (!is.null(subset)) {
-    ord <- match(subset, choices)
-    choices <- choices[ord]
-    raw_labels <- raw_labels[ord]
-    combined_labels <- combined_labels[ord]
-    types <- types[ord]
-  }
   choices <- structure(
     choices,
     names = combined_labels,

From cd5ddfb8eb69a781a53756bac72dabc2c66a14cd Mon Sep 17 00:00:00 2001
From: Dawid Kaledkowski <dawid.kaledkowski@gmail.com>
Date: Thu, 6 Nov 2025 10:54:20 +0100
Subject: [PATCH 2/9] correct an assertion

---
 R/FilteredData.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/FilteredData.R b/R/FilteredData.R
index f3db0c40b..f0b56dc2e 100644
--- a/R/FilteredData.R
+++ b/R/FilteredData.R
@@ -741,7 +741,7 @@ FilteredData <- R6::R6Class( # nolint
     #'   panel will be hidden.
     #' @return `NULL`.
     srv_overview = function(id, active_datanames = self$datanames) {
-      checkmate::assert_class(active_datanames, "reactive")
+      checkmate::assert_function(active_datanames)
       moduleServer(
         id = id,
         function(input, output, session) {

From a9edb6f9e64655873de304154c91dc7d039d6d69 Mon Sep 17 00:00:00 2001
From: Dawid Kaledkowski <dawid.kaledkowski@gmail.com>
Date: Thu, 6 Nov 2025 10:55:42 +0100
Subject: [PATCH 3/9] simplify set_selected

---
 R/FilterStateChoices.R | 31 ++++++++++---------------------
 1 file changed, 10 insertions(+), 21 deletions(-)

diff --git a/R/FilterStateChoices.R b/R/FilterStateChoices.R
index 32b2b19c8..450414fb5 100644
--- a/R/FilterStateChoices.R
+++ b/R/FilterStateChoices.R
@@ -122,7 +122,6 @@ ChoicesFilterState <- R6::R6Class( # nolint
   # public methods ----
 
   public = list(
-
     #' @description
     #' Initialize a `FilterState` object.
     #'
@@ -309,14 +308,15 @@ ChoicesFilterState <- R6::R6Class( # nolint
     },
     # If multiple forbidden but selected, restores previous selection with warning.
     check_length = function(values) {
-      if (!private$is_multiple() && length(values) > 1) {
+      if (!private$is_multiple() && length(values) != 1) {
         warning(
           sprintf("Selection: %s is not a vector of length one. ", toString(values, width = 360)),
           "Maintaining previous selection."
         )
-        values <- isolate(private$get_selected())
+        isolate(private$get_selected())
+      } else {
+        values
       }
-      values
     },
     remove_out_of_bounds_values = function(values) {
       in_choices_mask <- values %in% private$get_choices()
@@ -463,14 +463,7 @@ ChoicesFilterState <- R6::R6Class( # nolint
               eventExpr = input$selection,
               handlerExpr = {
                 logger::log_debug("ChoicesFilterState$server_inputs@2 changed selection, id: { private$get_id() }")
-
-                selection <- if (is.null(input$selection) && private$is_multiple()) {
-                  character(0)
-                } else {
-                  input$selection
-                }
-
-                private$set_selected(selection)
+                private$set_selected(input$selection)
               }
             )
           } else {
@@ -482,11 +475,9 @@ ChoicesFilterState <- R6::R6Class( # nolint
                 if (!isTRUE(input$selection_open)) { # only when the dropdown got closed
                   logger::log_debug("ChoicesFilterState$server_inputs@2 changed selection, id: { private$get_id() }")
 
-                  selection <- if (is.null(input$selection) && private$is_multiple()) {
-                    character(0)
-                  } else if (isTRUE(length(input$selection) != 1) && !private$is_multiple()) {
-                    # In optionalSelectInput user is able to select mutliple options. But if FilterState is not multiple
-                    # we should prevent this selection to be processed further.
+                  if (length(input$selection) != 1 && !private$is_multiple()) {
+                    # In optionalSelectInput user is able to select mutliple options.
+                    # But if FilterState is not multiple we should prevent this selection to be processed further.
                     # This is why notification is thrown and dropdown is changed back to latest selected.
                     showNotification(paste(
                       "This filter exclusively supports single selection.",
@@ -496,11 +487,9 @@ ChoicesFilterState <- R6::R6Class( # nolint
                       session, "selection",
                       selected = private$get_selected()
                     )
-                    return(NULL)
-                  } else {
-                    input$selection
                   }
-                  private$set_selected(selection)
+
+                  private$set_selected(input$selection)
                 }
               }
             )

From 2ba01fb74d7037348195da469996c2234e164e7e Mon Sep 17 00:00:00 2001
From: Dawid Kaledkowski <dawid.kaledkowski@gmail.com>
Date: Thu, 6 Nov 2025 10:56:03 +0100
Subject: [PATCH 4/9] test coverage

---
 tests/testthat/test-FilteredData.R | 462 +++++++++++++++++++++++++++++
 tests/testthat/test-teal_slice.R   |   5 +
 2 files changed, 467 insertions(+)

diff --git a/tests/testthat/test-FilteredData.R b/tests/testthat/test-FilteredData.R
index caa7baf21..855ccad35 100644
--- a/tests/testthat/test-FilteredData.R
+++ b/tests/testthat/test-FilteredData.R
@@ -550,6 +550,113 @@ testthat::test_that("get_filter_overview return counts based on reactive filteri
   )
 })
 
+testthat::describe("srv_overview", {
+  it("srv_overview produces table with filtered counts of non-relational datasets", {
+    filtered_data <- init_filtered_data(x = list(iris = iris, mtcars = mtcars))
+    filtered_data$set_filter_state(
+      teal_slices(
+        teal_slice(dataname = "iris", varname = "Species", selected = "setosa"),
+        teal_slice(dataname = "mtcars", varname = "cyl", selected = c(4, 6))
+      )
+    )
+    shiny::testServer(
+      filtered_data$srv_overview,
+      args = list(id = "test", active_datanames = reactive(c("iris", "mtcars"))),
+      expr = {
+        testthat::expect_identical(
+          as.data.frame(
+            rvest::html_table(rvest::read_html(as.character(output$table$html)),
+              header = TRUE
+            ),
+            check.names = FALSE
+          ),
+          data.frame(
+            `Data Name` = c("iris", "mtcars"),
+            `Obs` = c("50/150", "18/32"),
+            check.names = FALSE
+          )
+        )
+      }
+    )
+  })
+
+  it("srv_overview produces table with filtered counts of relational datasets", {
+    parent <- data.frame(id = seq_len(5), a = letters[seq_len(5)])
+    child <- data.frame(id = seq_len(10), parent_id = rep(seq_len(5), each = 2), b = LETTERS[seq_len(10)])
+
+    filtered_data <- init_filtered_data(
+      x = list(parent = parent, child = child),
+      join_keys = teal.data::join_keys(
+        teal.data::join_key("parent", "parent", "id"),
+        teal.data::join_key("child", "child", "id"),
+        teal.data::join_key("parent", "child", c(id = "parent_id"))
+      )
+    )
+    filtered_data$set_filter_state(
+      teal_slices(
+        teal_slice(dataname = "parent", varname = "a", selected = c("a", "b", "c"))
+      )
+    )
+    shiny::testServer(
+      filtered_data$srv_overview,
+      args = list(id = "test", active_datanames = reactive(c("parent", "child"))),
+      expr = {
+        testthat::expect_identical(
+          as.data.frame(
+            rvest::html_table(rvest::read_html(as.character(output$table$html)),
+              header = TRUE
+            ),
+            check.names = FALSE
+          ),
+          data.frame(
+            `Data Name` = c("parent", "child"),
+            Obs = c("3/5", "6/10"),
+            Subjects = c("3/5", "3/5"),
+            check.names = FALSE
+          )
+        )
+      }
+    )
+  })
+
+  it("srv_overview produces table with popover information for unsupported dataset class", {
+    filtered_data <- init_filtered_data(x = list(iris = iris, test = structure(1L, class = "testing-class")))
+    shiny::testServer(
+      filtered_data$srv_overview,
+      args = list(id = "test", active_datanames = reactive(c("iris", "test"))),
+      expr = {
+        testthat::expect_identical(
+          trimws(rvest::html_text(
+            rvest::html_nodes(
+              rvest::read_html(as.character(output$table$html)),
+              xpath = "//td[i[@title='Unsupported dataset']]"
+            )
+          )),
+          "test"
+        )
+      }
+    )
+  })
+
+  it("srv_overview returns NULL when active_dataset returns nothing", {
+    filtered_data <- init_filtered_data(x = list(iris = iris, mtcars = mtcars))
+    filtered_data$set_filter_state(
+      teal_slices(
+        teal_slice(dataname = "iris", varname = "Species", selected = "setosa"),
+        teal_slice(dataname = "mtcars", varname = "cyl", selected = c(4, 6))
+      )
+    )
+    shiny::testServer(
+      filtered_data$srv_overview,
+      args = list(id = "test", active_datanames = reactive(character(0))),
+      expr = {
+        testthat::expect_null(output$table)
+      }
+    )
+  })
+})
+
+
 # active_datanames ----
 testthat::test_that("active_datanames fails if returns dataname which isn't a subset of available datanames", {
   filtered_data <- FilteredData$new(list(iris = iris, mtcars = mtcars))
@@ -678,3 +785,358 @@ shiny::testServer(
     )
   }
 )
+
+
+testthat::describe("test FilterState server", {
+  it("input$back restores previous filter selection", {
+    filtered_data <- init_filtered_data(x = list(iris = iris))
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive(c("iris", "mtcars"))),
+      expr = {
+        set_filter_state(
+          filtered_data,
+          teal_slices(teal_slice(dataname = "iris", varname = "Species", selected = "versicolor"))
+        )
+        session$flushReact()
+        set_filter_state(
+          filtered_data,
+          teal_slices(teal_slice(dataname = "iris", varname = "Species", selected = "setosa"))
+        )
+        session$flushReact()
+        testthat::expect_identical(
+          get_filter_state(filtered_data)[[1]]$selected,
+          "setosa"
+        )
+        session$setInputs(`iris-filter-iris_Species-back` = 1L)
+        testthat::expect_identical(
+          get_filter_state(filtered_data)[[1]]$selected,
+          "versicolor"
+        )
+      }
+    )
+  })
+
+  it("input$reset restores initial filter selection", {
+    filtered_data <- init_filtered_data(x = list(iris = iris))
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive(c("iris", "mtcars"))),
+      expr = {
+        set_filter_state(
+          filtered_data,
+          teal_slices(teal_slice(dataname = "iris", varname = "Species", selected = "versicolor"))
+        )
+        session$flushReact()
+        set_filter_state(
+          filtered_data,
+          teal_slices(teal_slice(dataname = "iris", varname = "Species", selected = "setosa"))
+        )
+        session$flushReact()
+        set_filter_state(
+          filtered_data,
+          teal_slices(teal_slice(dataname = "iris", varname = "Species", selected = "virginica"))
+        )
+        session$flushReact()
+
+        session$setInputs(`iris-filter-iris_Species-reset` = 1L)
+        testthat::expect_identical(
+          get_filter_state(filtered_data)[[1]]$selected,
+          "versicolor"
+        )
+      }
+    )
+  })
+
+  it("input$remove removes filter from states", {
+    filtered_data <- init_filtered_data(x = list(iris = iris))
+    set_filter_state(
+      filtered_data,
+      teal_slices(teal_slice(dataname = "iris", varname = "Species"))
+    )
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive(c("iris", "mtcars"))),
+      expr = {
+        session$flushReact()
+        session$setInputs(`iris-filter-iris_Species-remove` = 1L)
+        testthat::expect_length(get_filter_state(filtered_data), 0)
+      }
+    )
+  })
+
+  it("setting input$keep_na-value reflects in filter-state", {
+    filtered_data <- init_filtered_data(x = list(iris = within(iris, Species[1] <- NA)))
+    set_filter_state(
+      filtered_data,
+      teal_slices(teal_slice(dataname = "iris", varname = "Species", keep_na = FALSE))
+    )
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive(c("iris", "mtcars"))),
+      expr = {
+        session$flushReact()
+        session$setInputs(`iris-filter-iris_Species-inputs-keep_na-value` = FALSE)
+        testthat::expect_false(get_filter_state(filtered_data)[[1]]$keep_na)
+      }
+    )
+  })
+})
+
+
+testthat::describe("test ChoicesFilterState server", {
+  it("summary displays selected choices as text", {
+    filtered_data <- init_filtered_data(x = list(iris = iris))
+    set_filter_state(
+      filtered_data,
+      teal_slices(teal_slice(dataname = "iris", varname = "Species", selected = c("setosa", "versicolor")))
+    )
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive(c("iris", "mtcars"))),
+      expr = {
+        session$flushReact()
+        testthat::expect_identical(
+          trimws(rvest::html_text(
+            rvest::read_html(as.character(output$`iris-filter-iris_Species-summary-summary`$html))
+          )),
+          "setosa, versicolor"
+        )
+      }
+    )
+  })
+
+  it("summary displays 'n levels selected' when selected exceeds 40 characters", {
+    filtered_data <- init_filtered_data(x = list(mtcars = within(mtcars, model <- rownames(mtcars))))
+    set_filter_state(
+      filtered_data,
+      teal_slices(teal_slice(dataname = "mtcars", varname = "model"))
+    )
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive(c("iris", "mtcars"))),
+      expr = {
+        session$flushReact()
+        testthat::expect_identical(
+          trimws(rvest::html_text(
+            rvest::read_html(as.character(output$`mtcars-filter-mtcars_model-summary-summary`$html))
+          )),
+          "32 levels selected"
+        )
+      }
+    )
+  })
+
+  it("summary displays 'no selection' when nothing is selected", {
+    filtered_data <- init_filtered_data(x = list(iris = iris))
+    set_filter_state(
+      filtered_data,
+      teal_slices(teal_slice(dataname = "iris", varname = "Species", selected = character(0), multiple = TRUE))
+    )
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive(c("iris", "mtcars"))),
+      expr = {
+        session$flushReact()
+        testthat::expect_identical(
+          trimws(rvest::html_text(
+            rvest::read_html(as.character(output$`iris-filter-iris_Species-summary-summary`$html))
+          )),
+          "no selection"
+        )
+      }
+    )
+  })
+
+  it("setting input$selection changes filter state (radioButton)", {
+    filtered_data <- init_filtered_data(x = list(iris = iris))
+    set_filter_state(
+      filtered_data,
+      teal_slices(teal_slice(dataname = "iris", varname = "Species"))
+    )
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive(c("iris", "mtcars"))),
+      expr = {
+        session$flushReact()
+        session$setInputs(`iris-filter-iris_Species-inputs-selection` = "setosa")
+        session$setInputs(`iris-filter-iris_Species-inputs-selection_open` = FALSE)
+
+        testthat::expect_identical(
+          get_filter_state(filtered_data)[[1]]$selected,
+          "setosa"
+        )
+      }
+    )
+  })
+
+  it("setting input$selection changes filter state (pickerInput)", {
+    withr::with_options(
+      list("teal.threshold_slider_vs_checkboxgroup" = 1L), # when length(choices) < 1 then radio-button
+      {
+        filtered_data <- init_filtered_data(x = list(iris = iris))
+        set_filter_state(
+          filtered_data,
+          teal_slices(teal_slice(dataname = "iris", varname = "Species"))
+        )
+        shiny::testServer(
+          filtered_data$srv_active,
+          args = list(id = "test", active_datanames = reactive(c("iris", "mtcars"))),
+          expr = {
+            session$flushReact()
+            session$setInputs(`iris-filter-iris_Species-inputs-selection` = c("setosa", "versicolor"))
+            session$setInputs(`iris-filter-iris_Species-inputs-selection_open` = FALSE)
+
+            testthat::expect_identical(
+              get_filter_state(filtered_data)[[1]]$selected,
+              c("setosa", "versicolor")
+            )
+          }
+        )
+      }
+    )
+  })
+
+  it("setting input$selection has no effect on filter state when fixed = TRUE", {
+    filtered_data <- init_filtered_data(x = list(iris = iris))
+    set_filter_state(
+      filtered_data,
+      teal_slices(teal_slice(dataname = "iris", varname = "Species", fixed = TRUE))
+    )
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive(c("iris", "mtcars"))),
+      expr = {
+        session$flushReact()
+        session$setInputs(`iris-filter-iris_Species-inputs-selection` = c("setosa", "versicolor", "virginica"))
+        session$setInputs(`iris-filter-iris_Species-inputs-selection_open` = FALSE)
+
+        testthat::expect_identical(
+          get_filter_state(filtered_data)[[1]]$selected,
+          c("setosa", "versicolor", "virginica")
+        )
+      }
+    )
+  })
+
+  it("setting many input$selection when multiple = FALSE is ignored with warning (radioInput)", {
+    filtered_data <- init_filtered_data(x = list(iris = iris))
+    set_filter_state(
+      filtered_data,
+      teal_slices(teal_slice(dataname = "iris", varname = "Species", selected = "setosa", multiple = FALSE))
+    )
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive(c("iris", "mtcars"))),
+      expr = {
+        session$flushReact()
+        testthat::expect_warning(
+          session$setInputs(`iris-filter-iris_Species-inputs-selection` = c("setosa", "versicolor", "virginica")),
+          "is not a vector of length one. Maintaining previous selection."
+        )
+        testthat::expect_identical(
+          get_filter_state(filtered_data)[[1]]$selected,
+          "setosa"
+        )
+      }
+    )
+  })
+
+  it("setting many input$selection when multiple = FALSE is ignored with warning (pickerInput)", {
+    withr::with_options(
+      list("teal.threshold_slider_vs_checkboxgroup" = 1L), # when length(choices) < 1 then radio-button
+      {
+        filtered_data <- init_filtered_data(x = list(iris = iris))
+        set_filter_state(
+          filtered_data,
+          teal_slices(teal_slice(dataname = "iris", varname = "Species", selected = "setosa", multiple = FALSE))
+        )
+        shiny::testServer(
+          filtered_data$srv_active,
+          args = list(id = "test", active_datanames = reactive(c("iris", "mtcars"))),
+          expr = {
+            session$flushReact()
+            session$setInputs(`iris-filter-iris_Species-inputs-selection` = c("setosa", "versicolor", "virginica"))
+            testthat::expect_warning(
+              session$setInputs(`iris-filter-iris_Species-inputs-selection_open` = FALSE),
+              "is not a vector of length one. Maintaining previous selection."
+            )
+            testthat::expect_identical(
+              get_filter_state(filtered_data)[[1]]$selected,
+              "setosa"
+            )
+          }
+        )
+      }
+    )
+  })
+})
+
+
+testthat::describe("test DateFilterState server", {
+  it("summary displays selected date-range as text", {
+    filtered_data <- init_filtered_data(x = list(iris = within(iris, date <- as.Date(seq_len(150)))))
+    set_filter_state(
+      filtered_data,
+      teal_slices(teal_slice(dataname = "iris", varname = "date", selected = c("1970-01-02", "1970-01-30")))
+    )
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive(c("iris", "mtcars"))),
+      expr = {
+        session$flushReact()
+        testthat::expect_match(
+          trimws(rvest::html_text(
+            rvest::read_html(as.character(output$`iris-filter-iris_date-summary-summary`$html))
+          )),
+          "1970-01-02.+1970-01-30"
+        )
+      }
+    )
+  })
+
+  it("setting input changes filter state $selected", {
+    filtered_data <- init_filtered_data(x = list(iris = within(iris, date <- as.Date(seq_len(150)))))
+    set_filter_state(
+      filtered_data,
+      teal_slices(teal_slice(dataname = "iris", varname = "date"))
+    )
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive(c("iris", "mtcars"))),
+      expr = {
+        session$flushReact()
+
+        session$setInputs(`iris-filter-iris_date-inputs-selection` = c("1970-01-02", "1970-01-30"))
+        testthat::expect_identical(
+          get_filter_state(filtered_data)[[1]]$selected,
+          as.Date(c("1970-01-02", "1970-01-30"))
+        )
+      }
+    )
+  })
+})
+
+
+testthat::describe("test RangeFilterState", {
+  it("summary displays selected numeric-range as text", {
+    filtered_data <- init_filtered_data(x = list(iris = iris))
+    set_filter_state(
+      filtered_data,
+      teal_slices(teal_slice(dataname = "iris", varname = "Sepal.Length", selected = c(5.0, 6.0)))
+    )
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive("iris")),
+      expr = {
+        session$flushReact()
+        testthat::expect_match(
+          trimws(rvest::html_text(
+            rvest::read_html(as.character(output$`iris-filter-iris_Sepal_Length-summary-summary`$html))
+          )),
+          "^5.+6$"
+        )
+      }
+    )
+  })
+})
diff --git a/tests/testthat/test-teal_slice.R b/tests/testthat/test-teal_slice.R
index 3dcbfe592..05f1e97fd 100644
--- a/tests/testthat/test-teal_slice.R
+++ b/tests/testthat/test-teal_slice.R
@@ -98,6 +98,11 @@ testthat::test_that("teal_slice checks arguments", {
     teal_slice(dataname = "data", varname = "var", id = 1L),
     "Assertion on 'id' failed"
   )
+
+  testthat::expect_error(
+    teal_slice(dataname = "data", varname = "var", expr = "a > 1"),
+    "Must provide either `expr` or `varname`"
+  )
 })
 
 testthat::test_that("teal_slice returns `teal_slice`", {

From 764330a6327ec3ad371a587355b0fcc11746bd4d Mon Sep 17 00:00:00 2001
From: Dawid Kaledkowski <dawid.kaledkowski@gmail.com>
Date: Thu, 6 Nov 2025 11:31:52 +0100
Subject: [PATCH 5/9] lint

---
 tests/testthat/test-FilteredData.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/tests/testthat/test-FilteredData.R b/tests/testthat/test-FilteredData.R
index 855ccad35..ab73f2f8d 100644
--- a/tests/testthat/test-FilteredData.R
+++ b/tests/testthat/test-FilteredData.R
@@ -866,7 +866,7 @@ testthat::describe("test FilterState server", {
   })
 
   it("setting input$keep_na-value reflects in filter-state", {
-    filtered_data <- init_filtered_data(x = list(iris = within(iris, Species[1] <- NA)))
+    filtered_data <- init_filtered_data(x = list(iris = within(iris, Species[1] <- NA))) # nolint: object_name_linter
     set_filter_state(
       filtered_data,
       teal_slices(teal_slice(dataname = "iris", varname = "Species", keep_na = FALSE))

From 3ec96c7fceaaa87564b429ba68ee7fb73225adcc Mon Sep 17 00:00:00 2001
From: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Date: Thu, 6 Nov 2025 10:42:28 +0000
Subject: [PATCH 6/9] [skip roxygen] [skip vbump] Roxygen Man Pages Auto Update

---
 DESCRIPTION               | 2 +-
 man/FilteredData.Rd       | 2 +-
 man/MAEFilteredDataset.Rd | 2 +-
 man/choices_labeled.Rd    | 6 +-----
 4 files changed, 4 insertions(+), 8 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 4efb76aa2..eccedffa9 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -79,4 +79,4 @@ Encoding: UTF-8
 Language: en-US
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3
diff --git a/man/FilteredData.Rd b/man/FilteredData.Rd
index 0f4b16320..d288e8ce6 100644
--- a/man/FilteredData.Rd
+++ b/man/FilteredData.Rd
@@ -62,7 +62,7 @@ isolate(datasets$get_filter_state())
 isolate(datasets$get_call("iris"))
 isolate(datasets$get_call("mtcars"))
 
-\dontshow{if (requireNamespace("MultiAssayExperiment")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
+\dontshow{if (requireNamespace("MultiAssayExperiment")) withAutoprint(\{ # examplesIf}
 ### set_filter_state
 library(shiny)
 
diff --git a/man/MAEFilteredDataset.Rd b/man/MAEFilteredDataset.Rd
index 77fc77e97..c746b0c4a 100644
--- a/man/MAEFilteredDataset.Rd
+++ b/man/MAEFilteredDataset.Rd
@@ -10,7 +10,7 @@
 \code{MAEFilteredDataset} \code{R6} class
 }
 \examples{
-\dontshow{if (requireNamespace("MultiAssayExperiment")) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf}
+\dontshow{if (requireNamespace("MultiAssayExperiment")) withAutoprint(\{ # examplesIf}
 # use non-exported function from teal.slice
 MAEFilteredDataset <- getFromNamespace("MAEFilteredDataset", "teal.slice")
 
diff --git a/man/choices_labeled.Rd b/man/choices_labeled.Rd
index a37a77fb3..c424703c7 100644
--- a/man/choices_labeled.Rd
+++ b/man/choices_labeled.Rd
@@ -4,7 +4,7 @@
 \alias{choices_labeled}
 \title{Set "\verb{<choice>:<label>}" type of names}
 \usage{
-choices_labeled(choices, labels, subset = NULL, types = NULL)
+choices_labeled(choices, labels, types = NULL)
 }
 \arguments{
 \item{choices}{(\code{character} or \code{numeric} or \code{logical}) vector}
@@ -12,10 +12,6 @@ choices_labeled(choices, labels, subset = NULL, types = NULL)
 \item{labels}{(\code{character}) vector containing labels to be applied to \code{choices}. If \code{NA} then
 "Label Missing" will be used.}
 
-\item{subset}{a vector that is a subset of \code{choices}. This is useful if
-only a few variables need to be named. If this argument is used, the returned vector will
-match its order.}
-
 \item{types}{vector containing the types of the columns.}
 }
 \value{

From 9ea4bb21b1e0d6555d1442f21e45057f92f3ae60 Mon Sep 17 00:00:00 2001
From: Dawid Kaledkowski <dawid.kaledkowski@gmail.com>
Date: Thu, 6 Nov 2025 12:22:16 +0100
Subject: [PATCH 7/9] missing dependency

---
 DESCRIPTION | 1 +
 1 file changed, 1 insertion(+)

diff --git a/DESCRIPTION b/DESCRIPTION
index eccedffa9..be31563fe 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -59,6 +59,7 @@ Suggests:
     knitr (>= 1.42),
     MultiAssayExperiment,
     rmarkdown (>= 2.23),
+    rvest,
     shinytest2 (>= 0.4.1),
     SummarizedExperiment,
     testthat (>= 3.2.2),

From 949b349acdb5244e2fba9f7eaf11b4c88b2644a5 Mon Sep 17 00:00:00 2001
From: Dawid Kaledkowski <dawid.kaledkowski@gmail.com>
Date: Thu, 6 Nov 2025 15:20:55 +0100
Subject: [PATCH 8/9] add more coverage

---
 tests/testthat/test-FilteredData.R | 127 +++++++++++++++++++++++++++++
 1 file changed, 127 insertions(+)

diff --git a/tests/testthat/test-FilteredData.R b/tests/testthat/test-FilteredData.R
index ab73f2f8d..f5f140a17 100644
--- a/tests/testthat/test-FilteredData.R
+++ b/tests/testthat/test-FilteredData.R
@@ -1140,3 +1140,130 @@ testthat::describe("test RangeFilterState", {
     )
   })
 })
+
+
+testthat::describe("test FilterStateExpr server", {
+  it("summary displays expression as text", {
+    filtered_data <- init_filtered_data(x = list(iris = iris))
+    filtered_data$set_filter_state(
+      teal_slices(
+        teal_slice(dataname = "iris", id = "test_expr", title = "Custom filter", expr = "Species == 'setosa'")
+      )
+    )
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive("iris")),
+      expr = {
+        session$flushReact()
+        testthat::expect_identical(
+          as.character(output$`iris-filter-test_expr-summary-summary`$html),
+          "Species == 'setosa'"
+        )
+      }
+    )
+  })
+
+  it("input$remove removes filter from states", {
+    filtered_data <- init_filtered_data(x = list(iris = iris))
+    filtered_data$set_filter_state(
+      teal_slices(
+        teal_slice(dataname = "iris", id = "test_expr", title = "Custom filter", expr = "Species == 'setosa'")
+      )
+    )
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive("iris")),
+      expr = {
+        session$flushReact()
+        testthat::expect_length(filtered_data$get_filter_state(), 1)
+        session$setInputs(`iris-filter-test_expr-remove` = 1L)
+        testthat::expect_length(filtered_data$get_filter_state(), 0)
+      }
+    )
+  })
+
+  it("input$remove has no effect when filter is anchored", {
+    filtered_data <- init_filtered_data(x = list(iris = iris))
+    filtered_data$set_filter_state(
+      teal_slices(
+        teal_slice(
+          dataname = "iris", id = "test_expr", title = "Custom filter",
+          expr = "Species == 'setosa'", anchored = TRUE
+        )
+      )
+    )
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive("iris")),
+      expr = {
+        session$flushReact()
+        testthat::expect_length(filtered_data$get_filter_state(), 1)
+        # The remove button should not exist for anchored filters, so this won't do anything
+        testthat::expect_length(filtered_data$get_filter_state(), 1)
+      }
+    )
+  })
+
+  it("multiple FilterStateExpr filters can coexist for the same varname", {
+    filtered_data <- init_filtered_data(x = list(iris = iris))
+    filtered_data$set_filter_state(
+      teal_slices(
+        teal_slice(dataname = "iris", id = "expr1", title = "Filter 1", expr = "Species == 'setosa'"),
+        teal_slice(
+          dataname = "iris", id = "expr2", title = "Filter 2",
+          expr = "Species %in% c('setosa', 'versicolor')"
+        )
+      )
+    )
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive("iris")),
+      expr = {
+        session$flushReact()
+        testthat::expect_length(filtered_data$get_filter_state(), 2)
+        testthat::expect_identical(filtered_data$get_filter_state()[[1]]$expr, "Species == 'setosa'")
+        testthat::expect_identical(
+          filtered_data$get_filter_state()[[2]]$expr, "Species %in% c('setosa', 'versicolor')"
+        )
+      }
+    )
+  })
+
+  it("FilterStateExpr can be mixed with other FilterState types", {
+    filtered_data <- init_filtered_data(x = list(iris = iris))
+    filtered_data$set_filter_state(
+      teal_slices(
+        teal_slice(dataname = "iris", varname = "Species", selected = "setosa"),
+        teal_slice(dataname = "iris", id = "expr1", title = "Custom", expr = "Sepal.Length > 5")
+      )
+    )
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive("iris")),
+      expr = {
+        session$flushReact()
+        testthat::expect_length(filtered_data$get_filter_state(), 2)
+        # First is ChoicesFilterState
+        testthat::expect_identical(filtered_data$get_filter_state()[[1]]$varname, "Species")
+        # Second is FilterStateExpr
+        testthat::expect_identical(filtered_data$get_filter_state()[[2]]$expr, "Sepal.Length > 5")
+      }
+    )
+  })
+
+  it("FilterStateExpr is executed and produces filtered data", {
+    filtered_data <- init_filtered_data(x = list(iris = iris))
+    filtered_data$set_filter_state(
+      teal_slices(teal_slice(dataname = "iris", id = "expr1", title = "Setosa only", expr = "Species == 'setosa'"))
+    )
+    shiny::testServer(
+      filtered_data$srv_active,
+      args = list(id = "test", active_datanames = reactive("iris")),
+      expr = {
+        session$flushReact()
+        filtered_iris <- filtered_data$get_data("iris", filtered = TRUE)
+        testthat::expect_identical(filtered_iris, subset(iris, Species == "setosa"))
+      }
+    )
+  })
+})

From 29aca2605a25d5c396d3db91a37ca267bd12e837 Mon Sep 17 00:00:00 2001
From: Dawid Kaledkowski <dawid.kaledkowski@gmail.com>
Date: Fri, 7 Nov 2025 09:07:33 +0100
Subject: [PATCH 9/9] @osenan @m7pr review comments

---
 DESCRIPTION                        |  2 +-
 tests/testthat/test-FilteredData.R | 66 +++++++++++++++---------------
 2 files changed, 34 insertions(+), 34 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index be31563fe..1a7071b05 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -59,7 +59,7 @@ Suggests:
     knitr (>= 1.42),
     MultiAssayExperiment,
     rmarkdown (>= 2.23),
-    rvest,
+    rvest (>= 1.0.0),
     shinytest2 (>= 0.4.1),
     SummarizedExperiment,
     testthat (>= 3.2.2),
diff --git a/tests/testthat/test-FilteredData.R b/tests/testthat/test-FilteredData.R
index f5f140a17..daaffe161 100644
--- a/tests/testthat/test-FilteredData.R
+++ b/tests/testthat/test-FilteredData.R
@@ -564,12 +564,10 @@ testthat::describe("srv_overview", {
       args = list(id = "test", active_datanames = reactive(c("iris", "mtcars"))),
       expr = {
         testthat::expect_identical(
-          as.data.frame(
-            rvest::html_table(rvest::read_html(as.character(output$table$html)),
-              header = TRUE
-            ),
-            check.names = FALSE
-          ),
+          as.character(output$table$html) %>%
+            rvest::read_html() %>%
+            rvest::html_table(header = TRUE) %>%
+            as.data.frame(check.names = FALSE),
           data.frame(
             `Data Name` = c("iris", "mtcars"),
             `Obs` = c("50/150", "18/32"),
@@ -602,12 +600,10 @@ testthat::describe("srv_overview", {
       args = list(id = "test", active_datanames = reactive(c("parent", "child"))),
       expr = {
         testthat::expect_identical(
-          as.data.frame(
-            rvest::html_table(rvest::read_html(as.character(output$table$html)),
-              header = TRUE
-            ),
-            check.names = FALSE
-          ),
+          as.character(output$table$html) %>%
+            rvest::read_html() %>%
+            rvest::html_table(header = TRUE) %>%
+            as.data.frame(check.names = FALSE),
           data.frame(
             `Data Name` = c("parent", "child"),
             Obs = c("3/5", "6/10"),
@@ -626,12 +622,11 @@ testthat::describe("srv_overview", {
       args = list(id = "test", active_datanames = reactive(c("iris", "test"))),
       expr = {
         testthat::expect_identical(
-          trimws(rvest::html_text(
-            rvest::html_nodes(
-              rvest::read_html(as.character(output$table$html)),
-              xpath = "//td[i[@title='Unsupported dataset']]"
-            )
-          )),
+          as.character(output$table$html) %>%
+            rvest::read_html() %>%
+            rvest::html_nodes(xpath = "//td[i[@title='Unsupported dataset']]") %>%
+            rvest::html_text() %>%
+            trimws(),
           "test"
         )
       }
@@ -897,9 +892,10 @@ testthat::describe("test ChoicesFilterState server", {
       expr = {
         session$flushReact()
         testthat::expect_identical(
-          trimws(rvest::html_text(
-            rvest::read_html(as.character(output$`iris-filter-iris_Species-summary-summary`$html))
-          )),
+          as.character(output$`iris-filter-iris_Species-summary-summary`$html) %>%
+            rvest::read_html() %>%
+            rvest::html_text() %>%
+            trimws(),
           "setosa, versicolor"
         )
       }
@@ -918,9 +914,10 @@ testthat::describe("test ChoicesFilterState server", {
       expr = {
         session$flushReact()
         testthat::expect_identical(
-          trimws(rvest::html_text(
-            rvest::read_html(as.character(output$`mtcars-filter-mtcars_model-summary-summary`$html))
-          )),
+          as.character(output$`mtcars-filter-mtcars_model-summary-summary`$html) %>%
+            rvest::read_html() %>%
+            rvest::html_text() %>%
+            trimws(),
           "32 levels selected"
         )
       }
@@ -939,9 +936,10 @@ testthat::describe("test ChoicesFilterState server", {
       expr = {
         session$flushReact()
         testthat::expect_identical(
-          trimws(rvest::html_text(
-            rvest::read_html(as.character(output$`iris-filter-iris_Species-summary-summary`$html))
-          )),
+          as.character(output$`iris-filter-iris_Species-summary-summary`$html) %>%
+            rvest::read_html() %>%
+            rvest::html_text() %>%
+            trimws(),
           "no selection"
         )
       }
@@ -1086,9 +1084,10 @@ testthat::describe("test DateFilterState server", {
       expr = {
         session$flushReact()
         testthat::expect_match(
-          trimws(rvest::html_text(
-            rvest::read_html(as.character(output$`iris-filter-iris_date-summary-summary`$html))
-          )),
+          as.character(output$`iris-filter-iris_date-summary-summary`$html) %>%
+            rvest::read_html() %>%
+            rvest::html_text() %>%
+            trimws(),
           "1970-01-02.+1970-01-30"
         )
       }
@@ -1131,9 +1130,10 @@ testthat::describe("test RangeFilterState", {
       expr = {
         session$flushReact()
         testthat::expect_match(
-          trimws(rvest::html_text(
-            rvest::read_html(as.character(output$`iris-filter-iris_Sepal_Length-summary-summary`$html))
-          )),
+          as.character(output$`iris-filter-iris_Sepal_Length-summary-summary`$html) %>%
+            rvest::read_html() %>%
+            rvest::html_text() %>%
+            trimws(),
           "^5.+6$"
         )
       }