knit DT::datatable without pandoc
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)}