I am trying to use DT::datatable to output a nicely formatted, interactive table in R.
...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.
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')
generates:
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
desired behavior: have my datatable come through (not <!–html_preserve–>)
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.
Thanks!
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)
}
This can be called like this:
render_with_widgets("testing.Rmd")
This should work for any htmlwidgets, even in combination. Example:
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")
```
And then from R
render_with_widgets("TestWidgets.Rmd")
A little bit from a category some crazy stuff with saveWidget but if you can use XML package (you'll need cedar-14 for that) something like below should do the trick:
#' 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)
}
