knit DT::datatable without pandoc knit DT::datatable without pandoc r r

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