Fix formatting in PlusMinus and Paste

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

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.

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
 }

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))
 }

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))

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 ) )
 }

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.

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}

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