R Shiny中maximizable=TRUE的bs4Dash::box内图表自适应问题

问题根因 #

bs4Dash的Box最大化功能基于AdminLTE的card组件实现，触发最大化时仅切换了Box本身的CSS类，存在两个核心缺陷：

• 原生plotOutput默认仅监听窗口宽度变化，未监听父容器高度变化，因此只会横向拉伸、纵向高度不同步
• Plotly这类HTML组件的重绘逻辑仅绑定全局window.resize事件，Box最大化时不会触发全局resize通知；且网上现有方案触发resize的时机早于CSS动画完成，因此需要点击两次才能生效

可靠实现方案 #

仅需要在dashboardBody中注入两段自定义代码，不需要修改原有绘图逻辑，一次点击即可实现所有类型图表完美适配：

• 自定义CSS：强制Box内的图表容器占满最大化后的可用高度，解决纵向拉伸问题
• 监听JS事件：在Box最大化/还原的动画完成后，主动触发全局resize事件，通知所有图表重绘，解决Plotly不响应、需点击两次的问题

完整可运行代码 #

library(ggplot2)
library(plotly)
library(shiny)
library(bs4Dash)

df <- data.frame(gp = factor(rep(letters[1:3], each = 10)), y = rnorm(30))

ds <- do.call(rbind, lapply(split(df, df$gp), function(d) {
  data.frame(mean = mean(d$y), sd = sd(d$y), gp = d$gp)
}))

g1 <- ggplot(df, aes(gp, y)) +
  geom_point() +
  geom_point(data = ds, aes(y = mean), colour = 'red', size = 3)
g2 <- ggplotly(g1)

shinyApp(
  ui = dashboardPage(
    header = dashboardHeader(
      title = dashboardBrand(
        title = "My dashboard",
        color = "primary",
        href = "#",
        image = "https://adminlte.io/themes/v3/dist/img/AdminLTELogo.png"
      )
    ),
    sidebar = dashboardSidebar(),
    body = dashboardBody(
      # 注入自定义CSS
      tags$style(
        ".card.maximized-card .card-body {
          height: calc(100% - 57px) !important;
          padding: 1rem;
          display: flex;
          flex-direction: column;
        }
        .card .shiny-plot-output,
        .card .html-widget {
          width: 100% !important;
          height: 100% !important;
          flex: 1 1 auto;
        }"
      ),
      # 注入JS监听逻辑
      tags$script(
        "$(function() {
          $(document).on('click', '[data-card-widget=\"maximize\"]', function() {
            setTimeout(function() {
              window.dispatchEvent(new Event('resize'));
            }, 300);
          });
        });"
      ),
      fluidRow(
        box(status = getAdminLTEColors()[1],
            width = 4,
            maximizable = TRUE,
            plotOutput("plot1")),
        box(status = getAdminLTEColors()[2],
            width = 4,
            maximizable = TRUE,
            plotOutput("plot2")),
        bs4Dash::box(status = getAdminLTEColors()[3],
                     width = 4,
                     maximizable = TRUE,
                     plotlyOutput("plot3"))
      )
    ),
    controlbar = dashboardControlbar(),
    title = "DashboardPage"
  ),
  server = function(input, output) {
    output$plot1 <- renderPlot(plot(df))
    output$plot2 <- renderPlot(g1)
    output$plot3 <- renderPlotly(g2)
  }
)

适配效果 #

• 原生base plot、ggplot输出：最大化/还原时横纵方向均自动适配Box尺寸，无拉伸变形
• Plotly输出：单次点击最大化/还原按钮即可自动调整尺寸，无需重复点击
• 方案兼容所有基于resize事件触发重绘的HTML组件，不需要针对单个图表单独写适配逻辑

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