How to adjust plot size when the box is maximized

Question

How to adjust plot size when the box is maximized

lemuelemos opened this issue 3 years ago · comments

Lemuel de Lemos Romão commented 3 years ago

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?

David Granjon · Answer 1 · Thu Dec 03 2020 00:08:41 GMT+0800 (China Standard Time)

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.

Lemuel de Lemos Romão · Answer 2 · Thu Dec 03 2020 00:22:10 GMT+0800 (China Standard Time)

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?

David Granjon · Answer 3 · Thu Dec 03 2020 01:32:05 GMT+0800 (China Standard Time)

Inside dashboardBody for instance.

David Granjon · Answer 4 · Thu Dec 03 2020 01:34:43 GMT+0800 (China Standard Time)

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

Lemuel de Lemos Romão · Answer 5 · Thu Dec 03 2020 01:47:47 GMT+0800 (China Standard Time)

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?

David Granjon · Answer 6 · Thu Dec 03 2020 02:02:59 GMT+0800 (China Standard Time)

Could you provide me your code?

Lemuel de Lemos Romão · Answer 7 · Thu Dec 03 2020 02:04:59 GMT+0800 (China Standard Time)

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

David Granjon · Answer 8 · Thu Dec 03 2020 05:07:00 GMT+0800 (China Standard Time)

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

Lemuel de Lemos Romão · Answer 9 · Thu Dec 03 2020 06:31:56 GMT+0800 (China Standard Time)

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.

David Granjon · Answer 10 · Thu Dec 03 2020 15:55:50 GMT+0800 (China Standard Time)

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

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.

Lemuel de Lemos Romão · Answer 11 · Thu Dec 03 2020 20:19:44 GMT+0800 (China Standard Time)

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?

David Granjon · Answer 12 · Thu Dec 03 2020 21:32:43 GMT+0800 (China Standard Time)

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

  }
)

Lemuel de Lemos Romão · Answer 13 · Fri Dec 04 2020 05:45:00 GMT+0800 (China Standard Time)

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!!!

Jacob Bumgarner · Answer 14 · Wed Feb 22 2023 06:46:53 GMT+0800 (China Standard Time)

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 · Answer 15 · Wed Apr 19 2023 17:51:08 GMT+0800 (China Standard Time)

@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

Jacob Bumgarner · Answer 16 · Wed Apr 19 2023 22:29:21 GMT+0800 (China Standard Time)

@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 · Answer 17 · Thu Apr 20 2023 00:22:46 GMT+0800 (China Standard Time)

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

Jacob Bumgarner · Answer 18 · Thu Apr 20 2023 00:35:33 GMT+0800 (China Standard Time)

@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 · Answer 19 · Thu Apr 20 2023 00:42:40 GMT+0800 (China Standard Time)

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 · Answer 20 · Fri Apr 21 2023 23:21:41 GMT+0800 (China Standard Time)

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