reset selectizeInputs each time I modify a numericInput in RShiny - r

Question

I'm learning shiny and working with a numericInput connected to many selectizeInputs.
if the numeric input equals to 1 or 2, I would like to create respectively 1 and 2 selectizeInputs and select the "i"th modality of a vector called "modalities" for each selectizeInput EDIT : and that choices = modalities[i] only (and not modalities)
if the numeric input equals to 3 or 4, I would like to create respectively 3 and 4 selectizeInputs which are connected with each other (with choices = modalities). In other words : if an item is selected in one of the selectizeinputs i would like that it disappears from the other selectizeinputs' choices.
In addition (and this is what I have trouble with) I would like to "reset" all the selected SelectizeInputs each time I modify the numericInput. I tried with the observeEvent below and I tried to use an isolate(input$ui_number) but I did not find any solution to my question because i don't understand how to do it... !
Thank you for your help !
library(shiny)
modalities <- LETTERS[1:10]
ui = tabPanel("Change modalities",
numericInput("ui_number", label = "Number of modalities",
min = 1, max = 4, value = 3),
uiOutput("renderui")
)
server = function(input, output, session) {
# Generate modalities select lists
output$renderui <- renderUI({
output = tagList()
for (i in seq_len(input$ui_number)) {
output[[i]] = selectizeInput(paste0("ui_mod_choose", i),
label = paste0("Modality ", i),
choices = modalities, multiple = TRUE)
}
return(output)
})
# if input$ui_number is modified to 3 or 4 : set selected to NULL ##### NOT WORKING
observeEvent({input$ui_number},
{
n <- input$ui_number
if(n%in%c(3,4)){
for (i in seq_len(n)) {
updateSelectizeInput(session, paste0("ui_mod_choose",i),selected=NULL)
}
}
}
)
observe({
n <- input$ui_number
if(n%in%c(1,2)){ #if n=1 or 2 => Select the "i"th modality for each selectizeInput
for (i in seq_len(n)) {
updateSelectizeInput(session, paste0("ui_mod_choose",i),
choices = modalities[i],
selected = modalities[i]
)
}
} else{ # if n=3 or 4 => Remove selected modalities from other select lists
for (i in seq_len(n)) {
vecteur <- unlist(lapply((1:n)[-i], function(i)
input[[paste0("ui_mod_choose",i)]]))
updateSelectizeInput(session, paste0("ui_mod_choose",i),
choices = setdiff(modalities, vecteur),
selected = input[[paste0("ui_mod_choose",i)]])
}
}
})
}
runApp(shinyApp(ui, server))
This issue corresponds to the following of this one :
lapply function using a numericInput parameter around an observeEvent in RShiny
EDIT2 : new try thanks to #Aurèle 's tip.
The only problem which remains is the 1:100 in lapply which can take time to load (did not find a solution to add a reactive content such as 1:input&ui_number around a conditional panel)
library(shiny)
modalities <- LETTERS[1:10]
make_conditional_selectizeInputs <- function() {
do.call(
div,
lapply(1:100, function(i)
conditionalPanel(
condition = sprintf("%d <= input.ui_number", i),
selectizeInput(sprintf("ui_mod_choose%d", i),
label = sprintf("Modality %d", i),
choices = character(0), multiple = TRUE, selected = NULL)
)
)
)
}
ui <- tabPanel(
"Change modalities",
uiOutput("rendernumeric"),
#numericInput("ui_number", label = "Number of modalities", min = 1L, max = max, value = 1L),
make_conditional_selectizeInputs()
)
server <- function(input, output, session) {
max <- 4
output$rendernumeric <- renderUI({
numericInput("ui_number", label = "Number of modalities", min = 1L, max = max, value = 1L)
})
n <- reactive({
n <- input$ui_number
if (is.null(n) || is.na(n) || !n >= 0) 0 else n
})
# Reset all
observeEvent(
eventExpr = n(),
handlerExpr = for (i in seq_len(max))
updateSelectizeInput(
session, sprintf("ui_mod_choose%d", i),
choices = if (n() %in% 1:2 && i <= n()) modalities[i] else modalities,
selected = if (n() %in% 1:2 && i <= n()) modalities[i] else NULL
)
)
all_selected <- reactive({
unlist(lapply(seq_len(max), function(i)
input[[sprintf("ui_mod_choose%d", i)]]))
})
# Update available modalities
observeEvent(
eventExpr = all_selected(),
handlerExpr = if (!n() %in% 1:2) for (i in seq_len(n())) {
x <- input[[sprintf("ui_mod_choose%d", i)]]
other_selected <- setdiff(all_selected(), x)
updateSelectizeInput(session, sprintf("ui_mod_choose%d", i),
choices = setdiff(modalities, other_selected),
selected = x)
}
)
}
runApp(shinyApp(ui, server))

Answer 1

