Import initial

.Rbuildignore

@@ -0,0 +1,5 @@
+TODO.org
+README.md
+.projectile
+^.*\.Rproj$
+^\.Rproj\.user$

.gitignore

@@ -0,0 +1,11 @@
+*~
+# History files
+.Rhistory
+.RData
+# Example code in package build process
+*-Ex.R
+# Mac OS X annoyance.
+.DS_Store
+.projectile
+.Rproj.user
+*.Rproj

DESCRIPTION

@@ -0,0 +1,22 @@
+Package: rmdformats
+Maintainer: Julien Barnier <[email protected]>
+Authors@R: c(person("Julien", "Barnier", email="[email protected]",
+    role=c("aut","cre")))
+Version: 0.0.1
+Date: 2014-06-20
+License: GPL (>= 2)
+Encoding: UTF-8
+Title: HTML output formats for RMarkdown documents
+Description: HTML formats and templates for RMarkdown documents, with some extra
+    features such as automatic table of contents and lightboxed figures.
+Imports:
+    questionr,
+    knitr,
+    rmarkdown,
+    htmltools
+URL: https://github.com/juba/rmdclean
+Collate:
+    'create.doc.R'
+    'pilltabs.R'
+    'html_clean.R'
+    'rmdformats-package.R'

NAMESPACE

@@ -0,0 +1,9 @@
+export(create.doc)
+export(html_clean)
+export(pilltabs)
+import(htmltools)
+import(rmarkdown)
+importFrom(knitr,kable)
+importFrom(questionr,chisq.residuals)
+importFrom(questionr,cprop)
+importFrom(questionr,rprop)

NEWS

@@ -0,0 +1,4 @@
+rmdformats 0.1
+--------------
+
+* First version

R/create.doc.R

@@ -0,0 +1,44 @@
+#' Create a new directory with a clean RMarkdown file
+#'
+#' This function creates a new subdirectory inside the current directory, which will
+#' contain a ready-to-use RMarkdown file to be rendered in the given format.
+#'
+#' @param dirname name of the directory to create
+#' @param format R Markdown format to use
+#' @param report indicates if the new document is living in the \code{report}
+#' @param makefile indicates if a `Makefile` for HTML and PDF rendering should
+#' be created in the document folder
+#' @details
+#' If \code{report} is TRUE, then a small snippet of code is added at the
+#' beginning of the Rmd file. This code allows to switch to the project root
+#' before running \code{load.project} when using the included Makefile.
+#' @return
+#' No value is returned.
+#' @author Julien Barnier <julien.barnier@@ens-lyon.fr>
+#' This function is heavily inspired and copied from the \link[ProjectTemplate]{create.project} function
+#' of the \code{ProjectTemplate} package.
+#' @examples
+#' library(rmdformats)
+#' \dontrun{create.doc("MyDocument", format="html_clean")}
+#' @export
+
+create.doc <- function(dirname="new-doc", format="html_clean", report=FALSE, makefile=FALSE) {
+    formats <- c("html_clean")
+    format <- match.arg(format, formats)
+    tmp.dir <- paste(dirname, "_tmp", sep = "")
+    if (file.exists(dirname) || file.exists(tmp.dir)) {
+        stop(paste("Cannot run create.doc() from a directory containing", 
+                   dirname, "or", tmp.dir))
+    }
+    dir.create(tmp.dir)
+    template_dir <- ifelse(report, paste0(format, "_projecttemplate"), format)
+    file.copy(system.file(file.path("rmarkdown", "templates", template_dir, "skeleton", "skeleton.Rmd"), 
+                          package = "rmdformats"), file.path(tmp.dir))
+    if (makefile)
+        file.copy(system.file(file.path("templates", format, "Makefile"), 
+                              package = "rmdformats"), file.path(tmp.dir))
+    file.rename(tmp.dir, dirname)
+    file.rename(file.path(dirname, "skeleton.Rmd"), file.path(dirname, paste0(dirname, ".Rmd")))
+    unlink(tmp.dir, recursive = TRUE)
+}
+

R/html_clean.R

