闪亮的多项选择输入选择多次选择答案

【问题标题】：shiny multiple select input select choice many times闪亮的多项选择输入选择多次选择
【发布时间】：2018-08-02 14:32:57
【问题描述】：

在这个最小的示例中，我希望有一个选项可以多次选择选项，即生成输入值，例如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)

【问题讨论】：

在您链接到它的 github 问题中声称 selectize 支持重复但查看 this thread 它仍然没有正式支持。很确定您将无法为此使用selectizeInput。

标签： r shiny

【解决方案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)

【讨论】：

不错的解决方法，当然它需要做很多额外的工作才能使其在现实生活中的应用程序中可用，即删除和重新排序的选项。不过好主意！
@M.Dubel 是的，这肯定需要更多的工作。如果你真的需要它，我想将它变成一个能够重用它的模块是值得的。

【解决方案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)

【讨论】：