Help! updateselectInputs with dynamic choices

shiny
1

Hi shiny community,

I need some help. I am new and still learning even some basics. I am making an app with 5 selectInputs that fuel a funnel chart from highcharter package. My problem is that the selection is not dynamically updated.
I would like to achieve two things:

  1. I would like the selected inputs in one stage to be not available in any other stage. (this is already achieved)
  2. The communication b/n the selected stages to be absolute - to go both ways, dynamically to be updated. Currently, the inputs are remembered only when the selection starts from Stage 1 downward and I would like it to be both ways and from every starting point.
    If I delete one input from a stage I would like not to lose the selected inputs in the later stages. I will elaborate more on that.

For example, I select:

A and B in stage 1
C and D in stage 2
E in stage 3
X and Y in stage 4
Z in stage 5
and if I change my mind and delete in stage 2 the choice D all other next stages lose their inputs. This is something I am not after.
I am providing my code. I would appreciate some guidance and solutions. If you need more elaboration, please let me know!

Thank you in advance!

# 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(
  
  
  
 
  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) {
  

  # ObserveEvent for the 1st stage
  observeEvent(input$stage1,{
    
    stageone <- mynames[!(mynames %in% input$stage1)]
    
    updateSelectInput(session, 'stage2', choices = c("Please make a selection" = '', stageone))
    updateSelectInput(session, 'stage3', choices = c("Please make a selection" = '', stageone))
    updateSelectInput(session, 'stage4', choices = c("Please make a selection" = '', stageone))
    updateSelectInput(session, 'stage5', choices = c("Please make a selection" = '', stageone))
  })
  
  
  # ObserveEvent for the 2nd stage
  observeEvent(input$stage2,{
    
    stagetwo <- mynames[!(mynames %in% c(input$stage1,input$stage2))]
    
    updateSelectInput(session, 'stage3', choices = c("Please make a selection" = '', stagetwo))
    updateSelectInput(session, 'stage4', choices = c("Please make a selection" = '', stagetwo))
    updateSelectInput(session, 'stage5', choices = c("Please make a selection" = '', stagetwo))
  })
  
  
  # ObserveEvent for the 3rd stage
  observeEvent(input$stage3,{
    
    stagethree <- mynames[!(mynames %in% c(input$stage1,input$stage2,input$stage3))]
    
    updateSelectInput(session, 'stage4', choices = c("Please make a selection" = '', stagethree))
    updateSelectInput(session, 'stage5', choices = c("Please make a selection" = '', stagethree))
  })
  
  # ObserveEvent for the 4th stage
  observeEvent(input$stage4,{
    
    stagefour <- mynames[!(mynames %in% c(input$stage1,input$stage2,input$stage3,input$stage4))]
    
    updateSelectInput(session, 'stage5', choices = c("Please make a selection" = '', stagefour))
  })
  
  # ObserveEvent for the 5th stage is controlled by the previous Events
  
  
  
  
  
  
  
  # 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)
2

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()))
      )
    }
  })
  1. 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.
  2. 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.
  3. 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.
  4. 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.
  5. chosen(unlist(stages())) sets the chosen reactiveVal to be the value of all the things selected across all the inputs to this point.
  6. 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)
4 Likes
3

Hi Alan,
thank you very much for taking the time to help me with my issue. Mostly, thank you for taking the time to write these detailed explanations. I've learned a lot from your post. Thank you!

All the best

2 Likes