diff --git a/DESCRIPTION b/DESCRIPTION index 8cf1591..b25bc58 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: tables Title: Formula-Driven Table Generation -Version: 0.9.17 +Version: 0.9.18 Author: Duncan Murdoch Description: Computes and displays complex tables of summary statistics. Output may be in LaTeX, HTML, plain text, or an R diff --git a/NEWS.md b/NEWS.md index f035918..7e01e31 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,8 @@ +# tables 0.9.18 + +- `PlusMinus()` and `Paste()` didn't handle formatting properly +when multiple columns were involved (issue #13). + # tables 0.9.17 - Change host to Github. diff --git a/R/Paste.R b/R/Paste.R index d5751b5..a3251dc 100644 --- a/R/Paste.R +++ b/R/Paste.R @@ -35,16 +35,20 @@ Paste <- function(..., head, digits=2, justify="c", prefix="", sep="", postfix=" just <- paste0(just, "@{", postfix, "\\hspace{\\tabcolsep}}") term <- substitute(xhead*Justify(just)*x, list(xhead=xhead, just=just, x=args[[i]])) - if (length(digits) > 1) - term <- substitute(Format(digits=digits)*term, - list(digits = digits[i], term = term)) + if (length(digits) > 1) { + fmt <- multicolumnFormat(digits[i]) + term <- substitute(Format(fmt())*term, + list(fmt = fmt, term = term)) + } result <- if (i == 1) term else substitute(result + term, list(result=result, term=term)) } result <- substitute( head*1*result, list(head=head, result=result) ) - if (length(digits) == 1) - result <- substitute(Format(digits=digits)*result, - list(digits=digits, result=result)) + if (length(digits) == 1) { + fmt <- multicolumnFormat(digits) + result <- substitute(Format(fmt())*result, + list(digits=digits, result=result, fmt=fmt)) + } result } diff --git a/R/PlusMinus.R b/R/PlusMinus.R index 3668977..a0cf30a 100644 --- a/R/PlusMinus.R +++ b/R/PlusMinus.R @@ -1,18 +1,29 @@ -PlusMinus <- function(x, y, head, xhead, yhead, digits=2, character.only = FALSE, - ...) { - head <- getHeading(head, substitute(head), character.only) - xhead <- getHeading(xhead, substitute(xhead), character.only) - yhead <- getHeading(yhead, substitute(yhead), character.only) +# Create a function that applies a common format to its argument, +# then removes leading blanks by column. - fmt <- function(x){ - s <- format(x, digits=digits, ...) - is_stderr <- (1:length(s)) > length(s) %/% 2 - s[is_stderr] <- sprintf("$%s$", s[is_stderr]) - s[!is_stderr] <- latexNumeric(s[!is_stderr]) - s - } - substitute( head*1*Format(fmt())*(xhead*Justify("r@{}")*x - + yhead*Justify("@{ $\\pm$ }l")*y), - list(x=substitute(x), y=substitute(y), - head=head, xhead=xhead, yhead=yhead, fmt=fmt)) +multicolumnFormat <- function(digits = 2, ...) { + function(x){ + s <- format(x, digits=digits, ...) + if (!is.null(col <- attr(x, "col"))) { + for (j in unique(col)) { + blanks <- nchar(sub("[^ ].*$", "", s[col == j])) + if (all(blanks > 0)) + s[col == j] <- substring(s[col == j], min(blanks) + 1) + } + } + latexNumeric(s) + } +} + +PlusMinus <- function(x, y, head, xhead, yhead, digits=2, character.only = FALSE, ...) { + head <- getHeading(head, substitute(head), character.only) + xhead <- getHeading(xhead, substitute(xhead), character.only) + yhead <- getHeading(yhead, substitute(yhead), character.only) + + fmt <- multicolumnFormat(digits, ...) + + substitute( head*1*Format(fmt())*(xhead*Justify("r@{}")*x + + yhead*Justify("@{ $\\pm$ }l")*y), + list(x=substitute(x), y=substitute(y), + head=head, xhead=xhead, yhead=yhead, fmt=fmt)) } diff --git a/R/tabular.R b/R/tabular.R index 56389a5..3691a23 100644 --- a/R/tabular.R +++ b/R/tabular.R @@ -802,7 +802,11 @@ format.tabular <- function(x, digits=4, justification="n", if (isformat) skip <- ischar | (lengths != 1) else skip <- ischar & FALSE last <- length(call) + x <- do.call(c, result[ind & !skip]) + # record the column number + attr(x, "col") <- col(ind)[ind & !skip] + call[[last+1]] <- x names(call)[last+1] <- "x" chars[ind & !skip] <- eval(call, environment(table)) diff --git a/man/Paste.Rd b/man/Paste.Rd index 181f517..fc6e89c 100644 --- a/man/Paste.Rd +++ b/man/Paste.Rd @@ -22,7 +22,7 @@ If not missing, this will be used as a column heading for the combined columns. } \item{digits}{ Will be passed to the \code{\link{format}} function. If \code{digits} is -length one, all columns use a common format; otherwise they are +length one, all expressions use a common format; otherwise they are formatted separately. } \item{justify}{ @@ -44,6 +44,11 @@ An expression which will produce the requested output in LaTeX. } \examples{ stderr <- function(x) sd(x)/sqrt(length(x)) -toLatex( tabular( (Species+1) ~ Sepal.Length* - PlusMinus(mean, stderr, digits=1), data=iris ) ) +lcl <- function(x) mean(x) - qt(0.975, df=length(x)-1)*stderr(x) +ucl <- function(x) mean(x) + qt(0.975, df=length(x)-1)*stderr(x) +toLatex( tabular( (Species+1) ~ All(iris)* + Paste(lcl, ucl, digits = 2, + head="95\\\% CI", + prefix = "[", sep = ",", postfix = "]"), + data=iris ) ) } diff --git a/vignettes/knitrTables.Rmd b/vignettes/knitrTables.Rmd index 1e0ecdb..36249fc 100644 --- a/vignettes/knitrTables.Rmd +++ b/vignettes/knitrTables.Rmd @@ -887,16 +887,19 @@ This function produces table entries like $x \pm y$ with an optional header. It has syntax ```r -PlusMinus(x, y, head, xhead, yhead, digits=2, ...) +PlusMinus(x, y, head, xhead, yhead, digits = 2, + character.only = FALSE, ...) ``` The arguments are -- ``x, y`: These are expressions which should each generate a single column in the table. The `x` +- `x, y`: These are expressions which should each generate a single column in the table. The `x` value will be flush right, the `y` value will be flush left, with the $\pm$ symbol between. -- ``head`: If not missing, this header will be put over the pair of columns. -- ``xhead, yhead`: If not missing, these will be put over the individual columns. -- ``digits, ...`: These arguments will be passed to the standard `format()` function. +- `head`: If not missing, this header will be put over the pair of columns. +- `xhead, yhead`: If not missing, these will be put over the individual columns. +- `digits, ...`: These arguments will be passed to the standard `format()` function. +- `character.only`: If `TRUE`, the `head`, `xhead` and `yhead` +arguments will be interpreted as expressions evaluating to character values. Example: Display mean $\pm$ standard error. diff --git a/vignettes/tables.Rnw b/vignettes/tables.Rnw index 76a940a..fba6007 100644 --- a/vignettes/tables.Rnw +++ b/vignettes/tables.Rnw @@ -954,8 +954,8 @@ Expressions to be displayed in the columns of the table. If not missing, this will be used as a column heading for the combined columns. \item[\code{digits}] Digits used in formatting. If a single value -is given, all columns will be formatted in common. -If multiple values are given, each is formatted separately. +is given, all expressions will be formatted in common. +If multiple values are given, each expression is formatted separately, recycling the \code{digits} values if necessary. \item[\code{justify}] One or more justifications to use on the individual columns. \item[\code{prefix, sep, postfix}] @@ -969,8 +969,8 @@ lcl <- function(x) mean(x) - qt(0.975, df=length(x)-1)*stderr(x) ucl <- function(x) mean(x) + qt(0.975, df=length(x)-1)*stderr(x) toLatex( tabular( (Species+1) ~ All(iris)* Paste(lcl, ucl, digits=2, - head="95\\% CI", sep=",", prefix="[", - postfix="]"), + head="95\\% CI", + prefix="[", sep=",", postfix="]"), data=iris ) ) @ \end{center} diff --git a/vignettes/tables.Rout.save b/vignettes/tables.Rout.save index cad6bf5..94e03f1 100644 --- a/vignettes/tables.Rout.save +++ b/vignettes/tables.Rout.save @@ -606,7 +606,7 @@ All & \multicolumn{1}{r@{}}{$5.84$} & \multicolumn{1}{@{ $\pm$ }l}{$0.07$} & \m + 1) * stderr(x) > toLatex(tabular((Species + 1) ~ All(iris) * Paste(lcl, -+ ucl, digits = 2, head = "95\\% CI", sep = ",", prefix = "[", ++ ucl, digits = 2, head = "95\\% CI", prefix = "[", sep = ",", + postfix = "]"), da .... [TRUNCATED] \begin{tabular}{lcccccccc} \toprule @@ -984,4 +984,4 @@ All & $150$ & $5.84$ & $0.83$ & $3.06$ & $0.44$ \\ *** Run successfully completed *** > proc.time() user system elapsed - 3.664 0.285 4.127 + 2.709 0.175 3.015