S3 method for microbenchmark

NAMESPACE

@@ -48,6 +48,7 @@ S3method(pander,survfit)
 S3method(pander,table)
 S3method(pander,ts)
 S3method(pander,zoo)
+S3method(pander, microbenchmark)
 export(Pandoc)
 export(Pandoc.brew)
 export(Pandoc.convert)

R/S3.R

@@ -935,3 +935,19 @@ pander.sessionInfo <- function (x, locale = TRUE, compact = TRUE, ...)
   invisible(x)
 }
 
+#' @S3method pander microbenchmark
+pander.microbenchmark <- function(x, caption = attr(x, 'caption'), expr.labels, unit, ...){
+  xs <- summary(x, unit = unit)
+  if (is.null(caption)) {
+    if (is.null(storage$caption))
+      caption <- paste("Unit: ", attr(xs, "unit"), sep = "")
+    else
+      caption <- get.caption()
+  }  
+  if (!missing(expr.labels)){
+    xs[,1] <- as.vector(xs[,1])
+    xs[1:length(expr.labels), 1] <- expr.labels
+  }
+  pander(xs, caption = caption, ...)
+}
+

R/pandoc.R

@@ -526,31 +526,10 @@ pandoc.list <- function(...)
 #' emphasize.strong.cells(which(t > 20, arr.ind = TRUE))
 #' pandoc.table(t)
 pandoc.table.return <- function(t, caption, digits = panderOptions('digits'), decimal.mark = panderOptions('decimal.mark'), big.mark = panderOptions('big.mark'), round = panderOptions('round'), justify, style = c('multiline', 'grid', 'simple', 'rmarkdown'), split.tables = panderOptions('table.split.table'), split.cells = panderOptions('table.split.cells'), keep.trailing.zeros = panderOptions('keep.trailing.zeros'), keep.line.breaks = panderOptions('keep.line.breaks'), plain.ascii = panderOptions('plain.ascii'), use.hyphening = panderOptions('use.hyphening'), emphasize.rows, emphasize.cols, emphasize.cells, emphasize.strong.rows, emphasize.strong.cols, emphasize.strong.cells, ...) {
-
     ## helper functions
     table.expand <- function(cells, cols.width, justify, sep.cols) {
-
-        df  <- data.frame(txt = cells, width = cols.width, justify = justify)
-
-        if (any(grepl('\n', df$txt))) {
-
-            if (style %in% c('simple', 'rmarkdown'))
-                stop('Pandoc does not support newlines in simple or Rmarkdown table format!')
-
-            res <- lapply(strsplit(as.character(df$txt), '\n'), unlist)
-            res.lines <- max(sapply(res, length))
-            res <- paste(sapply(1:res.lines, function(i) table.expand(sapply(res, function(x) ifelse(is.na(x[i]), '  ', x[i])), cols.width, justify, sep.cols)), collapse = '\n')
-            return(res)
-
-        } else {
-
-            res <- apply(df, 1, function(x) format(x[1], justify = x[3], width = as.numeric(x[2]) + length(which(gregexpr("\\\\", x[1])[[1]] > 0))))
-            return(paste0(sep.cols[1], paste(res, collapse = sep.cols[2]), sep.cols[3]))
-
-        }
-
+      .Call('pander_tableExpand_cpp', PACKAGE = 'pander', cells, cols.width, justify, sep.cols, style)
     }
-
     # function for cell conversion to plain-ascii (deletion of markup characters)
     to.plain.ascii <- function(x){
       x <- gsub("&nbsp;", "", x)  # table non-breaking space
@@ -905,7 +884,9 @@ pandoc.table.return <- function(t, caption, digits = panderOptions('digits'), de
             res <- list(t[1:t.split, drop = FALSE], t[(t.split + 1):length(t), drop = FALSE])
 
         ## recursive call
-        res <- paste(pandoc.table.return(res[[1]], caption = caption, digits = digits, decimal.mark = decimal.mark, round = round, justify = justify[[1]], style = style), pandoc.table.return(res[[2]], caption = NULL, digits = digits, decimal.mark = decimal.mark, round = round, justify = justify[[2]], style = style))
+        res <- paste(
+          pandoc.table.return(res[[1]], caption = caption, digits = digits, decimal.mark = decimal.mark, round = round, justify = justify[[1]], style = style), 
+          pandoc.table.return(res[[2]], caption = NULL, digits = digits, decimal.mark = decimal.mark, round = round, justify = justify[[2]], style = style))
 
         return(res)
 

src/RcppExports.cpp

@@ -23,3 +23,22 @@ BEGIN_RCPP
     return __sexp_result;
 END_RCPP
 }
+// tableExpand_cpp
+std::string tableExpand_cpp(CharacterVector cells, IntegerVector colsWidth, CharacterVector justify, CharacterVector sepCols, std::string style);
+RcppExport SEXP pander_tableExpand_cpp(SEXP cellsSEXP, SEXP colsWidthSEXP, SEXP justifySEXP, SEXP sepColsSEXP, SEXP styleSEXP) {
+BEGIN_RCPP
+    SEXP __sexp_result;
+    {
+        Rcpp::RNGScope __rngScope;
+        Rcpp::traits::input_parameter< CharacterVector >::type cells(cellsSEXP );
+        Rcpp::traits::input_parameter< IntegerVector >::type colsWidth(colsWidthSEXP );
+        Rcpp::traits::input_parameter< CharacterVector >::type justify(justifySEXP );
+        Rcpp::traits::input_parameter< CharacterVector >::type sepCols(sepColsSEXP );
+        Rcpp::traits::input_parameter< std::string >::type style(styleSEXP );
+        std::string __result = tableExpand_cpp(cells, colsWidth, justify, sepCols, style);
+        PROTECT(__sexp_result = Rcpp::wrap(__result));
+    }
+    UNPROTECT(1);
+    return __sexp_result;
+END_RCPP
+}

src/splitLine.cpp → src/helpers.cpp

@@ -68,8 +68,7 @@ void process_hyphenation(std::string &result, std::string &word, int &nline, int
     }
     delete []cword;
 }
-
-
+//[[Rcpp::export]]
 std::string splitLine_cpp(std::string str, int max_width, bool use_hyphening, Rcpp::Function hyphen){
   char *pch_word, *cstr, *end_word;
   std::string result, word, hyphened_word, syllable;

src/pandoc.cpp

@@ -0,0 +1,76 @@
+#include <Rcpp.h>
+#include <string.h>
+#include <cstdio> 
+#include <cstdlib>
+using namespace Rcpp;
+
+std::string format_cpp(std::string x, std::string justify, int width){
+  std::string result = "";
+  if (justify == "left"){
+    result += x;
+    result += std::string(width, ' ');
+  } else if (justify == "right"){
+    result += std::string(width, ' ');
+    result += x;
+  } else {
+    result += std::string((width - x.length())/2, ' ');
+    result += x;
+    for (int j = (width + x.length())/2; j < width; j++)
+      result += " ";
+  } 
+  return result;
+}
+
+//[[Rcpp::export]]
+std::string tableExpand_cpp(CharacterVector cells, IntegerVector colsWidth, CharacterVector justify, CharacterVector sepCols, std::string style) {
+    std::string res = "", word, *line;
+    size_t pos;
+    char endline = '\n';
+    std::vector<std::string> cellsC(cells.size()), *resSplit;
+    int i, j, width, maxLengthCells = 0, n = 0;
+    bool hasLineBreak = false;
+    // check for having a line break and convert to string vector for easiness
+    for (i = 0; i < cellsC.size(); i++){
+      cellsC[i] = std::string(cells[i]);
+      if (cellsC[i].find(endline) != std::string::npos)
+        hasLineBreak = true;
+    }
+    if (hasLineBreak){
+      if (style == "simple" || style == "rmarkdown")
+        stop("Pandoc does not support newlines in simple or Rmarkdown table format!");
+      n = cellsC.size();
+      resSplit = new std::vector<std::string>[n];
+      for (i = 0; i < n; i++){
+        line = &cellsC[i];
+        do
+        {
+          pos = line->find(endline);
+          if (line->substr(0, pos) != "")
+            resSplit[i].push_back(line->substr(0, pos));
+          line->erase(0, pos + 1);
+        }
+        while (pos != std::string::npos);
+        if (resSplit[i].size() > maxLengthCells)
+          maxLengthCells = resSplit[i].size();
+      }
+      for (i = 0; i < maxLengthCells; i++){
+        CharacterVector newCells(n);
+        for (j = 0; j < n; j++)
+          newCells[j] = resSplit[j].size() > i ? resSplit[j][i] : "  ";
+        res +=  tableExpand_cpp(newCells, colsWidth, justify, sepCols, style);
+        if (i != (maxLengthCells - 1)) // because of collapse usage
+          res += '\n';
+      }
+    } else {
+      res = sepCols[0];
+      for (i = 0; i < cells.size(); i++){
+        width = colsWidth[i] + std::count(cells[i].begin(), cells[i].end(), '\\');
+        std::string fres = format_cpp(as<std::string>(cells[i]), as<std::string>(justify[i]), width);
+        res += fres;
+        if (i != (cells.length() - 1)) // because of collapse usage
+          res += sepCols[1];
+      }
+      res += sepCols[2];
+    }
+    return res;
+}