selectizeInput：每组允许一个元素

Question

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

到目前为止，我以编程方式尝试过，但是当更新 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)