rplotshinyr-plotlybs4dash

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


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)
  }
)

Solution

  • 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)
      }
    )