How to adjust plot size when the box is maximized

[lemuelemos]

I'm using the option from box: maximizable = TRUE. When the box is maximized the plot height stop on mid, how can i maximize the plot too?

[DivadNojnarg]

You want:

tags$head(
          tags$script(
            "$(function() {
              $('[data-card-widget=\"maximize\"]').on('click', function() {
                setTimeout(function() {
                  var isMaximized = $('html').hasClass('maximized-card');
                  if (isMaximized) {
                    $('#<plotid>').css('height', '100%');
                  } else {
                    $('#<plotid>').css('height', '400px');
                  }
                }, 300);
                $('#<plotid>').trigger('resize');
              });
            });
            "
          )
        )

and change <plotid> by the real plot id. Be careful if you have multiple maximizable cards, you will need to be more specific for the $('[data-card-widget="maximize"]') selector to listen to the good button.

[lemuelemos]

You want:

tags$head(
          tags$script(
            "$(function() {
              $('[data-card-widget=\"maximize\"]').on('click', function() {
                setTimeout(function() {
                  var isMaximized = $('html').hasClass('maximized-card');
                  if (isMaximized) {
                    $('#<plotid>').css('height', '100%');
                  } else {
                    $('#<plotid>').css('height', '400px');
                  }
                }, 300);
                $('#<plotid>').trigger('resize');
              });
            });
            "
          )
        )

and change <plotid> by the real plot id. Be careful if you have multiple maximizable cards, you will need to be more specific for the $('[data-card-widget="maximize"]') selector to listen to the good button.

Where i put this? Inside box?

[DivadNojnarg]

Inside dashboardBody for instance.

[DivadNojnarg]

library(shiny)
library(bs4Dash)

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(
      tags$head(
        tags$script(
          "$(function() {
              $('[data-card-widget=\"maximize\"]').on('click', function() {
                setTimeout(function() {
                  var isMaximized = $('html').hasClass('maximized-card');
                  if (isMaximized) {
                    $('#distPlot').css('height', '100%');
                  } else {
                    $('#distPlot').css('height', '400px');
                  }
                }, 300);
                $('#distPlot').trigger('resize');
              });
            });
            "
        )
      ),
      sliderInput("obs", "Number of observations:",
                  min = 0, max = 1000, value = 500
      ),
      box(
        maximizable = TRUE,
        plotOutput("distPlot")
      )
    ),
    controlbar = dashboardControlbar(),
    title = "DashboardPage"
  ),
  server = function(input, output) {
    output$distPlot <- renderPlot({
      hist(rnorm(input$obs))
    })
  }
)

[lemuelemos]

library(shiny)
library(bs4Dash)

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(
      tags$head(
        tags$script(
          "$(function() {
              $('[data-card-widget=\"maximize\"]').on('click', function() {
                setTimeout(function() {
                  var isMaximized = $('html').hasClass('maximized-card');
                  if (isMaximized) {
                    $('#distPlot').css('height', '100%');
                  } else {
                    $('#distPlot').css('height', '400px');
                  }
                }, 300);
                $('#distPlot').trigger('resize');
              });
            });
            "
        )
      ),
      sliderInput("obs", "Number of observations:",
                  min = 0, max = 1000, value = 500
      ),
      box(
        maximizable = TRUE,
        plotOutput("distPlot")
      )
    ),
    controlbar = dashboardControlbar(),
    title = "DashboardPage"
  ),
  server = function(input, output) {
    output$distPlot <- renderPlot({
      hist(rnorm(input$obs))
    })
  }
)

I have other problem, the plot is rendered inside server by renderUI, so this solution doesn't work in this situation. It1s possible adapt?

[DivadNojnarg]

Could you provide me your code?

[lemuelemos]

library(shiny)
library(bs4Dash)

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(
      tags$head(
        tags$script(
          "$(function() {
              $('[data-card-widget=\"maximize\"]').on('click', function() {
                setTimeout(function() {
                  var isMaximized = $('html').hasClass('maximized-card');
                  if (isMaximized) {
                    $('# plot_teste distPlot').css('height', '100%');
                  } else {
                    $('#distPlot').css('height', '400px');
                  }
                }, 300);
                $('#distPlot').trigger('resize');
              });
            });
            "
        )
      ),
      sliderInput("obs", "Number of observations:",
                  min = 0, max = 1000, value = 500
      ),
      uiOutput("plot_teste")
    ),
    controlbar = dashboardControlbar(),
    title = "DashboardPage"
  ),
  server = function(input, output) {

    output$plot_teste <- renderUI({
      box(
        maximizable = TRUE,
        plotOutput("distPlot")
      )
    })

    output$distPlot <- renderPlot({
      hist(rnorm(input$obs))
    })
  }
)

[DivadNojnarg]

