Maximizing plots in R Shiny bs4Dash

Question

I have looked online everywhere to no avail. I cannot seem to get these plots to maximize their heights and widths to full window size upon maximizing the boxes. It is a requirement that I use bs4Dash. I looked at this post but the provided solutions did not seem to work for me. What am I missing?

library(shiny)
library(bs4Dash)
library(circlepackeR) # devtools::install_github("jeromefroe/circlepackeR")
library(wordcloud2) # devtools::install_github("lchiffon/wordcloud2")
library(plotly)

ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),
  dashboardSidebar(),
  dashboardBody(
    # Boxes need to be put in a row (or column)
    fluidRow(
      box(id="histbox", 
          title = "hist box", 
          plotOutput("plot1", 
                     height = 250),
          maximizable = T),
      
      box(id = "circlebox", title="circle box", 
          circlepackeR::circlepackeROutput("circles"), maximizable = T)
      
    ),
    fluidRow(
      box(id="wordlcoudbox", 
          title = "wordcloud box", 
          wordcloud2::wordcloud2Output("cloud"), 
          maximizable = T),
      
      box(id = "plotlybox",
          title = "plotly box", 
          plotly::plotlyOutput("plotlyplot"), 
          maximizable = T))
  )
)

server <- function(input, output) {
  set.seed(122)
  histdata <- rnorm(500)
  
  output$plot1 <- renderPlot({
    data <- histdata[seq_len(10)]
    hist(data)
  })
  
  
  output$plotlyplot <- renderPlotly(
    plot1 <- plot_ly(
      type = 'scatter',
      mode = 'markers')
  )
  
  
  
  hierarchical_list <- list(name = "World",
                            children = list(
                              list(name = "North America",
                                   children = list(
                                     list(name = "United States", size = 308865000),
                                     list(name = "Mexico", size = 107550697),
                                     list(name = "Canada", size = 34033000))),
                              list(name = "South America", 
                                   children = list(
                                     list(name = "Brazil", size = 192612000),
                                     list(name = "Colombia", size = 45349000),
                                     list(name = "Argentina", size = 40134425))),
                              list(name = "Europe",  
                                   children = list(
                                     list(name = "Germany", size = 81757600),
                                     list(name = "France", size = 65447374),
                                     list(name = "United Kingdom", size = 62041708))),
                              list(name = "Africa",  
                                   children = list(
                                     list(name = "Nigeria", size = 154729000),
                                     list(name = "Ethiopia", size = 79221000),
                                     list(name = "Egypt", size = 77979000))),
                              list(name = "Asia",  
                                   children = list(
                                     list(name = "China", size = 1336335000),
                                     list(name = "India", size = 1178225000),
                                     list(name = "Indonesia", size = 231369500)))
                            )
  )
  
  output$cloud <- wordcloud2::renderWordcloud2(wordcloud2(demoFreq, 
                                                          minRotation = -pi/6, 
                                                          maxRotation = -pi/6, 
                                                          minSize = 10,
                                                          rotateRatio = 1))
  
  output$circles <- circlepackeR::renderCirclepackeR(circlepackeR(hierarchical_list))
  
}

shinyApp(ui, server)

Jacob Bumgarner · Answer 1 · 2023-02-22T16:44:37.543

As @yeahman269 mentioned, @ismirsehregal's solution wasn't working for me.

I've created a different solution that does work for me using a combination of @ismirsehregal's solution in this current post and in this post.

Importantly, the solution I've created is functional, meaning that you only have to insert a single line per plot into the server.

