如何将图表复制到剪贴板以便粘贴?

3
在运行下面这段可复现的代码时,用户可以通过单击呈现的Shiny屏幕顶部的单选按钮来选择查看实际数据或数据图表(默认为数据)。在呈现的屏幕底部,您会看到一个“复制”按钮。通过选择“数据”,然后选择“复制”,您可以轻松地将数据粘贴到XLS中。
然而,如果用户选择查看图表,我希望用户也能以同样的方式复制/粘贴图表。如何做到这一点?
我尝试在以下的observeEvent(...)函数中插入plotPNG(...) (以及各种迭代),使用由条件触发的条件语句,如果input$view =='Plot',但是还没有成功。
library(shiny)
library(ggplot2)

ui <- fluidPage(
   radioButtons("view",
                label = "View data or plot",
                choiceNames = c('Data','Plot'),
                choiceValues = c('Data','Plot'),
                selected = 'Data',
                inline = TRUE
                ),
   conditionalPanel("input.view == 'Data'",tableOutput("DF")),
   conditionalPanel("input.view == 'Plot'",plotOutput("plotDF")),
   actionButton("copy","Copy",style = "width:20%;")
)
  
server <- function(input, output, session) {
  
  data <- data.frame(Period = c(1,2,3,4,5,6),Value = c(10,20,15,40,35,30))

  output$DF <- renderTable(data)
  output$plotDF <- renderPlot(ggplot(data, aes(Period,Value)) + geom_line())

  observeEvent(
    req(input$copy),
    writeLines(
      capture.output(
        write.table(
          x = data,
          sep = "\t",
          row.names = FALSE
          )
        ),
      "clipboard")
    )
 
}

shinyApp(ui, server)

您可以将您的图表嵌入到 ggplotly() 中,它会显示一个相机图标以复制该图表(并添加良好的交互性)。 - HubertL
你也可以使用 DT 代替基础表格。它有一个内置的复制按钮(以及许多其他交互功能)。 - HubertL
2个回答

2

在 Edge 浏览器上测试通过。

library(shiny)
library(ggplot2)

js <- '
async function getImageBlobFromUrl(url) {
  const fetchedImageData = await fetch(url);
  const blob = await fetchedImageData.blob();
  return blob;
}
$(document).ready(function () {
  $("#copybtn").on("click", async () => {
    const src = $("#plotDF>img").attr("src");
    try {
      const blob = await getImageBlobFromUrl(src);
      await navigator.clipboard.write([
        new ClipboardItem({
          [blob.type]: blob
        })
      ]);
      alert("Image copied to clipboard!");
    } catch (err) {
      console.error(err.name, err.message);
      alert("There was an error while copying image to clipboard :/");
    }
  });
});
'

ui <- fluidPage(
  tags$head(
    tags$script(HTML(js))
  ),
  br(),
  actionButton("copybtn", "Copy", icon = icon("copy"), class = "btn-primary"),
  br(),
  plotOutput("plotDF")
)

server <- function(input, output, session){
  
  output[["plotDF"]] <- renderPlot({
    ggplot(
      iris, aes(x = Sepal.Length, y = Sepal.Width)
    ) + geom_point()
  })
  
}

shinyApp(ui, server)

enter image description here


编辑

警报不太好。我建议使用shinyToastify代替。

library(shiny)
library(shinyToastify)
library(ggplot2)

js <- '
async function getImageBlobFromUrl(url) {
  const fetchedImageData = await fetch(url);
  const blob = await fetchedImageData.blob();
  return blob;
}
$(document).ready(function () {
  $("#copybtn").on("click", async () => {
    const src = $("#plotDF>img").attr("src");
    try {
      const blob = await getImageBlobFromUrl(src);
      await navigator.clipboard.write([
        new ClipboardItem({
          [blob.type]: blob
        })
      ]);
      Shiny.setInputValue("success", true, {priority: "event"});
    } catch (err) {
      console.error(err.name, err.message);
      Shiny.setInputValue("failure", true, {priority: "event"});
    }
  });
});
'

