stricken DT :: Datentabelle ohne pandoc

Question

Ich versuche DT::datatable zur Ausgabe zu verwenden, um eine schön formatierte, interaktive Tabelle in R.

... Problem ist nur, dass ich ein Heroku Aufgabe, das Dokument für mich stricken möchten, und ich habe gelernt, dass RStudio und rmarkdown::render() Pandoc unter der Haube verwenden - aber Pandoc liefert nicht in der abgespeckten R Buildpack für Heroku.

Gibt es eine Möglichkeit, die alte Abmeldungs-Engine (knitr:knit2html oder markdown:markdownToHTML) zu erhalten, um das Javascript, das datatable antreibt, zu übergeben? Oder um genauer zu sein, um die Probentabelle unter ohne mit Pandoc zu erzeugen?

Hier ist ein minimal Beispiel:

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

erzeugt:

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 

gewünschtes Verhalten: hat meine Datentabelle kommen durch (nicht <!–html_preserve–>)

was ich versucht habe ich htmltools und die htmlPreserve Sachen sah, kann aber nicht herausfinden, wie das hier anzuwenden. hat ein paar verrückte Sachen mit saveWidget, die nicht erfolgreich war und nicht zu wiederholen.

Danke!

Answer 1

Ein wenig aus einer Kategorie einige verrückte Sachen mit saveWidget aber wenn man XML package verwenden können etwas (Sie werden für die Zeder-14 müssen) wie unter den Trick tun sollten:

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

Answer 2

Hier eine Lösung, die die Pakete knitr, markdown, base64enc und htmltools verwendet. Es basiert auf dem, was intern in rmarkdown::render passiert, hat aber keine Abhängigkeiten zu pandoc. Es generiert standardmäßig eine eigenständige HTML-Datei oder kopiert optional alle Abhängigkeiten in einen Ordner. Mit letzterem wird angenommen, dass alle CSS- und JS-Dateien, auf die es ankommt, eindeutig benannt sind (d. H., Es wird nicht beide importiert, wenn zwei htmlwidgets beide ihre CSS-Datei style.css aufrufen).

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

Dies kann wie folgt aufgerufen werden:

render_with_widgets("testing.Rmd") 

für alle htmlwidgets Dies sollte auch in Kombination arbeiten. Beispiel:

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

Und dann von R

render_with_widgets("TestWidgets.Rmd")