Select max 2 different groups with pickerInput - r

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)

Answer 1

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)