使用 DT 导出表格时保持格式（DataTables 按钮扩展）

Question

我制作了一个闪亮的应用程序，其中有人上传文件，计算了一些比率，并且可以使用阈值滑块来格式化这些比率。我为此使用DT::formatStyle，它工作得非常好。据我了解这个函数，它创建一个回调来处理条件格式。

然后，我想使用DT 中的按钮扩展名导出数据。我想在导出为 pdf 或打印时保留格式。事实证明这是行不通的：数据在没有任何格式的情况下被导出。我试过设置exportOptions(list(stripHtml = FALSE))，还是不行。

令我惊讶的是，即使我直接从 Firefox 打印（作为文件/打印...但保持字体粗细。我怀疑我可能需要调整 CSS，但我不知道该怎么做。

我想有一种方法可以“按原样”制作 pdf 和/或打印，最接近我在浏览器中看到的内容。 下面是一个例子：

library(shiny)
library(DT)
library(dplyr)
data("starwars")

ui <- fluidPage(title = "Ratios",
  sidebarLayout(
    sidebarPanel(width = 2,
                 actionButton("button", "Go"), # Emulates data loading
                 sliderInput("seuil_j", "Threshold J",
                             min = 0,  max = 80, value = 35, step = 0.5)),
    mainPanel( 
      fluidRow(column(width = 12,
                      DT::dataTableOutput("ratios"))))
  )
)

server <- function(input, output, session) {
  donnees_ratios <- reactive({
    req(input$button)
    set.seed(14)
    starwars %>% 
      select(1:10) %>% # DataTables is not happy with list columns
      mutate(signe = sample(c(1, -1), replace = TRUE, size = nrow(.)),
             ratio_j = signe * mass / height) %>% 
      select(name, mass, height, signe, ratio_j, everything())
  })

  output$ratios <- DT::renderDataTable({
    donnees_ratios() %>% 
      creer_DT() %>% 
      formatter_DT(input)
  })
}

creer_DT <- function(donnees) {
  datatable(donnees, 
            rownames = FALSE, 
            class = 'cell-border stripe compact hover',
            extensions = c("Buttons"),
            options = list(
              dom = 'Blfrtip',
              buttons = list(
                list(extend = "pdf", 
                     exportOptions = list(stripHtml = FALSE,
                                                     columns = ':visible'),
                     orientation = 'landscape'),
                list(extend = "print", 
                     exportOptions = list(stripHtml = FALSE,
                                          columns = ':visible')),
               "excel", "csv", "colvis"),
              language = list(
                decimal = ",",
                thousands = "&#8239;"  # small unbreakable space
              )
            )
  )
}

formatter_DT <- function(table, input) {
  table %>% 
    formatPercentage(columns = c("ratio_j"),
                     digits = 1L, dec.mark = ",", mark = "&#8239;") %>%
    formatRound(columns = c("height", "mass"),
                digits = 1L, dec.mark = ",", mark = "&#8239;") %>%
    format_seuil("ratio_j", input$seuil_j)
}

format_seuil <- function(table, column, seuil) {
  # Threshold for the aboslute value, and different coloring if higher or lower
  formatStyle(table, column, 
              fontWeight = styleInterval(
                c(-seuil / 100, seuil / 100), c("bold", "normal", "bold")),
              color = styleInterval(
                c(-seuil / 100, seuil / 100), c("red", "black", "orange")
              ))
}

shinyApp(ui, server)

我可以导出为 pdf 或打印，但显示被修改。我还可以使用rmarkdown 和knitr 生成一个pdf，但这将是工作量的两倍，而且感觉就像我错过了使用按钮扩展的东西。

我希望这很清楚，并感谢您的帮助！

弗洛里安

Answer 1

tl;dr 你不能继续格式化；你必须编写一个自定义的 JavaScript 函数。

PDF 和 print 按钮的行为非常不同。

print 按钮行为

当您单击print 按钮时，您使用用户代理（在此用例中为浏览器）将HTML 文档呈现为分页文档 (PDF)。有一个名为 CSS Paged Media 的 W3C 标准定义了 CSS 规则如何应用于分页媒体。
这些 CSS 规则包含在 CSS @media print at-rule 中。
这里有关于 CSS 分页媒体的综合指南：print-css.rocks。

处理 CSS 分页媒体并不简单：

