Search code examples
rshinyshinyjsbslib

How to show/hide cards in with shinyjs and bslib with a D.R.Y. approach

Consider the following mockup shiny app. It does what I need (effectively toggling the show/hide of each card based on the checkbox, input$checkbox), but it's not very D.R.Y. and would be hard to scale and maintain.

library(shiny)
library(tidyverse)
library(bslib)
library(shinyjs)

cards <- list(
  card(
    id = "card1",
    card_header("Card 1"),
    plotOutput("card1_plot")
  ),
  card(
    id = "card2",
    card_header("Card 2"),
    plotOutput("card2_plot")
  ),
  card(
    id = "card3",
    card_header("Card 3"),
    plotOutput("card3_plot")
  ),
  card(
    id = "card4",
    card_header("Card 4"),
    plotOutput("card4_plot")
  )
)

ui <- page_sidebar(
  useShinyjs(),
  title = "My Dashboard",
  sidebar = sidebar(
    "Controls",
    checkboxGroupInput("checkbox", "Select Stuff", 
                       choices = c("card1", "card2", "card3", "card4"), 
                       selected = c("card1", "card2", "card3", "card4"))
  ),
  "Main Content Area",
  fillable = FALSE,
  cards
)

server <- function(input, output) {
  
  observeEvent(input$checkbox, {
    if (is.null(input$checkbox)) hide("card1"); hide("card2"); hide("card3"); hide("card4");
    if ("card1" %in% input$checkbox) show("card1") else hide("card1")
    if ("card2" %in% input$checkbox) show("card2") else hide("card2")
    if ("card3" %in% input$checkbox) show("card3") else hide("card3")
    if ("card4" %in% input$checkbox) show("card4") else hide("card4")
  }, ignoreNULL = FALSE)
  
}

shinyApp(ui = ui, server = server)

Quick visual:

enter image description here

Is there a way to abstract the multiple similar calls to if ("cardXX" %in% input$checkbox) show("cardXX") else hide("cardXX")? Likewise for the multiple calls to hide("cardXX"); in the if (is.null(input$checkbox)) line?

Solution

  • You could vectorize the content of the observeEvent:

    card_ids = c("card1", "card2", "card3", "card4")

observeEvent(input$checkbox, {
    lapply(card_ids, function(card) {
        toggle(id = card, condition = card %in% input$checkbox)
    })
}, ignoreNULL = FALSE)

    Notice that the toggle call here is a short form for the if () show () else hide () parts.

    Concerning the if (is.null(input$checkbox)) clause which shall hide all cards if nothing is selected I don't think that it is needed at all. If it is really needed for some reason, you could use the fact that all of your card ids start with "card" and shorten it to

    if (is.null(input$checkbox)) hide(selector = "[id^='card']");

    Complete example:

    library(shiny)
library(tidyverse)
library(bslib)
library(shinyjs)

card_ids = c("card1", "card2", "card3", "card4")

cards <- list(
    card(id = "card1",
         card_header("Card 1"),
         plotOutput("card1_plot")),
    card(id = "card2",
         card_header("Card 2"),
         plotOutput("card2_plot")),
    card(id = "card3",
         card_header("Card 3"),
         plotOutput("card3_plot")),
    card(id = "card4",
         card_header("Card 4"),
         plotOutput("card4_plot"))
)

ui <- page_sidebar(
    useShinyjs(),
    title = "My Dashboard",
    sidebar = sidebar(
        "Controls",
        checkboxGroupInput(
            "checkbox",
            "Select Stuff",
            choices = card_ids,
            selected = card_ids
        )
    ),
    "Main Content Area",
    fillable = FALSE,
    cards
)

server <- function(input, output) {
    
    observeEvent(input$checkbox, {
        lapply(card_ids, function(card) {
            toggle(id = card, condition = card %in% input$checkbox)
        })
    }, ignoreNULL = FALSE)
    
}

shinyApp(ui = ui, server = server)