R 中的动态 selectInput 闪亮

我有 3 个 selectInput 框和一组 4 个选项，可以通过这 3 个框进行选择。我希望 selectInputs 显示的选项在选择其他 selectInputs 时动态更改。不过，我希望所有三个框在任何时间点都可以使用“无”选项。我正在使用的代码是

    library(shiny)
    library(shinydashboard)


    ui <- dashboardPage(
      dashboardHeader(title = "Dynamic selectInput"),
      dashboardSidebar(
        sidebarMenu(
          menuItemOutput("menuitem")
        )
      ),
      dashboardBody(
        uiOutput('heirarchy1'),
        uiOutput('heirarchy2'),
        uiOutput('heirarchy3')
      )
    )

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

      heirarchy_vector<-c("NONE","A","B","C")
      output$heirarchy1<-renderUI({
        selectInput("heir1","Heirarchy1",c("NONE",setdiff(heirarchy_vector,c(input$heir2,input$heir3))),selected="NONE")
      })


      output$heirarchy2<-renderUI({
        selectInput("heir2","Heirarchy2",c("NONE",setdiff(heirarchy_vector,c(input$heir1,input$heir3))),selected="NONE")
      })

      output$heirarchy3<-renderUI({
        selectInput("heir3","Heirarchy3",c("NONE",setdiff(heirarchy_vector,c(input$heir1,input$heir2))),selected="NONE")
      })

    }

    shinyApp(ui, server)

Any help on this will be greatly appreciated

EDIT

我尝试使用 updateSelectInput 来达到此目的。但是代码似乎没有运行

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) {
  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)
    updateSelectInput(session,"heir2",choices=choice2)
    updateSelectInput(session,"heir3",choices=choice3)

  })

 }

shinyApp(ui, server)

你很接近了！有两件事，您需要在启动服务器实例时分配会话变量，此外，当您更新选择输入时，您需要设置选择的选项，除此之外一切看起来都正常。尝试这个：

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)