pander.tabular again

.travis.yml

@@ -18,7 +18,7 @@ install:
   - "[ ! -d ~/R ] && mkdir ~/R"
   - R --version
   - R -e '.libPaths(); sessionInfo()'
-  - Rscript -e 'install.packages(c("ggplot2", "testthat", "koRpus", "descr", "Rcpp", "microbenchmark", "pander", "devtools", "XML"), dep = TRUE, repos = "http://cran.r-project.org")'
+  - Rscript -e 'install.packages(c("ggplot2", "testthat", "koRpus", "descr", "Rcpp", "microbenchmark", "pander", "devtools", "XML", "tables"), dep = TRUE, repos = "http://cran.r-project.org")'
   - Rscript -e 'devtools::install_github("jimhester/covr")'
 
 # run tests

DESCRIPTION

@@ -36,7 +36,8 @@ Suggests:
     nlme,
     descr,
     MASS,
-    knitr
+    knitr,
+    tables
 SystemRequirements: pandoc (http://johnmacfarlane.net/pandoc) for exporting
     markdown files to other formats.
 LinkingTo: Rcpp

NAMESPACE

@@ -47,6 +47,7 @@ S3method(pander,summary.prcomp)
 S3method(pander,survdiff)
 S3method(pander,survfit)
 S3method(pander,table)
+S3method(pander,tabular)
 S3method(pander,ts)
 S3method(pander,zoo)
 export(Pandoc)

R/S3.R

@@ -1504,3 +1504,31 @@ pander.function <- function(x, add.name = FALSE, verbatim = TRUE, syntax.highlig
         cat('```')
 
 }
+
+#' Pander method for tabular class
+#'
+#' @param x an tabular object
+#' @param ... ignored parameters
+#' @export
+pander.tabular <- function(x, ...) {
+  # Get the cols and rows header
+  colLabels <- attr(x, 'colLabels')
+  rowLabels <- attr(x, 'rowLabels')
+  content <- format(x, ...)
+
+  # Replace NA values with empty strings
+  colLabels[is.na(colLabels)] <- ''
+  rowLabels[is.na(rowLabels)] <- ''
+
+  # Create an empty matrix to get the same size
+  header <- matrix(data="", nrow = nrow(colLabels), ncol = ncol(rowLabels))
+  header[nrow(colLabels), 1:ncol(rowLabels)] <- colnames(rowLabels)
+  # Add the row labels to the table header
+  header <- cbind(header, colLabels)
+
+  colnames(rowLabels) <- NULL
+  table <- cbind(rowLabels, content)
+  colnames(table) <- apply(header, 2, paste, collapse= '\\ \n')
+
+  pandoc.table(table, keep.line.breaks = TRUE, ...)
+}

inst/tests/test-S3.R

@@ -359,3 +359,23 @@ test_that('table.expand behaves correctly',{
   # unicode string issue
   expect_equal(pandoc.table.return(data.frame(a = 'ßß')), "\n---\n a \n---\nßß \n---\n\n")
 })
+
+context("pander.tabular")
+test_that('tables::tabular behaves correctly', {
+  if(!suppressMessages(require('tables'))) {
+    skip('Package tables not installed : skipping pander.tabular tests')
+  }
+  # checking nested columns
+  x <- tabular((Species + 1) ~ (n=1) + Format(digits=2) * (Sepal.Length + Sepal.Width)*(mean + sd), data=iris)
+  tabularmd <- pander.return(x);
+
+  expect_equal(tabularmd[3], "    \\       \\    Sepal.Length\\    \\    Sepal.Width\\    \\  ")
+  expect_equal(tabularmd[4], " Species    n         mean        sd       mean        sd ")
+
+  # checking nested rows
+  x <- tabular(as.factor(am) * (mean+median) ~ (mpg+hp+qsec), data = mtcars)
+  tabularmd <- pander.return(x);
+
+  expect_equal(tabularmd[5], "       0          mean   17.15 160.3 18.18 ")
+  expect_equal(tabularmd[7], "                 median  17.30 175.0 17.82 ")
+})

man/pander.tabular.Rd

@@ -0,0 +1,17 @@
+% Generated by roxygen2 (4.1.0): do not edit by hand
+% Please edit documentation in R/S3.R
+\name{pander.tabular}
+\alias{pander.tabular}
+\title{Pander method for tabular class}
+\usage{
+\method{pander}{tabular}(x, ...)
+}
+\arguments{
+\item{x}{an tabular object}
+
+\item{...}{ignored parameters}
+}
+\description{
+Pander method for tabular class
+}
+