如何实现bslib卡片仅在全屏模式下渲染DT表格？

问题描述 #

使用bslib开发Shiny UI时，创建了多个开启full_screen = TRUE的卡片，需求是仅当卡片展开至全屏模式时才渲染DT表格，非全屏状态下不渲染（实际场景中表格数据来自数据库查询，需避免不必要的查询，实现懒加载）。当前示例中DT表格始终渲染，不符合需求。

解决方案 #

bslib的全屏卡片会自动生成一个输入状态值，格式为input$<卡片ID>_full_screen，该值在卡片全屏时为TRUE，非全屏时为FALSE。利用这个特性，我们可以：

1. 给每个卡片设置唯一ID
2. 在卡片内容区域使用uiOutput动态加载表格
3. 服务器端根据对应卡片的全屏状态，决定是否渲染DT表格

修改后的完整代码 #

library(shiny)
library(bslib)
library(DT)
library(purrr)

datasets <- list(
  Iris = iris, Mtcars = mtcars, Volcanos = volcano,
  `Chick Weights` = chickwts, Earthquakes = quakes, 
  `US Arrests` = USArrests, `CO2` = co2, `Air Quality` = airquality
)

ui <- page_fillable(
  uiOutput("cards")
)

server <- function(input, output) {
  
  output$cards <- renderUI({
    card_list <- imap(datasets, ~{
      card_id <- gsub(" ", "_", .y)  # 将数据集名称转为合法的ID格式
      card(
        card_header(.y),
        card_body(
          # 动态加载表格的占位容器
          uiOutput(paste0("table_", card_id))
        ),
        full_screen = TRUE,
        height = 200,
        id = card_id  # 设置卡片唯一ID
      )
    }) |> 
      unname()
    
    layout_columns(
      !!!card_list
    )
  })
  
  # 为每个数据集创建对应的表格渲染逻辑
  imap(datasets, ~{
    card_id <- gsub(" ", "_", .y)
    output_name <- paste0("table_", card_id)
    
    output[[output_name]] <- renderUI({
      # 仅当卡片处于全屏状态时渲染表格
      if (isTRUE(input[[paste0(card_id, "_full_screen")]])) {
        datatable(head(as.data.frame(.x)))
      } else {
        # 非全屏时显示引导提示
        tags$p("点击右上角全屏按钮查看表格")
      }
    })
  })
}

shinyApp(ui = ui, server = server)

关键说明 #

• 每个卡片通过id参数设置唯一标识，确保能正确捕获全屏状态
• 利用input$<card_id>_full_screen判断当前卡片是否处于全屏模式
• 表格通过renderUI动态生成，只有当全屏状态为TRUE时才会执行DT渲染（对应实际场景中的数据库查询），避免了非必要的资源消耗
• 非全屏状态下可自定义提示内容，引导用户操作

内容的提问来源于stack exchange，提问作者Will Hipson