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

Question

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)

Answer 1

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)

Answer 2

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)
}
)