时间戳

首页 > 解决方案 > R 闪亮：如何在数据表中包含“导出到 LaTeX”按钮？

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

问题描述

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

基本上，此按钮的工作方式与“复制”或“csv”按钮（参见此处的第 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)

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

有人知道怎么做吗？

标签： rshinylatex

解决方案

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

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. 通过在数据表的 UI 中编写 Javascript 来读取整个表action，用于Shiny.setInputValue将值从 UI 发送到服务器。
  2. 使用 R 将列表（json）解析为数据框。
  3. 将数据帧转换为乳胶字符串。

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

推荐阅读