I have 3 selectInput boxes and a pool of 4 options which can be selected by these 3 boxes. I want the options displayed by the selectInputs to change dynamically as other selectInputs are selected. However I want the "NONE" option to be available at all points of time for all the three boxes. The code I am using is
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
I tried using updateSelectInput for this purpose. However the code doesn't seem to run
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)
You're close! Two things, you need to assign the session variable when you start your server instance, also when you update the select inputs you need to set which choice was selected, other than that everything looks OK. Try this:
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)
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With