Make Shiny SelectInput allow for multiple duplicated values to be selected-CodePudding

I would like to allow the user to select multiple times the same choice. It implies that when the user selects some element, it should not be removed from the choices' dropdown menu.

Here is a minimal reproducible example:

library(shiny)

ui <- fluidPage(
  selectInput(
    inputId = "ManyDuplicated",
    label = 'SelectInput',
    choices = c('Hello', 'World'),
    selected = NULL,
    multiple = TRUE
    )
)

server <- function(input, output) {

}

shinyApp(ui = ui, server = server)

How it is:

How I would like it to be:

What I tried and may be of help:

This code (https://github.com/rstudio/shiny/issues/2939#issuecomment-678269674) works perfectly for a single choice ("^" in the case). However, I can't make it work for more choices (c("^", "a"), for example).

library(shiny)

ui <- fluidPage(
  selectInput("x", "choose", c("^" = 1), multiple = TRUE)
)

server <- function(input, output, session) {
  observeEvent(input$x, {
    choices <- seq_len(length(input$x) 1)
    names(choices) <- rep("^", length(choices))
    updateSelectInput(session, "x", choices = choices, selected = isolate(input$x))
  })
}

shinyApp(ui, server)

CodePudding user response：

With multiple choices it gets a bit more complicated

library(shiny)
my_choices <- c('Hello', 'World')

ui <- fluidPage(
  selectInput(
    inputId = "ManyDuplicated",
    label = 'SelectInput',
    choices = my_choices,
    selected = NULL,
    multiple = TRUE
  )
)

server <- function(input, output, session) {
  observeEvent(input$ManyDuplicated, {
    
    selected_values <- input$ManyDuplicated
    names(selected_values) <- gsub("\\..*", "", selected_values)
    
    print( paste( "Current selection :", 
                  paste( names(selected_values), collapse = ", ")))
    
    number_of_items <- length(input$ManyDuplicated)
    new_choices <- paste(my_choices, number_of_items   1, sep = ".")
    names(new_choices) <- my_choices
    
    all_choices <- c(selected_values, new_choices )
    updateSelectInput(session, "ManyDuplicated", 
                      choices = all_choices, 
                      selected = isolate(input$ManyDuplicated))
  })
}

shinyApp(ui = ui, server = server)

CodePudding user response：

shinyApp(
  ui = fluidPage(
    selectInput("choose", "Choose",
                sort(c("a" = "a1", "b" = "b2")),
                multiple = TRUE
    )
  ),
  server = function(input, output, session) {
    
    old_choose = c()
    old_choices = sort(c("a" = "a1", "b" = "b2"))
    idx <- 2
    
    observeEvent(input$choose, {
      
      req(!identical(old_choose, input$choose))
      
      addition <- base::setdiff(input$choose, old_choose)
      if (length(addition) > 0) {
        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_choose, input$choose)
      if (length(missing) > 0) {
        missing_idx <- which(old_choices == missing)
        choices <- old_choices[-missing_idx]
      }
      
      choices <- sort(choices)
      
      updateSelectInput(session, "choose",
                        choices = choices,
                        selected = input$choose
      )
      
      old_choose <<- input$choose
      old_choices <<- choices
    }, ignoreNULL = FALSE)
  }
)