R Shiny:如何在数据表中包含“导出到LaTeX”按钮?

时间:2019-08-30 20:34:52

标签: r shiny latex

我有一个带有数据表的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得到启发。这是observeEvent中嵌套的renderDataTable的代码。但是,剪贴板中的文本是% Error: Unrecognized object type,或者我有一个错误:Error in : Clipboard on X11 requires that the DISPLAY envvar be configured.

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

有人知道怎么做吗?

1 个答案:

答案 0 :(得分:2)

要将数据框复制到服务器中的剪贴板,请执行以下操作:

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将列表(json)解析为数据帧。
  3. 将数据帧转换为乳胶字符串。

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