ui <- fluidPage(
  tags$head(
    tags$script(HTML(js))
  ),
  useShinyToastify(),
  br(),
  actionButton("copybtn", "Copy", icon = icon("copy"), class = "btn-primary"),
  br(),
  plotOutput("plotDF")
)

server <- function(input, output, session){
  
  output[["plotDF"]] <- renderPlot({
    ggplot(
      iris, aes(x = Sepal.Length, y = Sepal.Width)
    ) + geom_point()
  })
  
  observeEvent(input[["success"]], {
    showToast(
      session,
      input,
      text = tags$span(
        style = "color: white; font-size: 20px;", "Image copied!"
      ),
      type = "success",
      position = "top-center",
      autoClose = 3000,
      pauseOnFocusLoss = FALSE,
      draggable = FALSE,
      style = list(
        border = "4px solid crimson",
        boxShadow = "rgba(0, 0, 0, 0.56) 0px 22px 30px 4px"
      )
    )
  })

  observeEvent(input[["failure"]], {
    showToast(
      session,
      input,
      text = tags$span(
        style = "color: white; font-size: 20px;", "Failed to copy image!"
      ),
      type = "error",
      position = "top-center",
      autoClose = 3000,
      pauseOnFocusLoss = FALSE,
      draggable = FALSE,
      style = list(
        border = "4px solid crimson",
        boxShadow = "rgba(0, 0, 0, 0.56) 0px 22px 30px 4px"
      )
    )
  })
  
}

shinyApp(ui, server)

enter image description here


当我运行它时,它无法复制。无论是使用原始代码还是使用 shinyToastify 软件包编辑后的代码都无法运行。我尝试添加 htmlTable、htmltools、htmlwidgets 和 shinyjs 库,但它们都无法使其工作。可能还需要其他 library() 吗? - Curious Jorge - user9788072
@CuriousJorge-user9788072 你使用的是哪个浏览器?你是否使用相同的ids(copybtn和plotDF)? - Stéphane Laurent
我的默认浏览器是Edge。我刚刚运行了你编辑过的代码,如果我选择“在浏览器中打开”,它可以正常工作。否则我会收到“复制失败”的通知。 - Curious Jorge - user9788072
@CuriousJorge-user9788072 哦,是的,在RStudio浏览器中可能不起作用。 - Stéphane Laurent
@Stéphane Laurent。你改过的带有shinyToastify代码在Edge中没有问题,但在Firefox中却无法正常工作,可能的原因是什么?所有浏览器都是最新的。 - TarJae

1
您可以尝试使用“shinyscreenshot”进行屏幕截图:您可以进一步调整它,详情请见https://daattali.com/shiny/shinyscreenshot-demo/
以下是一个示例:
library(shiny)
library(ggplot2)
library(shinyscreenshot)


ui <- fluidPage(
  radioButtons("view",
               label = "View data or plot",
               choiceNames = c('Data','Plot'),
               choiceValues = c('Data','Plot'),
               selected = 'Data',
               inline = TRUE
  ),
  div(
    id = "takemyscreenshot",
  conditionalPanel("input.view == 'Data'",tableOutput("DF")),
  conditionalPanel("input.view == 'Plot'",plotOutput("plotDF")),
  actionButton("go","Go",style = "width:20%;")
  )
)

server <- function(input, output, session) {
  
  observeEvent(input$go, {
    screenshot(id = "takemyscreenshot")
  })
  
  data <- data.frame(Period = c(1,2,3,4,5,6),Value = c(10,20,15,40,35,30))
  
  output$DF <- renderTable(data)
  output$plotDF <- renderPlot(ggplot(data, aes(Period,Value)) + geom_line())
  
  observeEvent(
    req(input$copy),
    writeLines(
      capture.output(
        write.table(
          x = data,
          sep = "\t",
          row.names = FALSE
        )
      ),
      "clipboard")
  )
  
}

shinyApp(ui, server)

1
这对于下载很有效,我会使用它。然而它不会复制到剪贴板。 - Curious Jorge - user9788072

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接