dzianina DT :: DataTable bez pandoc

Question

Próbuję użyć DT::datatable do wyjścia ładnie sformatowany, interaktywny stolik w R.

... Jedynym problemem jest to, że chcę praca Heroku na drutach dokument dla mnie, i nauczyłem się, że RStudio i rmarkdown::render() używają pandoc pod maską - ale pandoc nie wysyła w usuniętym puszku R Buildpack dla heroku.

Czy istnieje sposób, aby uzyskać stary silnik przeciążania (knitr:knit2html lub markdown:markdownToHTML), aby przekazać javascript, który napędza datatable przez? A może bardziej precyzyjnie, aby wygenerować próbną tabelę poniżej bez przy użyciu pandoc?

Oto minimalny przykład:

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

generuje:

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 

pożądane zachowanie: mam mój DataTable przyjść do (nie <!–html_preserve–>)

co Próbowałem Spojrzałem na htmltools i htmlPreserve rzeczy, ale nie mógł dowiedzieć się, jak zastosować to tutaj. zrobiłem szalone rzeczy z saveWidget, które nie powiodły się i nie dają się powtórzyć.

Dzięki!

Answer 1

Trochę z kategorii niektóre szalone rzeczy z saveWidget ale jeśli można użyć XML package (musisz cedru-14 dla tego) coś jak poniżej powinno załatwić sprawę:

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

tutaj rozwiązanie używające pakietów knitr, markdown, base64enc i htmltools. Jest wzorowany na tym, co dzieje się wewnętrznie w rmarkdown::render, ale nie ma zależności od pandoc. Generuje autonomiczny plik HTML domyślnie lub opcjonalnie kopiuje wszystkie zależności do folderu. W drugim przypadku zakłada się, że wszystkie pliki CSS i JS, od których zależy, są niepowtarzalnie nazwane (tj. Nie będzie importować obu, jeśli dwa htmlwidgety zdecydują się wywołać swój plik 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) 
} 

Można to nazwać tak:

render_with_widgets("testing.Rmd") 

ten powinien pracować dla wszelkich htmlwidgets, nawet w połączeniu. Przykład:

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

a następnie od R

render_with_widgets("TestWidgets.Rmd")