时间戳

首页 > 解决方案 > selectizeInput：每组允许一个元素

r - selectizeInput：每组允许一个元素

问题描述

我有一个 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)

标签： rshinygroupingselectinput

解决方案

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

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

确保您inputId="pick"与脚本中的 id 匹配#pick。重命名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)

推荐阅读