@@ -0,0 +1,199 @@
+#' Convert to an HTML document
+#'
+#' Format for converting from R Markdown to an HTML document.
+#'
+#' @param number_sections \code{TRUE} to number section headings
+#' @param fig_width Default width (in inches) for figures
+#' @param fig_height Default width (in inches) for figures
+#' @param fig_retina Scaling to perform for retina displays (defaults to 2 when
+#'   \code{fig_caption} is \code{FALSE}, which currently works for all widely
+#'   used retina displays). Set to \code{NULL} to prevent retina scaling. Note
+#'   that this will always be \code{NULL} when \code{keep_md} is specified (this
+#'   is because \code{fig_retina} relies on outputting HTML directly into the
+#'   markdown document).
+#' @param fig_caption \code{TRUE} to render figures with captions
+#' @param smart Produce typographically correct output, converting straight
+#'   quotes to curly quotes, --- to em-dashes, -- to en-dashes, and ... to
+#'   ellipses.
+#' @param self_contained Produce a standalone HTML file with no external
+#'   dependencies, using data: URIs to incorporate the contents of linked
+#'   scripts, stylesheets, images, and videos. Note that even for self
+#'   contained documents MathJax is still loaded externally (this is
+#'   necessary because of it's size).
+#' @param highlight Syntax highlighting style. Supported styles include
+#'   "default", "tango", "pygments", "kate", "monochrome", "espresso",
+#'   "zenburn", "haddock", and "textmate". Pass \code{NULL} to prevent syntax
+#'   highlighting.
+#' @param mathjax Include mathjax. The "default" option uses an https URL from
+#'   the official MathJax CDN. The "local" option uses a local version of
+#'   MathJax (which is copied into the output directory). You can pass an
+#'   alternate URL or pass \code{NULL} to exclude MathJax entirely.
+#' @param css One or more css files to include
+#' @param includes Named list of additional content to include within the
+#'   document (typically created using the \code{\link{includes}} function).
+#' @param keep_md Keep the markdown file generated by knitting.
+#' @param lib_dir Directory to copy dependent HTML libraries (e.g. jquery,
+#'   bootstrap, etc.) into. By default this will be the name of the document
+#'   with \code{_files} appended to it.
+#' @param pandoc_args Additional command line options to pass to pandoc
+#' @param ... Additional function arguments to pass to the base R Markdown HTML
+#'   output formatter
+#'
+#' @return R Markdown output format to pass to \code{\link{render}}
+#'
+#' @examples
+#' \dontrun{
+#'
+#' library(rmdformats)
+#'
+#' render("input.Rmd", html_clean())
+#' 
+#' }
+#'
+#' @export
+#' @import rmarkdown
+#' @import htmltools
+
+html_clean <- function(number_sections = FALSE,
+                       fig_width = 6,
+                       fig_height = 6,
+                       fig_retina = if (!fig_caption) 2,
+                       fig_caption = TRUE,
+                       smart = TRUE,
+                       self_contained = TRUE,
+                       highlight = "pygments",
+                       mathjax = "default",
+                       css = NULL,
+                       includes = NULL,
+                       keep_md = FALSE,
+                       lib_dir = NULL,
+                       pandoc_args = NULL,
+                       ...) {
+
+    ## build pandoc args
+    args <- c("--standalone")
+    ## use section divs
+    args <- c(args, "--section-divs")
+
+    ## template
+    args <- c(args, "--template",
+              rmarkdown::pandoc_path_arg(system.file("templates/html_clean/default.html", package="rmdformats")))
+    ## numbered sections
+    if (number_sections)
+        args <- c(args, "--number-sections")
+    ## additional css
+    for (css_file in css)
+        args <- c(args, "--css", rmarkdown::pandoc_path_arg(css_file))
+
+                                        # pre-processor for arguments that may depend on the name of the
+                                        # the input file (e.g. ones that need to copy supporting files)
+    pre_processor <- function(metadata, input_file, runtime, knit_meta, files_dir,
+                              output_dir) {
+
+                                        # use files_dir as lib_dir if not explicitly specified
+        if (is.null(lib_dir))
+            lib_dir <- files_dir
+
+                                        # extra args
+        args <- c()
+
+                                        # highlight
+        args <- c(args, rmarkdown:::pandoc_html_highlight_args(highlight,
+                                                               "default",
+                                                               self_contained,
+                                                               lib_dir,
+                                                               output_dir))
+
+                                        # content includes (we do this here so that user include-in-header content
+                                        # goes after dependency generated content)
+        args <- c(args, rmarkdown:::includes_to_pandoc_args(includes))
+
+                                        # return additional args
+        args
+    }
+
+    ## Added js and css dependencies
+    extra_dependencies <- list(rmarkdown:::html_dependency_jquery(),
+                               rmarkdown:::html_dependency_bootstrap("bootstrap"),
+                               html_dependency_jquery_ui(),
+                               html_dependency_tocify(),
+                               html_dependency_magnific_popup(),
+                               html_dependency_clean())
+    ## knitr options
+    knitr_opts <- list(dev = 'png',
+                       dpi = 96,
+                       fig.width = fig_width,
+                       fig.height = fig_height,
+                       fig.retina = fig_retina)
+    if (keep_md)
+        knitr_opts$fig.retina <- NULL
+
+    ## knitr hooks for plots
+    knitr_hooks <- list(plot=function(x, options) {
+        name <- paste(options$fig.path, options$label,".png", sep = '')
+        if(!is.null(options$fig.cap)){
+            caption <-  paste('<p class="caption">', options$fig.cap, '</p>', sep = "")
+        } else {
+            caption <- ""
+        }
+        out <- "<div class='figure'>"
+        out <- paste0(out, "<a class='image-link' href='",name,"' title='",options$fig.cap,"'>")
+        out <- paste0(out, "<img src='",name,"' class='img-polaroid image-thumb' />")
+        out <- paste0(out, "</a>")
+        out <- paste0(out, caption)
+        out <- paste0(out, "</div>")
+        return(out)
+    })
+
+    ## return format
+    rmarkdown::output_format(
+        knitr = rmarkdown::knitr_options(opts_chunk=knitr_opts, knit_hooks=knitr_hooks),
+        pandoc = rmarkdown::pandoc_options(to = "html",
+            from = rmarkdown:::from_rmarkdown(fig_caption),
+            args = args),
+        keep_md = keep_md,
+        clean_supporting = self_contained,
+        pre_processor = pre_processor,
+        base_format = rmarkdown:::html_document_base(smart = smart, theme = "default",
+            self_contained = self_contained,
+            lib_dir = lib_dir, mathjax = mathjax,
+            pandoc_args = pandoc_args,
+            extra_dependencies = extra_dependencies,
+            ...)
+    )
+}
+
+
+# create an html dependency for jquery-ui
+html_dependency_jquery_ui <- function() {
+  htmltools:::htmlDependency(name = "jquery-ui",
+                 version = "1.10.4",
+                 src = system.file("templates/jquery-ui-1.10.4", package="rmdformats"),
+                 script = "jquery-ui-1.10.4.custom.min.js")
+}
+
+# create an html dependency for tocify
+html_dependency_tocify <- function() {
+  htmltools:::htmlDependency(name = "tocify",
+                 version = "1.9.0",
+                 src = system.file("templates/tocify-1.9.0", package="rmdformats"),
+                 script = "jquery.tocify.min.js")
+}
+
+# create an html dependency for Maginfic popup
+html_dependency_magnific_popup <- function() {
+  htmltools:::htmlDependency(name = "magnific-popup",
+                 version = "0.9.9",
+                 src = system.file("templates/magnific-popup-0.9.9", package="rmdformats"),
+                 script = "jquery.magnific-popup.min.js",
+                 stylesheet = "magnific-popup.css")
+}
+
+# html_clean js and css
+html_dependency_clean <- function() {
+  htmltools:::htmlDependency(name = "clean",
+                 version = "0.1",
+                 src = system.file("templates/html_clean", package="rmdformats"),
+                 script = "clean.js",
+                 stylesheet = "clean.css")
+}

