闪亮的多次选择输入多次选择选择

Question

在这个最小的示例中，我希望有一个选择多个选择的选项，即产生输入值，例如A，B，B，B，A，A，C

选项hideSelected = FALSE使选定的选项仍然可见，但无法再次选择。

根据https://github.com/rstudio/shiny/issues/518 ，在selectize中有这样一个选项，但是即使在这里我也找不到这样的选项： 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)

Answer 1

由于Shiny尚未实现此功能，并且如果您想坚持使用selectInput ，则一种解决方法是使用selectInput但每次用户做出选择时都会清除选择。 然后，您可以放置​​另一个DT输出以显示当前选定的元素，并让用户从那里删除元素。 我仅出于演示目的使用verbertimTextOutput 。

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)

Answer 2

我想出了一些在选择列表中添加不可见空间的好主意。 我还通过在开始时添加“”选项来欺骗选择，它解决了删除最后一个元素时缺乏反应性的问题。 这几乎可以完成工作-添加项目时非常出色。

仍然存在两个无法解决的问题：

• 每次关闭下拉列表（由于输入需要更新，因此无法修复）
• 删除项目时，下拉列表上闪烁了太多选项

码：

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)