Динамический selectInput in R shiny

Question

У меня есть 3 selectInput box и пул из 4 вариантов, которые могут быть выбраны этими тремя блоками. Я хочу, чтобы параметры, отображаемые параметрами selectInput, изменялись динамически, когда выбраны другие selectInputs. Однако я хочу, чтобы опция «NONE» была доступна во все моменты времени для всех трех ящиков. Код я использую

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) 

Answer 1

Ваше близкое! Две вещи, вам нужно назначить переменную сеанса при запуске экземпляра сервера, также когда вы обновляете входы выбора, вам нужно установить, какой выбор был выбран, кроме этого все выглядит нормально. Попробуйте следующее:

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)