闪亮应用程序中的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)

就个人而言，我更喜欢后者，因为它看起来更干净。