maglia DT :: DataTable senza Pandoc

Question

Sto cercando di utilizzare DT::datatable per produrre un, tavolo interattivo ben formattata in R.

... unico problema è che io voglio un lavoro Heroku a lavorare a maglia il documento per me, e ho appreso che RStudio e rmarkdown::render() usano pandoc sotto il cofano - ma pandoc non viene spedito nella versione ridotta R Buildpack per heroku.

C'è un modo per ottenere il vecchio motore di markdown (knitr:knit2html o markdown:markdownToHTML) per passare il javascript che alimenta lo datatable tramite? O per essere più precisi, per generare la tabella di esempio sotto senza utilizzando pandoc?

Ecco un esempio minimo:

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

genera:

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 

comportamento desiderato: la mia datatable venire attraverso (non <!–html_preserve–>)

quello che ho provato ho guardato HTMLTools e la roba htmlPreserve ma non riuscivo a capire come applicare quello qui. ha fatto alcune cose pazzesche con saveWidget che non ha avuto successo e non porta ripetere.

Grazie!

Answer 1

Un po 'da una categoria alcune cose folli con saveWidget, ma se è possibile utilizzare XML package (avrete bisogno di cedro-14 per quello) qualcosa di simile al di sotto dovrebbe fare il trucco:

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

Ecco una soluzione che utilizza i pacchetti knitr, markdown, base64enc e htmltools. È modellato su ciò che accade internamente in rmarkdown::render, ma non ha dipendenze su pandoc. Genera un file HTML autonomo per impostazione predefinita o, facoltativamente, copia tutte le dipendenze in una cartella. Con quest'ultimo, si presuppone che tutti i file CSS e JS da cui dipende dipendano in modo univoco (vale a dire non importa se entrambi due htmlwidgets decidono entrambi di chiamare il proprio file 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) 
} 

Questo può essere chiamato in questo modo:

render_with_widgets("testing.Rmd") 

Questo dovrebbe funzionare per qualsiasi htmlwidgets, anche in combinazione. Esempio:

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

E poi da R

render_with_widgets("TestWidgets.Rmd")