Carl
Carl

Reputation: 5779

Dealing with nested selectizeInputs and modules

I am having trouble with nested selectizeInputs, i.e. a group of select inputs where the selection in the first determines the choices in the second, which control the choices in the third, and so on.

Let's say I have an select1 that lets you choose a dataset, and select2 which lets you pick a variable in the dataset. Obviously the choices in select2 depend on the selection in select1. I find that if a user selects a variable from select2, and then changes select1, it doesn't immediately wipe out the value from select2, but instead it goes through a reactive sequence with the new value in select1, and the old value from select2, which is suddenly referencing a variable in a different dataset, which is a problem.

Example:

library(shiny)

ui =fluidPage(
  selectizeInput('d',choices=c('mtcars','iris'),
                 label="Datasets"),
  uiOutput("vars"),
  htmlOutput("out")
)

server = function(input, output, session) {

  output$vars <- renderUI({
    req(input$d)
    selectizeInput("v",choices=names(get(input$d)), label="Variables",
                   options=list(onInitialize=I('function() {this.setValue("");}')))
  })

  output$out <- renderUI({
    req(input$d,input$v)
    HTML(paste0("The max is ",max(get(input$d)[[input$v]])))
  })

}
runApp(list(ui = ui, server = server))

On launch, select mpg, and displays max value.

Now, after selecting mpg, if you switch to iris, you will get a barely noticeable error, then it corrects itself. This is a toy example, so the error is insignificant, but there could easily be cases where the error is much more dire (as is the case with the app I am currently developing).

Is there a way to handle nested selectizeInputs such that changes in an upstream selectizeInput won't evaluate with old values of down stream selectizeInputs when changed?

Thanks

edit: This issue turns out to have to do more with modules than anything else I believe:

library(shiny)
library(DT)

testModUI <- function(id) {
  ns <- NS(id)
  DT::dataTableOutput(ns("out"))
}

testMod <- function(input, output, session, data) {
  output$out <- DT::renderDataTable({
    data()
  },caption="IN MODULE")
}

ui =fluidPage(
  selectizeInput('d',choices=c('mtcars','iris'),
                 label="Datasets"),
  uiOutput("vars"),
  testModUI("test"),
  DT::dataTableOutput("test2")
)

server = function(input, output, session) {

  output$vars <- renderUI({
    req(input$d)
    selectizeInput("v",choices=names(get(input$d)), label="Variables",
                   options=list(onInitialize=I('function() {this.setValue("");}')))
  })

  observe({
    req(input$d,input$v)#,get(input$d)[[input$v]])
    validate(
      need(input$v %in% names(get(input$d)), 'Wait.')
    )
    callModule(testMod,"test",reactive(data.frame(v1=max(get(input$d)[[input$v]]))))
  })

  output$test2 <- DT::renderDataTable({
    req(input$d,input$v)#,get(input$d)[[input$v]])
    validate(
      need(input$v %in% names(get(input$d)), 'Wait.')
    )
    data.frame(v1=max(get(input$d)[[input$v]]))
  },caption="OUTSIDE MODULE")

}
runApp(list(ui = ui, server = server))

Upvotes: 1

Views: 290

Answers (1)

Victorp
Victorp

Reputation: 13866

Hello you can put condition to check if your code is going to run, here you just need that input$v to be a valid variable from input$d, so do :

output$out <- renderUI({
  req(input$d,input$v)
  if (input$v %in% names(get(input$d))) {
    HTML(paste0("The max is ",max(get(input$d)[[input$v]])))
  }
})

# or
output$out <- renderUI({
  req(input$d,input$v)
  validate(
    need(input$v %in% names(get(input$d)), 'Wait.')
  )
  HTML(paste0("The max is ",max(get(input$d)[[input$v]])))
})

EDIT with module, you can define your module with an expression to validate like this :

testMod <- function(input, output, session, data, validExpr) {
  output$out <- DT::renderDataTable({
    validate(need(validExpr(), FALSE))
    data()
  },caption="IN MODULE")
}

And call the module in the server with the expression in a function :

observe({
  req(input$d,input$v)
  callModule(
    module = testMod,
    id = "test",
    data = reactive({ data.frame(v1=max(get(input$d)[[input$v]])) }), 
    validExpr = function() input$v %in% names(get(input$d))
  )
})

Upvotes: 1

Related Questions