Return values from nested `selectInput` inside shiny module

Viewed 315

I am having problems with nested selectInputs inside a shiny module.

Consider the following minimal sample app

library(shiny)

options <- list(A = 1:3, B = 4:6)

module_ui <- function(id) {
    ns <- NS(id)
    tagList(
        selectInput(ns("option1"), "Option 1", choices = LETTERS[1:2]),
        selectInput(ns("option2"), "Option 2", choices = NULL))
}
    
module_server <- function(id) {
    moduleServer(
        id,
        function(input, output, session) { 
            observe({
                updateSelectInput(
                    session, "option2", choices = options[[input$option1]])
            })
            return(list(
                option1 = reactive(input$option1),
                option2 = reactive(input$option2)))
        }
    )
}

ui <- fluidPage(
    module_ui("module"),
    textOutput("text")
)

server <- function(input, output, session) {
    sel <- module_server("module")
    output$text <- renderText({
        req(sel$option1(), sel$option2())
        print(paste0(sel$option1(), sel$option2(), collape = ""))
        paste0(sel$option1(), sel$option2(), collape = "")
    })
}

shinyApp(ui, server)

My problem can be reproduced when doing the following:

  1. Keep entry "A" from "Option 1" and entry "1" from "Option 2" (entries for "Option 2" are based on the currently selected entry from "Option 1").
  2. Then select entry "B" from "Option 1".

This does not immediately clear and update the list entries in "Option 2". Instead, for a short time, the reactive return values from module_server give the non-existent "Option 1"-"Option 2" combination "B1" (see the terminal output in the sample app); this happens only very briefly before the entries in "Option 2" are then correctly updated via updateSelectInput. The issue is that any non-existent value combination that is returned by the module causes issues/errors downstream.

The post Dealing with nested selectizeInputs and modules describes a very similar problem but I find the solution problematic in my case. Amongst other things, I'd like the module to handle validation of inputs.

I don't have this issue when I place the selectInputs in the main ui and use updateSelectInput in the main server. Somehow the two reactive elements in the return argument of module_server are "too quick". Is there a way to validate/check the inputs prior to returning them in module_server.

1 Answers

Here's a solution. You can explicitly do the validation with a req() in the second reactive output. i.e.

module_server <- function(id) {
  moduleServer(
    id,
    function(input, output, session) { 
      observe({
        updateSelectInput(
          session, "option2", choices = options[[input$option1]])
      })
      
      return(list(
        option1 = reactive(input$option1),
        option2 = reactive({
          req(input$option2 %in% options[[input$option1]])
          input$option2
          })))
    }
  )
}

It'll basically stop anything downstream with that reactive until the condition is satisifed.

Related