Shiny & plotly: re-use a plot in a larger modal window & control font sizes

Question

I faced a specific challenge and have come up with a solution. I am uncertain if this is an elegant solution though. Asking for improvements.

Challenge

I am developing a shiny app using shinydashboard with a page with multiple boxes. Each box may contain a plolty plot or a DT table. I am providing an actionButton in the footer of each box which allows a modalDialog to be opened, displaying a larger version of the plot.

I found an old comment from Joe Cheng here showing a way to link the same renderPlot call to two output objects. That works as long as I call one object in my UI file and the other in the modalDialog function.

However, I wanted to control the various font sizes in the plotly plot: in the zoomed plot, rendered in a large modalDialog, I want to use larger fonts compared to the 'normal' rendering of the plot. I did not want to venture into javascript solutions either.

One can force oneself through this by duplicating the renderPlotly functions with different font sizes. But I wanted to reuse the existing renderPlotly functions; in my case that function was rather lengthy.

Solution

• Create a function, I called it renderDynamic which takes a list of font sizes as an argument
• The function returns a renderPlotly object

Using iris as a dataset:

renderDynamic <- function(pars = list(tick_font_size = 14, title_font_size = 18)) {   
  tick_font_size <- pars[[1]]
  title_font_size <- pars[[2]]

  return(
   renderPlotly({
     plot <- plot_ly(data = iris, x = ~Sepal.Length, y = ~Sepal.Width, 
                                type = 'scatter', mode = 'markers', 
                                color = ~Species, 
                                marker = list(size = 10, opacity = 0.7))) %>%
       layout(
         xaxis = list(
           tickfont = list(size = tick_font_size),
           titlefont = list(size = title_font_size)),
         yaxis = list(
           tickfont = list(size = tick_font_size),
           titlefont = list(size = title_font_size))
     plot
    })
   )
})

output$plot_normal <- renderDynamic(pars = list(tick_font_size = 15, title_font_size = 18, slider_font_size = 15))
output$plot_zoom <- renderDynamic(pars = list(tick_font_size = 22, title_font_size = 22, slider_font_size = 18))

Thoughts?

Answer 1

We can modify an existing plotly object without re-rendering via plotlyProxy(). In this case we'll need to call relayout - which is faster than re-rendering the entire widget:

library(shiny)
library(plotly)

ui <- fluidPage(column(4, plotlyOutput("plot_normal")),
                actionButton("zoom", "zoom"))

server <- function(input, output, session) {
  # render plot once for both outputs
  output$plot_zoom <- output$plot_normal <- renderPlotly({
    plot <- plot_ly(
      data = iris,
      x = ~ Sepal.Length,
      y = ~ Sepal.Width,
      type = 'scatter',
      mode = 'markers',
      color = ~ Species,
      marker = list(size = 10, opacity = 0.7)
    ) %>% layout(
      xaxis = list(
        tickfont = list(size = 15),
        titlefont = list(size = 18)
      ),
      yaxis = list(
        tickfont = list(size = 15),
        titlefont = list(size = 18)
      )
    )
  })
  
  zoom_proxy <- plotlyProxy("plot_zoom", session)
  
  outputOptions(output, "plot_zoom", suspendWhenHidden = FALSE)
  
  observeEvent(input$zoom, {
    showModal(modalDialog(plotlyOutput("plot_zoom", height = "75vh"), size = "l", easyClose = TRUE))
    # modify plot shown in modalDialog
    plotlyProxyInvoke(zoom_proxy, "relayout", list(
      xaxis = list(
        tickfont = list(size = 22),
        titlefont = list(size = 22)
      ),
      yaxis = list(
        tickfont = list(size = 22),
        titlefont = list(size = 22)
      )
    ))
  })
}

shinyApp(ui, server)

On a side note: are you aware of bslib::card() or bs4Dash::box()? Both are expandable - However, I'm not sure if they can be used along with {shinydashboard}.

PS: There is a equivalent function available in library(DT) called dataTableProxy().

---

Edit: a modularized version of the above approach:

library(shiny)
library(plotly)

# plots could be generated in the server() function and wrapped in reactive({}) if needed
plot1 <- plot_ly(
  data = iris,
  x = ~ Sepal.Length,
  y = ~ Sepal.Width,
  type = 'scatter',
  mode = 'markers',
  color = ~ Species,
  marker = list(size = 10, opacity = 0.7)
) %>% layout(
  xaxis = list(
    tickfont = list(size = 15),
    titlefont = list(size = 18)
  ),
  yaxis = list(
    tickfont = list(size = 15),
    titlefont = list(size = 18)
  )
)

plot2 <- plot_ly(x = 1:10, y = 1:10, type = "scatter", mode = "lines")

plotUI <- function(id) {
  tagList(
    column(5, plotlyOutput(NS(id, "plot_normal"))),
    column(1, actionButton(NS(id, "zoom"), "zoom"))
  )
}

plotServer <- function(id, plotly_object) {
  moduleServer(id, function(input, output, session) {
    # render plot once for both outputs
    output$plot_zoom <- output$plot_normal <- renderPlotly({
      plotly_object
    })
    
    outputOptions(output, "plot_zoom", suspendWhenHidden = FALSE)
    
    zoom_proxy <- plotlyProxy("plot_zoom", session)
    
    observeEvent(input$zoom, {
      showModal(modalDialog(plotlyOutput(NS(id, "plot_zoom"), height = "75vh"), size = "l", easyClose = TRUE))
      # modify plot shown in modalDialog
      plotlyProxyInvoke(zoom_proxy, "relayout", list(
        xaxis = list(
          tickfont = list(size = 22),
          titlefont = list(size = 22)
        ),
        yaxis = list(
          tickfont = list(size = 22),
          titlefont = list(size = 22)
        )
      ))
    })
  })
}

plotApp <- function() {
  ui <- fluidPage(
    plotUI("my1stplot"),
    plotUI("my2ndplot")
  )
  server <- function(input, output, session) {
    plotServer(id = "my1stplot", plotly_object = plot1)
    plotServer(id = "my2ndplot", plotly_object = plot2)
  }
  shinyApp(ui, server)  
}

plotApp()