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)
}