如何创建自定义 JS 函数以将图像复制到 R Shiny 中的剪贴板答案

【问题标题】：How can I create a custom JS function to copy plotly image to clipboard in R shiny如何创建自定义 JS 函数以将图像复制到 R Shiny 中的剪贴板
【发布时间】：2021-02-19 14:20:05
【问题描述】：

我想在绘图图表上实现一个按钮，它将绘图复制到用户的剪贴板，类似于快照按钮如何将绘图的 png 作为文件下载。

我引用了this documentation 来创建自定义模式栏按钮，但我对 Javascript 不够熟悉，不知道如何编写 sn-p（或者如果可能的话）。

下面是我写的R代码试一下，但是不行。确实会出现一个按钮（虽然图像不可见，但如果我将鼠标悬停在右上角，我可以告诉它）。但是当我单击它时，绘图不会复制到剪贴板，并且 chrome 控制台会显示：

未捕获的类型错误：Plotly.execCommand 不是函数在 Object.eval [as click] (eval at tryEval ((index):258), :2:15) 在 HTMLAnchorElement。 (:7:2055670)

图：

我的代码：

library(plotly)
library(shiny)

d <- data.frame(xaxis = c(1,2,3,4,5), 
                ydata = c(10,40,60,30,25))

p <- plot_ly() %>%
  add_trace(data = d,
            x = ~xaxis,
            y = ~ydata,
            type = "scatter", mode = "lines")

plotClip <- list(
  name = "plotClip",
  icon = list(
    path = "plotClip.svg",
    transform = 'matrix(1 0 0 1 -2 -2) scale(0.7)'
  ),
  click = htmlwidgets::JS(
    'function(gd) {
       Plotly.execCommand("copy");
       alert("Copied the plot");
    }'
  )
)

p <- p %>%
  config(modeBarButtonsToAdd = list(plotClip),
         displaylogo = FALSE,
         toImageButtonOptions= list(filename = "plot.png",
                                    format = "png",
                                    width = 800, height = 400))

ui <- fluidPage(
      plotlyOutput(outputId = "myplot")
)

server <- function(input, output) {
  output$myplot <- renderPlotly({
    p
  })
}

shinyApp(ui, server)

感谢您对此的任何见解！

【问题讨论】：

标签： javascript r shiny plotly r-plotly

【解决方案1】：

我以 Joe 的回答为基础解决了他的解决方案的局限性

使用 Plotly.toImage 而不是 Plotly.Snapshot.toImage 使用户能够通过 toImageButtonOptions 选择复制的绘图大小或默认为闪亮应用中显示的任何大小。
添加了 svg 复制图标

限制：

仅适用于 localhost 或 shinyapps.io 或 shiny server pro，因为所有浏览器都会阻止剪贴板访问，除非网站使用 HTTPS 或 localhost

library(tidyverse)
library(plotly)

