bendae
bendae

Reputation: 789

Shiny selectInput depending on validated reactive does not pass on validation error

I'm trying to use validate in R shiny to prevent outputs from showing when they shouldn't be. When a validated reactive is used in creating an input inside a uiOutput and the validation throws an error, this error does not get passed on to a depending reactive or output.

Reading https://shiny.rstudio.com/articles/validation.html and using reactlog has me thinking that the issue lies in the generated input not depending on the validated reactive. The article states:

Shiny will: [...] pass a validation error to any reactive expression or observer object that depends on it

I'm unsure what an input inside a uiOutput really is, but I suspect it's neither a reactive expression nor an observer.

Consider the following example:

library(shiny)
library(data.table)

cars <- data.table(mtcars, keep.rownames = T )
setnames(cars, "rn", "name")

ui <- fluidPage(
  selectInput("cyl", "Cyl", c(4, 12)),
  uiOutput("uiOutCars"),
  h4("Filtered Table"),
  tableOutput("filteredTable")
)

server <- function(input, output, session) {

  availableCars <- reactive({
    choices <- cars[cyl == input$cyl, name]
    validate(need(try(length(choices) > 0),
                  "No cars with this cyl!"))
    choices

  })


  output$uiOutCars <- renderUI({
    selectInput(inputId = "selectCar", 
                label = "Car", 
                choices = availableCars())
  })


  output$filteredTable <- renderTable({
    cars[name == input$selectCar]
  })


}

shinyApp(ui, server)

Initial state:

Shiny App initial state

When changing the cyl input from 4 to 12 (no cars with 12 cylinders exist in cars), the selectCar input is not shown. The validation message No cars with this cyl! is:

Shiny App input cyl changed to 12

My expectation was that the filteredTable also stops showing, because input$selectCar should not have a proper value. However, it seems to retain its last value when availableCars() did not yet throw the error.

Is it possible to pass on the validation error "through" an input generated by a uiOutput?

EDIT

@TimTeaFan adds that neither does it work when using updateSelectInput (thanks for checking!):

library(shiny)
library(data.table)

cars <- data.table(mtcars, keep.rownames = T )
setnames(cars, "rn", "name")

ui <- fluidPage(
    selectInput("cyl", "Cyl", c(4, 
    selectInput("selectCar", "Car", 
                cars[cyl == 4, name]), # differs from original example here
    h4("Filtered Table"),
    tableOutput("filteredTable")
)

server <- function(input, output, session) {

    availableCars <- reactive({
        choices <- cars[cyl == input$cyl, name]
        validate(need(length(choices) > 0,
                      "No cars with this cyl!"))
        choices

    })

    # differs from original example here
    observeEvent(input$cyl, {
        updateSelectInput(session, "selectCar",
                          choices = availableCars())
    })


    output$filteredTable <- renderTable({
        cars[name == input$selectCar]
    })


}

shinyApp(ui, server)

Upvotes: 6

Views: 1101

Answers (3)

Marcus
Marcus

Reputation: 3636

For completeness, per my comment on the other answer, strictly speaking you cannot have a validation message propagate to an input (in uiOutput or otherwise). As quoted from the article, validation propagates to reactive expressions and observers. In the language of reactivity (see this article), these are reactive conductors and reactive endpoints, respectively. This means they can take on a reactive dependency. Reactive conductors can also be used to create a reactive dependency. input is a reactive source. Reactive sources can be used to create a reactive dependency, but strictly speaking can't take on a reactive dependency (technically renderUI is actually making output$uiOutCars have the reactive dependency not input$selectCar)

All this being said, here is another workaround. It creates a pseudo-input which is a reactive expression (i.e. will have validation messages propagate through).

library(shiny)
library(data.table)

cars <- data.table(mtcars, keep.rownames = T )
setnames(cars, "rn", "name")

ui <- fluidPage(
  selectInput("cyl", "Cyl", c(4, 12)),
  uiOutput("uiOutCars"),
  h4("Filtered Table"),
  tableOutput("filteredTable")
)

server <- function(input, output, session) {

  availableCars <- reactive({
    choices <- cars[cyl == input$cyl, name]
    validate(need(try(length(choices) > 0),
                  "No cars with this cyl!"))
    choices

  })


  output$uiOutCars <- renderUI({
    selectInput(inputId = "selectCar", 
                label = "Car", 
                choices = availableCars(),
                selected = "Merc 230")
  })

  pseudoSelectCar <- reactive(
    {

      availableCars()
      # include other dependencies here
      input$selectCar

    })

  output$filteredTable <- renderTable({
    req(pseudoSelectCar()) # prevent warning on initialization
    cars[name == pseudoSelectCar()]
  })


}

The idea is that as the expression for the the pseudo input is re-evaluated, if any of the dependencies fail validation, they will short-circuit the "input" evaluation as well. Otherwise, the pseudo input is just equal to the input value.

The downside is you do have to explicitly list all your dependencies for input$selectCar in the definition of pseudoSelectCar. The upside is you just have to do this in one place and you can use pseudoSelectCar everywhere else in your code where you would have otherwise used input$selectCar

Upvotes: 2

Marcus
Marcus

Reputation: 3636

Do you need to have the error message repeated twice or could you move the h4 and tableOutput into the renderUI?

library(shiny)
library(data.table)

cars <- data.table(mtcars, keep.rownames = T )
setnames(cars, "rn", "name")

ui <- fluidPage(
  selectInput("cyl", "Cyl", c(4, 12)),
  uiOutput("uiOutCars")

)

server <- function(input, output, session) {

  availableCars <- reactive({
    choices <- cars[cyl == input$cyl, name]
    validate(need(try(length(choices) > 0),
                  "No cars with this cyl!"))
    choices

  })


  output$uiOutCars <- renderUI({
    tagList(
      selectInput(inputId = "selectCar", 
                  label = "Car", 
                  choices = availableCars()),
      h4("Filtered Table"),
      tableOutput("filteredTable")
    )
  })


  output$filteredTable <- renderTable({
    cars[name == input$selectCar]
  })


}

shinyApp(ui, server)

shinyout

Upvotes: 1

phalteman
phalteman

Reputation: 3532

You can get the behaviour you're looking for by replacing your renderTable() with the following:

  output$filteredTable <- renderTable({
    req(availableCars())
    cars[name %in% input$selectCar]
  })

As noted in the comments, my suspicion is that when the validation error gets passed on, it stops any downstream calculations and therefore input$selectCar doesn't get updated and the table continues to show the last selection. Using req() gets the app to check for the current value of availableCars() which then passes the validation message and updates the table.

I know this doesn't answer your question exactly, but hopefully it provides a useful workaround.

Upvotes: 2

Related Questions