Getting values in vars from selectizeGroup-module

I am using selectizeGroup-module and find it wonderful for interdependent filters but how can I access the filters actually selected. https://rdrr.io/cran/shinyWidgets/man/selectizeGroup-module.html has this bit of code. How can I see or pull out the values in vars_f?

 vars_r <- reactive({
      input$vars
    })

its designed to modify a dataframe for you, its not designed to report the sub-settings that resulted in that dataframe. Such a widget is =achievable but involved getting the code for this widget and modify it.
Here:

library(shiny)
library(shinyWidgets)
library(tidyverse)
data("mpg", package = "ggplot2")
`%inT%`<- shinyWidgets:::`%inT%`
toggleDisplayServer<-shinyWidgets:::toggleDisplayServer
ui <- fluidPage(
  fluidRow(
    column(
      width = 10, offset = 1,
      tags$h3("Filter data with selectize group"),
      panel(
        checkboxGroupInput(
          inputId = "vars",
          label = "Variables to use:",
          choices = c("manufacturer", "model", "trans", "class"),
          selected = c("manufacturer", "model", "trans", "class"),
          inline = TRUE
        ),
        selectizeGroupUI(
          id = "my-filters",
          params = list(
            manufacturer = list(inputId = "manufacturer", title = "Manufacturer:"),
            model = list(inputId = "model", title = "Model:"),
            trans = list(inputId = "trans", title = "Trans:"),
            class = list(inputId = "class", title = "Class:")
          )
        ),
        status = "primary"
      ),
      DT::dataTableOutput(outputId = "table"),
      verbatimTextOutput("inputslist_content")
    )
  )
)

selectizeGroupServer <- function (input, output, session, data, vars) 
{
  ns <- session$ns
  toggleDisplayServer(session = session, id = ns("reset_all"), 
                      display = "none")
  rv <- reactiveValues(data = NULL, vars = NULL)
  observe({
    if (is.reactive(data)) {
      rv$data <- data()
    }
    else {
      rv$data <- as.data.frame(data)
    }
    if (is.reactive(vars)) {
      rv$vars <- vars()
    }
    else {
      rv$vars <- vars
    }
    for (var in names(rv$data)) {
      if (var %in% rv$vars) {
        toggleDisplayServer(session = session, id = ns(paste0("container-", 
                                                              var)), display = "table-cell")
      }
      else {
        toggleDisplayServer(session = session, id = ns(paste0("container-", 
                                                              var)), display = "none")
      }
    }
  })
  observe({
    lapply(X = rv$vars, FUN = function(x) {
      vals <- sort(unique(rv$data[[x]]))
      updateSelectizeInput(session = session, inputId = x, 
                           choices = vals, server = TRUE)
    })
  })
  observeEvent(input$reset_all, {
    lapply(X = rv$vars, FUN = function(x) {
      vals <- sort(unique(rv$data[[x]]))
      updateSelectizeInput(session = session, inputId = x, 
                           choices = vals, server = TRUE)
    })
  })
  observe({
    vars <- rv$vars
    lapply(X = vars, FUN = function(x) {
      ovars <- vars[vars != x]
      observeEvent(input[[x]], {
        data <- rv$data
        indicator <- lapply(X = vars, FUN = function(x) {
          data[[x]] %inT% input[[x]]
        })
        indicator <- Reduce(f = `&`, x = indicator)
        data <- data[indicator, ]
        if (all(indicator)) {
          toggleDisplayServer(session = session, id = ns("reset_all"), 
                              display = "none")
        }
        else {
          toggleDisplayServer(session = session, id = ns("reset_all"), 
                              display = "block")
        }
        for (i in ovars) {
          if (is.null(input[[i]])) {
            updateSelectizeInput(session = session, inputId = i, 
                                 choices = sort(unique(data[[i]])), server = TRUE)
          }
        }
        if (is.null(input[[x]])) {
          updateSelectizeInput(session = session, inputId = x, 
                               choices = sort(unique(data[[x]])), server = TRUE)
        }
      }, ignoreNULL = FALSE, ignoreInit = TRUE)
    })
  })
  return(reactive({
    data <- rv$data
    vars <- rv$vars
    inputslist <- purrr::map(vars,~input[[.]])
    indicator <- lapply(X = vars, FUN = function(x) {
      data[[x]] %inT% input[[x]]
    })
    indicator <- Reduce(f = `&`, x = indicator)
    data <- data[indicator, ]
    return(list(data=data,
                inputslist=inputslist))
  }))
}

server <- function(input, output, session) {
  
  vars_r <- reactive({
    input$vars
  })
  
  res_mod <- callModule(
    module = selectizeGroupServer,
    id = "my-filters",
    data = mpg,
    vars = vars_r
  )
  
  output$table <- DT::renderDataTable({
    req(res_mod())
    res_mod()$data
  })
  output$inputslist_content <- renderPrint({
    req(res_mod())
    res_mod()$inputslist
  })
}

shinyApp(ui, server)
}

This topic was automatically closed 54 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.