R 闪亮：如何在数据表中包含“导出到 LaTeX”按钮？

Question

我有一个带有数据表的 Shiny 应用程序。我想在这个数据表的顶部（但在它的标题下面）实现一个按钮，这样当我点击它时，构建这个表所需的 LaTeX 代码就会被复制到剪贴板。

基本上，此按钮的工作方式与“复制”或“csv”按钮（参见here 第 2 部分）相同，但使用的是 LaTeX 代码。

这是一个可重现的例子：

library(DT)
library(shiny)
library(shinydashboard)
library(data.table)
library(stargazer)
library(clipr)

ui <- dashboardPage(
  dashboardHeader(title = "test with mtcars", titleWidth = 1000),
  dashboardSidebar(
    selectizeInput("var.cor", label = "Correlation",
                   choices = names(mtcars),
                   selected = c("mpg", "cyl"), 
                   multiple = TRUE)
  ),
  dashboardBody(
    tabsetPanel(
      tabPanel("test with mtcars",
               br(),
               box(dataTableOutput("cor"),
                   width = NULL),
               actionButton("copy.latex", label = "Copy to LaTeX")
      )
    )
  )
)

server <- function(input, output) {

  var.selected <- reactive({
    out <- input$var.cor
    out
  })

  user.selection <- reactive({
    mtcars <- mtcars[, var.selected()]
  })

  output$cor <- renderDataTable({
    dtable <- user.selection()
    tmp <- datatable(cor(dtable), 
                     extensions = 'Buttons',
                     options = list(
                       dom = 'Bfrtip',
                       buttons = list(
                         "copy",
                         list(
                           extend = "collection",
                           text = 'test',
                           action = DT::JS("function ( e, dt, node, config ) {
                                      Shiny.setInputValue('test', true, {priority: 'event'});
                                   }")
                         )
                       )
                     )
    )
    observeEvent(input$test, {
      write_clip(stargazer(tmp), 
                 object_type = "auto")  
    })
    tmp
  }) 

  observeEvent(input$copy.latex, {
    write_clip(stargazer(input$cor), 
               object_type = "character")
  })


}


shinyApp(ui, server)

我在这段代码中测试了两件事：

• 首先，我的灵感来自here。这是嵌套在renderDataTable 中的observeEvent 的代码。但是，剪贴板中的文本要么是% Error: Unrecognized object type，要么我有一个错误：Error in : Clipboard on X11 requires that the DISPLAY envvar be configured.

• 其次，我在数据表之外创建了一个按钮，但它不起作用，因为我有Error in : $ operator is invalid for atomic vectors

有人知道怎么做吗？

Answer 1

将数据框复制到服务器中的剪贴板：

library(shiny)
library(shinyjs)
library(DT)
table <- iris[1:10,]

ui <- fluidPage(
  useShinyjs(),
  actionButton("latex","Copy Latex to Clipboard"),
  DT::dataTableOutput("table")
)

server <- function(input, output, session) {
  output$table <- DT::renderDT(table)

  observeEvent(input$latex,{
    writeClipboard(paste0(capture.output(xtable(table))[-c(1:2)],collapse = "\n"))
    shinyjs::alert("table copied to latex")
  })
}
shinyApp(ui, server)

我不建议你使用 DT 的按钮。为了使用 DT 来完成，至少有 3 个步骤：

1. 通过在action 中编写Javascript 来读取datatable 的UI 中的整个表格，使用Shiny.setInputValue 将值从UI 发送到服务器。
2. 使用 R 将 list(json) 解析成数据框。
3. 将数据帧转换为乳胶字符串。

使用数据表的源数据进行转换要容易得多。