r - 编织 DT::datatable 没有 pandoc

Question

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

...唯一的问题是我想要一份 heroku 工作来为我编写文档，而且我了解到 RStudio 和 rmarkdown::render()在引擎盖下使用 pandoc - 但 pandoc 不会在精简版中发货 R Buildpack对于heroku。

有什么方法可以让旧的 Markdown 引擎( knitr:knit2html 或 markdown:markdownToHTML )传递支持 datatable 的 javascript通过？或者更准确地说，在不使用 pandoc 的情况下生成下面的示例表？

这是一个最小的例子:

测试.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 做了一些疯狂的事情那是不成功的，不值得重复。

谢谢!

Answer 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，甚至是组合使用。例子:

测试小部件.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")