代码之家 › 专栏 › 技术社区 › Mal_a

使用downloadHandler以绘图方式下载

r-plotly shiny r

2

Mal_a · 技术社区 · 7 年前

我在尝试使用时被卡住了 downloadHandler 下载绘图图像。我只是无法进一步了解如何从临时目录获取映像。。。

下面是一个示例代码:

library(shiny)
library(plotly)
library(rsvg)
library(ggplot2)

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(
      helpText(),
      downloadButton('download'),
      tags$script('
                  document.getElementById("download").onclick = function() {
                  var plotly_svg = Plotly.Snapshot.toSVG(
                  document.querySelectorAll(".plotly")[0]
                  );

                  Shiny.onInputChange("plotly_svg", plotly_svg);
                  };
                  ')
      ),
    mainPanel(
      plotlyOutput('regPlot'),
      plotlyOutput('regPlot2')
    )
      )
)

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

  output$regPlot <- renderPlotly({
    p <- plot_ly(d, x = d$X1, y = d$X2,mode = "markers")
    p
  })

  output$regPlot2 <- renderPlotly({
    p <- plot_ly(d, x = d$X1, y = d$X2,mode = "markers")
    p
  })

  observeEvent(input$plotly_svg, priority = 10, {
    png_gadget <- tempfile(fileext = ".png")
    png_gadget <- "out.png"
    print(png_gadget)
    rsvg_png(charToRaw(input$plotly_svg), png_gadget)
  })

  output$download <- 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()
    })
}

shinyApp(ui = ui, server = server)

此外,我不确定如何选择应下载哪些plotly图像。谢谢你的提示和帮助!

信息:

--&燃气轮机;我试过使用 webshot

--&燃气轮机;我没有使用可用的 plotly 用于下载的面板,因为它在使用IE时不起作用

2 回复 | 直到 7 年前

1

2

Stéphane Laurent 7 年前

OP编辑了他/她的帖子,添加了一项要求:

--&燃气轮机;我尝试过使用webshot,但是如果我以任何方式缩放或过滤绘图,不幸的是webshot并没有镜像它

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(
      helpText(),
      actionButton('download', "Download")
    ),

    mainPanel(
      plotlyOutput('regPlot'),
      plotlyOutput('regPlot2'),
      tags$script('
                  function download(url, filename, mimeType){
                    return (fetch(url)
                      .then(function(res){return res.arrayBuffer();})
                      .then(function(buf){return new File([buf], filename, {type:mimeType});})
                    );
                  }
                  document.getElementById("download").onclick = function() {
                  var gd = document.getElementById("regPlot");
                  Plotly.Snapshot.toImage(gd, {format: "png"}).once("success", function(url) {
                    download(url, "plot.png", "image/png")
                      .then(function(file){
                        var a = window.document.createElement("a");
                        a.href = window.URL.createObjectURL(new Blob([file], {type: "image/png"}));
                        a.download = "plot.png";
                        document.body.appendChild(a);
                        a.click();
                        document.body.removeChild(a);                      
                      });
                  });
                  }
                  ')
    )
  )
)

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

  regPlot <- reactive({
    plot_ly(d, x = d$X1, y = d$X2, mode = "markers")
  })
  output$regPlot <- renderPlotly({
    regPlot()
  })

  regPlot2 <- reactive({
    plot_ly(d, x = d$X1, y = d$X2, mode = "markers")
  })
  output$regPlot2 <- renderPlotly({
    regPlot2()
  })

}

shinyApp(ui = ui, server = server)

我是对的。有一种更短更干净的解决方案:

  tags$script('
              document.getElementById("download").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);                      
              });
              }
              ')

要选择要下载的绘图,可以执行以下操作:

  sidebarLayout(

    sidebarPanel(
      helpText(),
      selectInput("selectplot", "Select plot to download", choices=list("plot1","plot2")),
      actionButton('download', "Download")
    ),

    mainPanel(
      plotlyOutput('regPlot'),
      plotlyOutput('regPlot2'),
      tags$script('
                  document.getElementById("download").onclick = function() {
                  var plot = $("#selectplot").val();
                  if(plot == "plot1"){
                    var gd = document.getElementById("regPlot");
                  }else{
                    var gd = document.getElementById("regPlot2");
                  }
                  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);                      
                  });
                  }
                  ')
    )
  )

2

1

Stéphane Laurent 7 年前

1) 安装 webshot

phantom.js

library(webshot)
install_phantomjs()

看见 ?install_phantomjs

3) 现在您可以使用 export plotly 包裹:

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(
      helpText(),
      downloadButton('download')
    ),

    mainPanel(
      plotlyOutput('regPlot'),
      plotlyOutput('regPlot2')
    )
  )
)

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

  regPlot <- reactive({
    plot_ly(d, x = d$X1, y = d$X2, mode = "markers")
  })
  output$regPlot <- renderPlotly({
    regPlot()
  })

  regPlot2 <- reactive({
    plot_ly(d, x = d$X1, y = d$X2, mode = "markers")
  })
  output$regPlot2 <- renderPlotly({
    regPlot2()
  })

  output$download <- downloadHandler(
    filename = function(){
      paste0(paste0("test", Sys.Date()), ".png")
    },
    content = function(file) {
      export(regPlot(), file=file)
    })
}

shinyApp(ui = ui, server = server)

您可以保存到 svg ?export 谢谢你的解释。

3

0

ozturkib 6 年前

代替使用WebScript,你应该考虑尝试。 webshot2 my detailed answer 类似的情况。

# Webshot and phantomjs have been previously installed.
library(webshot2)