javascript - 如何创建自定义 JS 函数以将 plotly 图像复制到 R shiny 中的剪贴板

Question

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

我引用了 this documentation创建自定义模式栏按钮，但我对 Javascript 不够熟悉，不知道如何编写该代码段(或者如果可能的话)。

下面是我写的 R 代码来尝试，但它不起作用。确实出现了一个按钮(虽然图像不可见，但如果我将鼠标悬停在最右上角，我可以告诉它那里)。但是当我点击它时， plotly 没有被复制到剪贴板并且 chrome 控制台显示:

Uncaught TypeError: Plotly.execCommand is not a functionat Object.eval [as click] (eval at tryEval ((index):258), :2:15)at 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)

感谢您对此的任何见解!

Answer 1

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

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)

---

编辑

我找到了如何处理工具栏。这甚至不需要 Shiny。

library(plotly)

asd <- data.frame(
  week = c(1, 2, 3), 
  a    = c(12, 41, 33), 
  b    = c(43, 21, 23), 
  c    = c(43, 65, 43), 
  d    = c(33, 45, 83)
)

js <- c(
  'function (gd) {',
  '  Plotly.Snapshot.toImage(gd, { format: "png" }).once(',
  '    "success",',
  '    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);',
  '      }',
  '    }',
  '  );',
  '}'
)

Copy_SVGpath <- "M97.67,20.81L97.67,20.81l0.01,0.02c3.7,0.01,7.04,1.51,9.46,3.93c2.4,2.41,3.9,5.74,3.9,9.42h0.02v0.02v75.28 v0.01h-0.02c-0.01,3.68-1.51,7.03-3.93,9.46c-2.41,2.4-5.74,3.9-9.42,3.9v0.02h-0.02H38.48h-0.01v-0.02 c-3.69-0.01-7.04-1.5-9.46-3.93c-2.4-2.41-3.9-5.74-3.91-9.42H25.1c0-25.96,0-49.34,0-75.3v-0.01h0.02 c0.01-3.69,1.52-7.04,3.94-9.46c2.41-2.4,5.73-3.9,9.42-3.91v-0.02h0.02C58.22,20.81,77.95,20.81,97.67,20.81L97.67,20.81z M0.02,75.38L0,13.39v-0.01h0.02c0.01-3.69,1.52-7.04,3.93-9.46c2.41-2.4,5.74-3.9,9.42-3.91V0h0.02h59.19 c7.69,0,8.9,9.96,0.01,10.16H13.4h-0.02v-0.02c-0.88,0-1.68,0.37-2.27,0.97c-0.59,0.58-0.96,1.4-0.96,2.27h0.02v0.01v3.17 c0,19.61,0,39.21,0,58.81C10.17,83.63,0.02,84.09,0.02,75.38L0.02,75.38z M100.91,109.49V34.2v-0.02h0.02 c0-0.87-0.37-1.68-0.97-2.27c-0.59-0.58-1.4-0.96-2.28-0.96v0.02h-0.01H38.48h-0.02v-0.02c-0.88,0-1.68,0.38-2.27,0.97 c-0.59,0.58-0.96,1.4-0.96,2.27h0.02v0.01v75.28v0.02h-0.02c0,0.88,0.38,1.68,0.97,2.27c0.59,0.59,1.4,0.96,2.27,0.96v-0.02h0.01 h59.19h0.02v0.02c0.87,0,1.68-0.38,2.27-0.97c0.59-0.58,0.96-1.4,0.96-2.27L100.91,109.49L100.91,109.49L100.91,109.49 L100.91,109.49z"

CopyImage <- list(
  name = "Copy",
  icon = list(
    path = Copy_SVGpath,
    width = 111,
    height = 123
  ),
  click = htmlwidgets::JS(js)
)

plot_ly(
  asd, x = ~week, y = ~`a`, name = "a", type = "scatter", mode = "lines"
) %>%
  add_trace(y = ~`b`, name = "b", mode = "lines") %>%
  layout(
    xaxis = list(title = "Week", showgrid = FALSE, rangemode = "normal"),
    yaxis = list(title = "", showgrid = FALSE, rangemode = "normal"),
    hovermode = "x unified"
  ) %>%
  config(modeBarButtonsToAdd = list(CopyImage))