Skip to content

Commit

Permalink
187 new filter panel api (#222)
Browse files Browse the repository at this point in the history
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)
```
:point_up: 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

```

---------

Signed-off-by: Marek Blazewicz <110387997+BLAZEWIM@users.noreply.github.com>
Co-authored-by: Marek Blazewicz <110387997+BLAZEWIM@users.noreply.github.com>
Co-authored-by: Blazewicz <blazewim@emea.roche.com>
Co-authored-by: Dawid Kałędkowski <6959016+gogonzo@users.noreply.github.com>
  • Loading branch information
4 people authored Apr 14, 2023
1 parent c3f86dd commit 29937b7
Show file tree
Hide file tree
Showing 81 changed files with 7,895 additions and 6,596 deletions.
12 changes: 9 additions & 3 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -1,5 +1,10 @@
# Generated by roxygen2: do not edit by hand

S3method("[",teal_slices)
S3method(c,teal_slice)
S3method(c,teal_slices)
S3method(format,teal_slice)
S3method(format,teal_slices)
S3method(get_supported_filter_varnames,FilteredDataset)
S3method(get_supported_filter_varnames,MAEFilteredDataset)
S3method(get_supported_filter_varnames,default)
Expand All @@ -20,16 +25,17 @@ S3method(init_filtered_data,TealData)
S3method(init_filtered_data,default)
S3method(init_filtered_dataset,MultiAssayExperiment)
S3method(init_filtered_dataset,data.frame)
S3method(resolve_state,default)
S3method(resolve_state,default_filter)
S3method(resolve_state,list)
S3method(print,teal_slice)
S3method(print,teal_slices)
S3method(variable_types,DFrame)
S3method(variable_types,DataTable)
S3method(variable_types,data.frame)
S3method(variable_types,default)
S3method(variable_types,matrix)
export(FilterPanelAPI)
export(clear_filter_states)
export(filter_settings)
export(filter_var)
export(get_filter_expr)
export(get_filter_state)
export(init_filter_states)
Expand Down
32 changes: 20 additions & 12 deletions R/FilterPanelAPI.R
Original file line number Diff line number Diff line change
Expand Up @@ -21,10 +21,10 @@
#' isolate(fpa$get_filter_state())
#'
#' # set a filter state
#' isolate(
#' set_filter_state(
#' fpa,
#' list(iris = list(Species = list(selected = "setosa", keep_na = TRUE)))
#' set_filter_state(
#' fpa,
#' filter_settings(
#' filter_var(dataname = "iris", varname = "Species", selected = "setosa", keep_na = TRUE)
#' )
#' )
#'
Expand All @@ -40,10 +40,12 @@
FilterPanelAPI <- R6::R6Class( # nolint
"FilterPanelAPI",
## __Public Methods ====

public = list(
#' @description
#' Initialize a `FilterPanelAPI` object
#' @param datasets (`FilteredData`) object.
#'
initialize = function(datasets) {
checkmate::assert_class(datasets, "FilteredData")
private$filtered_data <- datasets
Expand All @@ -56,16 +58,17 @@ FilterPanelAPI <- R6::R6Class( # nolint
#' The output list is a compatible input to `set_filter_state`.
#'
#' @return `list` with named elements corresponding to `FilteredDataset` objects with active filters.
#'
get_filter_state = function() {
private$filtered_data$get_filter_state()
},

#' @description
#' Sets active filter states.
#' @param filter (`named list`)\cr
#' nested list of filter selections applied to datasets.
#' @param filter (`teal_slices`)
#'
#' @return `NULL` invisibly
#'
#' @return `NULL`
set_filter_state = function(filter) {
if (private$filtered_data$get_filter_panel_active()) {
private$filtered_data$set_filter_state(filter)
Expand All @@ -77,10 +80,13 @@ FilterPanelAPI <- R6::R6Class( # nolint

#' @description
#' Remove one or more `FilterState` of a `FilteredDataset` in the `FilteredData` object.
#' @param filter (`named list`)\cr
#' nested list of filter selections applied to datasets.
#'
#' @return `NULL`
#' @param filter (`teal_slices`)\cr
#' specifying `FilterState` objects to remove;
#' `teal_slice`s may contain only `dataname` and `varname`, other elements are ignored
#'
#' @return `NULL` invisibly
#'
remove_filter_state = function(filter) {
if (private$filtered_data$get_filter_panel_active()) {
private$filtered_data$remove_filter_state(filter)
Expand All @@ -96,7 +102,7 @@ FilterPanelAPI <- R6::R6Class( # nolint
#' datanames to remove their `FilterStates`;
#' omit to remove all `FilterStates` in the `FilteredData` object
#'
#' @return `NULL`
#' @return `NULL` invisibly
#'
clear_filter_states = function(datanames) {
if (private$filtered_data$get_filter_panel_active()) {
Expand All @@ -107,14 +113,16 @@ FilterPanelAPI <- R6::R6Class( # nolint
}
invisible(NULL)
},

#' @description
#' Toggle the state of the global Filter Panel button by running `javascript` code
#' to click the toggle button with the `filter_panel_active` id suffix.
#' The button id is prefixed with the Filter Panel shiny namespace.
#' This button is observed in `srv_filter_panel` method that executes
#' `filter_panel_enable()` or `filter_panel_disable()` method depending on the toggle state.
#'
#' @return `NULL`
#' @return `NULL` invisibly
#'
filter_panel_toggle = function() {
shinyjs::runjs(
sprintf(
Expand Down
70 changes: 0 additions & 70 deletions R/FilterState-abstract.R

This file was deleted.

Loading

0 comments on commit 29937b7

Please # to comment.