Use bindCache() on renderPlot() with reactive height parameter

Question

I'm looking for an elegant solution to keep plots with variable height cached in memory. In my use case there are currently about 100 different plots, so I could simply pre-generate them and load at startup but I'll rather avoid that since (extra work and scales badly). I would also rather avoid having to load any external packages apart from shiny and ggplot2.

The problem is: When I use bindCache() on renderPlot() its plot_height() seems to be ignored.

library(shiny)
ui <- fluidPage(
  selectInput("x_var", "X:", c("cyl", "carb")),
  plotOutput("plot")
)
server <- function(input, output, session) {
  plot_height <- reactive(200 + 50 * length(unique(mtcars[[input$x_var]])))
  make_plot <- function(col) {
    groups <- factor(mtcars[[col]])
    boxplot(mtcars$mpg ~ groups, horizontal = TRUE)    
  }
  output$plot <- renderPlot(expr = make_plot(input$x_var), height = plot_height) #|> bindCache(input$x_var)
}
shinyApp(ui, server)

Answer 1

As mentioned by @MichaelDewar in the comments, when bindCache() is used with renderPlot(), the height and width passed to the original renderPlot() are ignored, from help(bindCache), section Caching with renderPlot():

When bindCache() is used with renderPlot(), the height and width passed to the original renderPlot() are ignored. They are superseded by sizePolicy argument passed to bindCache. [...] sizePolicy must be a function that takes a two-element numeric vector as input, representing the width and height [...]

As stated, we can pass a custom function to the sizePolicy parameter, which takes into account the plot_height reactive. For this to work please note, that we also have to pass height = 100% to the plotOutput otherwise the hight of the img-tag's parent div will be set to its default of 400 px:

library(shiny)

ui <- fluidPage(
  selectInput("x_var", "X:", c("cyl", "carb")),
  plotOutput("plot", width = "100%", height = "100%")
)

server <- function(input, output, session) {
  plot_height <- reactive(200 + 50 * length(unique(mtcars[[input$x_var]])))
  make_plot <- function(col) {
    groups <- factor(mtcars[[col]])
    boxplot(mtcars$mpg ~ groups, horizontal = TRUE)
  }
  output$plot <- renderPlot(
    expr = make_plot(input$x_var)
  ) |>
    bindCache(input$x_var, sizePolicy = function(x) {
      return(c(x[1L], plot_height()))
    })
}

shinyApp(ui, server)