如何使用shinyjs和bslib以及D.R.Y.来显示/隐藏卡片。方法

Question

考虑以下闪亮的应用程序模型。它满足了我的需要（根据复选框有效地切换每张卡片的显示/隐藏，

input$checkbox

），但它不是很D.R.Y。并且难以扩展和维护。

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)

快速视觉：

有没有办法抽象出对

if ("cardXX" %in% input$checkbox) show("cardXX") else hide("cardXX")

的多个类似调用？同样，对于

hide("cardXX");

行中的

if (is.null(input$checkbox))

的多次调用？

Answer 1

您可以对

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)

请注意，此处的

toggle

调用是

if () show () else hide ()

部分的缩写形式。

关于

if (is.null(input$checkbox))

子句，如果没有选择任何内容，将隐藏所有卡片，我认为根本不需要它。如果出于某种原因确实需要它，您可以使用所有卡 ID 都以“card”开头的事实，并将其缩短为

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

完整示例：

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)