CheckboxGroupButtons responsive to another CheckboxGroupButtons

[PK57]

Greetings,

I am trying to make one checkboxgroupbuttons() widget respond to the selection of another one. That is by using the observeEvent() and updateCheckboxGroupButtons() functions. Unfortunately without success.

What I want to achieve is that by clicking on one "Region" in checkbox_1, all provinces in that region would automatically get selected in checkbox_2.

Here is my reprex:

library(shiny)
library(shinydashboard)
library(dplyr)
library(shinyWidgets)




df <- data.frame(Region = c(rep("A", times = 7), rep("B", times = 3), rep("C", times = 2)),
                 Province = c(rep(c("x","y","z"), length.out = 7), rep(c("j","k"), length.out = 3), c("u","i")),
                 Garbage = rep(c("blah","bleh"), length.out = 12))




ui <- dashboardPage(
    dashboardHeader(title = "REPREX"),
    dashboardSidebar(),
    dashboardBody(
        column(width = 6,
        checkboxGroupButtons(
            inputId = "checkbox_1",
            label = "Please select regions",
            choices = levels(df$Region),
            status = "default",
            justified = TRUE,
            direction = "vertical",
            selected = levels(df$Region)[1],
            checkIcon = list(
                yes = icon("ok", 
                           lib = "glyphicon"))
        ),
        
        verbatimTextOutput(outputId = "res1"),
        ),
        
        column(width = 6,
        checkboxGroupButtons(
            inputId = "checkbox_2",
            label = "Please select provinces",
            choices = levels(df$Province),
            status = "default",
            justified = TRUE,
            direction = "vertical",
            selected = levels(df$Province)[1],
            checkIcon = list(
                yes = icon("ok", 
                           lib = "glyphicon"))
        ),
        
        verbatimTextOutput(outputId = "res2"),
        )
    )
    
)

server <- function(input, output, session) {
    
    observeEvent(input$Region, {
        updateCheckboxGroupButtons(session = session,
                                   inputId = "checkbox_2",
                                   selected = df %>% 
                                       dplyr::select(Region, Province) %>% 
                                       dplyr::filter(Region %in% input$checkbox_1) %>% 
                                       dplyr::distinct() %>% 
                                       dplyr::select(Province) %>% 
                                       c(as.character())
                                       )
 
        })
    
    output$res1 <- renderText(input$checkbox_1)
    output$res2 <- renderText(input$checkbox_2)
    
}
shinyApp(ui = ui, server = server)

[ifendo]

see below updated version:

library(shiny)
library(shinydashboard)
library(dplyr)
library(shinyWidgets)




df <- data.frame(Region = c(rep("A", times = 7), rep("B", times = 3), rep("C", times = 2)),
                 Province = c(rep(c("x","y","z"), length.out = 7), rep(c("j","k"), length.out = 3), c("u","i")),
                 Garbage = rep(c("blah","bleh"), length.out = 12))




ui <- dashboardPage(
  dashboardHeader(title = "REPREX"),
  dashboardSidebar(),
  dashboardBody(
    column(width = 6,
           checkboxGroupButtons(
             inputId = "checkbox_1",
             label = "Please select regions",
             choices = unique(df$Region), # as Region is not a factor, levels(df$Region) returns NULL
             status = "default",
             justified = TRUE,
             direction = "vertical",
             selected = unique(df$Region)[1],
             checkIcon = list(
               yes = icon("ok", 
                          lib = "glyphicon"))
           ),
           
           verbatimTextOutput(outputId = "res1"),
    ),
    
    column(width = 6,
           checkboxGroupButtons(
             inputId = "checkbox_2",
             label = "Please select provinces",
             choices = unique(df$Province),
             status = "default",
             justified = TRUE,
             direction = "vertical",
             selected = unique(df$Province)[1],
             checkIcon = list(
               yes = icon("ok", 
                          lib = "glyphicon"))
           ),
           
           verbatimTextOutput(outputId = "res2"),
    )
  )
  
)

server <- function(input, output, session) {
 #  should be input$checkbox_1, not input$Region, which is not defined
  observeEvent(input$checkbox_1, {
    updateCheckboxGroupButtons(session = session,
                               inputId = "checkbox_2",
                               selected = df %>% 
                                 dplyr::select(Region, Province) %>% 
                                 dplyr::filter(Region %in% input$checkbox_1) %>% 
                                 dplyr::distinct() %>% 
                                 dplyr::select(Province) %>% 
                                 dplyr::pull() # original c(as.character()) returns a named list, not expected
    )
    
  })
  
  output$res1 <- renderText(input$checkbox_1)
  output$res2 <- renderText(input$checkbox_2)
  
}
shinyApp(ui = ui, server = server)

Hope it helps

[PK57]

Thank you for your reply,

I tested your suggestion and it didn't work using unique(input$Region), however everything worked when i reverted it back to levels(input$Region) because df$Region is indeed a factor in the reprex I provided.

All in all, it works. I'm very grateful for your help. Have a great day!