Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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)
like image 277
bendae Avatar asked Aug 01 '19 10:08

bendae


1 Answers

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

like image 188
Marcus Avatar answered Oct 23 '22 05:10

Marcus