• 浏览器没有很好地执行 CSS Paged Media 标准；无头用户代理（wkhtmltopdf、weasyprint、XML Prince...）用于使用 CSS 分页媒体生成 PDF。由于pandoc 2.0，使用其中一个用户代理非常容易：它们可以替换LaTeX 引擎。
• 当您打开HTML 文件时，浏览器默认不应用@media print（它们应用@media screen at-rule）。因此，很难弄清楚@media print 规则。我知道跟踪这些规则的唯一方法是使用 Chrome 开发者工具（打开菜单，选择More tools 和Rendering。在Rendering 面板中，您可以模拟分页媒体选择print）。

既然要使用浏览器生成样式化的PDF，我认为CSS分页媒体规则是一种不切实际的方式。此外，将带有动态 HTML 文档的无头用户代理用作 Shiny App 非常复杂。所以，我的建议是忘记print 按钮。

PDF 按钮行为

DataTables 库依赖于pdfmake JavaScript 库来生成 PDF 文件。您可以将自定义样式传递给customize option of the pdfHtml5 button，并将 JavaScript 函数传递给。该函数自定义发送给pdfmake API的文档对象。

为了了解DataTables传递给pdfmake的JSON文档对象的结构，可以输出到浏览器控制台：

library(shiny)
library(DT)
library(dplyr)
data("starwars")

ui <- fluidPage(title = "Ratios",
                sidebarLayout(
                  sidebarPanel(width = 2,
                               actionButton("button", "Go"), # Emulates data loading
                               sliderInput("seuil_j", "Threshold J",
                                           min = 0,  max = 80, value = 35, step = 0.5)),
                  mainPanel( 
                    fluidRow(column(width = 12,
                                    DT::dataTableOutput("ratios"))))
                )
)

server <- function(input, output, session) {
  donnees_ratios <- reactive({
    req(input$button)
    set.seed(14)
    starwars %>% 
      select(1:10) %>% # DataTables is not happy with list columns
      mutate(signe = sample(c(1, -1), replace = TRUE, size = nrow(.)),
             ratio_j = signe * mass / height) %>% 
      select(name, mass, height, signe, ratio_j, everything())
  })

  output$ratios <- DT::renderDataTable({
    donnees_ratios() %>% 
      creer_DT() %>% 
      formatter_DT(input)
  })
}

creer_DT <- function(donnees) {
  datatable(donnees, 
            rownames = FALSE, 
            class = 'cell-border stripe compact hover',
            extensions = c("Buttons"),
            options = list(
              dom = 'Blfrtip',
              buttons = list(
                list(extend = "pdf", 
                     exportOptions = list(stripHtml = FALSE,
                                          columns = ':visible'),
                     orientation = 'landscape',
                     customize = JS("function(doc){console.dir(doc);}")),
                list(extend = "print", 
                     exportOptions = list(stripHtml = FALSE,
                                          columns = ':visible')),
                "excel", "csv", "colvis"),
              language = list(
                decimal = ",",
                thousands = "&#8239;"  # small unbreakable space
              )
            )
  )
}

formatter_DT <- function(table, input) {
  table %>% 
    formatPercentage(columns = c("ratio_j"),
                     digits = 1L, dec.mark = ",", mark = "&#8239;") %>%
    formatRound(columns = c("height", "mass"),
                digits = 1L, dec.mark = ",", mark = "&#8239;") %>%
    format_seuil("ratio_j", input$seuil_j)
}

format_seuil <- function(table, column, seuil) {
  # Threshold for the aboslute value, and different coloring if higher or lower
  formatStyle(table, column, 
              fontWeight = styleInterval(
                c(-seuil / 100, seuil / 100), c("bold", "normal", "bold")),
              color = styleInterval(
                c(-seuil / 100, seuil / 100), c("red", "black", "orange")
              ))
}

shinyApp(ui, server)

您可以修改默认样式。这是一个更改tableHeader 样式的字体颜色的示例：

customize = JS("function(doc){doc.styles.tableHeader.color='yellow';}"))

要进一步定制，您必须编写自己的 JavaScript 函数。这是一个用百分比格式化第五列的示例：

customize = JS("function(doc){doc.content[1].table.body.forEach(function(el,idx){if(idx>0){el[4].text=String((parseFloat(el[4].text)*100).toFixed(1))+'%'}})}"))