[英]Rmarkdown to html on windows: DT::datatable not rendering (suspect pandoc issue)
[英]knit DT::datatable without pandoc
我试图使用DT::datatable
在R中输出格式良好的交互式表。
...唯一的问题是我想要一个heroku工作为我编织文档,并且我已经知道RStudio和rmarkdown::render()
在引擎盖下使用pandoc - 但是pandoc不会在剥离的情况下发送R buildpack for heroku。
有没有什么办法让旧的降价引擎( knitr:knit2html
或markdown:markdownToHTML
)来传递力量的JavaScript datatable
通过? 或者更确切地说,在不使用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
做了一些疯狂的事情并没有成功,也没有重复。
谢谢!
这是一个使用包knitr
, markdown
, base64enc
和htmltools
的解决方案。 它模仿了rmarkdown::render
内部发生的事情,但没有对pandoc
依赖。 它默认生成一个自包含的HTML文件,或者可选地将所有依赖项复制到一个文件夹中。 对于后者,它假定它所依赖的所有CSS和JS文件都是唯一命名的(即如果两个htmlwidge都决定调用它们的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")
稍微从类别一些与saveWidget
疯狂的东西,但如果你可以使用XML
包 (你需要cedar-14),像下面这样的东西应该做的伎俩:
#' http://stackoverflow.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)
}
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.