diff --git a/.travis.yml b/.travis.yml index 9a867fd2..669a481b 100644 --- a/.travis.yml +++ b/.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 diff --git a/DESCRIPTION b/DESCRIPTION index a9507297..2c5dfe7d 100644 --- a/DESCRIPTION +++ b/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 diff --git a/NAMESPACE b/NAMESPACE index df3b7d95..3b9210ca 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/S3.R b/R/S3.R index 24a83ba3..0db872ed 100644 --- a/R/S3.R +++ b/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, ...) +} \ No newline at end of file diff --git a/inst/tests/test-S3.R b/inst/tests/test-S3.R index 9bb2013e..5e4b1592 100644 --- a/inst/tests/test-S3.R +++ b/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 ") +}) diff --git a/man/pander.tabular.Rd b/man/pander.tabular.Rd new file mode 100644 index 00000000..33efea86 --- /dev/null +++ b/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 +} +