You don't need to use renderUI (in the code you show). The renderPlot plotOutput pattern is enough.

[lemuelemos]

You don't need to use renderUI (in the code you show). The renderPlot plotOutput pattern is enough.

I know, i just rewrite your code to reprex my problem.

[DivadNojnarg]

You'll need, which shows even more why renderUI is evil :smiling_imp: :

library(shiny)
library(bs4Dash)

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(
      tags$head(
        tags$script(
          "$(function() {
              setTimeout(function() {
                $('[data-card-widget=\"maximize\"]').on('click', function() {
                  setTimeout(function() {
                    var isMaximized = $('html').hasClass('maximized-card');
                    if (isMaximized) {
                      $('#distPlot').css('height', '100%');
                    } else {
                      $('#distPlot').css('height', '400px');
                    }
                  }, 300);
                  $('#distPlot').trigger('resize');
                });
              }, 500);
            });
            "
        )
      ),
      sliderInput("obs", "Number of observations:",
                  min = 0, max = 1000, value = 500
      ),
      uiOutput("plot_test")
    ),
    controlbar = dashboardControlbar(),
    title = "DashboardPage"
  ),
  server = function(input, output) {
    output$distPlot <- renderPlot({
      hist(rnorm(input$obs))
    })

    output$plot_test <- renderUI({
      box(
        maximizable = TRUE,
        plotOutput("distPlot")
      )
    })
  }
)

Explanations:

It takes some time to render the content in the DOM once put inside renderUI. Therefore, we were trying to add an event to something that does not even exist at the time the function is called:

$('[data-card-widget=\"maximize\"]').on('click', function() {
                  setTimeout(function() {
                    var isMaximized = $('html').hasClass('maximized-card');
                    if (isMaximized) {
                      $('#distPlot').css('height', '100%');
                    } else {
                      $('#distPlot').css('height', '400px');
                    }
                  }, 300);
                  $('#distPlot').trigger('resize');
                });

We need an extra setTimeout to wait for renderUI (500 ms is reasonable):

setTimeout(function() {
                $('[data-card-widget=\"maximize\"]').on('click', function() {
                  setTimeout(function() {
                    var isMaximized = $('html').hasClass('maximized-card');
                    if (isMaximized) {
                      $('#distPlot').css('height', '100%');
                    } else {
                      $('#distPlot').css('height', '400px');
                    }
                  }, 300);
                  $('#distPlot').trigger('resize');
                });
              }, 500);

If you want to programmatically update the box, maybe have a look at updateBox which does the same but without initial rendering delay.

[lemuelemos]

Really thanks for your time, you point out an important aspect that a need changing in my code: i need to use more update functions. I have one more question to close the issue. Can i generalize the resize plot to multiple plots? Or i need do this for every plot id?

[DivadNojnarg]

Each box is independant in a way you don't want to resize box A elements if only box B is maximized. What you could do is extract out a JavaScript wrapper and apply it to each box:

function resizeBoxContent(trigger, target) {
              $(trigger).on('click', function() {
                setTimeout(function() {
                  var isMaximized = $('html').hasClass('maximized-card');
                    if (isMaximized) {
                      $(target).css('height', '100%');
                    } else {
                      $(target).css('height', '400px');
                    }
                }, 300);
                $(target).trigger('resize');
              });
            }

setTimeout(function() {
              resizeBoxContent('#box_1 [data-card-widget=\"maximize\"]', '#plot_1');
              resizeBoxContent('#box_4 [data-card-widget=\"maximize\"]', '#plot_4');
            }, 500);

Notice I also need to specify id for each box to be able to distinguish the maximizable button. Below is the full example where I only resize plot 1 and plot 4. From there, you can basically do whatever you want.

library(shiny)
library(bs4Dash)

n_boxes <- 4

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(
      tags$head(
        tags$script(
          "$(function() {
            function resizeBoxContent(trigger, target) {
              $(trigger).on('click', function() {
                setTimeout(function() {
                  var isMaximized = $('html').hasClass('maximized-card');
                    if (isMaximized) {
                      $(target).css('height', '100%');
                    } else {
                      $(target).css('height', '400px');
                    }
                }, 300);
                $(target).trigger('resize');
              });
            }

            setTimeout(function() {
              resizeBoxContent('#box_1 [data-card-widget=\"maximize\"]', '#plot_1');
              resizeBoxContent('#box_4 [data-card-widget=\"maximize\"]', '#plot_4');
            }, 500);

          });
          "
        )
      ),
      fluidRow(
        lapply(seq_len(n_boxes), function(i) {
          output_id <- sprintf("plot_wrapper_%s", i)
          column(
            width = 12 / n_boxes,
            sliderInput(
              sprintf("obs_%s", i), 
              "Number of observations:",
              min = 0, 
              max = 1000, 
              value = 500
            ),
            uiOutput(output_id)
          )
        })
      )
    ),
    controlbar = dashboardControlbar(),
    title = "DashboardPage"
  ),
  server = function(input, output) {

    lapply(seq_len(n_boxes), function(i) {

      output_id <- sprintf("plot_%s", i)

      # generate plot
      output[[output_id]] <- renderPlot({
        hist(rnorm(input[[sprintf("obs_%s", i)]]))
      })

      # generate card wrapper
      output[[sprintf("plot_wrapper_%s", i)]] <- renderUI({
        box(
          width = 12,
          title = sprintf("Box %s", i),
          id = sprintf("box_%s", i),
          maximizable = TRUE,
          plotOutput(output_id)
        )
      })
    })

  }
)

