没有 pandoc 的 knit DT::datatable

Posted 2023-05-07

【中文标题】没有 pandoc 的 knit DT::datatable

【英文标题】：knit DT::datatable without pandoc

【发布时间】：2015-10-17 04:36:41

【问题描述】：

我正在尝试使用 DT::datatable 在 R 中输出格式良好的交互式表格。

...唯一的问题是我想要一个 heroku 工作来为我编写文档，而且我了解到 RStudio 和 rmarkdown::render() 在引擎盖下使用 pandoc——但 pandoc 并没有在精简版中发布R Buildpack 为 heroku。

有没有办法让旧的降价引擎（knitr:knit2html 或markdown:markdownToHTML）通过支持datatable 的javascript？或者更准确地说，不使用pandoc生成下面的示例表？

这是一个最小的例子：

testing.Rmd

---
title: "testing"
output: html_document
---

this is a datatable table
```r test2, echo=FALSE
library(DT)
DT::datatable(
  iris, 
  rownames = FALSE,
  options = list(pageLength = 12, dom = 'tip')
)
```

this is regular R output
```r
head(iris)

```

knit_test.R

require(knitr)
knitr::knit2html('testing.Rmd')

生成：

this is a datatable table <!–html_preserve–>

<!–/html_preserve–>
this is regular R output

head(iris)
##   Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## 1          5.1         3.5          1.4         0.2  setosa
## 2          4.9         3.0          1.4         0.2  setosa
## 3          4.7         3.2          1.3         0.2  setosa
## 4          4.6         3.1          1.5         0.2  setosa
## 5          5.0         3.6          1.4         0.2  setosa
## 6          5.4         3.9          1.7         0.4  setosa

期望的行为：让我的数据表通过（不是<!–html_preserve–>）

我尝试过的 我查看了 htmltools 和 htmlPreserve 的东西，但不知道如何在这里应用它。对saveWidget 做了一些疯狂的事情，但没有成功，不值得重复。

谢谢！

【问题讨论】：

还有Docverter，一种pandoc即服务...

【参考方案1】：

这是一个使用包knitr、markdown、base64enc 和htmltools 的解决方案。它以rmarkdown::render 内部发生的情况为模型，但不依赖于pandoc。默认情况下，它会生成一个自包含的 HTML 文件，或者可以选择将所有依赖项复制到一个文件夹中。对于后者，它假定它所依赖的所有 CSS 和 JS 文件都是唯一命名的（即，如果两个 htmlwidget 都决定调用它们的 css 文件 style.css，它不会同时导入两者）。

library("knitr")
library("htmltools")
library("base64enc")
library("markdown")
render_with_widgets <- function(input_file,
                                output_file = sub("\\.Rmd$", ".html", input_file, ignore.case = TRUE),
                                self_contained = TRUE,
                                deps_path = file.path(dirname(output_file), "deps")) 

  # Read input and convert to Markdown
  input <- readLines(input_file)
  md <- knit(text = input)
  # Get dependencies from knitr
  deps <- knit_meta()

  # Convert script dependencies into data URIs, and stylesheet
  # dependencies into inline stylesheets

  dep_scripts <-
    lapply(deps, function(x) 
      lapply(x$script, function(script) file.path(x$src$file, script)))
  dep_stylesheets <- 
    lapply(deps, function(x) 
      lapply(x$stylesheet, function(stylesheet) file.path(x$src$file, stylesheet)))
  dep_scripts <- unique(unlist(dep_scripts))
  dep_stylesheets <- unique(unlist(dep_stylesheets))
  if (self_contained) 
    dep_html <- c(
      sapply(dep_scripts, function(script) 
        sprintf('<script type="text/javascript" src="%s"></script>',
                dataURI(file = script))
      ),
      sapply(dep_stylesheets, function(sheet) 
        sprintf('<style>%s</style>',
                paste(readLines(sheet), collapse = "\n"))
      )
    )
   else 
    if (!dir.exists(deps_path)) 
      dir.create(deps_path)
    
    for (fil in c(dep_scripts, dep_stylesheets)) 
      file.copy(fil, file.path(deps_path, basename(fil)))
    
    dep_html <- c(
        sprintf('<script type="text/javascript" src="%s"></script>',
                file.path(deps_path, basename(dep_scripts))),
        sprintf('<link href="%s" type="text/css" rel="stylesheet">',
                file.path(deps_path, basename(dep_stylesheets)))
    )
  

  # Extract the <!--html_preserve--> bits
  preserved <- extractPreserveChunks(md)

  # Render the HTML, and then restore the preserved chunks
  html <- markdownToHTML(text = preserved$value, header = dep_html)
  html <- restorePreserveChunks(html, preserved$chunks)

  # Write the output
  writeLines(html, output_file)

