r - 如何将表输出复制到剪贴板？

Question

我试图通过单击按钮将表输出复制到剪贴板。我尝试查看 rclipboard 包，但以我有限的理解，它似乎无法复制输出。

我在屏幕截图中添加了一个带有图标的 actionButton 以显示我想要实现的目标。现在该按钮没有执行任何操作。

代码:

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

也许您可以使用DT中的复制按钮来复制整个表格。您还可以仅复制选定的行。试试这个

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)