How to select multiple Inputs based on another input

Question

Case

I do have the following problem. I have four cases, say A, B, C, and D. Based on these, I like to filter my plot and further results. So far so straight.

Furthermore, there are two kind of users, say group1 and group2. Group1 usually(!) wants to see only A and B and Group2 C and D. However, sometimes they want to mix it up and just see A, or A and C, etc...

Therefore, my goal is that one can just pick either group1 or group2 and A&B or C&D are selected automatically. But it should also be possible to select group1 and group2 (selecting A&B&C&D) or neither and selecting groups by hand. Here is a small example:

library(shiny)
library(shinyWidgets)
library(ggplot2)
library(dplyr)

ui <- shinyUI(fluidPage(

  titlePanel("Test 1"),

  sidebarLayout(
    sidebarPanel(
      prettyCheckbox(inputId = "g1",
                     label = "Group 1",
                     shape = "round", bigger = TRUE,
                     value = TRUE,
                     inline = TRUE),
      prettyCheckbox(inputId = "g2",
                     label = "Group 2",
                     shape = "round", bigger = TRUE,
                     value = FALSE,
                     inline = TRUE),
      br(),
      prettyCheckbox(inputId = "a",
                     label = "A",
                     value = TRUE,
                     inline = TRUE),
      prettyCheckbox(inputId = "b",
                     label = "B",
                     value = TRUE,
                     inline = TRUE),
      prettyCheckbox(inputId = "c",
                     label = "C",
                     value = FALSE,
                     inline = TRUE),
      prettyCheckbox(inputId = "d",
                     label = "D",
                     value = FALSE,
                     inline = TRUE),
      plotOutput("plot")
    ),

    mainPanel()
  )
))

server <- shinyServer(function(session, input, output) { 

  set.seed(0)
  df <- data.frame(group = sample(LETTERS[1:4], size = 50, replace = T),
                   x = rnorm(50),
                   y = rnorm(50))


  output$plot<- renderPlot({ 
    if(!input$a){
      df <- df %>% 
        filter(group != "A")
    }
    if(!input$b){
      df <- df %>% 
        filter(group != "B")
    }
    if(!input$c){
      df <- df %>% 
        filter(group != "C")
    }
    if(!input$d){
      df <- df %>% 
        filter(group != "D")
    }

    df %>% 
      ggplot(aes(x = x, y = y, color = group)) +
      geom_point()
  })
})

shiny::shinyApp(ui, server)

Note:

I want to see the second line of checkboxes marked as selected and filter by them. The user should have the possibility to uncheck boxes even if its corresponding group is selected. The top level boxes should be just convenient helpers. Since I only have four groups, a selectPicker() is not an option (from UX perspective).

O have the feeling this should be already implemented somehow and I dont want to tweak renderUIs and such things. Any Hints are welcome!

Answer 1

See below for the code, the trick was finding updatePrettyCheckbox!

library(shiny)
library(shinyWidgets)
library(ggplot2)
library(dplyr)

ui <- shinyUI(fluidPage(

  titlePanel("Test 1"),

  sidebarLayout(
    sidebarPanel(
      prettyCheckbox(inputId = "g1",
                     label = "Group 1",
                     shape = "round", bigger = TRUE,
                     value = FALSE,
                     inline = TRUE),
      prettyCheckbox(inputId = "g2",
                     label = "Group 2",
                     shape = "round", bigger = TRUE,
                     value = FALSE,
                     inline = TRUE),
      br(),
      prettyCheckbox(inputId = "a",
                     label = "A",
                     value = FALSE,
                     inline = TRUE),
      prettyCheckbox(inputId = "b",
                     label = "B",
                     value = FALSE,
                     inline = TRUE),
      prettyCheckbox(inputId = "c",
                     label = "C",
                     value = FALSE,
                     inline = TRUE),
      prettyCheckbox(inputId = "d",
                     label = "D",
                     value = FALSE,
                     inline = TRUE),
      plotOutput("plot")
    ),

    mainPanel()
  )
))

server <- shinyServer(function(session, input, output) { 

  set.seed(0)
  df <- data.frame(group = sample(LETTERS[1:4], size = 50, replace = T),
                   x = rnorm(50),
                   y = rnorm(50))

  observeEvent(input$g1, {

    if(input$g1 == TRUE){
      updatePrettyToggle(session = session,
                         inputId = "a",
                         value = TRUE)
      updatePrettyToggle(session = session,
                         inputId = "b",
                         value = TRUE)

    }
  })
  observeEvent(input$g2, {

    if(input$g2 == TRUE){
      updatePrettyToggle(session = session,
                         inputId = "c",
                         value = TRUE)
      updatePrettyToggle(session = session,
                         inputId = "d",
                         value = TRUE)

    }
  })



  output$plot<- renderPlot({ 


    if(!input$a){
      df <- df %>% 
        filter(group != "A")
    }
    if(!input$b){
      df <- df %>% 
        filter(group != "B")
    }
    if(!input$c){
      df <- df %>% 
        filter(group != "C")
    }
    if(!input$d){
      df <- df %>% 
        filter(group != "D")
    }

    df %>% 
      ggplot(aes(x = x, y = y, color = group)) +
      geom_point()
  })
})

shiny::shinyApp(ui, server)

I didn't include unchecking Group1 or Group 2 would turn off A&B/C&D but you would just add to the code something like this:

observeEvent(input$g1, {

if(input$g1 == TRUE){
  updatePrettyToggle(session = session,
                     inputId = "a",
                     value = TRUE)
  updatePrettyToggle(session = session,
                     inputId = "b",
                     value = TRUE)

}
if(input$g1 == FALSE){
  updatePrettyToggle(session = session,
                     inputId = "a",
                     value = FALSE)
  updatePrettyToggle(session = session,
                     inputId = "b",
                     value = FALSE)

}

})

Check your original code as well, you have the wrong inputId for Group 2