CODEWITHSUNDEEP
rshiny
M.Dubel
M.Dubel

Reputation: 126

shiny multiple select input select choice many times

In this minimal example I want to have an option to select choices more than once i.e. to produce input value as e.g. A,B,B,B,A,A,C

Option hideSelected = FALSE makes selected options still visible, but not selectable again.

According to https://github.com/rstudio/shiny/issues/518 there is such an option in selectize but I can't find such an option even here: https://github.com/selectize/selectize.js/blob/master/docs/usage.md

server <- function(input, output, session) {
  output$multipleSelect <- renderUI({
    selectizeInput("selectMany",
                   label = "I want to select each multiple times",
                   choices = LETTERS[1:3],
                   multiple = TRUE,
                   options = list(hideSelected = FALSE))
  })
}

ui <- function() {
  fluidPage(
    uiOutput("multipleSelect")
  )
}

shinyApp(ui, server)

Upvotes: 0

Views: 6476

Answers (2)

M.Dubel
M.Dubel

Reputation: 126

I've come up with some good idea of adding invisible space to choices list. I've also trick selectize by adding " " option at the beggining, which solves problem of lack of reactivity when removing last element. Here is sth that pretty much does the job - excellent when adding items.

There are still two unresolvable problems:

  • dropdown list is closed each time (won't be fixable as input needs to be updated)
  • when removing item there is blink of too many options on dropdown list

code:

library(shiny)
library(dplyr)
server <- function(input, output, session) {

  # set the default choices and set previous selection to initial selectInput vector
  globalList <- reactiveValues(ManyChoices = LETTERS[1:3], SelectedPrev = c())

output$multipleSelect <- renderUI({
selectizeInput("selectMany",
               label = "I want to select each multiple times",
               choices = c(" ", globalList$ManyChoices),
               selected = " ",
               multiple = TRUE,
               options = list(closeAfterSelect = TRUE, openOnFocus = TRUE))
})

observeEvent(input$selectMany, {

# if sth was added
if(length(input$selectMany) > length(globalList$SelectedPrev)) {
  #find out what was modified
  vDiff <- setdiff(input$selectMany, globalList$SelectedPrev) %>% setdiff(., " ")
  # used when removing " " and selecting sth to double the selection
  if(length(vDiff) == 0) vDiff <- input$selectMany[length(input$selectMany)]
  req(input$selectMany != " ") # if only " " is selected then there is no need to update
  # get the position of selected element
  vIndex <- which(globalList$ManyChoices == vDiff)
  vLength <- length(globalList$ManyChoices)
  # create new choices in the correct order
  globalList$ManyChoices <- c(globalList$ManyChoices[1:vIndex],
                              paste0(vDiff, " "),
                              if(vIndex < vLength) {globalList$ManyChoices[(vIndex + 1):vLength]})
} else {
  # remove the version with additional space when value was removed
  vDiff <- setdiff(globalList$SelectedPrev, input$selectMany)
  globalList$ManyChoices <- setdiff(globalList$ManyChoices, paste0(vDiff, " "))
}

# update previous selection
globalList$SelectedPrev <- input$selectMany

# update input with same selection but modified choices
updateSelectizeInput(session = session,
                     inputId = "selectMany",
                     selected = c(" ", input$selectMany),
                     choices = c(" ", globalList$ManyChoices))
})
}

ui <- function() {
fluidPage(
  uiOutput("multipleSelect")
)
}

shinyApp(ui, server)

Upvotes: 1

lkq
lkq

Reputation: 2366

Since Shiny hasn't implemented this yet and if you'd like to stick to selectInput, a workaround would be using a selectInput but clears the selection everytime the user makes a choice. Then you can put another DT output to show the currently selected elements and let the user delete elements from there. I'm using verbertimTextOutput just for demo purpose.

library(shiny)

ui <- fluidPage(
  selectInput(
    "selectMany",
    label = "Many",
    choices = LETTERS[1:3],
    multiple = TRUE
  ),
  verbatimTextOutput("debug")
)
server <- function(input, output, session) {

  elements <- reactiveVal(c())

  observeEvent(input$selectMany, {
    req(input$selectMany)
    elements(c(elements(), input$selectMany[[1]]))
  })

  observeEvent(elements(), {
    req(elements())
    updateSelectInput(session, "selectMany",
      selected = character(0),
      choices = LETTERS[1:3]
    )
  })

  output$debug <- renderPrint({
    print(elements())
  })
}


shinyApp(ui, server)

Upvotes: 1

Related Questions