duplicated available slices

R/FilterStates.R

@@ -201,14 +201,9 @@ FilterStates <- R6::R6Class( # nolint
     remove_filter_state = function(state) {
       shiny::isolate({
         checkmate::assert_class(state, "teal_slices")
-
-        lapply(state, function(x) {
-          state_id <- x$id
-          logger::log_trace("{ class(self)[1] }$remove_filter_state removing filter, state_id: { state_id }")
-          private$state_list_remove(state_id = state_id)
-          logger::log_trace("{ class(self)[1] }$remove_filter_state removed filter, state_id: { state_id }")
-        })
-
+        state_ids <- vapply(state, `[[`, character(1), "id")
+        logger::log_trace("{ class(self)[1] }$remove_filter_state removing filters, state_id: { toString(state_ids) }")
+        private$state_list_remove(state_ids)
         invisible(NULL)
       })
     },
@@ -636,14 +631,21 @@ FilterStates <- R6::R6Class( # nolint
         logger::log_trace("{ class(self)[1] } removing a filter, state_id: { state_id }")
         checkmate::assert_character(state_id)
         new_state_list <- private$state_list()
-        if (is.element(state_id, names(new_state_list))) {
-          if (new_state_list[[state_id]]$get_state()$locked) {
-            return(invisible(NULL))
-          }
-          new_state_list[[state_id]]$destroy_observers()
-          new_state_list[[state_id]] <- NULL
+        current_state_ids <- vapply(private$state_list(), function(x) x$get_state()$id, character(1))
+        to_remove <- state_id %in% current_state_ids
+        if (any(to_remove)) {
+          new_state_list <- Filter(
+            function(state) {
+              if (state$get_state()$id %in% state_id && !state$get_state()$locked) {
+                state$destroy_observers()
+                FALSE
+              } else {
+                TRUE
+              }
+            },
+            private$state_list()
+          )
           private$state_list(new_state_list)
-          logger::log_trace("{ class(self)[1] } removed a filter, state_id: { state_id }")
         } else {
           warning(sprintf("\"%s\" not found in state list", state_id))
         }
@@ -661,13 +663,12 @@ FilterStates <- R6::R6Class( # nolint
         logger::log_trace(
           "{ class(self)[1] }$state_list_empty removing all non-locked filters for dataname: { private$dataname }"
         )
+
         state_list <- private$state_list()
-        for (state_id in names(state_list)) {
-          private$state_list_remove(state_id)
+        if (length(state_list)) {
+          state_list_ids <- vapply(state_list, function(x) x$get_state()$id, character(1))
+          private$state_list_remove(state_list_ids)
         }
-        logger::log_trace(
-          "{ class(self)[1] }$state_list_empty removed all non-locked filters for dataname: { private$dataname }"
-        )
         invisible(NULL)
       })
     },

R/FilteredData.R

@@ -482,7 +482,7 @@ FilteredData <- R6::R6Class( # nolint
           private$module_add <- module_add
         }
 
-        lapply(datanames, function(dataname) {
+        lapply(self$datanames(), function(dataname) {
           states <- Filter(function(x) identical(x$dataname, dataname), state)
           private$get_filtered_dataset(dataname)$set_filter_state(states)
         })
@@ -591,7 +591,10 @@ FilteredData <- R6::R6Class( # nolint
     #' @return invisible `NULL`
     set_available_teal_slices = function(x) {
       checkmate::assert_class(x, "reactive")
-      private$available_teal_slices <- x
+      private$available_teal_slices <- reactive({
+        # we want to limit the available filters to the ones that are relevant for this FilteredData
+        Filter(function(x) x$dataname %in% self$datanames(), x())
+      })
       invisible(NULL)
     },
 
@@ -1073,7 +1076,6 @@ FilteredData <- R6::R6Class( # nolint
     # appropriate filter (identified by it's id)
     srv_available_filters = function(id) {
       moduleServer(id, function(input, output, session) {
-        slices <- reactive(Filter(function(slice) !isTRUE(slice$locked), private$available_teal_slices()))
         slices_interactive <- reactive(
           Filter(
             function(slice) !isTRUE(slice$fixed) && !inherits(slice, "teal_slice_expr"),
@@ -1086,8 +1088,16 @@ FilteredData <- R6::R6Class( # nolint
             private$available_teal_slices()
           )
         )
-        available_slices_id <- reactive(vapply(slices(), `[[`, character(1), "id"))
+        available_slices_id <- reactive(vapply(private$available_teal_slices(), `[[`, character(1), "id"))
         active_slices_id <- reactive(vapply(self$get_filter_state(), `[[`, character(1), "id"))
+        duplicated_slice_references <- reactive({
+          # slice refers to a particular column
+          slice_reference <- vapply(private$available_teal_slices(), get_default_slice_id, character(1))
+          is_duplicated_reference <- duplicated(slice_reference) | duplicated(slice_reference, fromLast = TRUE)
+          is_active <- available_slices_id() %in% active_slices_id()
+          is_not_expr <- vapply(private$available_teal_slices(), inherits, logical(1), "teal_slice_expr")
+          slice_reference[is_duplicated_reference & is_active & !is_not_expr]
+        })
 
         checkbox_group_element <- function(name, value, label, checked, disabled = FALSE) {
           tags$div(
@@ -1113,45 +1123,53 @@ FilteredData <- R6::R6Class( # nolint
             selected = NULL
           )
           active_slices_ids <- active_slices_id()
-
-          shiny::isolate({
-            interactive_choice_mock <- lapply(
-              slices_interactive(),
-              function(slice) {
+          duplicated_slice_refs <- duplicated_slice_references()
+          interactive_choice_mock <- lapply(
+            slices_interactive(),
+            function(slice) {
+              # we need to isolate changes in the fields of the slice (teal_slice)
+              shiny::isolate({
                 checkbox_group_element(
                   name = session$ns("available_slices_id"),
                   value = slice$id,
                   label = slice$id,
                   checked = if (slice$id %in% active_slices_ids) "checked",
-                  disabled = slice$locked
+                  disabled = slice$locked ||
+                    get_default_slice_id(slice) %in% duplicated_slice_refs &&
+                      !slice$id %in% active_slices_ids
                 )
-              }
-            )
+              })
+            }
+          )
 
-            non_interactive_choice_mock <- lapply(
-              slices_fixed(),
-              function(slice) {
+          non_interactive_choice_mock <- lapply(
+            slices_fixed(),
+            function(slice) {
+              # we need to isolate changes in the fields of the slice (teal_slice)
+              isolate(
                 checkbox_group_element(
                   name = session$ns("available_slices_id"),
                   value = slice$id,
                   label = slice$id,
                   checked = if (slice$id %in% active_slices_ids) "checked",
-                  disabled = slice$locked
+                  disabled = slice$locked ||
+                    get_default_slice_id(slice) %in% duplicated_slice_refs &&
+                      !slice$id %in% active_slices_ids
                 )
-              }
-            )
+              )
+            }
+          )
 
-            htmltools::tagInsertChildren(
-              checkbox,
-              br(),
-              tags$strong("Fixed filters"),
-              non_interactive_choice_mock,
-              tags$strong("Iteractive filters"),
-              interactive_choice_mock,
-              .cssSelector = "div.shiny-options-group",
-              after = 0
-            )
-          })
+          htmltools::tagInsertChildren(
+            checkbox,
+            br(),
+            tags$strong("Fixed filters"),
+            non_interactive_choice_mock,
+            tags$strong("Iteractive filters"),
+            interactive_choice_mock,
+            .cssSelector = "div.shiny-options-group",
+            after = 0
+          )
         })
 
         observeEvent(input$available_slices_id, ignoreNULL = FALSE, ignoreInit = TRUE, {
@@ -1160,22 +1178,22 @@ FilteredData <- R6::R6Class( # nolint
           if (length(new_slices_id)) {
             new_teal_slices <- Filter(
               function(slice) slice$id %in% new_slices_id,
-              slices()
+              private$available_teal_slices()
             )
             self$set_filter_state(new_teal_slices)
           }
 
           if (length(removed_slices_id)) {
             removed_teal_slices <- Filter(
               function(slice) slice$id %in% removed_slices_id,
-              slices()
+              self$get_filter_state()
             )
             self$remove_filter_state(removed_teal_slices)
           }
         })
 
-        observeEvent(slices(), ignoreNULL = FALSE, {
-          if (length(slices())) {
+        observeEvent(private$available_teal_slices(), ignoreNULL = FALSE, {
+          if (length(private$available_teal_slices())) {
             shinyjs::show("available_menu")
           } else {
             shinyjs::hide("available_menu")

R/FilteredDatasetDefault.R

@@ -183,15 +183,11 @@ DefaultFilteredDataset <- R6::R6Class( # nolint
     set_filter_state = function(state) {
       shiny::isolate({
         logger::log_trace("{ class(self)[1] }$set_filter_state initializing, dataname: { private$dataname }")
-        checkmate::assert_class(state, "teal_slices")
-        lapply(state, function(x) {
-          checkmate::assert_true(
-            shiny::isolate(x$dataname) == private$dataname,
-            .var.name = "dataname matches private$dataname"
-          )
-          private$get_filter_states()[[1L]]$set_filter_state(state = state)
-          logger::log_trace("{ class(self)[1] }$set_filter_state initialized, dataname: { private$dataname }")
+        lapply(state, function(slice) {
+          checkmate::assert_true(slice$dataname == private$dataname)
         })
+        checkmate::assert_class(state, "teal_slices")
+        private$get_filter_states()[[1L]]$set_filter_state(state = state)
         invisible(NULL)
       })
     },

R/teal_slice.R

@@ -150,10 +150,7 @@ teal_slice <- function(dataname,
     checkmate::assert_flag(keep_inf, null.ok = TRUE)
     checkmate::assert_flag(multiple)
     if (missing(id)) {
-      args$id <- paste(
-        Filter(length, args[c("dataname", "varname", "experiment", "arg")]),
-        collapse = " "
-      )
+      args$id <- get_default_slice_id(args)
     } else {
       checkmate::assert_string(id)
     }
@@ -318,3 +315,29 @@ trim_lines_json <- function(x) {
   substr(x_trim, trim_position - 2, trim_position) <- "..."
   x_trim
 }
+
+#' Default `teal_slice` id
+#'
+#' Function returns a default `id` for a `teal_slice` object which needs
+#' to be distinct from other `teal_slice` objects created for any
+#' `FilterStates` object. Returned `id` can be treated as a location of
+#' a vector on which `FilterState` is built:
+#' - for a `data.frame` `id` concatenates `dataname` and `varname`.
+#' - for a `MultiAssayExperiment` `id` concatenates `dataname`, `varname`,
+#' `experiment` and `arg`, so that one can add `teal_slice` for a `varname`
+#' which exists in multiple `SummarizedExperiment`s or exists in both `colData`
+#' and `rowData` of given experiment.
+#' @param x (`teal_slice` or `list`)
+#' @return (`character(1)`) `id` for a `teal_slice` object.
+#' @keywords internal
+get_default_slice_id <- function(x) {
+  shiny::isolate({
+    paste(
+      Filter(
+        length,
+        as.list(x)[c("dataname", "varname", "experiment", "arg")]
+      ),
+      collapse = " "
+    )
+  })
+}

R/teal_slices.R

@@ -211,9 +211,6 @@ as.teal_slices <- function(x) { # nolint
   y <- NextMethod("[")
   attrs <- attributes(x)
   attrs$names <- attrs$names[i]
-  datanames <- unique(unlist(vapply(y, function(ts) shiny::isolate(ts[["dataname"]]), character(1L))))
-  attrs[["exclude_varnames"]] <- Filter(Negate(is.null), attr(x, "exclude_varnames")[datanames])
-  attrs[["include_varnames"]] <- Filter(Negate(is.null), attr(x, "include_varnames")[datanames])
   attributes(y) <- attrs
   y
 }

tests/testthat/test-FilteredData.R

@@ -670,7 +670,6 @@ testthat::test_that("clear_filter_states does not remove locked filters", {
     )
   )
   datasets$set_filter_state(state = fs)
-
   datasets$clear_filter_states()
 
   testthat::expect_length(shiny::isolate(datasets$get_filter_state()), 2)
@@ -917,6 +916,7 @@ fs <- teal_slices(
   teal_slice(dataname = "iris", varname = "Sepal.Width", fixed = TRUE),
   teal_slice(dataname = "iris", varname = "Petal.Length"),
   teal_slice(dataname = "iris", varname = "Petal.Width"),
+  teal_slice(dataname = "iris", varname = "Petal.Width", id = "duplicated"),
   teal_slice(dataname = "iris", title = "test", id = "test", expr = "!is.na(Species)")
 )
 fs_rv <- reactiveVal(fs)
@@ -926,21 +926,21 @@ shiny::testServer(
   datasets$srv_available_filters,
   expr = {
     testthat::test_that("slices_interactive() reactive returns interactive filters", {
-      expect_identical_slices(slices_interactive(), fs[c(1, 3, 4)])
+      expect_identical_slices(slices_interactive(), fs[c(1, 3, 4, 5)])
     })
     testthat::test_that("slices_fixed() reactive returns fixed filters and teal_slice_expr", {
-      expect_identical_slices(slices_fixed(), fs[c(2, 5)])
-    })
-    testthat::test_that("FilteredData$srv_available_slices locked slices ommited", {
-      testthat::expect_identical(slices(), fs[-1])
+      expect_identical_slices(slices_fixed(), fs[c(2, 6)])
     })
 
     testthat::test_that("FilteredData$srv_available_slices new state in external list reflected in available slices", {
       species_slice <- teal_slice(dataname = "iris", varname = "Species")
       fs_rv(c(fs_rv(), teal_slices(species_slice)))
       testthat::expect_identical(
         available_slices_id(),
-        c("iris Sepal.Width", "iris Petal.Length", "iris Petal.Width", "test", "iris Species")
+        c(
+          "iris Sepal.Length", "iris Sepal.Width", "iris Petal.Length",
+          "iris Petal.Width", "duplicated", "test", "iris Species"
+        )
       )
     })
 
@@ -961,5 +961,18 @@ shiny::testServer(
       session$setInputs(available_slices_id = NULL)
       testthat::expect_identical(active_slices_id(), "iris Sepal.Length")
     })
+
+    testthat::test_that("duplicated_slice_references() returns character(0) if none of duplicated filters is active", {
+      session$setInputs(available_slices_id = "Sepal.Length")
+      testthat::expect_identical(duplicated_slice_references(), character(0))
+    })
+
+    testthat::test_that(
+      "duplicated_slice_references() returns variable reference when any of duplicated filters is on",
+      {
+        session$setInputs(available_slices_id = "duplicated")
+        testthat::expect_identical(duplicated_slice_references(), "iris Petal.Width")
+      }
+    )
   }
 )