View | Details | Raw Unified | Return to bug 16640 | Differences between
and this patch

Collapse All | Expand All

(-)tapply.R (-18 / +11 lines)
Lines 20-43 Link Here
20
{
20
{
21
    FUN <- if (!is.null(FUN)) match.fun(FUN)
21
    FUN <- if (!is.null(FUN)) match.fun(FUN)
22
    if (!is.list(INDEX)) INDEX <- list(INDEX)
22
    if (!is.list(INDEX)) INDEX <- list(INDEX)
23
    nI <- length(INDEX)
23
    INDEX <- lapply(INDEX, as.factor)  # now, 'INDEX' is not classed
24
    if (!nI) stop("'INDEX' is of length zero")
24
    if (!length(INDEX)) stop("'INDEX' is of length zero")
25
    namelist <- vector("list", nI)
25
    if (!all(lengths(INDEX) == length(X)))
26
    names(namelist) <- names(INDEX)
26
        stop("arguments must have same length")
27
    extent <- integer(nI)
27
    namelist <- lapply(INDEX, levels)#- all of them, yes !
28
    nx <- length(X)
28
    extent <- lengths(namelist, use.names = FALSE)
29
    one <- 1L
29
    ngroup <- prod(extent)
30
    group <- rep.int(one, nx) #- to contain the splitting vector
30
    group <- seq_len(ngroup)
31
    ngroup <- one
31
    dim(group) <- extent
32
    for (i in seq_along(INDEX)) {
32
    group <- group[do.call(cbind, INDEX)] #- to contain the splitting vector
33
	index <- as.factor(INDEX[[i]])
33
    if (!is.null(dim(group))) dim(group) <- NULL
34
	if (length(index) != nx)
35
	    stop("arguments must have same length")
36
	namelist[[i]] <- levels(index)#- all of them, yes !
37
	extent[i] <- nlevels(index)
38
	group <- group + ngroup * (as.integer(index) - one)
39
	ngroup <- ngroup * nlevels(index)
40
    }
41
    if (is.null(FUN)) return(group)
34
    if (is.null(FUN)) return(group)
42
    ans <- lapply(X = split(X, group), FUN = FUN, ...)
35
    ans <- lapply(X = split(X, group), FUN = FUN, ...)
43
    index <- as.integer(names(ans))
36
    index <- as.integer(names(ans))

Return to bug 16640