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

Collapse All | Expand All

(-)tapply.R (-3 / +23 lines)
Lines 37-46 Link Here
37
        for (i in 2L:nI)
37
        for (i in 2L:nI)
38
           group <- group + cumextent[i - 1L] * (as.integer(INDEX[[i]]) - 1L)
38
           group <- group + cumextent[i - 1L] * (as.integer(INDEX[[i]]) - 1L)
39
    if (is.null(FUN)) return(group)
39
    if (is.null(FUN)) return(group)
40
    levels(group) <- as.character(seq_len(ngroup))
40
    spliti <- function(x, group, at) {
41
    class(group) <- "factor"
41
        attributes(group) <- at
42
    ans <- split(X, group) # use generic, e.g. for 'Date'
42
        split(x, group) # use generic, e.g. for 'Date'
43
    }
44
    if (nI == 1L || ngroup <= (nmax <- as.integer(2^16))) {
45
        ans <- spliti(X, group, list(levels = if (nI == 1L) namelist[[1L]] else
46
            as.character(seq_len(ngroup)), class = "factor"))
43
    names(ans) <- NULL
47
    names(ans) <- NULL
48
    } else {
49
        ans <- as.character(seq_len(nmax))
50
        group <- group - 1L
51
        ngroup <- ngroup - 1L
52
        npart <- 1L + (ngroup%/%nmax)
53
        ans <- unlist(lapply(seq_len(npart), function(curpart,
54
            i, spliti, x, group, at, npart, nrest) {
55
            if (curpart == npart) length(at$levels) <- nrest
56
            i <- i[[curpart]]
57
            spliti(x[i], group[i], at)
58
        }, spliti(seq_along(X), 1L + (group%/%nmax),
59
            list(levels = ans[seq_len(npart)], class = "factor")),
60
            spliti, X, 1L + (group%%nmax),
61
            list(levels = ans, class = "factor"), npart, 1L + (ngroup%%nmax)),
62
            recursive = FALSE, use.names = FALSE)
63
    }
44
    index <- as.logical(lengths(ans))  # equivalently, lengths(ans) > 0L
64
    index <- as.logical(lengths(ans))  # equivalently, lengths(ans) > 0L
45
    ans <- lapply(X = ans[index], FUN = FUN, ...)
65
    ans <- lapply(X = ans[index], FUN = FUN, ...)
46
    if (simplify && all(lengths(ans) == 1L)) {
66
    if (simplify && all(lengths(ans) == 1L)) {

Return to bug 16640