[Vegan-commits] r2841 - pkg/permute/R

[noreply at r-forge.r-project.org]

Author: gsimpson
Date: 2014-01-26 03:18:45 +0100 (Sun, 26 Jan 2014)
New Revision: 2841

Modified:
   pkg/permute/R/cbindAllPerms.R
Log:
getting the block indices to vary slowest with first block to fastest for last block needed rethinking. Fix allows this to work for even and uneven sized blocks.

Modified: pkg/permute/R/cbindAllPerms.R
===================================================================
--- pkg/permute/R/cbindAllPerms.R	2014-01-26 02:15:18 UTC (rev 2840)
+++ pkg/permute/R/cbindAllPerms.R	2014-01-26 02:18:45 UTC (rev 2841)
@@ -6,17 +6,20 @@
 `cbindAllPerms` <- function(x) {
     nb <- length(x) ## number of blocks
 
+    ## allPerms has first block varying slowest, but expand.grid has
+    ## first factor varying fastest. Hence we reverse `x` here, and
+    ## also reverse `out` back again later
+    x <- rev(x)
+
     ## prepares nb seqence vectors 1:`obs in block` for expand.grid
-    rowind <- do.call(expand.grid, lapply(x, function(i) seq_len(nrow(i))))
+    rowind <- do.call(expand.grid,
+                      lapply(x, function(i) seq_len(nrow(i))))
 
-    ## contains row indices for each block, but 1st block varies fastest
-    ## and allPerms() traditionally had nth block varying fastest, so
-    ## reverse order of columns. drop ensures this work if only 1 block.
-    rowind <- rowind[, seq.int(nb, 1), drop = FALSE]
-
     ## index elements of x using the row indices - gives a list to cbind
-    ## next. sapply() over-simplifies to wrong dimensions so not used
-    out <- lapply(seq_len(nb), function(i, m, ind) m[[i]][ind[, i] ,],
-                  m = x, ind = rowind)
-    do.call(cbind, out) ## returns
+    ## next. sapply() over-simplifies to wrong dimensions so not used.
+    ## Note: the lapply() result is reversed with `rev` to undo the reversing
+    ## of `x` earlier; ensures everything is correct block order.
+    out <- rev(lapply(seq_len(nb), function(i, m, ind) m[[i]][ind[, i] ,],
+                      m = x, ind = rowind))
+    do.call(cbind, out) ## return
 }