# only works in shinyapps.io or localhost due to all browsers only allowing clipboard access over HTTPS or localhost
plotly_add_copy_button <- function(pl) {
  
  # can also be htmlwidgets::JS("Plotly.Icons.disk")
  # download svg from eg https://uxwing.com/files-icon/
  icon_copy_svg <- list(
    path = str_c(
      "M102.17,29.66A3,3,0,0,0,100,26.79L73.62,1.1A3,3,0,0,0,71.31,0h-46a5.36,5.36,0,0,0-5.36,5.36V20.41H5.36A5.36,5.36,0,0,0,0,25.77v91.75a5.36,",
      "5.36,0,0,0,5.36,5.36H76.9a5.36,5.36,0,0,0,5.33-5.36v-15H96.82a5.36,5.36,0,0,0,5.33-5.36q0-33.73,0-67.45ZM25.91,20.41V6h42.4V30.24a3,3,0,0,0,",
      "3,3H96.18q0,31.62,0,63.24h-14l0-46.42a3,3,0,0,0-2.17-2.87L53.69,21.51a2.93,2.93,0,0,0-2.3-1.1ZM54.37,30.89,72.28,47.67H54.37V30.89ZM6,116.89V26.",
      "37h42.4V50.65a3,3,0,0,0,3,3H76.26q0,31.64,0,63.24ZM17.33,69.68a2.12,2.12,0,0,1,1.59-.74H54.07a2.14,2.14,0,0,1,1.6.73,2.54,2.54,0,0,1,.63,1.7,2.",
      "57,2.57,0,0,1-.64,1.7,2.16,2.16,0,0,1-1.59.74H18.92a2.15,2.15,0,0,1-1.6-.73,2.59,2.59,0,0,1,0-3.4Zm0,28.94a2.1,2.1,0,0,1,1.58-.74H63.87a2.12,2.12,",
      "0,0,1,1.59.74,2.57,2.57,0,0,1,.64,1.7,2.54,2.54,0,0,1-.63,1.7,2.14,2.14,0,0,1-1.6.73H18.94a2.13,2.13,0,0,1-1.59-.73,2.56,2.56,0,0,1,0-3.4ZM63.87,83.",
      "41a2.12,2.12,0,0,1,1.59.74,2.59,2.59,0,0,1,0,3.4,2.13,2.13,0,0,1-1.6.72H18.94a2.12,2.12,0,0,1-1.59-.72,2.55,2.55,0,0,1-.64-1.71,2.5,2.5,0,0,1,.65",
      "-1.69,2.1,2.1,0,0,1,1.58-.74ZM17.33,55.2a2.15,2.15,0,0,1,1.59-.73H39.71a2.13,2.13,0,0,1,1.6.72,2.61,2.61,0,0,1,0,3.41,2.15,2.15,0,0,1-1.59.73H18.92a2.",
      "14,2.14,0,0,1-1.6-.72,2.61,2.61,0,0,1,0-3.41Zm0-14.47A2.13,2.13,0,0,1,18.94,40H30.37a2.12,2.12,0,0,1,1.59.72,2.61,2.61,0,0,1,0,3.41,2.13,2.13,0,0,1-1.58.",
      "73H18.94a2.16,2.16,0,0,1-1.59-.72,2.57,2.57,0,0,1-.64-1.71,2.54,2.54,0,0,1,.65-1.7ZM74.3,10.48,92.21,27.26H74.3V10.48Z"
    ),
    transform = 'scale(0.12)'
  )
  
  plotly_copy_button <- list(
    name = "Copy to Clipboard",
    icon = icon_copy_svg,
    click = htmlwidgets::JS('function(gd) {copyPlot(gd)}') # JS function defined by us and added in ui.R
  )
  
  pl <- pl %>%
    config(
      modeBarButtonsToAdd = list(plotly_copy_button),
      displaylogo = FALSE,
      toImageButtonOptions= list(format = "png", width = NULL, height = NULL)
    )
  
  pl
}


# based on https://stackoverflow.com/questions/64721568/how-can-i-create-a-custom-js-function-to-copy-plotly-image-to-clipboard-in-r-shi
# stackoverlow used Plotly.Snapshot.toImage, but need to use Plotly.toImage to control height width: https://github.com/plotly/plotly.js/issues/83
# see https://github.com/plotly/plotly.js/blob/master/src/plot_api/to_image.js for optional arguments
# this JS function needs to be added to ui.R
copy_plot_js <- 'function copyPlot(gd) {
  var toImageButtonOptions = gd._context.toImageButtonOptions;
  var opts = {
    format: toImageButtonOptions.format || "png",
    width: toImageButtonOptions.width || null,
    height: toImageButtonOptions.height || null
  };
  Plotly.toImage(gd, opts).then(async function(url) {
    try {
      const data = await fetch(url);
      const blob = await data.blob();
      await navigator.clipboard.write([
        new ClipboardItem({
          [blob.type]: blob
        })
      ]);
      console.log("Image copied.");
    } catch (err) {
      console.error(err.name, err.message);
    }
  });
  alert("Copied the plot");
}'

