--- tapply.R 2015-12-31 08:35:52.296875000 +0700 +++ tapply1new2.R 2016-01-02 11:02:42.062000000 +0700 @@ -20,24 +20,22 @@ { FUN <- if (!is.null(FUN)) match.fun(FUN) if (!is.list(INDEX)) INDEX <- list(INDEX) - nI <- length(INDEX) + INDEX <- lapply(INDEX, as.factor) + nI <- length(INDEX) # now, 'INDEX' is not classed if (!nI) stop("'INDEX' is of length zero") - namelist <- vector("list", nI) - names(namelist) <- names(INDEX) - extent <- integer(nI) - nx <- length(X) - one <- 1L - group <- rep.int(one, nx) #- to contain the splitting vector - ngroup <- one - for (i in seq_along(INDEX)) { - index <- as.factor(INDEX[[i]]) - if (length(index) != nx) - stop("arguments must have same length") - namelist[[i]] <- levels(index)#- all of them, yes ! - extent[i] <- nlevels(index) - group <- group + ngroup * (as.integer(index) - one) - ngroup <- ngroup * nlevels(index) - } + if (!all(lengths(INDEX) == length(X))) + stop("arguments must have same length") + namelist <- lapply(INDEX, levels)#- all of them, yes ! + extent <- lengths(namelist, use.names = FALSE) + cumextent <- cumprod(extent) + if (cumextent[nI] > .Machine$integer.max) + stop("total number of levels >= 2^31") + storage.mode(cumextent) <- "integer" + ngroup <- cumextent[nI] + group <- as.integer(INDEX[[1L]]) #- to contain the splitting vector + if (nI > 1L) + for (i in 2L:nI) + group <- group + cumextent[i - 1L] * (as.integer(INDEX[[i]]) - 1L) if (is.null(FUN)) return(group) ans <- lapply(X = split(X, group), FUN = FUN, ...) index <- as.integer(names(ans))