[lemuelemos]

Each box is independant in a way you don't want to resize box A elements if only box B is maximized. What you could do is extract out a JavaScript wrapper and apply it to each box:

function resizeBoxContent(trigger, target) {
              $(trigger).on('click', function() {
                setTimeout(function() {
                  var isMaximized = $('html').hasClass('maximized-card');
                    if (isMaximized) {
                      $(target).css('height', '100%');
                    } else {
                      $(target).css('height', '400px');
                    }
                }, 300);
                $(target).trigger('resize');
              });
            }

setTimeout(function() {
              resizeBoxContent('#box_1 [data-card-widget=\"maximize\"]', '#plot_1');
              resizeBoxContent('#box_4 [data-card-widget=\"maximize\"]', '#plot_4');
            }, 500);

Notice I also need to specify id for each box to be able to distinguish the maximizable button. Below is the full example where I only resize plot 1 and plot 4. From there, you can basically do whatever you want.

library(shiny)
library(bs4Dash)

n_boxes <- 4

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(
      tags$head(
        tags$script(
          "$(function() {
            function resizeBoxContent(trigger, target) {
              $(trigger).on('click', function() {
                setTimeout(function() {
                  var isMaximized = $('html').hasClass('maximized-card');
                    if (isMaximized) {
                      $(target).css('height', '100%');
                    } else {
                      $(target).css('height', '400px');
                    }
                }, 300);
                $(target).trigger('resize');
              });
            }

            setTimeout(function() {
              resizeBoxContent('#box_1 [data-card-widget=\"maximize\"]', '#plot_1');
              resizeBoxContent('#box_4 [data-card-widget=\"maximize\"]', '#plot_4');
            }, 500);

          });
          "
        )
      ),
      fluidRow(
        lapply(seq_len(n_boxes), function(i) {
          output_id <- sprintf("plot_wrapper_%s", i)
          column(
            width = 12 / n_boxes,
            sliderInput(
              sprintf("obs_%s", i), 
              "Number of observations:",
              min = 0, 
              max = 1000, 
              value = 500
            ),
            uiOutput(output_id)
          )
        })
      )
    ),
    controlbar = dashboardControlbar(),
    title = "DashboardPage"
  ),
  server = function(input, output) {

    lapply(seq_len(n_boxes), function(i) {

      output_id <- sprintf("plot_%s", i)

      # generate plot
      output[[output_id]] <- renderPlot({
        hist(rnorm(input[[sprintf("obs_%s", i)]]))
      })

      # generate card wrapper
      output[[sprintf("plot_wrapper_%s", i)]] <- renderUI({
        box(
          width = 12,
          title = sprintf("Box %s", i),
          id = sprintf("box_%s", i),
          maximizable = TRUE,
          plotOutput(output_id)
        )
      })
    })

  }
)

Perfect! Thanks!!!

[JacobBumgarner]

I know that this is quite old, but I've created another working solution. This solution is functional and requires a single line of code per plot/maximizable box in the server. Hopefully this is useful for anyone with many boxed graphs!

# Plot resizing example

library(shiny)
library(bs4Dash)
library(shinyjs)
library(plotly)

#' Add a box maximization observer to automatically resize a plot in that box.
#'
#' @param input The input of a shiny app session.
#' @param box_id The shiny ID of the box to observe.
#' @param plot_name The shiny ID of the plot to resize.
#' @param non_max_height The height that the graph should be when the box is
#'   not maximized. Defaults to "400px".
add_plot_maximize_observer <- function(input,
                                       box_id,
                                       plot_name,
                                       non_max_height = "400px") {
  observeEvent(input[[box_id]]$maximized, {
    plot_height <- if (input[[box_id]]$maximized) {
      "100%"
    } else {
      non_max_height
    }

    js_call <- sprintf(
      "
      setTimeout(() => {
        $('#%s').css('height', '%s');
      }, 300)
      $('#%s').trigger('resize');
      ",
      plot_name,
      plot_height,
      plot_name
    )
    shinyjs::runjs(js_call)
  }, ignoreInit = TRUE)
}