Basically, you just need one more line: selected = if (n %in% 1:2) modalities[i] else NULL whenever you regenerate your selectizeInputs.
library(shiny)
modalities <- LETTERS[1:10]
ui = tabPanel("Change modalities",
numericInput("ui_number", label = "Number of modalities",
min = 1, max = 4, value = 3),
uiOutput("renderui"))
server = function(input, output, session) {
# Generate modalities select lists
output$renderui <- renderUI({
output = tagList()
n <- input$ui_number
n <- if (is.null(n) || is.na(n) || ! n >= 0) 0 else n
for (i in seq_len(n)) {
output[[i]] = selectizeInput(paste0("ui_mod_choose", i),
label = paste0("Modality ", i),
choices = if (n %in% 1:2) modalities[i] else modalities,
multiple = TRUE,
# Add this
selected = if (n %in% 1:2) modalities[i] else NULL)
}
output
})
# Remove selected modalities from other select lists
observe({
n <- isolate(input$ui_number)
if (!n %in% 1:2) for (i in seq_len(n)) {
vecteur <- unlist(lapply((1:n)[-i], function(i)
input[[paste0("ui_mod_choose",i)]]))
updateSelectizeInput(session, paste0("ui_mod_choose",i),
choices = setdiff(modalities, vecteur),
selected = input[[paste0("ui_mod_choose",i)]])
}
})
}
runApp(shinyApp(ui, server))

Answer 2

(This is different enough to be a separate answer).
In https://shiny.rstudio.com/articles/dynamic-ui.html, four different approaches to a dynamic UI in Shiny are suggested, ordered by difficulty:
The conditionalPanel function, which is used in ui.R and wraps a set of UI elements that need to be dynamically shown/hidden.
The renderUI function, which is used in server.R in conjunction with the uiOutput function in ui.R, lets you generate calls to UI functions and make the results appear in a predetermined place in the UI.
The insertUI and removeUI functions, which are used in server.R and allow you to add and remove arbitrary chunks of UI code (all independent from one another), as many times as you want, whenever you want, wherever you want.
Use JavaScript to modify the webpage
Your attempts use the second approach, this answer uses the first one (though it should be doable with any of them):
library(shiny)
modalities <- LETTERS[1:10]
max <- 4L
First, a helper function to build the UI. The number of selectizeInputs is no longer dynamic but fixed to max, and they're alternatively shown/hidden based on input$ui_number:
make_conditional_selectizeInputs <- function(max) {
do.call(
div,
lapply(seq_len(max), function(i)
conditionalPanel(
condition = sprintf("%d <= input.ui_number", i),
selectizeInput(sprintf("ui_mod_choose%d", i),
label = sprintf("Modality %d", i),
choices = character(0), multiple = TRUE, selected = NULL)
)
)
)
}
ui <- tabPanel(
"Change modalities",
numericInput("ui_number", label = "Number of modalities",
min = 1L, max = max, value = 1L),
make_conditional_selectizeInputs(max)
)
The server function has two reactive expressions that help modularize code but are not essential to its logic (n() and all_expected()).
There is no longer a renderUI() (the selectizeInputs are already generated once and for all).
There is an observeEvent() that takes a dependency on input$ui_number and resets all selections and choices when it changes.
The last observeEvent() takes a dependency on all input$ui_mod_choose[i] and updates all the choices whenever there is a new selection.
server <- function(input, output, session) {
n <- reactive({
n <- input$ui_number
if (is.null(n) || is.na(n) || !n >= 0) 0 else n
})
# Reset all
observeEvent(
eventExpr = n(),
handlerExpr = for (i in seq_len(max))
updateSelectizeInput(
session, sprintf("ui_mod_choose%d", i),
choices = if (n() %in% 1:2 && i <= n()) modalities[i] else modalities,
selected = if (n() %in% 1:2 && i <= n()) modalities[i] else NULL
)
)
all_selected <- reactive({
unlist(lapply(seq_len(max), function(i)
input[[sprintf("ui_mod_choose%d", i)]]))
})
# Update available modalities
observeEvent(
eventExpr = all_selected(),
handlerExpr = if (!n() %in% 1:2) for (i in seq_len(n())) {
x <- input[[sprintf("ui_mod_choose%d", i)]]
other_selected <- setdiff(all_selected(), x)
updateSelectizeInput(session, sprintf("ui_mod_choose%d", i),
choices = setdiff(modalities, other_selected),
selected = x)
}
)
}
Essentially it differs from the second approach (with renderUI) in that it removes part of the dependency between input$ui_number and the input$ui_mod_choose[i], at least when they're generated (but there's a residual dependency when they're reset because of updateSelectizeInput. I'm not completely clear why I could make it work with this approach and not with renderUI though).
runApp(shinyApp(ui, server))
This is a screenshot of the reactlog, though it doesn't show the whole picture, because of the necessary impurity of updateSelectizeInput() that mixes the UI and server logics, and creates circular dependencies that can be tricky to reason about: