Hi, I think the key thing you are missing is an intermediary variable: a place to store the values that have been selected so far across all the selectInputs. Once you're tracking everything selected so far across all the inputs, you can reactively determine what's available to choose and update the inputs accordingly.
I copied your code but replaced your series of observeEvent calls at the top of your server function with the following chunk:
stageNames <- paste("stage", 1:5, sep = "")
chosen <- reactiveVal(c())
stages <- reactive(lapply(stageNames, function(name) input[[name]]))
observeEvent(stages(), {
chosen(unlist(stages()))
for (name in stageNames) {
updateSelectInput(session,
name,
selected = input[[name]],
choices = c("Please make a selection" = '', input[[name]], setdiff(mynames, chosen()))
)
}
})
-
stageNames <- ...: I generate the input IDs programmatically here so that the code can be shorter and we can handle an arbitrary number of "stages" in the future.
-
chosen is that missing variable I mentioned. It's a reactiveVal, which is a variable-like thing, that starts out containing the empty vector, because nothing has been selected yet.
-
stages is a reactive list of vectors, where each vector corresponds to the selection in a particular input. I use input[[name]] to refer to inputs in the function I pass to lapply so that I can construct name programmatically. It corresponds to the more common way of accessing inputs, input$someName, except someName can be parameterized.
- There's only one
observeEvent, and the event we're observing is the "aggregate" of all the stage inputs. We can do this because the logic we need to apply is the same for each one.
-
chosen(unlist(stages())) sets the chosen reactiveVal to be the value of all the things selected across all the inputs to this point.
-
for (name in stageNames) ... iterates through each stage input name and updates it with updateSelectInput. selected = input[[name]] tripped me up because I didn't think it was necessary, but it is. Apparently if you set choices you should also set selected. choices Is set to the difference between mynames and chosen(), plus whatever is currently selected and the default entry.
I didn't go through the exercise, but now that the selected items are stored in the chosen reactiveVal I think you could eliminate the dependencies on input$stageN inputs. Then, you could make the rest of your code handle an arbitrary number of stages via do.call, lapply, or similar.
One "gotcha" with this approach that I noticed is that the selection dropdown closes immediately after selecting a single item, which is slightly annoying. I couldn't figure out a way to fix it though.
The full version of your code that I worked with is below:
# Load packages -----------------------------------------------------
require(rCharts)
require(shiny)
require(highcharter)
require(dplyr)
require(tidyr)
mydata <- data.frame(A=rbinom(20, 1, 0.5),
B=rbinom(20, 1, 0.5),
C=rbinom(20, 1, 0.5),
D=rbinom(20, 1, 0.5),
E=rbinom(20, 1, 0.5),
X=rbinom(20, 1, 0.5),
Y=rbinom(20, 1, 0.5),
Z=rbinom(20, 1, 0.5))
mynames <- names(mydata)
# UI ----------------------------------------------------------------
ui <- fluidPage(
textOutput("debug"),
fluidRow(
# Inputs ---------------------------------------------------------
column(width = 4,
selectInput("stage1",
label = "Stage 1",
choices = c("Please make a selection" = '',mynames),
multiple = TRUE),
selectInput("stage2",
label = "Stage 2",
choices = c("Please make a selection" = '',mynames),
multiple = TRUE),
selectInput("stage3",
label = "Stage 3",
choices = c("Please make a selection" = '',mynames),
multiple = TRUE),
selectInput("stage4",
label = "Stage 4",
choices = c("Please make a selection" = '',mynames),
multiple = TRUE),
selectInput("stage5",
label = "Stage 5",
choices = c("Please make a selection" = '',mynames),
multiple = TRUE)),
column(width = 7,
highchartOutput("highchartFunnel"))))
# SERVER ------------------------------------------------------------
server <- function(input, output, session) {
# Manage stage
stageNames <- paste("stage", 1:5, sep = "")
chosen <- reactiveVal(c())
stages <- reactive(lapply(stageNames, function(name) input[[name]]))
observeEvent(stages(), {
chosen(unlist(stages()))
for (name in stageNames) {
updateSelectInput(session,
name,
selected = input[[name]],
choices = c("Please make a selection" = '', input[[name]], setdiff(mynames, chosen()))
)
}
})
output$debug <- renderText(paste0("stages = ", capture.output(dput(stages()))))
# Highchart Funnel chart START----------------------------------
output$highchartFunnel <- renderHighchart ({
# Calculate the 1st stage
funnelData1 <- reactive({
req(input$stage1)
mydata %>%
select(input$stage1) %>%
sum()
})
# Calculate the 2nd stage
funnelData2 <- reactive({
req(input$stage2)
mydata %>%
select(input$stage2) %>%
sum()
})
# Calculate the 3th stage
funnelData3 <- reactive({
req(input$stage3)
mydata %>%
select(input$stage3) %>%
sum()
})
# Calculate the 4th stage
funnelData4 <- reactive({
req(input$stage4)
mydata %>%
select(input$stage4) %>%
sum()
})
# Calculate the 5th stage
funnelData5 <- reactive({
req(input$stage5)
mydata %>%
select(input$stage5) %>%
sum()
})
# Highchart Funnel
hcF <- highchart() %>%
hc_chart(type = "funnel") %>%
hc_add_series(
data=list(
list("1st stage", funnelData1()),
list("2nd stage", funnelData2()),
list("3rd stage", funnelData3()),
list("4th stage", funnelData4()),
list("5th stage", funnelData5())
))
# Print highchart
hcF
})
# Highchart Funnel chart END--------------------------------
}
# Run app -----------------------------------------------------------
shinyApp(ui = ui, server = server)