Please find a minimally reproducible example below. The most important part is the is the add_plot_maximize_observer function. Hopefully this works for you as it worked for me!

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

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](https://rinterface.github.io/bs4Dash/reference/insertTab.html)) in the function but doesnt work. Also working with the id of [bs4TabCard](https://rinterface.github.io/bs4Dash/reference/tabBox.html) doesnt work and get an error `Warning: Error in $: $ operator is invalid for atomic vectors` — H. berg, Apr 19 '23 at 09:51
@H. berg -- 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](https://rinterface.github.io/bs4Dash/reference/tabBox.html#:~:text=items.%20See%20example.-,Note,-User%20will%20access) for the rinterface Bootstrap documentation that explains this. — Jacob Bumgarner, Apr 19 '23 at 14:28
Did you try this yourself too? Cause at my side it doesnt work. Would be great If you can check it! — H. berg, May 12 '23 at 07:26

ismirsehregal · Answer 2 · 2022-09-26T07:53:50.943

The following is not a fully working answer, but I'll share it anyway:

We can use library(shinyjs) to dynamically change CSS style properties. Please see this related article.

However, wordcloud2 and circlepackeR don't react on their height and width arguments as expected - only the margins change but the charts remain the same size (no matter where those arguments are changed).

The base plot get's resized only after maximizing it's box twice.

The plotly chart works fine.

library(shiny)
library(bs4Dash)
library(circlepackeR) # devtools::install_github("jeromefroe/circlepackeR")
library(wordcloud2) # devtools::install_github("lchiffon/wordcloud2")
library(plotly)
library(shinyjs)

ui <- dashboardPage(
  dashboardHeader(title = "Basic dashboard"),
  dashboardSidebar(),
  dashboardBody(
    useShinyjs(),
    # Boxes need to be put in a row (or column)
    fluidRow(
      box(id="histbox", 
          title = "hist box", 
          plotOutput("plot1", width = "100%"),
          maximizable = T),
      box(id = "circlebox", title="circle box", 
          circlepackeR::circlepackeROutput("circles"), # , width = "2000px", height = "2000px" # hopeless, only adds space - plot remains the same size
          maximizable = T)
    ),
    fluidRow(
      box(id="wordlcoudbox", 
          title = "wordcloud box", 
          wordcloud2::wordcloud2Output("cloud"), # , width = "2000px", height = "2000px" # hopeless, only adds space - cloud remains the same size
          maximizable = T),
      box(id = "plotlybox",
          title = "plotly box", 
          plotly::plotlyOutput("plotlyplot"), 
          maximizable = T))
  )
)

server <- function(input, output) {
  set.seed(122)
  histdata <- rnorm(500)
  
  output$plot1 <- renderPlot({
    data <- histdata[seq_len(10)]
    hist(data)
  })
  
  output$plotlyplot <- renderPlotly({
    plot_ly(type = 'scatter', mode = 'markers')
  })
  
  hierarchical_list <- list(name = "World",
                            children = list(
                              list(name = "North America",
                                   children = list(
                                     list(name = "United States", size = 308865000),
                                     list(name = "Mexico", size = 107550697),
                                     list(name = "Canada", size = 34033000))),
                              list(name = "South America", 
                                   children = list(
                                     list(name = "Brazil", size = 192612000),
                                     list(name = "Colombia", size = 45349000),
                                     list(name = "Argentina", size = 40134425))),
                              list(name = "Europe",  
                                   children = list(
                                     list(name = "Germany", size = 81757600),
                                     list(name = "France", size = 65447374),
                                     list(name = "United Kingdom", size = 62041708))),
                              list(name = "Africa",  
                                   children = list(
                                     list(name = "Nigeria", size = 154729000),
                                     list(name = "Ethiopia", size = 79221000),
                                     list(name = "Egypt", size = 77979000))),
                              list(name = "Asia",  
                                   children = list(
                                     list(name = "China", size = 1336335000),
                                     list(name = "India", size = 1178225000),
                                     list(name = "Indonesia", size = 231369500)))
                            )
  )
  
  output$cloud <- wordcloud2::renderWordcloud2(wordcloud2(demoFreq,
                                                          minRotation = -pi/6, 
                                                          maxRotation = -pi/6, 
                                                          minSize = 10,
                                                          rotateRatio = 1))
  
  output$circles <- circlepackeR::renderCirclepackeR(circlepackeR(hierarchical_list))
  
  observeEvent(input$histbox$maximized, {
    if(input$histbox$maximized){
      # runjs('document.getElementById("histbox").style.setProperty("background-color", "green", "important");')
      runjs('var plot1 = document.querySelector("#plot1 > img")
            plot1.style.setProperty("height", "90vh", "important");
            plot1.style.setProperty("width", "100%", "important");')
    } else {
      runjs('var plot1 = document.querySelector("#plot1 > img")
            plot1.style.setProperty("height", "400px", "important");
            plot1.style.setProperty("width", "100%", "important");')
    }
  })
  
  observeEvent(input$plotlybox$maximized, {
    if(input$plotlybox$maximized){
      # runjs('document.getElementById("plotlybox").style.setProperty("background-color", "red", "important");')
      runjs('var plotlyplot = document.querySelector("#plotlyplot");
            plotlyplot.style.setProperty("height", "90vh", "important");
            plotlyplot.style.setProperty("width", "100%", "important");')
    } else {
      runjs('var plotlyplot = document.querySelector("#plotlyplot");
            plotlyplot.style.setProperty("height", "400px", "important");
            plotlyplot.style.setProperty("width", "100%", "important");')
    }
  })
  

# not working -------------------------------------------------------------

  # observeEvent(input$circlebox$maximized, {
  #   if(input$circlebox$maximized){
  #     runjs('document.querySelector("#circles").style.setProperty("height", "90vh", "important");
  #           document.querySelector("#circles").style.setProperty("width", "100%", "important");')
  #   } else {
  #     runjs('document.querySelector("#circles").style.setProperty("height", "400px", "important");
  #           document.querySelector("#circles").style.setProperty("width", "100%", "important");')
  #   }
  # })
  # 
  # observeEvent(input$wordlcoudbox$maximized, {
  #   if(input$wordlcoudbox$maximized){
  #     runjs('document.querySelector("#cloud").style.setProperty("height", "90vh", "important");
  #           document.querySelector("#cloud").style.setProperty("width", "100%", "important");')
  #   } else {
  #     runjs('document.querySelector("#cloud").style.setProperty("height", "400px", "important");
  #           document.querySelector("#cloud").style.setProperty("width", "100%", "important");')
  #   }
  # })
  
}

shinyApp(ui, server)

From my side, none of the graph in @ismirsehregal answer actually resizes, even after maximising twice or more. — yeahman269, Sep 23 '22 at 12:46
@yeahman269 I added a gif of the result on my system. However, it might be a timing issue on your setup as David Granjon uses `setTimeout` in his solution. For future readers [here](https://stackoverflow.com/questions/72742583/scalability-of-plots-within-bs4dashbox-when-maximizable-true-in-r-shiny/73829748#73829748) you can find @yeahman269's related question. — ismirsehregal, Sep 26 '22 at 07:55

Maximizing plots in R Shiny bs4Dash

2 Answers2

Linked