selectizeInput：每组允许一个元素

Question

我有一个 selectizeInput，其中包含一些具有多项选择的分组元素。是否有一种优雅的方式（例如使用选项参数）允许每组只允许一个元素，以便在选择该特定组的元素时丢弃（或禁用）整个组？

到目前为止，我以编程方式进行了尝试，但是更新 selectizeInput 时，selectizeInput 的下拉菜单将关闭。

最小示例：

library(shiny)

ui <- fluidPage(
    selectizeInput("selInput", "Default",
                   choices=list(g1 = c(A="A",B="B"), 
                                g2 = c(C="C",D="D")),
                   multiple=T),
    
    selectizeInput("oneElementPerGroup", "One element per group",
                   choices=list(g1 = c(A="A",B="B"), 
                                g2 = c(C="C",D="D")),
                   multiple=T)
)

server <- function(session, input, output) {

    #Removes the corresponding groups of selected items
    observeEvent(input$oneElementPerGroup, ignoreNULL = F, {
        plusChoice <- input$oneElementPerGroup
        names(plusChoice) <- input$oneElementPerGroup
        
        choices <- list(g1 = c(A="A",B="B"), 
                        g2 = c(C="C",D="D"))
        
        if(any(input$oneElementPerGroup %in% c("A", "B"))){
            choices[["g1"]] <- NULL
        }
        if(any(input$oneElementPerGroup %in% c("C", "D"))){
            choices[["g2"]] <- NULL
        }
        choices$we <- plusChoice
        updateSelectizeInput(session,"oneElementPerGroup", 
                             choices = choices,
                             selected=input$oneElementPerGroup)
    })

}

shinyApp(ui = ui, server = server)

Answer 1

您可以使用来自 {shinyWidgets} 的 pickerInput。然后我们可以加一点javascript来做你想做的。不需要服务器代码，非常简单。阅读有关 data-max-options 选项的更多信息：https://developer.snapappointments.com/bootstrap-select/options/.

我们需要为每个组添加限制，而不是整体限制，所以我们不能通过 pickerInput 中的 options 参数添加它，必须在原始 HTML 或者像我一样使用一些 js 代码注入。

确保您的 inputId="pick" 与脚本 #pick 中的 ID 匹配。将 pick 重命名为您想要的任何名称。

ui <- fluidPage(
    shinyWidgets::pickerInput(
        inputId = "pick", label = "Selected",
        choices =list(g1 = c(A="A",B="B"), g2 = c(C="C",D="D")),
        multiple = TRUE
        ),
    tags$script(
        '
        $(function(){
            $("#pick optgroup").attr("data-max-options", "1");
        })
        '
    )
)

server <- function(input, output, session){}

shinyApp(ui, server)

更新：

如果您需要更新，我们需要从服务器再次运行脚本。我们可以使用 {shinyjs} 发送 js。假设一个观察者触发了更新事件。

library(shinyjs)
ui <- fluidPage(
    useShinyjs(),
    shinyWidgets::pickerInput(
        inputId = "pick", label = "Selected",
        choices =NULL,
        multiple = TRUE
    )
)

server <- function(input, output, session){
    observe({
        shinyWidgets::updatePickerInput(session, "pick", choices = list(g1 = c(A="A",B="B"), g2 = c(C="C",D="D")))
        observeEvent(once = TRUE, reactiveValuesToList(session$input), {
            runjs('$("#pick optgroup").attr("data-max-options", "1");')
        }, ignoreInit = TRUE)
    })

    
}

shinyApp(ui, server)

selectizeInput：每组允许一个元素

selectizeInput: allowing one element per group

grouping

r

shiny

selectinput

更新：