编织DT :: datatable无pandoc [英] knit DT::datatable without pandoc

问题描述

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

I am trying to use DT::datatable to output a nicely formatted, interactive table in R.

...唯一的问题是我想要一个英雄工作来编织我的文档，我已经了解到，RStudio和 rmarkdown :: render（）使用pandoc下引擎盖 - 但是pandoc不会在剥离的 R Buildpack 中为heroku

...only problem is that I want a heroku job to knit the document for me, and I've learned that RStudio and rmarkdown::render() use pandoc under the hood -- but pandoc doesn't ship in the stripped down R Buildpack for heroku.

有没有办法获取旧的降价引擎（ knitr：knit2html 或 markdown：markdownToHTML ）传递通过电源 datatable 的JavaScript？或者更准确地说，使用pandoc生成 下面的示例表

Is there any way to get the old markdown engine (knitr:knit2html or markdown:markdownToHTML) to pass the javascript that powers datatable through? Or to be more precise, to generate the sample table below without using pandoc?

这里是一个最小的例子：

Here is a minimal example:

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

所需行为：让我的datatable通过不是<！ - html_preserve-> ）

desired behavior: have my datatable come through (not <!–html_preserve–>)

我尝试过的
我查看了htmltools和 htmlPreserve 的东西，但无法弄清楚如何在这里申请。做了一些疯狂的东西与 saveWidget 不成功，不会重复。

what I've tried I looked at htmltools and the htmlPreserve stuff but couldn't figure out how to apply that here. did some crazy stuff with saveWidget that was not successful and does not bear repeating.

谢谢！

推荐答案

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

Here's a solution that uses the packages knitr, markdown, base64enc and htmltools. It's modelled on what happens internally in rmarkdown::render, but has no dependencies on pandoc. It generates a self-contained HTML file by default, or optionally copies all of the dependencies into a folder. With the latter, it assumes that all the CSS and JS files it depends on are uniquely named (i.e. it won't import both if two htmlwidgets both decide to call their css file 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，甚至结合。示例：

This should work for any htmlwidgets, even in combination. Example:

TestWidgets.Rmd

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")

这篇关于编织DT :: datatable无pandoc的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！