在 R shiny 中的公共服务器功能下,根据先前的 selectInput 更新 selectInput

Updating a selectInput based on previous selectInput under common server function in R shiny

在下面的 R shiny 脚本中,我试图实现这样的功能,即在第一个子菜单项中,每个 selectInput 值都取决于上一列中的项目选择。附上数据,代码也写好了。但是我无法达到预期的结果。请 运行 代码并检查,我希望整个服务器逻辑仅属于一个功能。谢谢,请帮忙。

library(shiny)
library(shinydashboard)
ui <- dashboardPage(
dashboardHeader(),
dashboardSidebar(
sidebarMenu(

  id = "tabs",
  menuItem("Charts", icon = icon("bar-chart-o"),
           menuSubItem("Sub-item 1", tabName = "subitem1"),
           menuSubItem("Sub-item 2", tabName = "subitem2")
  ))),
dashboardBody(
tabItems(tabItem("subitem1", uiOutput("brand_selector")),
         tabItem("subitem2", 4))
))
server <- shinyServer(function(input, output) {
candyData <- read.table(
text = "
Brand       Candy           value
Nestle      100Grand        Choc1
Netle       Butterfinger    Choc2
Nestle      Crunch          Choc2
Hershey's   KitKat          Choc4
Hershey's   Reeses          Choc3
Hershey's   Mounds          Choc2
Mars        Snickers        Choc5
Nestle      100Grand        Choc3
Nestle      Crunch          Choc4
Hershey's   KitKat          Choc5
Hershey's   Reeses          Choc2
Hershey's   Mounds          Choc1
Mars        Twix            Choc3
Mars        Vaid            Choc2",
header = TRUE,
stringsAsFactors = FALSE)
output$brand_selector <- renderUI({
box(title = "Data", status = "primary", solidHeader = T, width = 12,
    fluidPage(
      fluidRow(
        Brand_Select <- unique(candyData$Brand),
        column(2,offset = 0, style='padding:1px;', 
selectInput("Select1","select1",Brand_Select)),
        Candy_Select <- candyData$Candy[candyData$Brand == input$Select1],
        Candy_Select <- unique(Candy_Select),
        column(2,offset = 0, style='padding:1px;', 
selectInput("Select2","select2",Candy_Select)),
        Value_Select <- candyData$value[candyData$Candy == input$Select2],
column(2, offset = 0, 
style='padding:1px;',selectInput("select3","select3",Value_Select ))
)))
})
})
shinyApp(ui = ui, server = server)

您的代码不起作用,因为每次其中一个输入更改时,整个 renderUI 都会再次运行,从而重置您的所有输入,因为它们都是从头开始创建的!

那么我们该如何解决这个问题呢?您可以尝试以下操作。请注意,我删除了很多不必要的格式,因此更容易看出它是如何工作的。

我们在 UI 中创建输入,并添加一些 observeEvents 来监听第一个或第二个输入的变化。如果第一个输入发生变化,这将触发第一个 observeEvent 并将更改 input$Select2 的选择。随后,这将触发第二个 observeEvent,从而限制 input$Select3 中的选择。

希望对您有所帮助!

library(shiny)
library(shinydashboard)

candyData <- read.table(
  text = "
    Brand       Candy           value
    Nestle      100Grand        Choc1
    Netle       Butterfinger    Choc2
    Nestle      Crunch          Choc2
    Hershey's   KitKat          Choc4
    Hershey's   Reeses          Choc3
    Hershey's   Mounds          Choc2
    Mars        Snickers        Choc5
    Nestle      100Grand        Choc3
    Nestle      Crunch          Choc4
    Hershey's   KitKat          Choc5
    Hershey's   Reeses          Choc2
    Hershey's   Mounds          Choc1
    Mars        Twix            Choc3
    Mars        Vaid            Choc2",
  header = TRUE,
  stringsAsFactors = FALSE)

ui <- fluidPage(
  selectInput("Select1","select1",unique(candyData$Brand)),
  selectInput("Select2","select2",choices = NULL),
  selectInput("Select3","select3",choices=NULL ))

server <- function(input, output,session) {
 observeEvent(input$Select1,{
   updateSelectInput(session,'Select2',
           choices=unique(candyData$Candy[candyData$Brand==input$Select1]))
 }) 
  observeEvent(input$Select2,{
    updateSelectInput(session,'Select3',
           choices=unique(candyData$value[candyData$Brand==input$Select1 & candyData$Candy==input$Select2]))
  }) 

}

shinyApp(ui = ui, server = server)