Select Group Input Module

Group of mutually dependent select menus for filtering data.frame's columns (like in Excel).

Usage

select_group_ui(
  id,
  params,
  label = NULL,
  btn_reset_label = "Reset filters",
  inline = TRUE,
  vs_args = list()
)

select_group_server(id, data_r, vars_r, selected_r = reactive(list()))

Arguments

id

Module's id.

params

A list of parameters passed to each shinyWidgets::virtualSelectInput(), you can use :

• inputId: mandatory, must correspond to variable name.

• label: Display label for the control.

• placeholder: Text to show when no options selected.

label

Character, global label on top of all labels.

btn_reset_label

Character, reset button label. If NULL no button is added.

inline

If TRUE (the default), select menus are horizontally positioned, otherwise vertically.

vs_args

Arguments passed to all shinyWidgets::virtualSelectInput() created.

data_r

Either a data.frame() or a shiny::reactive() function returning a data.frame (do not use parentheses).

vars_r

character, columns to use to create filters, must correspond to variables listed in params. Can be a shiny::reactive() function, but values must be included in the initial ones (in params).

selected_r

shiny::reactive() function returning a named list with selected values to set.

Value

A shiny::reactive() function containing data filtered with an attribute inputs containing a named list of selected inputs.

Examples

# Default -----------------------------------------------------------------

library(shiny)
library(datamods)
library(shinyWidgets)


ui <- fluidPage(
  # theme = bslib::bs_theme(version = 5L),
  fluidRow(
    column(
      width = 10, offset = 1,
      tags$h3("Filter data with select group module"),
      shinyWidgets::panel(
        select_group_ui(
          id = "my-filters",
          params = list(
            list(inputId = "Manufacturer", label = "Manufacturer:"),
            list(inputId = "Type", label = "Type:"),
            list(inputId = "AirBags", label = "AirBags:"),
            list(inputId = "DriveTrain", label = "DriveTrain:")
          ), vs_args = list(disableSelectAll = FALSE)
        ),
        status = "primary"
      ),
      reactable::reactableOutput(outputId = "table"),
      tags$b("Inputs values:"),
      verbatimTextOutput("inputs")
    )
  )
)

server <- function(input, output, session) {
  res_mod <- select_group_server(
    id = "my-filters",
    data = reactive(MASS::Cars93),
    vars = reactive(c("Manufacturer", "Type", "AirBags", "DriveTrain"))
  )

  output$table <- reactable::renderReactable({
    reactable::reactable(res_mod())
  })

  output$inputs <- renderPrint({
    attr(res_mod(), "inputs")
  })
}

if (interactive())
  shinyApp(ui, server)


# Selected value --------------------------------------------------------------------

library(shiny)
library(datamods)

ui <- fluidPage(
  select_group_ui(
    id = "my-filters",
    params = list(
      list(inputId = "Manufacturer", label = "Manufacturer:"),
      list(inputId = "Type", label = "Type:")
    ),
    vs_args = list(
      disableSelectAll = FALSE
    )
  ),
  actionButton("set_sel", "Set Manufacturer=Acura"),
  verbatimTextOutput("res")
)

server <- function(input, output, session) {
  # We use a reactiveValue so that it can be updated
  rv <- reactiveValues(selected = list(Manufacturer = "Audi")) # for init
  res_r <- select_group_server(
    id = "my-filters",
    data = reactive(MASS::Cars93),
    vars = reactive(c("Manufacturer", "Type")),
    selected_r = reactive(rv$selected)
  )
  output$res <- renderPrint({
    res_r()
  })
  observeEvent(input$set_sel, {
    rv$selected <- list(Manufacturer = "Acura")
  })
}

if (interactive())
  shinyApp(ui, server)