selectInput: select repetitive options

shiny
1

Hi everyone,

I know in selectInput, we can allow user to select multiple options, but after each selection, the selected one will be removed from the list of options given. So is it possible to make the selected one not be removed from the list of given options, so that a user can select repetitive options?

For example, in the example below, I want to user to be able to select multiple NY's, so the server is able to know how many NY's the user selects. Is that possible?

shinyApp(
  ui = fluidPage(
    selectInput("state", "Choose a state:",
      list(`East Coast` = c("NY", "NJ", "CT"),
           `West Coast` = c("WA", "OR", "CA"),
           `Midwest` = c("MN", "WI", "IA"))
    ),
    textOutput("result")
  ),
  server = function(input, output) {
    output$result <- renderText({
      paste("You chose", input$state)
    })
  }
)
}

image
image770×306 14.5 KB

2

Quick suggestions:

  • store the old value of the control in a variable
  • use an observeEvent to update the control each time the control changes
    • use the old value (previously stored) to identify what values has been added or removed
    • do nothing (exit) if old values the same as the current one (this is to avoid the update loop)
    • update the control selected and choices
    • update the old value
  • it helps to use a module to wrap this new control
2 Likes
3

Thanks Mike. I made a prototype using observaeEvent and updateSelectInput(), as shown below. However, even though it seems good, it still has problem. The biggest one, in my opinion, is I can't select 4 No's. You can try it and select all options in distances. It should be obvious if you try it out, but if it does not make sense, please let me know. Thank you!

yes_no_generator = function(old_list = NULL, new_value = NULL){
  if(is.null(new_value)) {
    new_value = "Yes" # default value when first runs
  } else{
    new_value = paste0(strsplit(new_value, "")[[1]][1:(length(strsplit(new_value, "")[[1]]) -1 )], collapse = "") # remove the post-index
   
  }
  
  # count the number of yes and no in the old_list
  counter_yes = sum(names(old_list) == "Yes") # number of yes
  counter_no = sum(names(old_list) == "No") # number of no

  # based on the number of yes and no, we now know how to name the new yes or no
  if(new_value == "Yes") 
    {new_option = paste0("Yes", counter_yes + 1); names(new_option) = "Yes"}
  if(new_value == "No") 
    {new_option = paste0("No", counter_no + 1); names(new_option) = "No" }

  # next, we just need to insert the new thing to the right position
  browser()

  new_list = append(old_list, new_option, length(old_list) - 2)

  # get old selected values and append on it
  if(length(old_list) == 2){
    new_selected = new_option
  } else{
    new_selected = c(old_list[1:(length(old_list) - 2)], new_option)  
  }
  
  
  return(list(choices = new_list, selected = new_selected))
}

shinyApp(
  ui = fluidPage(
    selectInput("distance", "Choose a Distance:",
                c("Bray-Curtis"= "Bray-Curtis", "Jaccard" = "Jaccard", "UnWeighted" = "UnWeighted", 
                       "Generalized" = "Generalized"),
                multiple = TRUE
    ),
    selectInput("rarefication", "Rarefy ?",
                c("Yes", "No"),
                multiple = TRUE
    ),
    textInput("alpha", "Alpha", ""),
    textOutput("result")
  ),
  server = function(input, output, session) {
    choices = NULL
    observeEvent(input$distance, {
      if(is.null(input$rarefication)){ # when the program first runs
        choices = c("Yes" = "Yes1", "No" = "No1")
      } 
      
      choices_n_selected = yes_no_generator(old_list = choices, new_value = input$rarefication)
      choices <<- choices_n_selected$choices

      updateSelectInput(session, "rarefication",
            label = "Rarefy ?",
            choices = choices_n_selected$choices,
            selected = choices_n_selected$selected
          )

    })
    output$result <- renderText({
      paste("You chose", input$state)
    })
  }
)
4

I was thinking something along these lines:

shinyApp(
    ui = fluidPage(
        selectInput("rarefication", "Rarefy ?",
                    sort(c("Yes" = "Yes1", "No" = "No2")),
                    multiple = TRUE
        )
    ),
    server = function(input, output, session) {
        
        # need <<- when written in observers
        old_rarefication = c()
        old_choices = sort(c("Yes" = "Yes1", "No" = "No2"))  # must match ui
        idx <- 2  # too lazy to extract max idx from old_choices
        
        observeEvent(input$rarefication, {
            
            cat("\nstep 0> trigger", "\n")
            req(!identical(old_rarefication, input$rarefication))
            cat("step 1> change detected", "\n")
            
            addition <- base::setdiff(input$rarefication, old_rarefication)
            if (length(addition) > 0) {
                cat("step 2> addition:", addition, "\n")
                idx <<- idx + 1
                new_nm <- names(old_choices[old_choices == addition])
                new_val <- paste0(new_nm, idx)
                choices <- c(old_choices, new_val)
                names(choices) <- c(names(old_choices), new_nm)
            }
            
            missing <- base::setdiff(old_rarefication, input$rarefication)
            if (length(missing) > 0) {
                cat("step 2> missing:", missing, "\n")
                missing_idx <- which(old_choices == missing)
                choices <- old_choices[-missing_idx]
            }
            
            # sort choices so that No is always first
            choices <- sort(choices)
            cat("step 3> updated choices:", choices, "\n")
            
            updateSelectInput(session, "rarefication",
                              choices = choices,
                              selected = input$rarefication
            )
            
            # save current values
            old_rarefication <<- input$rarefication
            old_choices <<- choices
        }, ignoreNULL = FALSE)
    }
)
1 Like