在下面的 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)
关于r - 在 R Shiny 的公共(public)服务器功能下根据先前的 selectInput 更新 selectInput,我们在Stack Overflow上找到一个类似的问题:https://stackoverflow.com/questions/48376156/