【讨论】：

【解决方案2】：

对于专门在工具栏/模式栏中寻找如何执行此操作的任何人，我从下面修改了 Stephane Laurent 的答案以使其正常工作。

但是，仍然存在的问题是：

最初单击按钮会将图表复制到剪贴板，但大小与屏幕上最初显示的不同。如果您完全更改图表，即使只是更改浏览器窗口大小，然后再次单击按钮，复制的图表看起来与浏览器中的完全一样（理想行为）。
设置{format: "png", height: 400, width: 800} 似乎没有明确定义复制图表的大小。
尽管文件与应用位于同一目录中，但按钮上未显示图标。

完整代码：

library(plotly)
library(shiny)

d <- data.frame(xaxis = c(1,2,3,4,5), 
                ydata = c(10,40,60,30,25))

p <- plot_ly() %>%
  add_trace(data = d,
            x = ~xaxis,
            y = ~ydata,
            type = "scatter", mode = "lines")

plotClip <- list(
  name = "plotClip",
  icon = list(
    path = "plotClip.svg",
    transform = 'matrix(1 0 0 1 -2 -2) scale(0.7)'
  ),
  click = htmlwidgets::JS(
    'function(gd) {
       Plotly.Snapshot.toImage(gd, {format: "png"}).once("success", function(url) {
            copyImage(url);
          });
       alert("Copied the plot");
    }'
  )
)

p <- p %>%
  config(modeBarButtonsToAdd = list(plotClip),
         displaylogo = FALSE,
         toImageButtonOptions= list(filename = "plot.png",
                                    format = "png",
                                    width = 800, height = 400))

copyImgTag <- tags$script(
  'async function copyImage(url) {
          try {
            const data = await fetch(url);
            const blob = await data.blob();
            await navigator.clipboard.write([
              new ClipboardItem({
                [blob.type]: blob
              })
            ]);
            console.log("Image copied.");
          } catch (err) {
            console.error(err.name, err.message);
          } 
        }'
)

ui <- tagList(
  fluidPage(
    plotlyOutput(outputId = "myplot")
    ), 
  copyImgTag
)

server <- function(input, output) {
  output$myplot <- renderPlotly({
    p
  })
}

shinyApp(ui, server)

【讨论】：

【解决方案3】：

我不知道如何处理工具栏，但这里是如何通过单击按钮将图像复制到剪贴板：

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 = 'Copy Plotly to clipboard',
  sidebarLayout(
    
    sidebarPanel(
      helpText(),
      actionButton('copy', "Copy")
    ),
    
    mainPanel(
      plotlyOutput('regPlot'),
      tags$script('
        async function copyImage(url) {
          try {
            const data = await fetch(url);
            const blob = await data.blob();
            await navigator.clipboard.write([
              new ClipboardItem({
                [blob.type]: blob
              })
            ]);
            console.log("Image copied.");
          } catch (err) {
            console.error(err.name, err.message);
          } 
        }
        document.getElementById("copy").onclick = function() {
          var gd = document.getElementById("regPlot");
          Plotly.Snapshot.toImage(gd, {format: "png"}).once("success", function(url) {
            copyImage(url);
          });
        }')
    )
  )
)

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

shinyApp(ui = ui, server = server)

【讨论】：

这很棒。我不得不使用 NS() 对其进行一些修改，因为我执行此操作的过程在 Shiny 模块中。我还必须确保这个标签脚本出现在适当的时间......即，在图表生成之后。有没有办法明确定义图像的大小？我尝试使用 {format: "png", height: 400, width: 800} 但它没有用。我的问题是，在我的应用程序中第一次使用按钮会产生一个奇怪大小的图表，但是如果我以任何方式修改图表并重新尝试按钮，它看起来还可以（即显示的大小） - 真的只是第一次使用很奇怪。