閃亮應用程序中的renderUI函數內的selectInput更新

Question

我已將閃亮的應用程序簡化如下：

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)
    
  })   
}

如果我的第一個選擇是 1，我希望在第二個下拉列表中獲得x1和x2 ，否則4和8或9和27應該是第二個下拉列表中的預期值。

但令人驚訝的是，我得到的只是在第二個下拉列表中選擇的一個值：如果1我得到x1 ，如果2我只有4 ，如果3我只有9 ！

為什么selectInput沒有正確更新？

Answer 1

從ifelse的在線幫助：

ifelse 返回一個與 test 具有相同形狀的值，該值填充有從 yes 或 no 中選擇的元素，具體取決於 test 的元素是 TRUE 還是 FALSE。

和

ifelse（測試，是，否）

在您的情況下， test是input$s1 == "1" 。 換句話說，一個長度為 1 的（字符）向量。這就是為什么您在input$t1的選擇中只能得到一個值。

要得到你想要的，試試這樣的（未經測試的代碼）：

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)

順便說一句，您可以使用updateSelectInput獲得相同的效果，而無需renderUI和uiOutput 。

編輯

這是uiOutput版本的完整代碼

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)

對於updateSelectinput版本

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)

就個人而言，我更喜歡后者，因為它看起來更干凈。