How to copy a plot into the clipboard for pasting? - r

Question

In running the below reproducible code, the user can select to view either the actual data or a plot of the data via a click of the radio button at the top of the rendered Shiny screen (as coded it defaults to data). At the bottom of the rendered screen you'll see a "Copy" button. By selecting "Data" and then "Copy", you can easily paste the data into XLS.
However, if the user instead selects to view the plot, I'd like the user to also be able to copy/paste the plot in the same manner. How can this be done?
I've tried inserting plotPNG(...) inside the capture.output(...) function (and various iterations thereof) in the below observeEvent(...), using conditionals triggered by a conditional if input$view == 'Plot', but with no luck yet.
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)

Answer 1

Tested on 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)
EDIT
Alerts are not nice. I suggest shinyToastify instead.
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)

Answer 2

You may try shinyscreenshot: You can further tweak it https://daattali.com/shiny/shinyscreenshot-demo/
Here is an example:
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)