--- 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))