R/pilltabs.R

@@ -0,0 +1,75 @@
+#' Given a cross-table, outputs HTML code to display several views of with a tabbed interface
+#'
+#' Given a two dimensions contingency tables, this function outputs HTML code to display,
+#' within a dynamic tabbed interface, the count, line row percentages, column percentages and
+#' chi-squared residuals tables.
+#'
+##' @param tab a two dimensions table object
+##' @param count wether or not to the displya the count table
+##' @param rows wether or not to the displya the row percentages table
+##' @param cols wether or not to the displya the column percentages table
+##' @param chisq wether or not to the displya the table chi-squared test results
+##' @param resid wether or not to the displya the chi-squared residuals table
+#' @details
+#' The function is intended to be called inside an rmarkdown document.
+#' @return
+#' No value is returned.
+#' @author Julien Barnier <julien.barnier@@ens-lyon.fr>
+#' @export
+#' @importFrom questionr cprop rprop chisq.residuals
+#' @importFrom knitr kable
+
+
+pilltabs <- function(tab, count=TRUE, rows=TRUE, cols=TRUE, chisq=TRUE, resid=TRUE) {
+
+    ## Tab counter for generating unique div ids
+    if (!exists(".dyntabseq", envir=parent.frame())) {
+        .dseq <- 1
+        assign(".dyntabseq", 1, envir=parent.frame())
+    }
+    else {
+        .dseq <- get(".dyntabseq", envir=parent.frame())
+        .dseq <- .dseq + 1
+        assign(".dyntabseq", .dseq, envir=parent.frame())
+    }
+
+    result <- paste0('<ul class="nav nav-pills">\n',
+                    '  <li class="active"><a href="#dyntab-count', .dseq,'" data-toggle="pill">Count</a></li>\n',
+                    '  <li><a href="#dyntab-rows', .dseq,'" data-toggle="pill">Rows %</a></li>\n',
+                    '  <li><a href="#dyntab-columns', .dseq,'" data-toggle="pill">Columns %</a></li>\n ',
+                    '  <li><a href="#dyntab-residuals', .dseq,'" data-toggle="pill">Residuals</a></li>\n',
+                    '</ul>\n',
+                    '<div class="tab-content">\n')
+    if (count)
+        result <- paste0(result,
+                        '  <div class="tab-pane active" id="dyntab-count', .dseq,'">\n\n\n',
+                        paste(kable(tab, output=FALSE), collapse="\n"),
+                        '\n\n\n  </div>\n')
+    if (rows)    
+        result <- paste0(result,
+                        '  <div class="tab-pane" id="dyntab-rows', .dseq,'">\n\n\n',
+                        paste(kable(round(questionr::rprop(tab, n=TRUE),1), output=FALSE), collapse="\n"),
+                        '\n\n\n  </div>\n')
+    if (cols)    
+        result <- paste0(result,
+                        '  <div class="tab-pane" id="dyntab-columns', .dseq,'">\n\n\n',
+                        paste(kable(round(questionr::cprop(tab, n=TRUE),1), output=FALSE), collapse="\n"),
+                        '\n\n\n  </div>\n', sep="\n")
+    if (resid)    
+        result <- paste0(result,
+                        '  <div class="tab-pane" id="dyntab-residuals', .dseq,'">\n\n\n',
+                        paste(kable(round(questionr::chisq.residuals(tab),2), output=FALSE), collapse="\n"),
+                        '\n\n\n  </div>\n', sep="\n")
+    result <- paste0(result,
+                    '</div>', sep="\n")
+    if (chisq) {
+        test <- chisq.test(tab)
+        result <- paste0(result,
+                        '<p class="chisq-results">X-squared = ', round(test$statistic, 4),
+                        ', df = ', test$parameter,
+                        ', p = ', format.pval(test$p.value, digits=4),
+                        '</p>')
+    }
+    cat(result)
+
+}

R/rmdformats-package.R

@@ -0,0 +1,5 @@
+#' rmdformats
+#'
+#' @name rmdformats
+#' @docType package
+NULL

README.md

@@ -0,0 +1,3 @@
+rmdformats
+===============
+

inst/examples/html_clean/.gitignore

@@ -0,0 +1,4 @@
+cache/
+out/
+*.md
+.#*