Hello everyone,
I have built a Shiny module that is aimed at handling selectInput with a large number of options. This small shiny module simply adds two buttons (a "Select all" button and a "Unselect all" button) below the selectInput widget.
Now, I have set up a small application where I used my Shiny module and defined two SelectizeInputs. I would like to dynamically update the choices of the first SelectizeInput (x) based on the value selected in the second SelectizeInput (y).
Here is a minimal code to reproduce the issue:
library(shiny)
library(tidyverse)
# Dummy dataframe
df <- tibble(x=1:10, y=rep(LETTERS[1:2], 5))
# the UI part of the module
customSelectUI <- function(id, label, choices, selected=NULL, placeholder=NULL, maxItems=NULL, plugins=list("remove_button")){
ns <- NS(id)
tagList(
selectizeInput(
ns("myselect"),
label=label,
choices=choices,
selected=selected,
multiple=TRUE,
options=list(
placeholder=placeholder,
plugins=plugins,
maxItems=maxItems
)
),
tags$div(
style="display:inline-block; margin-bottom:20px;",
actionButton(
ns("selectAll"),
"Sélectionner tout",
class="btn-sm"
),
actionButton(
ns("unselectAll"),
"Désélectionner tout",
class="btn-sm"
)
)
)
}
# the server part of the module
customSelectServer <- function(id, choices){
moduleServer(
id,
function(input, output, session){
observeEvent(
input$selectAll,
{
updateSelectizeInput(
session=getDefaultReactiveDomain(),
inputId="myselect",
choices=choices,
selected=choices
)
}
)
observeEvent(
input$unselectAll,
{
updateSelectizeInput(
session=getDefaultReactiveDomain(),
inputId="myselect",
choices=choices,
selected=NULL
)
}
)
return(
reactive(
{
input$select
}
)
)
}
)
}
# Choices for the select
x_choices <- distinct(df, x)%>%pull()
y_choices <- distinct(df, y)%>%pull()
# Main UI
ui <- fluidPage(
fluidRow(
customSelectUI("x", "Choose a value of x", x_choices),
customSelectUI("y", "Choose a value of y", y_choices)
)
)
# Main server function
server <- function(input, output){
x <- customSelectServer("x", x_choices)
y <- customSelectServer("y", y_choices)
# Update the choices of X selectInput based on selection in Y
filtered_x <- reactive({
df %>% filter(y %in% y()) %>% distinct(x) %>% pull()
})
observeEvent(
filtered_x,
{
updateSelectizeInput(
inputId="x-myselect",
choices=filtered_x()
)
}
)
}
shinyApp(ui, server)
It does not work as expected. For instance, if the user select y==A, the possible values for x should be 1, 3, 5 etc.
Could anyone help ?
Thanks in advance !