CODEWITHSUNDEEP
rshinyadminltewordcloud2bs4dash
FreyGeospatial
FreyGeospatial

Reputation: 549

Maximizing plots in R Shiny bs4Dash

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)

Upvotes: 4

Views: 1016

Answers (2)

Jacob Bumgarner
Jacob Bumgarner

Reputation: 657

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)

Upvotes: 5

ismirsehregal
ismirsehregal

Reputation: 33417

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)

result

Upvotes: 2

Related Questions