Scalability of plots within bs4Dash::box when maximizable = TRUE in R Shiny

Question

I would like plots to be adjusted to full screen when maximizing a bs4Dash box. It works with standard plot on the horizontal axis, but not the vertical one. Plotly does not seems to be affected by the maximized.

This post Maximizing plots in R Shiny bs4Dash seems to apply some CSS script but does not work very fine from my side (for instance, plotly box plot must be maximized twice prior to see effect).

Is there any easy solution to achieve initial goal?

Example of app displaying 3 plots (1 standard, 1 ggplot & 1 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 = "https://adminlte.io/themes/v3",
        image = "https://adminlte.io/themes/v3/dist/img/AdminLTELogo.png"
      )
    ),
    sidebar = dashboardSidebar(),
    body = dashboardBody(
      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)
  }
)

I just tested my old code you linked above - resizing the plotly chart works fine right from the beginning. — ismirsehregal, Jun 29 '22 at 08:49
Would you mind sharing your sessionInfo() please? Furthermore, does all plot types resizes on both axis? (horizontally and vertically) from your side? — yeahman269, Jun 29 '22 at 13:34
The sessionInfo won't fit in a comment. Im using R 4.2.1. All libraries are the latest CRAN version. No, as mentioned in my answer not all plot types are correctly resized on both axis - only plotly works fine and base plots on the second try. — ismirsehregal, Jun 29 '22 at 13:39

yeahman269 · Accepted Answer · 2022-09-26T20:49:31.037

David Granjon (bs4Dash author) had actually already answered a similar question here at the time of my own question.

Below is the answer based on his'. However, there are still some improvements that could be done regarding the legend (which remain in original font size) as well as cex and other graphical parameters.

Idea is basically to add CSS that will tell the app to enlarge graph upon box maximization (and reversely). The ID of the graph has to be passed within the CSS (3 times).

(CSS part simplified thanks to @ismirsehregal's answer)

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 = "https://adminlte.io/themes/v3",
        image = "https://adminlte.io/themes/v3/dist/img/AdminLTELogo.png"
      )
    ),
    sidebar = dashboardSidebar(),
    body = dashboardBody(
      
      # CSS code to fix the graphs
      tags$head(
        tags$script(
          "$(function() {
              $('[data-card-widget=\"maximize\"]').on('click', function() {
                setTimeout(function() {
                  var isMaximized = $('html').hasClass('maximized-card');
                  if (isMaximized) {
                    $('#plot1').css('height', '100%');
                    $('#plot2').css('height', '100%');
                    $('#plot3').css('height', '100%');
                  } else {
                    $('#plot1').css('height', '400px');
                    $('#plot2').css('height', '400px');
                    $('#plot3').css('height', '400px');
                  }
                }, 300);
                $('#plot1').trigger('resize');
                $('#plot2').trigger('resize');
                $('#plot3').trigger('resize');
              });
            });
            "
        )
      ),
      
      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)
  }
)

score 1 · Answer 2 · answered Sep 26 '22 at 08:53

There is no need to repeat the JS function - this does the same:

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 = "https://adminlte.io/themes/v3",
        image = "https://adminlte.io/themes/v3/dist/img/AdminLTELogo.png"
      )
    ),
    sidebar = dashboardSidebar(),
    body = dashboardBody(
      
      # CSS code to fix the graphs
      tags$head(
        tags$script(
          "$(function() {
              $('[data-card-widget=\"maximize\"]').on('click', function() {
                setTimeout(function() {
                  var isMaximized = $('html').hasClass('maximized-card');
                  if (isMaximized) {
                    $('#plot1').css('height', '100%');
                    $('#plot2').css('height', '100%');
                    $('#plot3').css('height', '100%');
                  } else {
                    $('#plot1').css('height', '400px');
                    $('#plot2').css('height', '400px');
                    $('#plot3').css('height', '400px');
                  }
                }, 300);
                $('#plot1').trigger('resize');
                $('#plot2').trigger('resize');
                $('#plot3').trigger('resize');
              });
            });
            "
        )
      ),
      
      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)
  }
)

Scalability of plots within bs4Dash::box when maximizable = TRUE in R Shiny

2 Answers2

Linked