187 new filter panel api

[chlebowa]

This PR contains work towards a new filter panel API as outlined in #187.

TESTING class methods:

1. preparations

# get FilteredData object on demand
utils::data(miniACC, package = "MultiAssayExperiment")
get_fd <- function() {
  init_filtered_data(
    x = list(
      iris = list(dataset = iris),
      mtcars = list(dataset = mtcars),
      mae = list(dataset = miniACC)
    )
  )
}


# specify filter states (old way)
fss <- list(
  iris = list(
    "Species" = list(selected = "setosa"),
    "Sepal.Length" = list(selected = c(5, 6))
  ),
  mtcars = list(
    "disp" = list(selected = c(0, 280)),
    "cyl" = list(selected = 6)
  ),
  mae = list(
    subjects = list(
      years_to_birth = list(selected = c(30, 50), keep_na = TRUE, keep_inf = FALSE),
      vital_status = list(selected = "1", keep_na = FALSE),
      gender = list(selected = "female", keep_na = TRUE)
    ),
    RPPAArray = list(
      subset = list(
        ARRAY_TYPE = list(selected = "", keep_na = TRUE)
      )
    )
  )
)

# specify filter states (new way)
tss <- filter_settings(
  filter_var("iris", "Species", selected = "setosa"),
  filter_var("iris", "Sepal.Length", selected = c(5, 6)),
  filter_var("mtcars", "disp", selected = c(0, 280)),
  filter_var("mtcars", "cyl", selected = 6),
  filter_var("mae", "years_to_birth", selected = c(30, 50), keep_na = TRUE, keep_inf = FALSE, datalabel = "subjects", target = "y"),
  filter_var("mae", "vital_status", selected = "1", keep_na = FALSE, datalabel = "subjects", target = "y"),
  filter_var("mae", "gender", selected = "female", keep_na = TRUE, datalabel = "subjects", target = "y"),
  filter_var("mae", "ARRAY_TYPE", selected = "", keep_na = TRUE, datalabel = "RPPAArray", target = "subset")
)

2. convert old states specification to new one

fss_new <- as.teal_slices(fss)
identical(fss, tss)
identical(fss_new, tss)

☝️ this happens in FilteredData$set_filter_state with a warning
Note as.teal_slices does not perform any validation, so a list-like filter state that specifies filters on columns of MAE@colData that is not wrapped as list(MAE = list(...)) but is only list(var = list(...)) will be interpreted as a data.frame filter.

3. set states as list

# create FilteredData
fd <- get_fd()
# apply filter states
fd$set_filter_state(fss)
# see calls
fd$get_call("iris") %>% isolate
fd$get_call("mtcars") %>% isolate
fd$get_call("mae") %>% isolate
#recover filter states
fd$get_filter_state() %>% isolate

4. set states as teal_slices

# create FilteredData
fd <- get_fd()
# apply filter states
fd$set_filter_state(tss)
# see calls
fd$get_call("iris") %>% isolate
fd$get_call("mtcars") %>% isolate
fd$get_call("mae") %>% isolate
#recover filter states
fd$get_filter_state() %>% isolate

Note that calls are not generated. This is these filters are instantiated and constructors don't know how to handle choices yet, so by default they are created with everything selected, hence no calls.

5. modify states as teal_slices

fd$set_filter_state(tss)
# see calls
fd$get_call("iris") %>% isolate
fd$get_call("mtcars") %>% isolate
fd$get_call("mae") %>% isolate
#recover filter states
fd$get_filter_state() %>% isolate

TESTING wrapper functions:

