Extract all click event plots from Shiny, Plotly - R

Question

In the following shiny app, the plotly package is used to create an interactive correlation heat map. When individual tiles are clicked, the corresponding scatter plot appears. One can then download the individual scatters by clicking download plot as png . But is there a way to download all the possible scatter plots at once without having to click each individual tile and save each individual one? Thank you

library(plotly)
library(shiny)

# compute a correlation matrix
correlation <- round(cor(mtcars), 3)
nms <- names(mtcars)

ui <- fluidPage(
  mainPanel(
    plotlyOutput("heat"),
    plotlyOutput("scatterplot")
  ),
  verbatimTextOutput("selection")
)

server <- function(input, output, session) {
  output$heat <- renderPlotly({
    plot_ly(x = nms, y = nms, z = correlation, 
            key = correlation, type = "heatmap", source = "heatplot") %>%
      layout(xaxis = list(title = ""), 
             yaxis = list(title = ""))
  })

  output$selection <- renderPrint({
    s <- event_data("plotly_click")
    if (length(s) == 0) {
      "Click on a cell in the heatmap to display a scatterplot"
    } else {
      cat("You selected: \n\n")
      as.list(s)
    }
  })

  output$scatterplot <- renderPlotly({
    s <- event_data("plotly_click", source = "heatplot")
    if (length(s)) {
      vars <- c(s[["x"]], s[["y"]])
      d <- setNames(mtcars[vars], c("x", "y"))
      yhat <- fitted(lm(y ~ x, data = d))
      plot_ly(d, x = ~x) %>%
        add_markers(y = ~y) %>%
        add_lines(y = ~yhat) %>%
        layout(xaxis = list(title = s[["x"]]), 
               yaxis = list(title = s[["y"]]), 
               showlegend = FALSE)
    } else {
      plotly_empty()
    }
  })

}

shinyApp(ui, server)

Answer 1

You can use webshot to capture a static image of Plotly's HTML output using the instructions here: https://plot.ly/r/static-image-export/

An example for loop below generates random scatter plots from mtcars .

library(plotly)
library(webshot)

## You'll need to run the function the first time if you dont't have phantomjs installed
#webshot::install_phantomjs()
ColumnOptions <- colnames(mtcars)

for (i in seq_len(5)){
  xCol <- sample(ColumnOptions,1)
  yCol <- sample(ColumnOptions,1)
  ThisFileName <- paste0("Scatter_",xCol,"_vs_",yCol,".png")

  plot_ly(x = mtcars[[xCol]], y = mtcars[[yCol]], type = "scatter", mode = "markers") %>% 
    export(., file = ThisFileName)
}

However, if you're going to be potentially doing this dozens of times, the amount of computation required to go through the following steps really adds up.

1. Generate a JSON plotly object from R
2. Use htmlwidgets / htmltools to generate a self-contained HTML web page
3. Render that HTML as a browser would see it with an external program -- webshot
4. Use webshot to render an image of that HTML and save it as a PNG

This isn't really a reflection of plotly being slow, but to make an analogy it's kind've like using an airplane to travel half a mile -- the plane gets you there, but if you need to make that trip more than a few times you should probably consider a car.

The plotly loop above takes 27 seconds to render 5 PNG images, but the alternative method below using ggplot2 takes 1.2 seconds.

library(ggplot2)

ColumnOptions <- colnames(mtcars)

for (i in seq_len(5)){
  xCol <- sample(ColumnOptions,1)
  yCol <- sample(ColumnOptions,1)
  ThisFileName <- paste0("ggplot2_Scatter_",xCol,"_vs_",yCol,".png")

  ggplot() + 
    geom_point(aes(x = mtcars[[xCol]], y = mtcars[[yCol]])) +
    labs(x = xCol, y = yCol) -> ThisPlot 

  ggsave(plot = ThisPlot, filename = ThisFileName)
}