Since we are dealing with a module (and the inputs are not directly accessible), I modified the function selectizeGroupServer To include an updater for manufacturer input. The new function is called selectizeGroupServer_custom
observe({
updateSelectInput(inputId = 'manufacturer', choices = unique(rv$data$manufacturer), selected = 'audi')
})
new module:
selectizeGroupServer_modified <-
function(input, output, session, data, vars)
{
`%inT%` <- function(x, table) {
if (!is.null(table) && ! "" %in% table) {
x %in% table
} else {
rep_len(TRUE, length(x))
}
}
ns <- session$ns
shinyWidgets:::toggleDisplayServer(session = session, id = ns("reset_all"),
display = "none")
rv <- reactiveValues(data = NULL, vars = NULL)
observe({
if (is.reactive(data)) {
rv$data <- data()
}
else {#this will be the first data
rv$data <- as.data.frame(data)
}
if (is.reactive(vars)) { #this will be the data type for vars
rv$vars <- vars()
}
else {
rv$vars <- vars
}
for (var in names(rv$data)) {
if (var %in% rv$vars) {
shinyWidgets:::toggleDisplayServer(session = session, id = ns(paste0("container-",
var)), display = "table-cell")
}
else {
shinyWidgets:::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)
#CODE INSERTED HERE
if (x == 'manufacturer') {
updateSelectizeInput(session = session, inputId = x,
choices = vals, server = TRUE, selected = 'manufacturer')
}
})
})
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)) {
shinyWidgets:::toggleDisplayServer(session = session, id = ns("reset_all"),
display = "none")
}
else {
shinyWidgets:::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)
})
})
observe({
updateSelectInput(inputId = 'manufacturer', choices = unique(rv$data$manufacturer), selected = 'audi')
})
return(reactive({
data <- rv$data
vars <- rv$vars
indicator <- lapply(X = vars, FUN = function(x) {
`%inT%`(data[[x]], input[[x]])
})
indicator <- Reduce(f = `&`, x = indicator)
data <- data[indicator, ]
return(data)
}))
}
app:
library(shiny)
library(shinyWidgets)
data("mpg", package = "ggplot2")
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")
)
)
)
server <- function(input, output, session) {
vars_r <- reactive({
input$vars
})
res_mod <- callModule(
module = selectizeGroupServer_modified,
id = "my-filters",
data = mpg,
vars = vars_r
)
output$table <- DT::renderDataTable({
res_mod()
})
}
shinyApp(ui, server)
EDIT:
If we want to have a button that says "show all data", we can modify selectizeGroupUI. The new name will be selectizeGroupUI_custom
Modules and App code:
library(shiny)
library(shinyWidgets)
# SERVER MODULE -----------------------------------------------------------
selectizeGroupServer_modified <-
function(input, output, session, data, vars) {
`%inT%` <- function(x, table) {
if (!is.null(table) && !"" %in% table) {
x %in% table
} else {
rep_len(TRUE, length(x))
}
}
ns <- session$ns
shinyWidgets:::toggleDisplayServer(
session = session, id = ns("reset_all"),
display = "none"
)
rv <- reactiveValues(data = NULL, vars = NULL)
observe({
if (is.reactive(data)) {
rv$data <- data()
} else { # this will be the first data
rv$data <- as.data.frame(data)
}
if (is.reactive(vars)) { # this will be the data type for vars
rv$vars <- vars()
} else {
rv$vars <- vars
}
for (var in names(rv$data)) {
if (var %in% rv$vars) {
shinyWidgets:::toggleDisplayServer(session = session, id = ns(paste0(
"container-",
var
)), display = "table-cell")
} else {
shinyWidgets:::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)) {
shinyWidgets:::toggleDisplayServer(
session = session, id = ns("reset_all"),
display = "none"
)
} else {
shinyWidgets:::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
)
})
})
observe({
updateSelectInput(inputId = "manufacturer", choices = unique(rv$data$manufacturer), selected = "audi")
})
return(reactive({
data <- rv$data
vars <- rv$vars
indicator <- lapply(X = vars, FUN = function(x) {
`%inT%`(data[[x]], input[[x]])
})
indicator <- Reduce(f = `&`, x = indicator)
data <- data[indicator, ]
return(data)
}))
}
# UI MODULE ---------------------------------------------------------------
selectizeGroupUI_custom <-
function(id, params, label = NULL, btn_label = "Reset filters", inline = TRUE) {
ns <- NS(id)
if (inline) {
selectizeGroupTag <- tagList(
##### NEW LOCATION FOR THE BUTTON #####
actionButton(
inputId = ns("reset_all"), label = btn_label,
style = "float: left;"
##### NEW LOCATION FOR THE BUTTON #####
),
tags$b(label), tags$div(
class = "btn-group-justified selectize-group",
role = "group", `data-toggle` = "buttons", lapply(
X = seq_along(params),
FUN = function(x) {
input <- params[[x]]
tagSelect <- tags$div(
class = "btn-group",
id = ns(paste0("container-", input$inputId)),
selectizeInput(
inputId = ns(input$inputId),
label = input$title, choices = input$choices,
selected = input$selected, multiple = ifelse(is.null(input$multiple),
TRUE, input$multiple
), width = "100%",
options = list(
placeholder = input$placeholder,
plugins = list("remove_button"), onInitialize = I("function() { this.setValue(\"\"); }")
)
)
)
return(tagSelect)
}
)
)
)
} else {
selectizeGroupTag <- tagList(tags$b(label), lapply(
X = seq_along(params),
FUN = function(x) {
input <- params[[x]]
tagSelect <- selectizeInput(
inputId = ns(input$inputId),
label = input$title, choices = input$choices,
selected = input$selected, multiple = ifelse(is.null(input$multiple),
TRUE, input$multiple
), width = "100%", options = list(
placeholder = input$placeholder,
plugins = list("remove_button"), onInitialize = I("function() { this.setValue(\"\"); }")
)
)
return(tagSelect)
}
), actionLink(
inputId = ns("reset_all"), label = btn_label,
icon = icon("remove"), style = "float: right;"
))
}
tagList(
singleton(tagList(tags$link(
rel = "stylesheet", type = "text/css",
href = "shinyWidgets/modules/styles-modules.css"
), shinyWidgets:::toggleDisplayUi())),
selectizeGroupTag
)
}
# APP ---------------------------------------------------------------------
data("mpg", package = "ggplot2")
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_custom(
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:")
), btn_label = "Show all data"
),
status = "primary"
),
DT::dataTableOutput(outputId = "table")
)
)
)
########### SERVER###########
server <- function(input, output, session) {
vars_r <- reactive({
input$vars
})
res_mod <- callModule(
module = selectizeGroupServer_modified,
id = "my-filters",
data = mpg,
vars = vars_r
)
output$table <- DT::renderDataTable({
res_mod()
})
}
shinyApp(ui, server)
