[Rd] a patch to tapply (PR#1186)

[vograno@arbitrade.com]

Though tapply(x, factor, fun, simplify =TRUE) should be equivalent to
sapply(split(x, factor), fun, simplify=TRUE), note simplify=TRUE, it is not
so if fun() returns a vector rather than a scalar, e.g.

> tapply(1:6, c(0,0,0,1,1,1), function(x) c(min=min(x), max=max(x)),
simplify=TRUE)
$"0"
min max 
  1   3 

$"1"
min max 
  4   6 

> sapply(split(1:6, c(0,0,0,1,1,1)), function(x) c(min=min(x), max=max(x)),
simplify=TRUE)
    0 1
min 1 4
max 3 6

The patch submitted below fixes this problem
> tapply.new(1:6, c(0,0,0,1,1,1), function(x) c(min=min(x), max=max(x)),
simplify=TRUE)
    0 1
min 1 4
max 3 6

Another potential problem, which I am not able to verify at the moment, is
that whenever simplification is possible S-Plus returns a TRANSPOSE of that
of R, i.e.
  min max
0   1   3
1   4   6

Fixing this would require small changes to both tapply and sapply and I'll
be happy to provide the patches if requested.


R Version
> sapply(R.Version(), I)
           platform                arch                  os
system 
"i686-pc-linux-gnu"              "i686"         "linux-gnu"   "i686,
linux-gnu" 
             status               major               minor
year 
                 ""                 "1"               "3.1"
"2001" 
              month                 day            language 
               "08"                "31"                 "R"

 **************
The patch:
"tapply.new" <-
  function (X, INDEX, FUN = NULL, ..., simplify = TRUE) 
{
  FUN <- if (!is.null(FUN)) 
    match.fun(FUN)
  if (!is.list(INDEX)) 
    INDEX <- list(INDEX)
  nI <- length(INDEX)
  namelist <- vector("list", nI)
  names(namelist) <- names(INDEX)
  extent <- integer(nI)
  nx <- length(X)
  one <- as.integer(1)
  group <- rep(one, nx)
  ngroup <- one
  for (i in seq(INDEX)) {
    index <- as.factor(INDEX[[i]])
    if (length(index) != nx) 
      stop("arguments must have same length")
    namelist[[i]] <- levels(index)
    extent[i] <- nlevels(index)
    group <- group + ngroup * (as.integer(index) - one)
    ngroup <- ngroup * nlevels(index)
  }
  if (is.null(FUN)) 
    return(group)
  ans <- lapply(split(X, group), FUN, ...)
  if (simplify && length(common.len <- unique(unlist(lapply(ans, length))))
== 1) {
    if (common.len > 1) {
      extent <- c(common.len, extent)
      namelist <- c(list(names(ans[[1]])), namelist)
    }
    ansmat <- array(unlist(ans, recursive = FALSE), dim = extent, dimnames =
namelist)
    return(ansmat)
  }
  index <- as.numeric(names(ans))
  ansmat <- array(vector("list", prod(extent)), dim = extent, 
                  dimnames = namelist)
  names(ans) <- NULL
  ansmat[index] <- ans
  ansmat
}

-------------------------------------------------- 
DISCLAIMER 
This e-mail, and any attachments thereto, is intended only for use by the
addressee(s) named herein and may contain legally privileged and/or
confidential information.  If you are not the intended recipient of this
e-mail, you are hereby notified that any dissemination, distribution or
copying of this e-mail, and any attachments thereto, is strictly prohibited.
If you have received this e-mail in error, please immediately notify me and
permanently delete the original and any copy of any e-mail and any printout
thereof. 

E-mail transmission cannot be guaranteed to be secure or error-free.  The
sender therefore does not accept liability for any errors or omissions in
the contents of this message which arise as a result of e-mail transmission.

NOTICE REGARDING PRIVACY AND CONFIDENTIALITY 

Knight Trading Group may, at its discretion, monitor and review the content
of all e-mail communications. 


-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !)  To: r-devel-request@stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._