使用javascript时从闪亮的应用程序中进行绘图下载时出错 [英] Error in plotly graph download from a shiny app when using javascript

问题描述

我有一个闪亮的应用程序，在其下方显示了图表或表格.我对表格不感兴趣，我的问题专门针对绘图部分.当我使用此 javascript解决方案在浏览器中打开应用程序时，我正在尝试下载图表.我不熟悉javascript，我想知道如何防止它在我第一次按下下载"按钮并仅下载根本没有下载的地块时下载此空文件.

I have the shiny app below which displays either a plot or a table. Im not interested in the table and my Q is exclusively about the plot section. I am trying to download the plot when I open the app in browser using this javascript solution. I am not familiar with javascript and I would like to know how to prevent this from downloading this empty file when I press the "Download" button for 1st time and download only my plot which is not downloaded at all.

library(shiny)
library(plotly)

d <- data.frame(X1 = rnorm(50,mean=50,sd=10), 
                X2 = rnorm(50,mean=5,sd=1.5), 
                Y = rnorm(50,mean=200,sd=25))

ui <-fluidPage(
  title = 'Download Plotly',
  sidebarLayout(

    sidebarPanel(
      selectInput("S","SELECT",choices = c("Table","Plot"),selected = "Plot"),
      uiOutput('down'),
      tags$script('
              document.getElementById("down").onclick = function() {
                  var gd = document.getElementById("regPlot");
                  Plotly.Snapshot.toImage(gd, {format: "png"}).once("success", function(url) {
                  var a = window.document.createElement("a");
                  a.href = url; 
                  a.type = "image/png";
                  a.download = "plot.png";
                  document.body.appendChild(a);
                  a.click();
                  document.body.removeChild(a);                      
                  });
                  }
                  ')
    ),

    mainPanel(
      uiOutput('regPlot')

    )
  )
)

server <- function(input, output, session) {

output$down<-renderUI({
  if(input$S=="Table"){

      output$downloadData <- downloadHandler(
        filename = function() {
          paste(input$filename, input$extension, sep = ".")
        },

        # This function writes data to a file given to it by the argument 'file'.
        content = function(file) {
          sep <- "txt"=","
          # Write to a file specified by the 'file' argument
          write.table(data.frame(mtcars), file, sep = sep,
                      row.names = FALSE)
        }

      )
      downloadButton("downloadData", "Download",class = "butt1")
  }
  else{
    output$downloadData <- downloadHandler(
      filename = function(){
        paste(paste("test",Sys.Date(),sep=""), ".png",sep="")},
      content = function(file) {
        temp_dir <- tempdir()
        tempImage <- file.path(temp_dir, 'out.png')
        file.copy('out.png', tempImage, overwrite = TRUE)
        png(file, width = 1200, height = 800, units = "px", pointsize = 12, bg = "white", res = NA)
        dev.off()
      })
    downloadButton("downloadData", "Download",class = "butt1")
  }
})  

output$regPlot<-renderUI({
  if(input$S=="Plot"){
    output$pl<-renderPlotly(
    plot_ly(d, x = d$X1, y = d$X2, mode = "markers"))
    plotlyOutput("pl")
  }
  else{
    output$tbl =  DT::renderDataTable(datatable(
      d
    ))
    dataTableOutput("tbl") 
  }
  })

}

shinyApp(ui = ui, server = server)

推荐答案

这是下载绘图的代码.代码很少出现问题，

Here is the code to download the plot. Few of the issues with the code,

在ui.R中定义下载按钮.并参考javascript代码中的下载按钮id.此外，regplot是uiOutput元素，而不是实际图形.在javascript代码中，该图由pl引用.

Define the download button in ui.R. And refer to the download buttons id in the javascript code. Also, regplot is the uiOutput element and not the actual plot. In the javascript code the plot is referenced by pl.

这是修复了问题的示例代码.如果您使用的是JavaScript代码，则不需要闪亮的下载处理程序.如下所示，您可以在其中简单地从操作按钮下载.

Here is a sample code with the issues fixed. You don't need a shiny download handler if you are using the javascript code. This is shown below, where you can simply download from an action button.

您可以以此为基础来下载数据表，方法是将actionButton替换为downloadButton并在服务器上添加相应的代码.

You can build on this to download the data table by replacing the actionButton with a downloadButton and adding the respective code on the server.

library(shiny)
library(plotly)
library(DT)

ui <-fluidPage(
  title = 'Download Plotly',
  sidebarLayout(

    sidebarPanel(
      selectInput("S","SELECT",choices = c("Table","Plot"),selected = "Plot"),
      actionButton("downloadData", "Download",class = "butt1"),
      tags$script('
                  document.getElementById("downloadData").onclick = function() {
                  var gd = document.getElementById("pl");
                  Plotly.Snapshot.toImage(gd, {format: "png"}).once("success", function(url) {
                  var a = window.document.createElement("a");
                  a.href = url; 
                  a.type = "image/png";
                  a.download = "plot.png";
                  document.body.appendChild(a);
                  a.click();
                  document.body.removeChild(a);                      
                  });
                  }
                  ')
      ),

    mainPanel(
      uiOutput('regPlot')

    )
      )
    )

server <- function(input, output, session) {

  d <- data.frame(X1 = rnorm(50,mean=50,sd=10), 
                  X2 = rnorm(50,mean=5,sd=1.5), 
                  Y = rnorm(50,mean=200,sd=25))

  output$regPlot<-renderUI({
    if(input$S=="Plot"){
      output$pl<-renderPlotly(
        plot_ly(d, x = d$X1, y = d$X2, mode = "markers"))
      plotlyOutput("pl")
    }
    else{
      output$tbl =  DT::renderDataTable(datatable(
        d
      ))
      dataTableOutput("tbl") 
    }
  })
}

shinyApp(ui = ui, server = server)

这篇关于使用javascript时从闪亮的应用程序中进行绘图下载时出错的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！