FilteredData.R

#' @name FilteredData
#' @docType class
#'
#' @title Class to encapsulate filtered datasets
#'
#' @details
#' The main purpose of this class is to provide a collection of reactive datasets,
#' each dataset having a filter state that determines how it is filtered.
#'
#' For each dataset, `get_filter_expr` returns the call to filter the dataset according
#' to the filter state. The data itself can be obtained through `get_data`.
#' Other classes take care of actually merging together all the datasets.
#'
#' The datasets are filtered lazily, i.e. only when requested / needed in a Shiny app.
#'
#' By design, any dataname set through `set_data` cannot be removed because
#' other code may already depend on it. As a workaround, the underlying
#' data can be set to `NULL`.
#'
#' The class currently supports variables of the following types within datasets:
#' - `choices`: variable of type `factor`, e.g. `ADSL$COUNTRY`, `iris$Species`
#'      zero or more options can be selected, when the variable is a factor
#' - `logical`: variable of type `logical`, e.g. `ADSL$TRT_FLAG`
#'      exactly one option must be selected, `TRUE` or `FALSE`
#' - `ranges`: variable of type `numeric`, e.g. `ADSL$AGE`, `iris$Sepal.Length`
#'      numerical range, a range within this range can be selected
#' - `dates`: variable of type `Date`, `POSIXlt`
#' Other variables cannot be used for filtering the data in this class.
#'
#' Common arguments are:
#' 1. `filtered`: whether to return a filtered result or not
#' 2. `dataname`: the name of one of the datasets in this `FilteredData`
#' 3. `varname`: one of the columns in a dataset
#'
#' @keywords internal
#'
#' @examples
#' library(shiny)
#' datasets <- teal.slice:::FilteredData$new(
#'   iris = list(dataset = iris),
#'   mtcars = list(dataset = mtcars, metadata = list(type = training)),
#'   keys = NULL, check = FALSE # use wrapper function to avoid having to specify these
#' )
#'
#' # get datanames
#' datasets$datanames()
#'
#'
#' df <- datasets$get_data("iris", filtered = FALSE)
#' print(df)
#'
#' datasets$get_metadata("mtcars")
#'
#' datasets$set_filter_state(
#'   list(iris = list(Species = list(selected = "virginica")))
#' )
#' isolate(datasets$get_call("iris"))
#'
#' datasets$set_filter_state(
#'   list(mtcars = list(mpg = list(selected = c(15, 20))))
#' )
#'
#' isolate(datasets$get_filter_state())
#' isolate(datasets$get_filter_overview("iris"))
#' isolate(datasets$get_filter_overview("mtcars"))
#' isolate(datasets$get_call("iris"))
#' isolate(datasets$get_call("mtcars"))
FilteredData <- R6::R6Class( # nolint
  "FilteredData",
  ## __Public Methods ====
  public = list(
    #' @description
    #' Initialize a `FilteredData` object
    #' @param ... TODO
    #' @param keys TODO
    #' @param code TODO
    #' @param check TODO
    initialize = function(..., keys, code = NULL, check = FALSE) {
      data_objects <- list(...)
      checkmate::assert_list(data_objects, any.missing = FALSE, min.len = 0, names = "unique")
      #TODO other checks

      self$set_check(check)
      if (!is.null(code)) {
        self$set_code(code)
      }

      for(dataname in names(data_objects)){
        self$set_dataset(data_objects[[dataname]], dataname)
      }

      self$set_join_keys(keys)

      invisible(self)
    },
    #' @description
    #' Gets datanames
    #'
    #' The datanames are returned in the order in which they must be
    #' evaluated (in case of dependencies).
    #' @return (`character` vector) of datanames
    datanames = function() {
      names(private$filtered_datasets)
    },

    #' Gets data label for the dataset
    #'
    #' Useful to display in `Show R Code`.
    #'
    #' @param dataname (`character`) name of the dataset
    #' @return (`character`) keys of dataset
    get_datalabel = function(dataname) {
      self$get_filtered_dataset(dataname)$get_dataset_label()
    },

    #' @description
    #' Gets dataset names of a given dataname for the filtering.
    #'
    #' @param dataname (`character` vector) names of the dataset
    #' @return (`character` vector) of dataset names
    get_filterable_datanames = function(dataname) {
      dataname
    },

    #' @description
    #' Gets variable names of a given dataname for the filtering.
    #'
    #' @param dataname (`character`) name of the dataset
    #' @return (`character` vector) of variable names
    get_filterable_varnames = function(dataname) {
      self$get_filtered_dataset(dataname)$get_filterable_varnames()
    },

    # datasets methods ----
    #' @description
    #' Gets a `call` to filter the dataset according to the filter state
    #'
    #' It returns a `call` to filter the dataset only, assuming the
    #' other (filtered) datasets it depends on are available.
    #'
    #' Together with `self$datanames()` which returns the datasets in the correct
    #' evaluation order, this generates the whole filter code, see the function
    #' `FilteredData$get_filter_code`.
    #'
    #' For the return type, note that `rlang::is_expression` returns `TRUE` on the
    #' return type, both for base R expressions and calls (single expression,
    #' capturing a function call).
    #'
    #' The filtered dataset has the name given by `self$filtered_dataname(dataname)`
    #'
    #' This can be used for the `Show R Code` generation.
    #'
    #' @param dataname (`character`) name of the dataset
    #' @return (`call` or `list` of calls) to filter dataset
    #'  calls
    get_call = function(dataname) {
      private$check_data_varname_exists(dataname)
      self$get_filtered_dataset(dataname)$get_call()
    },

    #' @description
    #' Gets the R preprocessing code string that generates the unfiltered datasets
    #' @param dataname (`character`) name(s) of teal.data::dataset(s)
    #' @return (`character`) deparsed code
    get_code = function(dataname = self$datanames()) {
      if (!is.null(private$code)) {
        paste0(private$code$get_code(dataname), collapse = "\n")
      } else {
        paste0("# No pre-processing code provided")
      }
    },

    #' @description
    #' Gets `FilteredDataset` object which contains all informations
    #' related to specific dataset.
    #' @param dataname (`character(1)`)\cr
    #'  name of the dataset.
    #' @return `FilteredDataset` object or list of `FilteredDataset`
    get_filtered_dataset = function(dataname = character(0)) {
      if (length(dataname) == 0) {
        private$filtered_datasets
      } else {
        private$filtered_datasets[[dataname]]
      }
    },

    #' @description
    #' Gets filtered or unfiltered dataset
    #'
    #' For `filtered = FALSE`, the original data set with
    #' `set_data` is returned including all attributes.
    #'
    #' @param dataname (`character`) name of the dataset
    #' @param filtered (`logical`) whether to return a filtered or unfiltered dataset
    get_data = function(dataname, filtered = TRUE) {
      private$check_data_varname_exists(dataname)
      checkmate::assert_flag(filtered)

      self$get_filtered_dataset(dataname)$get_data(filtered = filtered)
    },

    #' @description
    #' Returns whether the datasets in the object have had a reproducibility check
    #' @return `logical`
    get_check = function() {
      private$.check
    },

    #' @description
    #' Gets data attributes for a given dataset
    #'
    #' Sets and gets the data attribute on unfiltered data as it is never modified
    #' as attributes.
    #'
    #' @param dataname (`character`) name of the dataset
    #' @param attr (`character`) attribute to get from the data attributes of the dataset
    #' @return value of attribute, may be `NULL` if it does not exist
    get_data_attr = function(dataname, attr) {
      private$check_data_varname_exists(dataname)
      checkmate::assert_string(attr)
      teal.data::get_attrs(self$get_filtered_dataset(dataname)$get_dataset())[[attr]]
    },

    #' @description
    #' Gets metadata for a given dataset
    #'
    #' @param dataname (`character`) name of the dataset
    #' @return value of metadata for given data (or `NULL` if it does not exist)
    get_metadata = function(dataname) {
      private$check_data_varname_exists(dataname)
      self$get_filtered_dataset(dataname)$get_metadata()
    },

    #' @description
    #' Get join keys between two datasets.
    #' @param dataset_1 (`character`) one dataset name
    #' @param dataset_2 (`character`) other dataset name
    #' @return (`named character`) vector with column names
    get_join_keys = function(dataset_1, dataset_2) {
      res <- if (!missing(dataset_1) && !missing(dataset_2)) {
        private$keys[[dataset_1]][[dataset_2]]
      } else if (!missing(dataset_1)) {
        private$keys[[dataset_2]]
      } else if (!missing(dataset_2)) {
        private$keys[[dataset_1]]
      } else {
        private$keys
      }
      if (length(res) == 0) {
        return(character(0))
      }
      return(res)
    },

    #' @description
    #' Get filter overview table in form of X (filtered) / Y (non-filtered)
    #'
    #' This is intended to be presented in the application.
    #' The content for each of the data names is defined in `get_filter_overview_info` method.
    #'
    #' @param datanames (`character` vector) names of the dataset
    #'
    #' @return (`matrix`) matrix of observations and subjects of all datasets
    get_filter_overview = function(datanames) {
      if (identical(datanames, "all")) {
        datanames <- self$datanames()
      }
      check_in_subset(datanames, self$datanames(), "Some datasets are not available: ")

      rows <- lapply(
        datanames,
        function(dataname) {
          self$get_filtered_dataset(dataname)$get_filter_overview_info()
        }
      )

      do.call(rbind, rows)
    },

    #' Get keys for the dataset
    #' @param dataname (`character`) name of the dataset
    #' @return (`character`) keys of dataset
    get_keys = function(dataname) {
      self$get_filtered_dataset(dataname)$get_keys()
    },
    #' @description
    #' Gets labels of variables in the data
    #'
    #' Variables are the column names of the data.
    #' Either, all labels must have been provided for all variables
    #' in `set_data` or `NULL`.
    #'
    #' @param dataname (`character`) name of the dataset
    #' @param variables (`character` vector) variables to get labels for;
    #'   if `NULL`, for all variables in data
    #' @return (`character` or `NULL`) variable labels, `NULL` if `column_labels`
    #'   attribute does not exist for the data
    get_varlabels = function(dataname, variables = NULL) {
      self$get_filtered_dataset(dataname)$get_varlabels(variables = variables)
    },

    #' @description
    #' Gets variable names
    #'
    #' @param dataname (`character`) the name of the dataset
    #' @return (`character` vector) of variable names
    get_varnames = function(dataname) {
      self$get_filtered_dataset(dataname)$get_varnames()
    },

    #' When active_datanames is "all", sets them to all datanames
    #' otherwise, it makes sure that it is a subset of the available datanames
    #'
    #' @param datanames `character vector` datanames to pick
    #'
    #' @return the intersection of `self$datanames()` and `datanames`
    handle_active_datanames = function(datanames) {
      logger::log_trace("FilteredData$handle_active_datanames handling { paste(datanames, collapse = \" \") }")
      if (identical(datanames, "all")) {
        datanames <- self$datanames()
      } else {
        for (dataname in datanames) {
          tryCatch(
            check_in_subset(datanames, self$datanames(), "Some datasets are not available: "),
            error = function(e) {
              message(e$message)
            }
          )
        }
      }
      datanames <- self$get_filterable_datanames(datanames)
      intersect(self$datanames(), datanames)
    },

    #' @description
    #' Adds a dataset to this `FilteredData`
    #'
    #' Technically `set_dataset` created `FilteredDataset` which keeps
    #' `dataset` for filtering purpose.
    #'
    #' @param dataset_args (`list`)\cr
    #'   containing the arguments except (`dataname`)
    #'   needed by `init_filtered_dataset`
    #' @param dataname (`string`)\cr
    #'   the name of the `dataset` to be added to this object
    #' @return (`self`) invisibly this `FilteredData`
    set_dataset = function(dataset_args, dataname) {
      # TODO validation here
      logger::log_trace("FilteredData$set_dataset setting dataset, name; { deparse1(dataname) }")

      dataset <- dataset_args[["dataset"]]
      dataset_args[["dataset"]] <- NULL

      # to include it nicely in the Show R Code; the UI also uses datanames in ids, so no whitespaces allowed
      check_simple_name(dataname)
      private$filtered_datasets[[dataname]] <- do.call(
        what = init_filtered_dataset,
        args = c(list(dataset), dataset_args, list(dataname = dataname))
      )

      invisible(self)
    },

    #' @description
    #' TODO
    #' @param keys TODO
    #' @return (`self`) invisibly this `FilteredData`
    set_join_keys = function(keys) {
      #TODO validation
      private$keys <- keys
    },

    #' @description
    #' sets whether the datasets in the object have had a reproducibility check
    #' @param check (`logical`) whether datasets have had reproducibility check
    #' @return (`self`)
    set_check = function(check) {
      checkmate::assert_flag(check)
      private$.check <- check
      invisible(self)
    },

    #' @description
    #' Sets the R preprocessing code for single dataset
    #'
    #' @param code (`CodeClass`)\cr
    #' preprocessing code that can be parsed to generate the
    #'   unfiltered datasets
    #' @return (`self`)
    set_code = function(code) {
      checkmate::assert_class(code, "CodeClass")
      logger::log_trace("FilteredData$set_code setting code")
      private$code <- code
      invisible(self)
    },

    # Functions useful for restoring from another dataset ----
    #' @description
    #' Gets the reactive values from the active `FilterState` objects.
    #'
    #' Gets all active filters in the form of a nested list.
    #' The output list is a compatible input to `self$set_filter_state`.
    #' @return `list` with named elements corresponding to `FilteredDataset` objects
    #' with active filters.
    get_filter_state = function() {
      states <- lapply(self$get_filtered_dataset(), function(x) x$get_filter_state())
      Filter(function(x) length(x) > 0, states)
    },

    #' @description
    #' Returns the filter state formatted for printing to an `IO` device.
    #'
    #' @return `character` the pre-formatted filter state
    #' @examples
    #' datasets <- teal.slice:::FilteredData$new()
    #' datasets$set_dataset(teal.data::dataset("iris", iris))
    #' utils::data(miniACC, package = "MultiAssayExperiment")
    #' datasets$set_dataset(teal.data::dataset("mae", miniACC))
    #' fs <- list(
    #'   iris = list(
    #'     Sepal.Length = list(selected = c(5.1, 6.4), keep_na = TRUE, keep_inf = FALSE),
    #'     Species = list(selected = c("setosa", "versicolor"), keep_na = FALSE)
    #'   ),
    #'   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))
    #'     )
    #'   )
    #' )
    #' datasets$set_filter_state(state = fs)
    #' cat(shiny::isolate(datasets$get_formatted_filter_state()))
    #'
    get_formatted_filter_state = function() {
      out <- c()
      for (filtered_dataset in self$get_filtered_dataset()) out <- c(out, filtered_dataset$get_formatted_filter_state())
      paste(out, collapse = "\n")
    },

    #' @description
    #' Sets active filter states.
    #' @param state (`named list`)\cr
    #'  nested list of filter selections applied to datasets.
    #' @examples
    #' datasets <- teal.slice:::FilteredData$new()
    #' datasets$set_dataset(teal.data::dataset("iris", iris))
    #' utils::data(miniACC, package = "MultiAssayExperiment")
    #' datasets$set_dataset(teal.data::dataset("mae", miniACC))
    #' fs <- list(
    #'   iris = list(
    #'     Sepal.Length = list(selected = c(5.1, 6.4), keep_na = TRUE, keep_inf = FALSE),
    #'     Species = list(selected = c("setosa", "versicolor"), keep_na = FALSE)
    #'   ),
    #'   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))
    #'     )
    #'   )
    #' )
    #' datasets$set_filter_state(state = fs)
    #' shiny::isolate(datasets$get_filter_state())
    #' @return `NULL`
    set_filter_state = function(state) {
      checkmate::assert_subset(names(state), self$datanames())
      logger::log_trace("FilteredData$set_filter_state initializing, dataname: { paste(names(state), collapse = ' ') }")
      for (dataname in names(state)) {
        fdataset <- self$get_filtered_dataset(dataname = dataname)
        dataset_state <- state[[dataname]]

        fdataset$set_filter_state(
          state = dataset_state,
          vars_include = self$get_filterable_varnames(dataname)
        )
      }
      logger::log_trace("FilteredData$set_filter_state initialized, dataname: { paste(names(state), collapse = ' ') }")
      invisible(NULL)
    },

    #' @description Remove one or more `FilterState` of a `FilteredDataset` in a `FilteredData` object
    #'
    #' @param state (`named list`)\cr
    #'  nested list of filter selections applied to datasets.
    #'
    #' @return `NULL`
    remove_filter_state = function(state) {
      logger::log_trace("FilteredData$remove_filter_state called, dataname: { paste(names(state), collapse = ' ') }")

      for (dataname in names(state)) {
        fdataset <- self$get_filtered_dataset(dataname = dataname)
        fdataset$remove_filter_state(element_id = state[[dataname]])
      }

      logger::log_trace("FilteredData$remove_filter_state done, dataname: { paste(names(state), collapse = ' ') }")
      invisible(NULL)
    },

    #' @description Remove all `FilterStates` of a `FilteredDataset` or all `FilterStates` of a `FilteredData` object
    #'
    #' @param datanames (`character`)\cr
    #'  datanames to remove their `FilterStates` or empty which removes all `FilterStates` in the `FilteredData` object.
    #'
    #' @return `NULL`
    #'
    remove_all_filter_states = function(datanames = self$datanames()) {
      logger::log_trace(
        "FilteredData$remove_all_filter_states called, datanames: { paste(datanames, collapse = ', ') }"
      )

      for (dataname in datanames) {
        fdataset <- self$get_filtered_dataset(dataname = dataname)
        fdataset$queues_empty()
      }

      logger::log_trace(
        paste(
          "FilteredData$remove_all_filter_states removed all FilterStates,",
          "datanames: { paste(datanames, collapse = ', ') }"
        )
      )

      invisible(NULL)
    },

    #' @description
    #' Sets this object from a bookmarked state
    #'
    #' Only sets the filter state, does not set the data
    #' and the preprocessing code. The data should already have been set.
    #' Also checks the preprocessing code is identical if provided in the `state`.
    #'
    #' Since this function is used from the end-user part, its error messages
    #' are more verbose. We don't call the Shiny modals from here because this
    #' class may be used outside of a Shiny app.
    #'
    #' @param state (`named list`)\cr
    #'  containing fields `data_hash`, `filter_states`
    #'   and `preproc_code`.
    #' @param check_data_hash (`logical`) whether to check that `md5sums` agree
    #'   for the data; may not make sense with randomly generated data per session
    restore_state_from_bookmark = function(state, check_data_hash = TRUE) {
      stop("Pure virtual method")
    },

    # shiny modules -----

    #' Module for the right filter panel in the teal app
    #' with a filter overview panel and a filter variable panel.
    #'
    #' This panel contains info about the number of observations left in
    #' the (active) datasets and allows to filter the datasets.
    #'
    #' @param id (`character(1)`)\cr
    #'   module id
    ui_filter_panel = function(id) {
      ns <- NS(id)
      div(
        id = ns("filter_panel_whole"), # used for hiding / showing
        include_css_files(pattern = "filter-panel"),
        div(
          id = ns("filters_overview"), # not used, can be used to customize CSS behavior
          class = "well",
          tags$div(
            class = "row",
            tags$div(
              class = "col-sm-9",
              tags$label("Active Filter Summary", class = "text-primary", style = "margin-bottom: 15px;")
            ),
            tags$div(
              class = "col-sm-3",
              tags$a(
                href = "javascript:void(0)",
                class = "remove pull-right",
                onclick = sprintf(
                  "$('#%s').toggle();",
                  ns("filters_overview_contents")
                ),
                title = "Minimise panel",
                tags$span(icon("minus-circle", lib = "font-awesome"))
              )
            )
          ),
          tags$br(),
          div(
            id = ns("filters_overview_contents"),
            self$ui_filter_overview(ns("teal_filters_info"))
          )
        ),
        div(
          id = ns("filter_active_vars"), # not used, can be used to customize CSS behavior
          class = "well",
          tags$div(
            class = "row",
            tags$div(
              class = "col-sm-6",
              tags$label("Active Filter Variables", class = "text-primary", style = "margin-bottom: 15px;")
            ),
            tags$div(
              class = "col-sm-6",
              actionLink(
                ns("remove_all_filters"),
                "",
                icon("times-circle", lib = "font-awesome"),
                title = "Remove active filters",
                class = "remove_all pull-right"
              ),
              tags$a(
                href = "javascript:void(0)",
                class = "remove pull-right",
                onclick = sprintf(
                  "$('#%s').toggle();",
                  ns("filter_active_vars_contents")
                ),
                title = "Minimise panel",
                tags$span(icon("minus-circle", lib = "font-awesome"))
              )
            )
          ),
          div(
            id = ns("filter_active_vars_contents"),
            tagList(
              lapply(
                self$datanames(),
                function(dataname) {
                  fdataset <- self$get_filtered_dataset(dataname)
                  fdataset$ui(id = ns(private$get_ui_id(dataname)))
                }
              )
            )
          )
        ),
        div(
          id = ns("filter_add_vars"), # not used, can be used to customize CSS behavior
          class = "well",
          tags$div(
            class = "row",
            tags$div(
              class = "col-sm-9",
              tags$label("Add Filter Variables", class = "text-primary", style = "margin-bottom: 15px;")
            ),
            tags$div(
              class = "col-sm-3",
              tags$a(
                href = "javascript:void(0)",
                class = "remove pull-right",
                onclick = sprintf("$('#%s').toggle();", ns("filter_add_vars_contents")),
                title = "Minimise panel",
                tags$span(icon("minus-circle", lib = "font-awesome"))
              )
            )
          ),
          div(
            id = ns("filter_add_vars_contents"),
            tagList(
              lapply(
                self$datanames(),
                function(dataname) {
                  fdataset <- self$get_filtered_dataset(dataname)
                  id <- ns(private$get_ui_add_filter_id(dataname))
                  # add span with same id to show / hide
                  return(
                    span(
                      id = id,
                      fdataset$ui_add_filter_state(id)
                    )
                  )
                }
              )
            )
          )
        )
      )
    },

    #' Server function for filter panel
    #'
    #' @param id (`character(1)`)\cr
    #'   an ID string that corresponds with the ID used to call the module's UI function.
    #' @param active_datanames `function / reactive` returning datanames that
    #'   should be shown on the filter panel,
    #'   must be a subset of the `datanames` argument provided to `ui_filter_panel`;
    #'   if the function returns `NULL` (as opposed to `character(0)`), the filter
    #'   panel will be hidden
    #' @return `moduleServer` function which returns `NULL`
    srv_filter_panel = function(id, active_datanames = function() "all") {
      stopifnot(
        is.function(active_datanames) || is.reactive(active_datanames)
      )
      moduleServer(
        id = id,
        function(input, output, session) {
          logger::log_trace("FilteredData$srv_filter_panel initializing")
          shiny::setBookmarkExclude("remove_all_filters")
          self$srv_filter_overview(
            id = "teal_filters_info",
            active_datanames = active_datanames
          )

          shiny::observeEvent(self$get_filter_state(), {
            if (length(self$get_filter_state()) == 0) {
              shinyjs::hide("remove_all_filters")
            } else {
              shinyjs::show("remove_all_filters")
            }
          })

          # use isolate because we assume that the number of datasets does not change over the course of the teal app
          # alternatively, one can proceed as in modules_filter_items to dynamically insert, remove UIs
          isol_datanames <- isolate(self$datanames()) # they are already ordered
          # should not use for-loop as variables are otherwise only bound by reference and last dataname would be used
          lapply(
            isol_datanames,
            function(dataname) {
              fdataset <- self$get_filtered_dataset(dataname)
              fdataset$server(id = private$get_ui_id(dataname))
            }
          )

          lapply(
            isol_datanames,
            function(dataname) {
              fdataset <- self$get_filtered_dataset(dataname)
              fdataset$srv_add_filter_state(
                id = private$get_ui_add_filter_id(dataname),
                vars_include = self$get_filterable_varnames(dataname)
              )
            }
          )

          # rather than regenerating the UI dynamically for the dataset filtering,
          # we instead choose to hide/show the elements
          # the filters for this dataset are just hidden from the UI, but still applied
          # optimization: we set `priority = 1` to execute it before the other
          # observers (default priority 0), so that they are not computed if they are hidden anyways
          observeEvent(active_datanames(),
            priority = 1,
            {
              logger::log_trace(
                "FilteredData$srv_filter_panel@1 active datanames: { paste(active_datanames(), collapse = \" \") }"
              )
              if (length(active_datanames()) == 0 || is.null(active_datanames())) {
                # hide whole module UI when no datasets or when NULL
                shinyjs::hide("filter_panel_whole")
                shinyjs::runjs('$("#teal_secondary_col").hide();
                             $("#teal_primary_col").attr("class", "col-sm-12").resize();')
              } else {
                shinyjs::show("filter_panel_whole")
                shinyjs::runjs('if (filter_open) {
              $("#teal_primary_col").attr("class", "col-sm-9").resize();
              $("#teal_secondary_col").show();}')

                # selectively hide / show to only show `active_datanames` out of all datanames
                lapply(
                  self$datanames(),
                  function(dataname) {
                    id_add_filter <- private$get_ui_add_filter_id(dataname)
                    id_filter_dataname <- private$get_ui_id(dataname)

                    if (dataname %in% active_datanames()) {
                      # shinyjs takes care of the namespace around the id
                      shinyjs::show(id_add_filter)
                      shinyjs::show(id_filter_dataname)
                    } else {
                      shinyjs::hide(id_add_filter)
                      shinyjs::hide(id_filter_dataname)
                    }
                  }
                )
              }
            },
            ignoreNULL = FALSE
          )

          observeEvent(input$remove_all_filters, {
            logger::log_trace("FilteredData$srv_filter_panel@1 removing all filters")
            lapply(self$datanames(), function(dataname) {
              fdataset <- self$get_filtered_dataset(dataname = dataname)
              fdataset$queues_empty()
            })
            logger::log_trace("FilteredData$srv_filter_panel@1 removed all filters")
          })

          logger::log_trace("FilteredData$srv_filter_panel initialized")
          NULL
        }
      )
    },

    #' Creates the UI for the module showing counts for each dataset
    #' contrasting the filtered to the full unfiltered dataset
    #'
    #' Per dataset, it displays
    #' the number of rows/observations in each dataset,
    #' the number of unique subjects.
    #'
    #' @param id module id
    ui_filter_overview = function(id) {
      ns <- NS(id)

      div(
        class = "teal_active_summary_filter_panel",
        tableOutput(ns("table"))
      )
    },

    #' Server function to display the number of records in the filtered and unfiltered
    #' data
    #'
    #' @param id (`character(1)`)\cr
    #'   an ID string that corresponds with the ID used to call the module's UI function.
    #' @param active_datanames (`function`, `reactive`)\cr
    #'   returning datanames that should be shown on the filter panel,
    #'   must be a subset of the `datanames` argument provided to `ui_filter_panel`;
    #'   if the function returns `NULL` (as opposed to `character(0)`), the filter
    #'   panel will be hidden.
    #' @return `moduleServer` function which returns `NULL`
    srv_filter_overview = function(id, active_datanames = function() "all") {
      stopifnot(
        is.function(active_datanames) || is.reactive(active_datanames)
      )
      moduleServer(
        id = id,
        function(input, output, session) {
          logger::log_trace("FilteredData$srv_filter_overview initializing")
          output$table <- renderUI({
            logger::log_trace("FilteredData$srv_filter_overview@1 updating counts")
            datanames <- if (identical(active_datanames(), "all")) {
              self$datanames()
            } else {
              active_datanames()
            }

            if (length(datanames) == 0) {
              return(NULL)
            }

            datasets_df <- self$get_filter_overview(datanames = datanames)

            body_html <- lapply(
              seq_len(nrow(datasets_df)),
              function(x) {
                tags$tr(
                  tags$td(rownames(datasets_df)[x]),
                  tags$td(datasets_df[x, 1]),
                  tags$td(datasets_df[x, 2])
                )
              }
            )

            header_html <- tags$tr(
              tags$td(""),
              tags$td(colnames(datasets_df)[1]),
              tags$td(colnames(datasets_df)[2])
            )

            table_html <- tags$table(
              class = "table custom-table",
              tags$thead(header_html),
              tags$tbody(body_html)
            )
            logger::log_trace("FilteredData$srv_filter_overview@1 updated counts")
            table_html
          })

          logger::log_trace("FilteredData$srv_filter_overview initialized")
          NULL
        }
      )
    }
  ),

  ## __Private Methods ====
  private = list(

    # private attributes ----
    filtered_datasets = list(),

    # whether the datasets had a reproducibility check
    .check = FALSE,

    # preprocessing code used to generate the unfiltered datasets as a string
    code = NULL,

    # keys used for joining/filtering data
    keys = NULL,

    # we implement these functions as checks rather than returning logicals so they can
    # give informative error messages immediately

    # @details
    # Composes id for the FilteredDataset shiny element (active filter vars)
    # @param dataname (`character(1)`) name of the dataset which ui is composed for.
    # @return `character(1)` - `<dataname>_filter`
    get_ui_id = function(dataname) {
      sprintf("%s_filter", dataname)
    },

    # @details
    # Composes id for the FilteredDataset shiny element (add filter state)
    # @param dataname (`character(1)`)  name of the dataset which ui is composed for.
    # @return `character(1)` - `<dataname>_filter`
    get_ui_add_filter_id = function(dataname) {
      sprintf("add_%s_filter", dataname)
    },

    # @details
    # Validates the state of this FilteredData.
    # The call to this function should be isolated to avoid a reactive dependency.
    # Getting the names of a reactivevalues also needs a reactive context.
    validate = function() {
      # Note: Here, we directly refer to the private attributes because the goal of this
      # function is to check the underlying attributes and the get / set functions might be corrupted

      has_same_names <- function(x, y) setequal(names(x), names(y))
      # check `filter_states` are all valid
      lapply(
        names(private$filter_states),
        function(dataname) {
          stopifnot(is.list(private$filter_states)) # non-NULL, possibly empty list
          lapply(
            names(private$filter_states[[dataname]]),
            function(varname) {
              var_state <- private$filter_states[[dataname]][[varname]]
              stopifnot(!is.null(var_state)) # should not be NULL, see doc of this attribute
              check_valid_filter_state(
                filter_state = var_state,
                dataname = dataname,
                varname = varname
              )
            }
          )
        }
      )

      return(invisible(NULL))
    },

    # @description
    # Checks if the dataname exists and
    # (if provided) that varname is a valid column in the dataset
    #
    # Stops when this is not the case.
    #
    # @param dataname (`character`) name of the dataset
    # @param varname (`character`) column within the dataset;
    #   if `NULL`, this check is not performed
    check_data_varname_exists = function(dataname, varname = NULL) {
      checkmate::assert_string(dataname)
      checkmate::assert_string(varname, null.ok = TRUE)

      isolate({
        # we isolate everything because we don't want to trigger again when datanames
        # change (which also triggers when any of the data changes)
        if (!dataname %in% names(self$get_filtered_dataset())) {
          # data must be set already
          stop(paste("data", dataname, "is not available"))
        }
        if (!is.null(varname) && !(varname %in% self$get_varnames(dataname = dataname))) {
          stop(paste("variable", varname, "is not in data", dataname))
        }
      })

      return(invisible(NULL))
    },
    filtered_dataname = function(dataname) {
      checkmate::assert_string(dataname)
      sprintf("%s_FILTERED", dataname)
    }
  )
)

# Wrapper functions for `FilteredData` class ----


#' Gets filter expression for multiple datanames taking into account its order.
#'
#' @description `r lifecycle::badge("stable")`
#' To be used in show R code button.
#'
#' @param datasets (`FilteredData`)
#' @param datanames (`character`) vector of dataset names
#'
#' @export
#'
#' @return (`expression`)
get_filter_expr <- function(datasets, datanames = datasets$datanames()) {
  checkmate::assert_character(datanames, min.len = 1, any.missing = FALSE)
  stopifnot(
    is(datasets, "FilteredData"),
    all(datanames %in% datasets$datanames())
  )

  paste(
    unlist(lapply(
      datanames,
      function(dataname) {
        datasets$get_call(dataname)
      }
    )),
    collapse = "\n"
  )
}

#' TODO documentation
#' @export
init_filtered_data <- function(..., keys = NULL, cdisc = FALSE, code = NULL, check = FALSE) {
  checkmate::check_flag(cdisc)
  if (cdisc) {
    CDISCFilteredData$new(..., keys = keys, code = code, check = check)
  } else {
    FilteredData$new(..., keys = keys, code = code, check = check)
  }
}