datasets <- init_filtered_data(
  x = list(
    iris = list(dataset = iris),
    mae = list(dataset = miniACC)
  )
)
fs <- filter_settings(
  filter_var("iris", "Species", selected = c("setosa", "versicolor")),
  filter_var("iris", "Sepal.Length", selected = c(5.1, 6.4)),
  filter_var("mae", "years_to_birth", selected = c(30, 50),
             keep_na = TRUE, keep_inf = FALSE, datalabel = "subjects", target = "y"),
  filter_var("mae", "vital_status", selected = "1", keep_na = FALSE, datalabel = "subjects", target = "y"),
  filter_var("mae", "gender", selected = "female", keep_na = TRUE, datalabel = "subjects", target = "y"),
  filter_var("mae", "ARRAY_TYPE", selected = "", keep_na = TRUE, datalabel = "RPPAArray", target = "subset")
)

# set initial filter state
set_filter_state(datasets, filter = fs)

fd$.__enclos_env__$private$get_filter_count() %>% isolate

# get filter state
get_filter_state(datasets)

fd$.__enclos_env__$private$get_filter_count() %>% isolate

# modify filter state
set_filter_state(
  datasets,
  filter_settings(
    filter_var("iris", "Species", selected = "setosa", keep_na = TRUE)
  )
)

fd$.__enclos_env__$private$get_filter_count() %>% isolate

# remove specific filters
remove_filter_state(
  datasets,
  filter_settings(
    filter_var("iris", "Species"),
    filter_var("mae", "years_to_birth"),
    filter_var("mae", "vital_status")
  )
)

fd$.__enclos_env__$private$get_filter_count() %>% isolate

# remove all states
clear_filter_states(datasets)

fd$.__enclos_env__$private$get_filter_count() %>% isolate

[chlebowa]

@asbates this stopped working after filter_panel_refactor@main was merged into this branch, could you have a look?

[donyunardi]

Is it possible to use the disable/enable() method instead of directly accessing the private field filter_panel_active?

This works for me:

testthat::test_that("switching disable/enable button caches and restores state", {
  filtered_data <- FilteredData$new(
    list(
      iris = list(dataset = iris),
      mtcars = list(dataset = mtcars)
    )
  )
  fs <- filter_settings(
    filter_var(dataname = "iris", varname = "Sepal.Length", selected = c(5.1, 6.4), keep_na = TRUE, keep_inf = FALSE),
    filter_var(dataname = "iris", varname = "Species", selected = c("setosa", "versicolor"), keep_na = FALSE),
    filter_var(dataname = "mtcars", varname = "cyl", selected = c(4, 6), keep_na = FALSE, keep_inf = FALSE),
    filter_var(dataname = "mtcars", varname = "disp", keep_na = FALSE, keep_inf = FALSE)
  )
  filtered_data$set_filter_state(fs)
  shiny::testServer(
    filtered_data$srv_filter_panel,
    expr = {
      cached <- filtered_data$get_filter_state()
      testthat::expect_true(filtered_data$get_filter_panel_active())
      filtered_data$filter_panel_disable() # here 
      testthat::expect_null(filtered_data$get_filter_state())
      testthat::expect_false(filtered_data$get_filter_panel_active())
      testthat::expect_warning(filtered_data$filter_panel_enable(), "Choices adjusted") # here
      testthat::expect_identical(filtered_data$get_filter_state(), cached)
      testthat::expect_true(filtered_data$get_filter_panel_active())
    }
  )
})

[chlebowa]

Can we call the disable/enable() method instead of accessing private field filter_panel_active? This works for me:

That is done in another test. It is very suspect that setInput did the job previously but stopped after the merge, might be a sign of a hidden flaw.

[chlebowa]

So setInputs doesn't trigger the relevant observer when session$setInputs(filter_panel_active = FALSE) is called. Odd, the switch works when clicked by hand (MAE example in #165).

I tried, I don't get it.

requested changes have been implemented

[chlebowa]

The test failure was caused by the fact that the button filter_panel_enable was move from the module srv_filter_panel to srv_active. Even though the latter is called by the former, setInputs failed to find the id "filter_panel_active" in input and thus could not assign another value.

We consider this a bug ar at least a limitation on setInputs.

The test was changed to run in srv_active directly.