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

Collapse All | Expand All

(-)tapply.R (-15 / +22 lines)
Lines 20-41 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
    INDEX <- lapply(INDEX, as.factor)
23
    nI <- length(INDEX)
24
    nI <- length(INDEX)  # now, 'INDEX' is not classed
25
    if (!nI) stop("'INDEX' is of length zero")
24
    if (!nI) stop("'INDEX' is of length zero")
26
    if (!all(lengths(INDEX) == length(X)))
25
    namelist <- vector("list", nI)
27
        stop("arguments must have same length")
26
    names(namelist) <- names(INDEX)
28
    namelist <- lapply(INDEX, levels)#- all of them, yes !
27
    extent <- integer(nI)
29
    extent <- lengths(namelist, use.names = FALSE)
28
    nx <- length(X)
30
    cumextent <- cumprod(extent)
29
    one <- 1L
31
    if (cumextent[nI] > .Machine$integer.max)
30
    for (i in seq_along(INDEX)) {
32
        stop("total number of levels >= 2^31")
31
	index <- as.factor(INDEX[[i]])
33
    storage.mode(cumextent) <- "integer"
32
	if (length(index) != nx)
34
    ngroup <- cumextent[nI]
33
	    stop("arguments must have same length")
35
    group <- as.integer(INDEX[[1L]]) #- to contain the splitting vector
34
	namelist[[i]] <- levi <- levels(index)#- all of them, yes !
36
    if (nI > 1L)
35
	extent[i] <- ei <- length(levi)
37
        for (i in 2L:nI)
36
	if (i == one || !ei) {
38
           group <- group + cumextent[i - 1L] * (as.integer(INDEX[[i]]) - 1L)
37
	    group <- as.integer(index) #- to contain the splitting vector
38
	    ngroup <- ei
39
	} else {
40
	    if (ngroup > .Machine$integer.max %/% ei)
41
		stop("integer overflow")
42
	    group <- group + ngroup * (as.integer(index) - one)
43
	    ngroup <- ngroup * ei
44
	}
45
    }
39
    if (is.null(FUN)) return(group)
46
    if (is.null(FUN)) return(group)
40
    levels(group) <- as.character(seq_len(ngroup))
47
    levels(group) <- as.character(seq_len(ngroup))
41
    class(group) <- "factor"
48
    class(group) <- "factor"

Return to bug 16640