I have a modularized shiny app. In one module there are 3 different selectize inputs that should update each other in the following manner:
“Upstream”-choices (e.g. inputs in sel_category_1) should change the choice options of “downstream” selectize inputs (i.e. inputs in sel_category_2 and sel_detail).
If only “downstream”-inputs are changed, it should update the selected option of “upstream”-choices but not the choice options.
Here is my code:
library(shiny)
library(tidyverse)
# base df
df <- tibble::tibble(
cat_1 = c("A", "A", "A", "B", "B", "B", "C", "C", "C"),
cat_2 = c("a", "a", "a", "a", "b", "c", "d", "e", "f"),
cat_detail = c("g", "h", "i", "j", "k", "l", "m", "n", "o")
)
# define ui_module
test_ui <- function(id) {
ns <- NS(id)
fluidRow(
selectizeInput(
inputId = ns("sel_category_1"),
label = "choose cat 1",
choices = c(df |> select(cat_1) |> distinct() |> pull() |> str_sort()),
selected = "",
multiple = T,
options = list(maxItems= 1,
maxOptions= 1500,
placeholder="put in text or select")
),
selectizeInput(
inputId = ns("sel_category_2"),
label = "choose cat 2",
choices = c(df |> select(cat_2) |> distinct() |> pull() |> str_sort()),
selected = "",
multiple = T,
options = list(maxItems= 1,
maxOptions= 1500,
placeholder="put in text or select")
),
selectizeInput(
inputId = ns("sel_detail"),
label = "choose detail",
choices = c(df |> select(cat_detail) |> distinct() |> pull() |> str_sort()),
selected = "",
multiple = T,
options = list(maxItems= 1,
maxOptions= 1500,
placeholder="put in text or select")
)
)
}
# define server module
test_server <- function(id) {
moduleServer(id, function(input, output, session) {
shiny::observeEvent(list(
input$sel_category_1,
input$sel_category_2,
input$sel_detail),
once = TRUE,
ignoreInit = TRUE, {
# function to update selected inputs
update_selected <- function(input_category_1,
input_category_2,
input_detail,
coltouse){
tmp_sel <- df %>%
{if(!is.null(input_category_1)) dplyr::filter(., cat_1 == input_category_1) else .} %>%
{if(!is.null(input_category_2)) dplyr::filter(., cat_2 == input_category_2) else .} %>%
{if(!is.null(input_detail)) dplyr::filter(., cat_detail == input_detail) else .} %>%
dplyr::select(coltouse) %>%
dplyr::distinct() %>%
dplyr::pull()
if(base::length(tmp_sel) == 1){base::return(tmp_sel)} else {base::return("")}
}
# update selectize inputs
updateSelectizeInput(
inputId = "sel_category_1",
label = "choose cat 1",
choices = c(df |> select(cat_1) |> distinct() |> pull() |> str_sort()),
selected = update_selected(input_category_1 = input$sel_category_1,
input_category_2 = input$sel_category_2,
input_detail = input$sel_detail,
coltouse = "cat_1"),
server = T,
options = list(maxItems= 1,
maxOptions= 1500,
placeholder="put in text or select")
)
updateSelectizeInput(
inputId = "sel_category_2",
label = "choose cat 2",
choices = c(df %>%
{if(!is.null(input$sel_category_1)) dplyr::filter(., cat_1 == input$sel_category_1) else .} %>%
select(cat_2) |>
distinct() |>
pull() |>
str_sort()),
selected = update_selected(input_category_1 = input$sel_category_1,
input_category_2 = input$sel_category_2,
input_detail = input$sel_detail,
coltouse = "cat_2"),
server = T,
options = list(maxItems= 1,
maxOptions= 1500,
placeholder="put in text or select")
)
updateSelectizeInput(
inputId = "sel_detail",
label = "choose detail",
choices = c(df %>%
{if(!is.null(input$sel_category_1)) dplyr::filter(., cat_1 == input$sel_category_1) else .} %>%
{if(!is.null(input$sel_category_2)) dplyr::filter(., cat_2 == input$sel_category_2) else .} %>%
select(cat_detail) |>
distinct() |>
pull() |>
str_sort()),
selected = update_selected(input_category_1 = input$sel_category_1,
input_category_2 = input$sel_category_2,
input_detail = input$sel_detail,
coltouse = "cat_detail"),
server = T,
options = list(maxItems= 1,
maxOptions= 1500,
placeholder="put in text or select")
)
}
)
}
)
}
# Define UI with selectize inputs
ui <- fluidPage(
test_ui(id = "test")
)
# Define server logic to update selectize inputs
server <- function(input, output) {
test_server(id = "test")
}
# Run the application
shinyApp(ui = ui, server = server)
With this code it is not possible to realize the desired behavior. It works in both directions when I run the app for the first time. When i have filled all selectize inputs and want to change the value of e.g. sel_category_2 the other selectize inputs do not update again.
I have tried to include the following into the observeEvent to prevent ending in an infinite loop (and that i dont have to use the once option). But it does not work.
r <- reactiveValues()
observeEvent(input$sel_category_1, {
r$sel_category_1 <- input$sel_category_1
})
observeEvent(input$sel_category_2, {
r$sel_category_2 <- input$sel_category_2
})
observeEvent(input$sel_detail, {
r$sel_detail <- input$sel_category_2
})
Another compromise could be to add an action button and reset all values but i want to attain that the user can change the inputs freely and more than one time. Only when the desired combination of inputs is found they should be submitted to a database. It must be ensured that no incorrect combinations of characteristics end up in the database.
Currently the code lacks (at least) a mechanism to get rid of “deprecated” input values and restart the updates.
Is there a solution for this issue?
You might want to check selectizeGroupUI.