Select max 2 different groups with pickerInput

Question

I would like to restrict a pickerInput from shinyWidgets so that only elements from a maximum of 2 different groups can be selected. I know that I can restrict the selection to max 2 elements or to 2 elements per group, but I did not find a way to have max 2 groups selected, no matter the amount of selected elements inside those groups.

Here is a little toy example:

library(shiny)
library(shinyWidgets)

ui <- fluidPage(
  pickerInput("groupslct", "Select elements from max 2 diff. Groups:",
              choices = list(
                Group1 = c(opt1 = "g11",
                           opt2 = "g12",
                           opt3 = "g13"),
                Group2 = c(opt1 = "g21"),
                Group3 = c(opt1 = "g31"),
                Group4 = c(opt1 = "g41", 
                           opt2 = "g42",
                           opt3 = "g43")
              ),
              selected = 1, multiple = TRUE,
              options = list("liveSearch" = TRUE, 
                            # "max-options" = 2,
                            "max-options-group" = 2,
                            "selectOnTab" = TRUE 
                            ))
)

server <- function(input, output, session) {
  observe({
    print(input$kennwertauswahl)
  })
}

shinyApp(ui, server)

score 0 · Accepted Answer · answered Jun 22 '20 at 12:57

I found a way using shinyjs, because updatePickerInput doesn't immediately refresh the input when changing the selected options.

library(shiny)
library(shinyjs)
library(shinyWidgets)

kennwertmap <- data.frame(vals=c("v", "vfree", "vref", "t", "state", "index", "index1", "index2"),
                          grp=c("v","v","v",
                                "t","s",
                                "ix","ix","ix"), stringsAsFactors = FALSE)


ui <- fluidPage(
  useShinyjs(),
  splitLayout(cellWidths = c("30%", "70%"),
              div(style = "height: 1000px;",
                  pickerInput(("kennwertauswahl"), "Auswahl",
                              choices = list(
                                v = c(`mean v` = "v",
                                      `mean v free` = "vfree",
                                      `mean v ref` = "vref"),
                                t = c(`time` = "t"),
                                s = c(state = "state"),
                                i = c(index = "index", 
                                      index1 = "index1",
                                      index2 = "index2")
                              ),
                              selected = 1, multiple = TRUE,
                              options = pickerOptions(liveSearch = TRUE, 
                                                      selectOnTab = TRUE))
              ),
              div(
                verbatimTextOutput("txt"),
                verbatimTextOutput("txt1")
              )
  )
  
)

server <- function(input, output, session) {
  kennwert <- reactiveValues(a = NULL)
  observe({
    if (is.null(input$kennwertauswahl)) {
      kennwert$a <- NULL
    } else {
      isolate({
        knwn <- input$kennwertauswahl
        mappedkenw <- kennwertmap[kennwertmap$vals %in% knwn, ]
        if (is.null(kennwert$a)) {
          kennwert$a <- mappedkenw 
        } else {
          ## Check if 2 Groups already selected
          if (length(unique(mappedkenw$grp)) > 2) {
            
            ## Grp to Remove          
            firstgrp <- kennwert$a[kennwert$a$grp != unique(kennwert$a$grp)[2],]
            
            ## Add One if new
            newone <- setdiff(mappedkenw[,"vals"], kennwert$a$vals)
            newone <- kennwertmap[kennwertmap$vals %in% newone, ]
            
            newgrp <- rbind(firstgrp, newone)
            kennwert$a <- newgrp 
            updatePickerInput(session, "kennwertauswahl", selected = newgrp$vals)
            delay(100, runjs(HTML('$("#kennwertauswahl").selectpicker("refresh")')))
            
          } else {
            ## Add One if new
            newone <- setdiff(mappedkenw[,"vals"], kennwert$a$vals)
            if (length(newone) != 0) {
              newone <- kennwertmap[kennwertmap$vals %in% newone, ]
              kennwert$a <- rbind(kennwert$a, newone)
            }
            ## Remove One
            lessone <- setdiff(kennwert$a$vals, mappedkenw[,"vals"])
            if (length(lessone) != 0) {
              kennwert$a <- kennwert$a[kennwert$a$vals != lessone,]
            }            
          }
        }
      })
      
    }
  })
  
  output$txt <- renderPrint({
    print(input$kennwertauswahl)
  })
  output$txt1 <- renderPrint({
    print(kennwert$a)
  })
  
}

shinyApp(ui, server)

Select max 2 different groups with pickerInput

1 Answers1