Fixed mtable. Added tests

.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", "tables", "reshape"), dep = TRUE, repos = "http://cran.r-project.org")'
+  - Rscript -e 'install.packages(c("ggplot2", "testthat", "koRpus", "descr", "Rcpp", "microbenchmark", "pander", "devtools", "XML", "tables", "reshape", "memisc"), dep = TRUE, repos = "http://cran.r-project.org")'
   - Rscript -e 'devtools::install_github("jimhester/covr")'
 
 # run tests

DESCRIPTION

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

R/S3.R

@@ -738,35 +738,44 @@ pander.ftable <- function(x, ...)
 #' @param ... optional parameters passed to raw \code{pandoc.table} function
 #' @export
 pander.mtable <- function(x, caption = attr(x, 'caption'), ...) {
-
     if (is.null(caption) & !is.null(storage$caption))
         caption <- get.caption()
-
+    horizontal <- FALSE
     coefs <- ftable(as.table(x$coefficients), row.vars = rev(x$as.row), col.vars = rev(x$as.col))
-    coefs <- as.data.frame(rbind(coefs, x$summaries))
-    col.size <- length(colnames(coefs))
+    col.size <- if (length(dimnames(x$coefficients)) > 3) length(dimnames(x$coefficients)[[4]]) else 1
     row.size <- length(dimnames(x$coefficients)[[3]])
+    nrows.coefs <- nrow(coefs)
+    k <- nrows.coefs / row.size
+    if (k == 1)
+        horizontal <- TRUE
+
     zeros <- rep(0, (col.size) * (row.size))
     temp <- matrix(zeros, ncol = (col.size))
     temp <- as.table(temp)
-
-    for (i in 1:row.size) {
-        tmp.row <- vector()
-        s <- as.vector(rbind(as.vector(as.matrix(coefs[2 *i - 1, ])), as.vector(as.matrix(coefs[2*i, ]))))
-        for (j in 1:col.size)
-            tmp.row <- c(tmp.row, paste(s[2*j - 1], s[2 * j], sep = '\\ \n'))
-        temp[i, ] <- tmp.row
+
+    if (horizontal) {
+        for (i in 1:row.size) {
+            s <- coefs[i, ]
+            tmp.row <- vector()
+            for (j in 1:col.size)
+                tmp.row <- c(tmp.row, paste(s[2*j - 1], s[2 * j], sep = '\\ \n'))
+            temp[i, ] <- tmp.row
+        }
+    } else {
+        for (i in 1:row.size) {
+            tmp.row <- vector()
+            s <- as.matrix(coefs[(i*k-k+1):(i*k), ])
+            for (j in 1:col.size)
+                tmp.row <- c(tmp.row, paste(s[,j], collapse = '\\ \n'))
+            temp[i, ] <- tmp.row
+        }
     }
-
     temp <- rbind(temp, x$summaries)
     rownames(temp) <- c(dimnames(x$coefficients)[[3]], rownames(x$summaries))
-    colnames(temp) <- colnames(coefs)
-
+    colnames(temp) <- colnames(x$summaries)
     pandoc.table(temp, caption = caption, keep.line.breaks = TRUE, ...)
-
 }
 
-
 #' Pander method for CrossTable class
 #'
 #' Prints a CrossTable object in Pandoc's markdown.

inst/tests/test-S3.R

@@ -464,4 +464,33 @@ test_that('pander.aovlist/pander.summary.aovlist behaves correctly', {
     a <- aov(yield ~  N*P*K + Error(block), npk)
     pa <- pander_return(a, style='simple')
     expect_equal(length(pa), 14)
-})
+})
+
+test_that('pander.mtable behaves correctly', {
+    suppressMessages(require(memisc))
+    lm0 <- lm(sr ~ pop15 + pop75,              data = LifeCycleSavings)
+    pm <- pander_return(memisc::mtable(lm0), style='grid') # produces 2 columns, corner case
+    expect_equal(length(strsplit(pm[3], "\\+")[[1]]), 3) 
+    expect_equal(length(pm), 35)
+
+    berkeley <- Aggregate(Table(Admit,Freq)~.,data=UCBAdmissions)
+    berk0 <- glm(cbind(Admitted,Rejected)~1,data=berkeley,family="binomial")
+    berk1 <- glm(cbind(Admitted,Rejected)~Gender,data=berkeley,family="binomial")
+    berk2 <- glm(cbind(Admitted,Rejected)~Gender+Dept,data=berkeley,family="binomial")
+    pm <- pander_return(mtable(berk0, summary.stats=NULL), style='grid') # only one row
+    expect_equal(length(pm), 7)
+
+    # horizontal, produced an error before
+    x <- memisc::mtable(berk0,berk1,berk2,
+           coef.style="horizontal",
+           summary.stats=c("Deviance","AIC","N"))
+    pm <- pander_return(x, style='grid')
+    expect_equal(length(pm), 33)
+    expect_true(all(sapply(colnames(x$coeficient), grepl, pm[4])))
+
+    # more complex mtable
+    pm <- pander_return(memisc::mtable(berk0,berk1,berk2,
+           coef.style="all",
+           summary.stats=c("Deviance","AIC","N")), style = 'grid')
+    expect_equal(length(pm), 47)
+})