简体   繁体   中英

Error in plotly graph download from a shiny app when using 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,

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 .

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.

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)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM