Implementing custom filters

cohortBuilder provides seven built-in filter types suitable for most common filtering tasks:

discrete,
discrete_text,
range,
date_range,
datetime_range,
multi_discrete,
query.

If none of the above filters meets your need, you can create a custom one. Below we describe how custom filters work and walk through an example: creating a logical filter.

Filter architecture

Filters in cohortBuilder are S7 objects that inherit from the CbFilter base class. Each filter type is an S7 class with properties describing its configuration (dataset, variable, value, etc.).

Filtering logic is implemented via S7 multi-dispatch generics that dispatch on both the filter class and the source class. This means you can define how a filter type behaves for different source backends (e.g. tblist, database, etc.).

The key generics are:

Generic	Purpose
`cb_filter_data(filter, source, data_object)`	Apply filter to data
`cb_get_filter_stats(filter, source, data_object)`	Compute filter statistics
`cb_plot_filter_data(filter, source, data_object)`	Plot filter data summary
`cb_get_filter_data(filter, source, data_object)`	Get filter-related data subset
`cb_get_filter_defaults(filter, source, data_object, cache_object)`	Get default parameter values
`cb_filter_to_expr(filter, source)`	Generate reproducible code expression

Built-in filter example

Let’s look at a built-in discrete filter to understand the structure:

spec_filter <- filter("discrete", value = "setosa", dataset = "iris", variable = "Species")
spec_filter
#> <cohortBuilder::CbFilterDiscrete>
#>  @ type       : chr "discrete"
#>  @ id         : chr "iris-Species"
#>  @ name       : chr "Species"
#>  @ active     : logi TRUE
#>  @ description: NULL
#>  @ domain     : NULL
#>  @ step_id    : NULL
#>  @ extra      : list()
#>  @ private    :List of 1
#>  .. $ input_param: chr "value"
#>  @ dataset    : chr "iris"
#>  @ variable   : chr "Species"
#>  @ value      : chr "setosa"
#>  @ keep_na    : logi TRUE

The filter is an S7 object with properties accessible via @:

spec_filter@type
#> [1] "discrete"
spec_filter@variable
#> [1] "Species"
spec_filter@value
#> [1] "setosa"
spec_filter@dataset
#> [1] "iris"

All user-facing parameters can be retrieved as a list:

str(get_filter_params(spec_filter))
#> List of 10
#>  $ type       : chr "discrete"
#>  $ id         : chr "iris-Species"
#>  $ name       : chr "Species"
#>  $ active     : logi TRUE
#>  $ description: NULL
#>  $ domain     : NULL
#>  $ dataset    : chr "iris"
#>  $ variable   : chr "Species"
#>  $ value      : chr "setosa"
#>  $ keep_na    : logi TRUE

Creating a custom filter: logical filter

To create a custom filter you need to:

Define an S7 class inheriting from CbFilter.
Register the type so filter("logical", ...) works.
Implement S7 methods for each source type you want to support.

Step 1: Define the S7 filter class

CbFilterLogical <- S7::new_class("CbFilterLogical",
  parent = CbFilter,
  properties = list(
    dataset = S7::class_character,
    variable = S7::class_character,
    value = S7::class_any,
    keep_na = S7::class_logical
  ),
  constructor = function(id = NULL, name = NULL, variable, value = NA,
                         dataset, keep_na = TRUE, description = NULL,
                         active = getOption("cb_active_filter", default = TRUE), ...) {
    if (is.null(id)) id <- paste(dataset, variable, sep = "-")
    if (is.null(name)) name <- variable
    S7::new_object(S7::S7_object(),
      type = "logical", id = id, name = name, input_param = "value",
      variable = variable, value = value, dataset = dataset,
      keep_na = keep_na, active = active, description = description,
      extra = list(...)
    )
  }
)

Key points:

parent = CbFilter makes it part of the filter hierarchy.
input_param = "value" tells the system which property holds the filtering value.
extra = list(...) captures any additional parameters (e.g. gui_input for shinyCohortBuilder).
value = NA means no filtering is applied by default.

Step 2: Register the filter type

register_filter_type("logical", CbFilterLogical)

Now filter("logical", ...) works:

my_filter <- filter("logical", variable = "is_setosa", dataset = "iris", value = TRUE)
my_filter@type
#> [1] "logical"
my_filter@value
#> [1] TRUE

Step 3: Implement methods for tblist source

Each method dispatches on (filter_class, source_class). We use tblist_class (provided by cohortBuilder) as the source class for the built-in list-of-tables backend.

filter_data – filtering logic

S7::method(cb_filter_data, list(CbFilterLogical, tblist_class)) <- function(filter, source, data_object, ...) {
  dataset <- filter@dataset
  variable <- filter@variable
  value <- filter@value
  keep_na <- filter@keep_na

  if (keep_na && !identical(value, NA)) {
    data_object[[dataset]] <- data_object[[dataset]] |>
      dplyr::filter(!!sym(variable) == !!value | is.na(!!sym(variable)))
  }
  if (!keep_na && identical(value, NA)) {
    data_object[[dataset]] <- data_object[[dataset]] |>
      dplyr::filter(!is.na(!!sym(variable)))
  }
  if (!keep_na && !identical(value, NA)) {
    data_object[[dataset]] <- data_object[[dataset]] |>
      dplyr::filter(!!sym(variable) == !!value)
  }
  attr(data_object[[dataset]], "filtered") <- TRUE
  data_object
}