ui <- dashboardPage(dashboardHeader(),
                    dashboardSidebar(),
                    dashboardBody(
                      shinyjs::useShinyjs(),
                      box(
                        id = "graph_box",
                        maximizable = TRUE,
                        collapsible = FALSE,
                        width = 12,
                        plotly::plotlyOutput("mpg_wt")
                      )
                    ))

server <- function(input, output, session) {
  output$mpg_wt <- plotly::renderPlotly({
    plotly::plot_ly(
      mtcars,
      x = ~ wt,
      y = ~ mpg,
      type = "scatter",
      mode = "markers"
    )
  })

  add_plot_maximize_observer(input, "graph_box", "mpg_wt")
}

shinyApp(ui, server)

Also see this related SO post.

[HugoGit39]

@JacobBumgarner your function works perfectly! However how would this work for a bs4TabCard with tabPanel? Cause entering the id of tabPanel doesnt work cause box_id is a different id. I tried to change box_id with tabPanel_id or tabsetPanel_id (see here) in the function but doesnt work. Also working with the id of bs4TabCard doesnt work and get an error Warning: Error in $: $ operator is invalid for atomic vectors

[JacobBumgarner]

@HugoGit39 The solution is that the state of a tabBox (bs4TabCard alias) isn't stored in its input name. Instead, given a tabBox with an id = "my_tabs", you can access the state of the tabBox maximization using osbserveEvent(input$my_tabs_box$maximized, {...}). The key part of this is adding the _box to the end of your box id. See here for the rinterface Bootstrap documentation that explains this.

I also gave this same comment on SO.

[HugoGit39]

@JacobBumgarner Thx for your quick reply! I checked the manual of tabBox and indeed understand it. However i can not get it to work properly. So bascially your function needs to be adjusted where input[[box_id]]$maximized needs to changed to input$my_tabs_box$maximized?

library(shiny)
library(bs4Dash)
library(shinyjs)
library(plotly)

#' Add a box maximization observer to automatically resize a plot in that box.
#'
#' @param input The input of a shiny app session.
#' @param tab_id The shiny ID of the tabbox to observe.
#' @param plot_name The shiny ID of the plot to resize.
#' @param non_max_height The height that the graph should be when the box is
#'   not maximized. Defaults to "400px".
add_plot_maximize_observer <- function(input,
                                       tab_id,
                                       plot_name,
                                       non_max_height = "400px") {

  tab_id <- as.name(tab_id)

  observeEvent(input$tab_id$maximized, {
    plot_height <- if (input$tab_id$maximized) {
      "100%"
    } else {
      non_max_height
    }

    js_call <- sprintf(
      "
      setTimeout(() => {
        $('#%s').css('height', '%s');
      }, 300)
      $('#%s').trigger('resize');
      ",
      plot_name,
      plot_height,
      plot_name
    )
    shinyjs::runjs(js_call)
  }, ignoreInit = TRUE)
}

ui <- dashboardPage(dashboardHeader(),
                    dashboardSidebar(),
                    dashboardBody(
                      shinyjs::useShinyjs(),
                      bs4TabCard(id = "my_tabs", maximizable = T,
                                 selected = "One", side = "left", height = "auto",
                                 tabPanel(
                                   title = "One", id = "One",
                                   plotlyOutput("mpg_wt", height = "400px")
                                 ),
                                 tabPanel(
                                   title = "Two", id= "Two",
                                   plotlyOutput("sepw_sepl", height = "400px")
                                 )
                      )
                    ))

server <- function(input, output, session) {
  output$mpg_wt <- plotly::renderPlotly({
    plotly::plot_ly(
      mtcars,
      x = ~ wt,
      y = ~ mpg,
      type = "scatter",
      mode = "markers"
    )
  })

  output$sepw_sepl <- plotly::renderPlotly({
    plotly::plot_ly(
      iris,
      x = ~ Sepal.Width,
      y = ~ Sepal.Length,
      type = "scatter",
      mode = "markers"
    )
  })

  add_plot_maximize_observer(input, "my_tabs_id", "mpg_wt")

 add_plot_maximize_observer(input, "my_tabs_id", "sepw_sepl")
}

shinyApp(ui, server)

[JacobBumgarner]

@HugoGit39 actually you don't need to change the add_plot_maximize_observer function at all.

All you need to do is add _box to the end of your my_tabs id, such as: add_plot_maximize_observer(input, "my_tabs_box", "mpg_wt")

Does this max sense?

[HugoGit39]

It does however only the width changes when the tab and box is maximized. And I need to first click and than the plots get wider, but not higher. Does it work for you?

[HugoGit39]

@JacobBumgarner does it work on your side? Cause it doesnt on my side