可以这样调用：

render_with_widgets("testing.Rmd")

这应该适用于任何 htmlwidgets，即使是组合使用。示例：

TestWidgets.Rmd

---
title: "TestWidgets"
author: "Nick Kennedy"
date: "5 August 2015"
output: html_document
---

First test a dygraph
```r
library(dygraphs)
dygraph(nhtemp, main = "New Haven Temperatures") %>% 
  dyRangeSelector(dateWindow = c("1920-01-01", "1960-01-01"))
```

Now a datatable
```r
library(DT)
datatable(iris, options = list(pageLength = 5))
```

```r
library(d3heatmap)
d3heatmap(mtcars, scale="column", colors="Blues")
```

然后从R

render_with_widgets("TestWidgets.Rmd")

【参考方案2】：

来自一个类别一些疯狂的东西saveWidget，但如果你可以使用XML package（你需要 cedar-14）像下面这样的东西应该可以解决问题：

#' http://***.com/q/31645528/1560062
#'
#' @param dt datatables object as returned from DT::datatable
#' @param rmd_path character path to the rmd template
#' @param libdir path to the directory with datatable static files
#' @param output_path where to write output file
#'
process <- function(dt, rmd_path, libdir, output_path) 

    widget_path <- tempfile()
    template_path <- tempfile()

    # Save widget and process Rmd template
    DT::saveWidget(dt, widget_path, selfcontained=FALSE)
    knitr::knit2html(input=rmd_path, output=template_path)

    # Parse html files
    widget <- XML::htmlParse(widget_path)
    template <- XML::htmlParse(paste0(template_path, ".html"))

    # Extract elements from the body of widget file
    widget_container <- XML::getNodeSet(
        widget, "/html/body/div[@id = 'htmlwidget_container']")
    body_scripts <- XML::getNodeSet(widget, "/html/body/script")

    # Make sure we point to the correct static dir
    # Using lapply purely for side effect is kind of
    # wrong but it is cheaper than a for loop if we use ::
    correct_libdir <- function(nodeset, attr_name) 
        lapply(nodeset, function(el) 
            src <- XML::xmlAttrs(el)[[attr_name]]
            XML::xmlAttrs(el)[[attr_name]] <- file.path(
                libdir, sub("^.*?/", "", src))
        )
        nodeset
    

    # Extract script and link tags, correct paths
    head_scripts <- correct_libdir(
        XML::getNodeSet(widget, "/html/head/script"), "src")

    head_links <- correct_libdir(
        XML::getNodeSet(widget, "/html/head/link"), "href")

    # Get template root    
    root <- XML::xmlRoot(template)

    # Append above in the right place
    root[[2]] <- XML::addChildren(root[[2]], widget_container)
    root[[2]] <- XML::addChildren(root[[2]], body_scripts)
    root[[1]] <- XML::addChildren(root[[1]], head_scripts)
    root[[1]] <- XML::addChildren(root[[1]], head_links)

    # Write output
    XML::saveXML(template, output_path)

【讨论】：

这对我不起作用。脚本不会被加载，因为至少在 Windows 上的 Firefox 上，绝对文件名不能用作“src”属性。小部件的 JSON 也会被破坏。

它不一定是绝对路径，但在服务器环境中它很可能是您想要的。依赖关系是恒定的，没有理由为每个生成的文档保留和提供单独的依赖关系。我不确定你所说的损坏的 JSON 是什么意思。

markdown::markdownToHTML 将一些字符替换为 HTML 实体，因此 JSON 不再有效。如果您查看我的回答，我已经使用htmltools:extractPreserveChunks 先将现有的 HTML 提取出来，然后再将其恢复；这是rmarkdown 使用的方法。我原则上同意不内联脚本和样式表以节省空间，尽管这是在 rmarkdown 中默认执行的操作，并且它使最终结果更加便携。再看一遍，你的代码应该使用相对路径，所以使用绝对路径是我的问题。

DT::saveWidget 生成一个有效的 JSON，之后markdown 就没有地方接触了。

谢谢。我发现拆开rmarkdown::render 很有趣，尽管使用具有前处理和后处理功能的output_formats 使其更难理解。我的目标是尽可能普遍。我认为您的技术（现在我了解如何设置参数）看起来也不错。当有两个或多个答案用不同的方法解决问题时，SO 总是更有趣！