Dear R-developers,
I would like to suggest a 'method' slot for format.ftable() (see an
adjusted
'format.ftable()' below, taken from the source of R-2.15.2).
At the moment, format.ftable() contains several empty cells due to the way the
row and column labels are printed. This creates problems (= unwanted empty
columns/rows) when converting an ftable to a LaTeX table; see an example based
on 'xtable' below (I am aware of other packages that can create LaTeX
tables). It would be great to have a 'method' slot with several, more
compact
versions. This would be helpful in various contexts (if required, I can provide
more details, including an adjusted .Rd).
Cheers,
Marius
##' @title Adjusted format.ftable() (based on ./src/library/stats/R/ftable.R
in R-2.15.2)
##' @param x see ?format.ftable
##' @param quote see ?format.ftable
##' @param digits see ?format.ftable
##' @param method different methods of how the formatted ftable is
presented;
##' currently available are:
##' "non.compact": the default of format.ftable()
##' "row.compact": without empty row under the column
labels
##' "col.compact": without empty column to the right of the
row labels
##' "compact" : without neither empty rows nor columns
##' @param sep separation character of row/col labels for
method=="compact"
##' @param ... see ?format.ftable
##' @return see ?format.ftable
format.ftable <- function(x, quote=TRUE,
digits=getOption("digits"),
method=c("non.compact",
"row.compact", "col.compact", "compact"),
sep=" \\ ", ...)
{
if(!inherits(x, "ftable"))
stop("'x' must be an \"ftable\" object")
charQuote <- function(s)
if(quote) paste0("\"", s, "\"") else s
makeLabels <- function(lst) {
lens <- sapply(lst, length)
cplensU <- c(1, cumprod(lens))
cplensD <- rev(c(1, cumprod(rev(lens))))
y <- NULL
for (i in rev(seq_along(lst))) {
ind <- 1 + seq.int(from = 0, to = lens[i] - 1) * cplensD[i + 1]
tmp <- character(length = cplensD[i])
tmp[ind] <- charQuote(lst[[i]])
y <- cbind(rep(tmp, times = cplensU[i]), y)
}
y
}
makeNames <- function(x) {
nmx <- names(x)
if(is.null(nmx))
nmx <- rep("", length.out = length(x))
nmx
}
xrv <- attr(x, "row.vars")
xcv <- attr(x, "col.vars")
method <- match.arg(method)
LABS <- switch(method,
"non.compact"={ # current default
cbind(rbind(matrix("", nrow = length(xcv), ncol
= length(xrv)),
charQuote(makeNames(xrv)),
makeLabels(xrv)),
c(charQuote(makeNames(xcv)),
rep("", times = nrow(x) + 1)))
},
"row.compact"={ # row-compact version
cbind(rbind(matrix("", nrow = length(xcv)-1,
ncol = length(xrv)),
charQuote(makeNames(xrv)),
makeLabels(xrv)),
c(charQuote(makeNames(xcv)),
rep("", times = nrow(x))))
},
"col.compact"={ # column-compact version
cbind(rbind(cbind(matrix("", nrow =
length(xcv), ncol = length(xrv)-1),
charQuote(makeNames(xcv))),
charQuote(makeNames(xrv)),
makeLabels(xrv)))
},
"compact"={ # fully compact version
l.xcv <- length(xcv)
l.xrv <- length(xrv)
xrv.nms <- makeNames(xrv)
xcv.nms <- makeNames(xcv)
mat <- cbind(rbind(cbind(matrix("", nrow =
l.xcv-1, ncol = l.xrv-1),
charQuote(makeNames(xcv[-l.xcv]))),
charQuote(xrv.nms),
makeLabels(xrv)))
mat[l.xcv, l.xrv] <- paste(tail(xrv.nms, 1),
tail(xcv.nms, 1), sep=sep)
mat
},
stop("wrong method"))
DATA <- rbind(if(length(xcv)) t(makeLabels(xcv)),
if(method == "non.compact" || method ==
"col.compact") rep("", times = ncol(x)),
format(unclass(x), digits = digits))
cbind(apply(LABS, 2L, format, justify = "left"),
apply(DATA, 2L, format, justify = "right"))
}
## toy example
(mdat <- matrix(c(1,20,3, -40, 5, 6), nrow=2, ncol=3, byrow=TRUE,
dimnames=list(a=c("a1", "a2"),
b=c("b1", "b2", "b3"))))
ft <- ftable(mdat) # print.ftable() ~> write.ftable() ~>
format.ftable()
format.ftable(ft, quote=FALSE)
format.ftable(ft, quote=FALSE, method="row.compact")
format.ftable(ft, quote=FALSE, method="col.compact")
format.ftable(ft, quote=FALSE, method="compact")
## Titanic data set
ft. <- ftable(Titanic, row.vars=1:2, col.vars=3:4)
format.ftable(ft., quote=FALSE)
format.ftable(ft., quote=FALSE, method="row.compact")
format.ftable(ft., quote=FALSE, method="col.compact")
format.ftable(ft., quote=FALSE, method="compact")
## convert to a LaTeX table via 'xtable'
require(xtable)
## current default
print(xtable(format.ftable(ft., quote=FALSE)),
floating=FALSE, only.contents=TRUE, hline.after=NULL,
include.rownames=FALSE, include.colnames=FALSE)
## compact version (=> does not introduce empty columns in the LaTeX table)
print(xtable(format.ftable(ft., quote=FALSE, method="compact")),
floating=FALSE, only.contents=TRUE, hline.after=NULL,
include.rownames=FALSE, include.colnames=FALSE)
--
Eth Zurich
Dr. Marius Hofert
RiskLab, Department of Mathematics
HG E 65.2
R?mistrasse 101
8092 Zurich
Switzerland
Phone +41 44 632 2423
http://www.math.ethz.ch/~hofertj
GPG key fingerprint 8EF4 5842 0EA2 5E1D 3D7F 0E34 AD4C 566E 655F 3F7C
>>>>> Marius Hofert <marius.hofert at math.ethz.ch> >>>>> on Mon, 17 Dec 2012 11:39:03 +0100 writes:> Dear R-developers, I would like to suggest a 'method' slot > for format.ftable() (see an adjusted 'format.ftable()' > below, taken from the source of R-2.15.2). > At the moment, format.ftable() contains several empty > cells due to the way the row and column labels are > printed. This creates problems (= unwanted empty > columns/rows) when converting an ftable to a LaTeX table; > see an example based on 'xtable' below (I am aware of > other packages that can create LaTeX tables). It would be > great to have a 'method' slot with several, more compact > versions. This would be helpful in various contexts (if > required, I can provide more details, including an > adjusted .Rd). Dear Marius, this sounds interesting and relevant, and clearly is 100% back-compatible, so I am planning to adopt it (with very very slight changes, nothing semantic). Yes, indeed, for the help page, please provide a patch against the *current* version, i.e. https://svn.r-project.org/R/trunk/src/library/stats/man/read.ftable.Rd Thank you for your contribution! Regards, Martin > ##' @title Adjusted format.ftable() (based on ./src/library/stats/R/ftable.R in R-2.15.2) > ##' @param x see ?format.ftable > ##' @param quote see ?format.ftable > ##' @param digits see ?format.ftable > ##' @param method different methods of how the formatted ftable is presented; > ##' currently available are: > ##' "non.compact": the default of format.ftable() > ##' "row.compact": without empty row under the column labels > ##' "col.compact": without empty column to the right of the row labels > ##' "compact" : without neither empty rows nor columns > ##' @param sep separation character of row/col labels for method=="compact" > ##' @param ... see ?format.ftable > ##' @return see ?format.ftable > format.ftable <- function(x, quote=TRUE, digits=getOption("digits"), > method=c("non.compact", "row.compact", "col.compact", "compact"), > sep=" \\ ", ...) > { > if(!inherits(x, "ftable")) > stop("'x' must be an \"ftable\" object") > charQuote <- function(s) > if(quote) paste0("\"", s, "\"") else s > makeLabels <- function(lst) { > lens <- sapply(lst, length) > cplensU <- c(1, cumprod(lens)) > cplensD <- rev(c(1, cumprod(rev(lens)))) > y <- NULL > for (i in rev(seq_along(lst))) { > ind <- 1 + seq.int(from = 0, to = lens[i] - 1) * cplensD[i + 1] > tmp <- character(length = cplensD[i]) > tmp[ind] <- charQuote(lst[[i]]) > y <- cbind(rep(tmp, times = cplensU[i]), y) > } > y > } > makeNames <- function(x) { > nmx <- names(x) > if(is.null(nmx)) > nmx <- rep("", length.out = length(x)) > nmx > } > xrv <- attr(x, "row.vars") > xcv <- attr(x, "col.vars") > method <- match.arg(method) > LABS <- switch(method, > "non.compact"={ # current default > cbind(rbind(matrix("", nrow = length(xcv), ncol = length(xrv)), > charQuote(makeNames(xrv)), > makeLabels(xrv)), > c(charQuote(makeNames(xcv)), > rep("", times = nrow(x) + 1))) > }, > "row.compact"={ # row-compact version > cbind(rbind(matrix("", nrow = length(xcv)-1, ncol = length(xrv)), > charQuote(makeNames(xrv)), > makeLabels(xrv)), > c(charQuote(makeNames(xcv)), > rep("", times = nrow(x)))) > }, > "col.compact"={ # column-compact version > cbind(rbind(cbind(matrix("", nrow = length(xcv), ncol = length(xrv)-1), > charQuote(makeNames(xcv))), > charQuote(makeNames(xrv)), > makeLabels(xrv))) > }, > "compact"={ # fully compact version > l.xcv <- length(xcv) > l.xrv <- length(xrv) > xrv.nms <- makeNames(xrv) > xcv.nms <- makeNames(xcv) > mat <- cbind(rbind(cbind(matrix("", nrow = l.xcv-1, ncol = l.xrv-1), > charQuote(makeNames(xcv[-l.xcv]))), > charQuote(xrv.nms), > makeLabels(xrv))) > mat[l.xcv, l.xrv] <- paste(tail(xrv.nms, 1), tail(xcv.nms, 1), sep=sep) > mat > }, > stop("wrong method")) > DATA <- rbind(if(length(xcv)) t(makeLabels(xcv)), > if(method == "non.compact" || method == "col.compact") rep("", times = ncol(x)), > format(unclass(x), digits = digits)) > cbind(apply(LABS, 2L, format, justify = "left"), > apply(DATA, 2L, format, justify = "right")) > } > ## toy example > (mdat <- matrix(c(1,20,3, -40, 5, 6), nrow=2, ncol=3, byrow=TRUE, > dimnames=list(a=c("a1", "a2"), b=c("b1", "b2", "b3")))) > ft <- ftable(mdat) # print.ftable() ~> write.ftable() ~> format.ftable() > format.ftable(ft, quote=FALSE) > format.ftable(ft, quote=FALSE, method="row.compact") > format.ftable(ft, quote=FALSE, method="col.compact") > format.ftable(ft, quote=FALSE, method="compact") > ## Titanic data set > ft. <- ftable(Titanic, row.vars=1:2, col.vars=3:4) > format.ftable(ft., quote=FALSE) > format.ftable(ft., quote=FALSE, method="row.compact") > format.ftable(ft., quote=FALSE, method="col.compact") > format.ftable(ft., quote=FALSE, method="compact") > ## convert to a LaTeX table via 'xtable' > require(xtable) > ## current default > print(xtable(format.ftable(ft., quote=FALSE)), > floating=FALSE, only.contents=TRUE, hline.after=NULL, > include.rownames=FALSE, include.colnames=FALSE) > ## compact version (=> does not introduce empty columns in the LaTeX table) > print(xtable(format.ftable(ft., quote=FALSE, method="compact")), > floating=FALSE, only.contents=TRUE, hline.after=NULL, > include.rownames=FALSE, include.colnames=FALSE) > -- > Eth Zurich > Dr. Marius Hofert > RiskLab, Department of Mathematics > HG E 65.2 > R?mistrasse 101 > 8092 Zurich > Switzerland > Phone +41 44 632 2423 > http://www.math.ethz.ch/~hofertj > GPG key fingerprint 8EF4 5842 0EA2 5E1D 3D7F 0E34 AD4C 566E 655F 3F7C > ______________________________________________ > R-devel at r-project.org mailing list > https://stat.ethz.ch/mailman/listinfo/r-devel
Dear Martin,
Thanks a lot, that sounds great. Here is the unified diff for ?read.ftable.Rd.
Cheers,
Marius
--- /home/mhofert/R/R-devel/src/library/stats/man/read.ftable.Rd 2012-12-21
02:09:18.488980586 +0100
+++ read.ftable.Rd 2012-12-22 21:45:08.574636009 +0100
@@ -14,9 +14,13 @@
row.var.names, col.vars, skip = 0)
write.ftable(x, file = "", quote = TRUE, append = FALSE,
- digits = getOption("digits"))
-
-\method{format}{ftable}(x, quote = TRUE, digits =
getOption("digits"), \dots)
+ digits = getOption("digits"),
+ method=c("non.compact", "row.compact",
"col.compact", "compact"),
+ sep=" \\ ")
+
+\method{format}{ftable}(x, quote = TRUE, digits =
getOption("digits"),
+ method=c("non.compact",
"row.compact",
+ "col.compact", "compact"),
sep=" \\ ", \dots)
}
\arguments{
\item{file}{either a character string naming a file or a connection
@@ -42,6 +46,22 @@
the contents of \code{file} will be overwritten.}
\item{digits}{an integer giving the number of significant digits to
use for (the cell entries of) \code{x}.}
+ \item{method}{methods of how the formatted \code{"ftable"} object
is
+ printed. Available are (see the examples):
+ \describe{
+ \item{"non.compact"}{the default representation of an
+ \code{"ftable"} object.}
+ \item{"row.compact"}{a row-compact version without empty cells
+ under the column labels.}
+ \item{"col.compact"}{a column-compact version without empty
cells
+ to the right of the row labels.}
+ \item{"compact"}{a row- and column-compact version. This may
imply
+ that a row and a column label have to share the
+ same cell. They are then separated by the character
+ specified by \code{sep}.}
+ }}
+ \item{sep}{separation character for row/column labels if
+ \code{method="compact"}.}
\item{\dots}{further arguments to be passed to or from methods.}
}
\details{
@@ -64,7 +84,9 @@
table from this using \code{\link{xtabs}}.
\code{write.ftable} writes a flat table to a file, which is useful for
- generating \sQuote{pretty} ASCII representations of contingency tables.
+ generating \sQuote{pretty} ASCII representations of contingency
+ tables. Different versions are available via the \code{method}
+ argument, which may be useful, for example, for constructing LaTeX tables.
}
\seealso{
\code{\link{ftable}} for more information on flat contingency tables.
@@ -108,6 +130,9 @@
ft22 <- ftable(Titanic, row.vars = 2:1, col.vars = 4:3)
write.ftable(ft22, quote = FALSE)
+write.ftable(ft22, quote = FALSE, method="row.compact")
+write.ftable(ft22, quote = FALSE, method="col.compact")
+write.ftable(ft22, quote = FALSE, method="compact")
\dontshow{
stopifnot(dim(format(ft)) == 4:5,
dim(format(ftable(UCBAdmissions))) == c(6,9),