Note:

When value = NA, no filtering is applied (unless keep_na = FALSE, which removes NA rows).
The filtered attribute signals to binding logic that this dataset was touched.

get_stats – data statistics

S7::method(cb_get_filter_stats, list(CbFilterLogical, tblist_class)) <- function(
  filter, source, data_object, name, ...
) {
  dataset <- filter@dataset
  variable <- filter@variable
  if (missing(name)) {
    name <- c("n_data", "choices", "n_missing")
  }
  column <- data_object[[dataset]][[variable]]
  stats <- list(
    choices = if ("choices" %in% name) as.list(table(stats::na.omit(column))),
    n_data = if ("n_data" %in% name) length(stats::na.omit(column)),
    n_missing = if ("n_missing" %in% name) sum(is.na(column))
  )
  if (length(name) == 1L) stats[[name]] else stats[name]
}

Tip: evaluating only the requested stat (via the name parameter) improves performance with large data.

plot_data – visualization

S7::method(cb_plot_filter_data, list(CbFilterLogical, tblist_class)) <- function(filter, source, data_object, ...) {
  dataset <- filter@dataset
  variable <- filter@variable
  if (nrow(data_object[[dataset]])) {
    data_object[[dataset]][[variable]] |> table() |> prop.table() |> graphics::barplot(...)
  } else {
    graphics::barplot(0.0, ylim = c(0.0, 0.1), main = "No data")
  }
}

get_data – filter-related data

S7::method(cb_get_filter_data, list(CbFilterLogical, tblist_class)) <- function(filter, source, data_object, ...) {
  data_object[[filter@dataset]][[filter@variable]]
}

get_defaults – default parameter values

S7::method(cb_get_filter_defaults, list(CbFilterLogical, tblist_class)) <- function(
  filter, source, data_object, cache_object, ...
) {
  list(value = names(cache_object$choices))
}

filter_to_expr – reproducible code

S7::method(cb_filter_to_expr, list(CbFilterLogical, tblist_class)) <- function(filter, source, ...) {
  dataset <- filter@dataset
  variable <- filter@variable
  value <- filter@value
  keep_na <- filter@keep_na

  if (keep_na && !identical(value, NA)) {
    rlang::expr({
      data_object[[!!dataset]] <- data_object[[!!dataset]] |>
        dplyr::filter(!!sym(variable) == !!value | is.na(!!sym(variable)))
    })
  } else if (!keep_na && identical(value, NA)) {
    rlang::expr({
      data_object[[!!dataset]] <- data_object[[!!dataset]] |>
        dplyr::filter(!is.na(!!sym(variable)))
    })
  } else if (!keep_na && !identical(value, NA)) {
    rlang::expr({
      data_object[[!!dataset]] <- data_object[[!!dataset]] |>
        dplyr::filter(!!sym(variable) == !!value)
    })
  } else {
    NULL
  }
}

Using the filter

Now we can use our filter for building a cohort. For the example we’ll use an extended iris table:

iris2 <- dplyr::mutate(iris, is_setosa = Species == "setosa")
coh <- set_source(tblist(iris = iris2)) |>
  cohort(
    filter("logical", dataset = "iris", variable = "is_setosa", value = TRUE)
  ) |>
  run()

Let’s verify the filtering worked:

nrow(get_data(coh)$iris)
#> [1] 50
collapse::funique(get_data(coh)$iris$is_setosa)
#> [1] TRUE

We can also check statistics and reproducible code:

stat(coh, step_id = 1L, filter_id = 1L)
#> $n_data
#> [1] 50
#> 
#> $choices
#> $choices$`TRUE`
#> [1] 50
#> 
#> 
#> $n_missing
#> [1] 0

code(coh, include_methods = NULL, include_action = NULL)
#> source <- list(dtconn = tblist(iris = iris2))
#> data_object <- source$dtconn
#> step_id <- "1"
#> data_object[["iris"]] <- dplyr::filter(data_object[["iris"]], is_setosa == TRUE |
#>     is.na(is_setosa))

Extra parameters

Filter constructors accept ... which is stored in filter@extra. This is useful for passing additional configuration consumed by other packages (e.g. gui_input for shinyCohortBuilder):

my_filter <- filter("logical",
  dataset = "iris", variable = "is_setosa", value = TRUE,
  gui_input = "checkbox"
)
my_filter@extra$gui_input
#> [1] "checkbox"
get_filter_params(my_filter)$gui_input
#> [1] "checkbox"

Extra parameters are included in get_filter_params() output, persisted in get_state(), and can be updated via update_filter().

Implementing filters in a package

When creating custom filters in a separate package:

Define your S7 filter class(es) and export them.
Call register_filter_type() in your package’s .onLoad().
Register S7 methods for your filter × source combinations.
Add S7 (>= 0.2.0) and cohortBuilder to Imports in DESCRIPTION.
Call S7::methods_register() in your .onLoad() to register S7 methods.

# R/zzz.R
.onLoad <- function(libname, pkgname) {
  S7::methods_register()
  cohortBuilder::register_filter_type("logical", CbFilterLogical)
}