R中的动态selectInput闪亮

你很亲密!有两件事,你需要在启动服务器实例时分配会话变量,当你更新选择输入时,你需要设置选择哪个选项,除了一切看起来都没问题.试试这个:

library(shiny)
library(shinydashboard)


ui <- dashboardPage(
  dashboardHeader(title = "Dynamic selectInput"),
  dashboardSidebar(
    sidebarMenu(
      menuItemOutput("menuitem")
    )
  ),
  dashboardBody(
    selectInput("heir1","Heirarchy1",c("NONE","A","B","C"),selected="NONE"),
    selectInput("heir2","Heirarchy2",c("NONE","A","B","C"),selected="NONE"),
    selectInput("heir3","Heirarchy3",c("NONE","A","B","C"),selected="NONE")
  )
)

server <- function(input, output, session) {
  output$menuitem <- renderMenu({
    menuItem("Menu item", icon = icon("calendar"))
  })

  heirarchy<-c("A","B","C")

  observe({
    hei1<-input$heir1
    hei2<-input$heir2
    hei3<-input$heir3

    choice1<-c("NONE",setdiff(heirarchy,c(hei2,hei3)))
    choice2<-c("NONE",setdiff(heirarchy,c(hei1,hei3)))
    choice3<-c("NONE",setdiff(heirarchy,c(hei1,hei2)))

    updateSelectInput(session,"heir1",choices=choice1,selected=hei1)
    updateSelectInput(session,"heir2",choices=choice2,selected=hei2)
    updateSelectInput(session,"heir3",choices=choice3,selected=hei3)

  })

}

shinyApp(ui, server)