Извлечь все сюжеты событий клика из Shiny, Plotly - R

Question

В следующем приложении shiny пакет plotly используется для создания интерактивной корреляционной тепловой карты.Когда щелкают отдельные плитки, появляется соответствующая диаграмма разброса.Затем можно загрузить отдельные скаттеры, нажав download plot as png.Но есть ли способ загрузить все возможные графики разброса сразу, не нажимая на каждый отдельный тайл и сохраняя каждый отдельный?Спасибо

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

Вы можете использовать webshot для захвата статического изображения HTML-вывода Plotly, используя следующие инструкции: https://plot.ly/r/static-image-export/

Пример цикла ниже генерирует случайные диаграммы рассеяния из 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)
}

Однако, если вы собираетесь делать это десятки раз, объем вычислений, необходимых для выполнения следующих шагов, действительно складывается.

1. Генерация JSON plotly объект из R
2. Используйте htmlwidgets / htmltools для создания автономной веб-страницы HTML
3. Визуализируйте этот HTML как браузер, который будет видеть его с внешней программой -webshot
4. Используйте webshot, чтобы визуализировать изображение этого HTML и сохранить его в формате PNG

Это не является отражением медленной plotly, ноЧтобы провести аналогию, это похоже на то, как если бы вы использовали самолет, чтобы проехать полмили - самолет доставит вас туда, но если вам нужно совершить эту поездку несколько раз, вам, вероятно, следует подумать об автомобиле.

Цикл plotly, приведенный выше, рендеринг занимает 27 секунд5 изображений PNG, но альтернативный метод, описанный ниже с использованием ggplot2, занимает 1,2 секунды.

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