有什么方法可以将我的 PDF 输出表转换为乳胶？

Question

我希望我的导出数据呈现良好。为此，我必须使用一些方法来自定义我的报告。

预期的结果是将我的 PDF 输出中的数据自定义为 LaTeX（甚至以一种好的方式）。有没有可能？

谢谢！

library(shiny)
library(DT)
library(base64enc)

ui <- fluidPage(
  tags$head(
    tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/pdfmake/0.1.53/pdfmake.min.js"),
    tags$script(src = "https://cdnjs.cloudflare.com/ajax/libs/pdfmake/0.1.53/vfs_fonts.js")
  ),
  br(),
  DTOutput("dtable")
)

server <- function(input, output, session){
  
  output[["dtable"]] <- renderDT({
    datatable(
      iris[1:5,],
      extensions = "Buttons",
      options = list(
        dom = "Bfrtip",
        buttons = list(
          list(
            extend = "pdfHtml5",
            customize = JS(
              "function(doc) {",
              "  doc.content.splice( 1, 0, {",
              "    margin: [ 0, 0, 0, 12 ],",
              "    alignment: 'center',",
              sprintf(
                "    image: '%s',", 
                dataURI(
                  file = "https://www.r-project.org/logo/Rlogo.png", 
                  mime = "image/png"
                )
              ),
              "    width: 50",
              "  })",
              "}"
            )
          )
        )
      )
    )
  })
  
}

shinyApp(ui, server)

Answer 1

在普通浏览器（Chrome、Firefox、...）中使用：

library(shiny)
library(DT)
library(base64enc)
library(rmarkdown)

js <- '
Shiny.addCustomMessageHandler("download", function(b64) {
  const a = document.createElement("a");
  document.body.append(a);
  a.download = "report.pdf";
  a.href = b64;
  a.click();
  a.remove();
})
'

ui <- basicPage(
  tags$head(
    tags$script(HTML(js))
  ),
  br(),
  DTOutput("dtable")
)

server <- function(input, output, session){
  
  dat <- iris[1:13, ] 
  
  output[["dtable"]] <- renderDT({
    datatable(
      dat,
      extensions = "Buttons",
      options = list(
        dom = "Bfrtip",
        buttons = list(
          list(
            extend = "collection",
            text = "Report",
            action = JS(
              "function ( e, dt, node, config ) {",
              "  var array = dt.data().toArray();",
              "  var tarray =  Object.keys(array[0]).map(function(c) {",
              "    return array.map(function(r) { return r[c]; });",
              "  });",
              "  var df = {};",
              "  for(var i = 1; i <= tarray.length; ++i) {",
              "    df['V' + i] = tarray[i-1];",
              "  }",
              "  Shiny.setInputValue('report', df);",
              "}")
          )
        )
      )
    )
  }, server = FALSE)
  
  observeEvent(input[["report"]], {
    df <- 
      setNames(as.data.frame(lapply(input[["report"]][-1], unlist)), names(dat))
    showNotification("Creating report...", type = "message")
    tmpReport <- tempfile(fileext = ".Rmd")
    file.copy("report.Rmd", tmpReport)
    outfile <- file.path(tempdir(), "report.pdf")
    render(
      tmpReport, 
      output_file = outfile,
      params = list(
        data = df
      )
    )
    b64 <- dataURI(
      file = outfile,
      mime = "application/pdf"
    )
    session$sendCustomMessage("download", b64)
  })
}

shinyApp(ui, server)

文件report.Rmd：

---
title: "My awesome report"
author: "John Doe"
date: "21/10/2020"
output: pdf_document
params:
  data: "x"
---

```{r setup, include=FALSE}
library(knitr)
opts_chunk$set(echo = FALSE)
```

## Data

```{r}
kable(params[["data"]], row.names = FALSE)
```

带有徽标的按钮：

  tags$head(
    tags$script(HTML(js)),
    tags$link(rel = "stylesheet", href = "https://cdnjs.cloudflare.com/ajax/libs/font-awesome/5.15.1/css/all.min.css", integrity="sha512-+4zCK9k+qNFUR5X+cKL9EIR+ZOhtIloNl9GIKS57V1MyNsYpYcUrUeQc9vNfzsWfV28IaLL3i96P9sdNyeRssA==", crossorigin="anonymous")
  ),

和：

buttons = list(
  list(
    extend = "collection",
    text = "<span style='font-size:20px;'><i class='fa fa-file-pdf' style='color:red;'></i>&nbsp;Report</span>",