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

Collapse All | Expand All

(-)src/library/base/R/tapply.R (-16 / +11 lines)
Lines 21-45 Link Here
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
    nI <- length(INDEX)
24
    if (!nI) stop("'INDEX' is of length zero")
24
##    if (!nI) stop("'INDEX' is of length zero") # can't happen given that index is now a list of something (even NULL)
25
    namelist <- vector("list", nI)
25
    namelist <- vector("list", nI)
26
    names(namelist) <- names(INDEX)
26
    names(namelist) <- names(INDEX)
27
    extent <- integer(nI)
27
    extent <- integer(nI)
28
    nx <- length(X)
28
    nx <- length(X)
29
    one <- 1L
29
    group <- rep.int(1L, nx) #- to contain the splitting vector
30
    group <- rep.int(one, nx) #- to contain the splitting vector
30
    ngroup <- 1L
31
    ngroup <- one
31
    if (any(lengths(INDEX) != nx))
32
        stop("arguments must have same length")
32
    for (i in seq_along(INDEX)) {
33
    for (i in seq_along(INDEX)) {
33
	index <- as.factor(INDEX[[i]])
34
	index <- as.factor(INDEX[[i]])
34
	if (length(index) != nx)
35
	namelist[[i]] <- ind_lev <- levels(index)#- all of them, yes !
35
	    stop("arguments must have same length")
36
	extent[i] <- e <- length(ind_lev)
36
	namelist[[i]] <- levels(index)#- all of them, yes !
37
        group <- group + ngroup * (as.integer(index) - 1L)
37
	extent[i] <- nlevels(index)
38
	ngroup <- ngroup * e
38
	group <- group + ngroup * (as.integer(index) - one)
39
	ngroup <- ngroup * nlevels(index)
40
    }
39
    }
41
    if (is.null(FUN)) return(group)
40
    if (is.null(FUN)) return(group)
42
    ans <- lapply(X = split(X, group), FUN = FUN, ...)
41
    group = structure(group, class="factor", levels=as.character(seq_len(ngroup)))
42
    ans <- lapply(X = split.default(X, group), FUN = FUN, ...)
43
    index <- as.integer(names(ans))
43
    index <- as.integer(names(ans))
44
    if (simplify && all(lengths(ans) == 1L)) {
44
    if (simplify && all(lengths(ans) == 1L)) {
45
	ansmat <- array(dim = extent, dimnames = namelist)
45
	ansmat <- array(dim = extent, dimnames = namelist)
Lines 54-61 Link Here
54
    }
54
    }
55
    ansmat
55
    ansmat
56
}
56
}
57
58
59
60
61

Return to bug 16640