Skip to contents

Run the backend server for filterInput

Usage

serverFilterInput(
  x,
  input,
  filter_combine_method = "and",
  args_apply_filters = NULL,
  ...
)

Arguments

x

An object being filtered; typically a data.frame.

input

A shiny input object, or a reactive that resolves to a list of named values.

filter_combine_method

A string or function indicating how to combine multiple filters. If a string, it can be "and" (or "&") for logical AND, or "or" (or "|") for logical OR. If a function, it should take two logical vectors and return a combined logical vector.

args_apply_filters

A named list of additional arguments passed to apply_filters().

...

Additional arguments passed to updateFilterInput().

Value

A reactiveValues list with a single element, input_values, which contains the current filter input values as a named list.

Examples

if (FALSE) { # interactive() && requireNamespace("bslib") && requireNamespace("DT")
library(bslib)
library(DT)
library(S7)
library(shiny)

must_use_radio <- new_S3_class(
   class = "must_use_radio",
   constructor = function(.data) .data
)
method(filterInput, must_use_radio) <- function(x, ...) {
   call_filter_input(x, shiny::radioButtons, ...)
}
method(updateFilterInput, must_use_radio) <- function(x, ...) {
   call_update_filter_input(x, shiny::updateRadioButtons, ...)
}

use_radio <- function(x) {
   structure(x, class = unique(c("must_use_radio", class(x))))
}

df_shared <- data.frame(
   x = letters,
   y = use_radio(sample(c("red", "green", "blue"), 26, replace = TRUE)),
   z = round(runif(26, 0, 3.5), 2),
   q = sample(Sys.Date() - 0:7, 26, replace = TRUE)
)

filters_ui <- function(id) {
   ns <- shiny::NS(id)
   filterInput(
     x = df_shared,
     range = TRUE,
     selectize = TRUE,
     slider = TRUE,
     multiple = TRUE,
     ns = ns
   )
}

filters_server <- function(id) {
   moduleServer(id, function(input, output, session) {
     # serverFilterInput() returns a shiny::observe() expressionc
     serverFilterInput(df_shared, input = input, range = TRUE)
   })
}

ui <- page_sidebar(
   sidebar = sidebar(filters_ui("demo")),
   DTOutput("df_full"),
   verbatimTextOutput("input_values"),
   DTOutput("df_filt")
)

server <- function(input, output, session) {
   res <- filters_server("demo")
   output$df_full <- renderDT(datatable(df_shared))
   output$input_values <- renderPrint(res$input_values)
   output$df_filt <- renderDT(datatable(apply_filters(
     df_shared,
     res$input_values
   )))
}

shinyApp(ui, server)
}