How to copy tableOutput to clipboard? - r

Question

I'm trying to copy the table output to the clipboard on a click of a button. I tried looking into the rclipboard package, but it doesn't appear to be able to copy output, in my limited understanding.
I added an actionButton with an icon to the screenshot to show what I'm trying to achieve. Right now the button doesn't do anything.
Code:
library(shiny)
library(dplyr)
df <- mtcars
one <- function(.data, var, na = TRUE) {
return({
.data %>%
group_by(.data[[var]]) %>%
filter(!is.na(.data[[var]])) %>%
tally() %>%
mutate(`%` = 100*n/sum(n))
})
}
ui <- fluidPage(
selectInput("var", label = "Select Variable", choices = c("", names(df))),
tableOutput("value")
)
server <- function(input, output) {
output$value <- renderTable({
if(input$var != '') {
data <- df %>% one(input$var, na = input$check)
return(data)
}
}, spacing = "xs", bordered = TRUE)
}
shinyApp(ui, server)

Answer 1

Perhaps you can use copy button from DT to copy the whole table. You can also copy only selected rows. Try this
library(shiny)
library(dplyr)
library(DT)
df <- mtcars
one <- function(.data, var, na = TRUE) {
return({
.data %>%
group_by(.data[[var]]) %>%
filter(!is.na(.data[[var]])) %>%
tally() %>%
mutate(`%` = 100*n/sum(n))
})
}
ui <- fluidPage(
selectInput("var", label = "Select Variable", choices = c("", names(df))),
DTOutput("valu", width = "15%")
#tableOutput("value")
)
server <- function(input, output) {
output$valu <- renderDT({
if(input$var != '') {
data <- df %>% one(input$var, na = input$check)
DT::datatable(data,
class = 'cell-border stripe',
rownames = FALSE,
extensions = c("Buttons", "Select"),
selection = 'none',
options =
list(
select = TRUE,
dom = "Bt", ## remove f to remove search ## Brftip
buttons = list(
list(
extend = "copy",
text = 'Copy'#,
#exportOptions = list(modifier = list(selected = TRUE))
)
)
)) %>% formatStyle(
0,
target = "row",
fontWeight = styleEqual(1, "bold")
)
}
}, server = FALSE)
output$value <- renderTable({
if(input$var != '') {
data <- df %>% one(input$var, na = input$check)
return(data)
}
}, spacing = "xs", bordered = TRUE)
}
shinyApp(ui, server)