selectInput update inside renderUI function in shiny app

Question

I have simplified my shiny app as follow:

library(shiny)
library(shinythemes)
library(shinyBS)



ui <- fluidPage(
  theme = shinytheme("flatly"),
  
  navbarPage("Demo",
             tabPanel("Home",
                      column(2,
                             selectInput(inputId = "s1",label = "select project",choices = c("1", "2", "3")),
                             uiOutput("sensor")
                             
                      ))))

server <- function(input, output,session){
  
  output$sensor <- renderUI({
    s = c(as.numeric((input$s1))^2,as.numeric((input$s1))^3)
    selectInput("t1",label ="Select",choices = ifelse(input$s1 == "1",c("x1","x2"),s ),multiple = FALSE)
    
  })   
}

I expect to get the x1 and x2 in second dropdown if my first selection is 1, otherwise either 4 and 8 or 9 and 27 should be the expected values in second dropdown.

But surprisingly, what I'm getting is just one value to select in second dropdown : if 1 I'm getting just x1 , if 2 I have just 4 and if 3 I have just 9 !!

why the selectInput is not updating properly ?

Answer 1

From the online help for ifelse :

ifelse returns a value with the same shape as test which is filled with elements selected from either yes or no depending on whether the element of test is TRUE or FALSE.

and

ifelse(test, yes, no)

In your case, test is input$s1 == "1" . In other words, a (character) vector of length 1. That's why you get only one value in your choices for input$t1 .

To get what you want, try something like this (untested code):

if (input$s1 == "1") {
  choiceList <- c("x1","x2")
} else {
  choiceList <- c(as.numeric((input$s1))^2,as.numeric((input$s1))^3)
}
selectInput("t1",label ="Select",choices = choiceList, multiple = FALSE)

As an aside, you can get the same effect with updateSelectInput and no need for renderUI and uiOutput .

Edit

Here's the full code for the uiOutput version

library(shiny)

ui <- fluidPage(
  navbarPage("Demo",
             tabPanel("Home",
                      column(2,
                             selectInput(inputId = "s1",label = "select project",choices = c("1", "2", "3")),
                             uiOutput("sensor")
                             
                      ))))

server <- function(input, output,session){
  output$sensor <- renderUI({
    if (input$s1 == "1") {
      choiceList <- c("x1","x2")
    } else {
      choiceList <- c(as.numeric((input$s1))^2,as.numeric((input$s1))^3)
    }
    selectInput("t1",label ="Select",choices = choiceList, multiple = FALSE)
  })   
}

shinyApp(ui = ui , server = server)

and for the updateSelectinput version

library(shiny)

ui <- fluidPage(
  navbarPage("Demo",
             tabPanel("Home",
                      column(2,
                             selectInput(inputId = "s1",label = "select project",choices = c("1", "2", "3")),
                             selectInput("t1", label="Select", choices=c(), multiple = FALSE)
                      ))))

server <- function(input, output, session){
  observeEvent(input$s1, {
    if (input$s1 == "1") {
      choiceList <- c("x1","x2")
    } else {
      choiceList <- c(as.numeric((input$s1))^2,as.numeric((input$s1))^3)
    }
    updateSelectInput(session, "t1",choices = choiceList)
  })   
}

shinyApp(ui = ui , server = server)

Personally, I prefer the latter as it seems cleaner.