[Vegan-commits] r2839 - in pkg/permute: R inst

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

Author: gsimpson
Date: 2014-01-23 19:11:45 +0100 (Thu, 23 Jan 2014)
New Revision: 2839

Added:
   pkg/permute/R/cbindAllPerms.R
Modified:
   pkg/permute/R/allPerms.R
   pkg/permute/inst/ChangeLog
Log:
to complete r2838, allPerms needs to expand.grid, matrix-wise each within-block permutation matrix

Modified: pkg/permute/R/allPerms.R
===================================================================
--- pkg/permute/R/allPerms.R	2014-01-23 16:11:23 UTC (rev 2838)
+++ pkg/permute/R/allPerms.R	2014-01-23 18:11:45 UTC (rev 2839)
@@ -60,9 +60,12 @@
                        nperms = nperms)
     }
 
+    ## bind all blocks together, repeating them as required
+    out <- cbindAllPerms(out)
+
     ## bind all the blocks together
-    out <- do.call(cbind, out) ## hmm are any of these the same shape?
-    out[, unlist(spl)] <- out
+    ## out <- do.call(cbind, out) ## hmm are any of these the same shape?
+    ##out[, unlist(spl)] <- out  ## is this being done at the doAllPerms level?
 
     if(!(observed <- getObserved(control))) {
         obs.v <- seq_len(n)
@@ -72,7 +75,7 @@
         ## observed ordering
         setNperm(control) <- getNperm(control) - 1
     }
-    class(out) <- "allPerms"
+    class(out) <- c("allPerms", "matrix")
     attr(out, "control") <- control
     attr(out, "observed") <- observed
     out

Added: pkg/permute/R/cbindAllPerms.R
===================================================================
--- pkg/permute/R/cbindAllPerms.R	                        (rev 0)
+++ pkg/permute/R/cbindAllPerms.R	2014-01-23 18:11:45 UTC (rev 2839)
@@ -0,0 +1,22 @@
+##' @title Replicate and cbind all block-level permutations
+##' @param x a list whose compontents are the set of all permutations
+##' at the block level
+##' @return a matrix
+##' @author Gavin L. Simpson
+`cbindAllPerms` <- function(x) {
+    nb <- length(x) ## number of blocks
+
+    ## prepares nb seqence vectors 1:`obs in block` for expand.grid
+    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
+}

Modified: pkg/permute/inst/ChangeLog
===================================================================
--- pkg/permute/inst/ChangeLog	2014-01-23 16:11:23 UTC (rev 2838)
+++ pkg/permute/inst/ChangeLog	2014-01-23 18:11:45 UTC (rev 2839)
@@ -7,6 +7,12 @@
 	* allPerms: with free permutations *within* blocks, `allPerms()`
 	was not returning the indices in the original data but in the
 	permutation indices within block.
+
+	In addition, `allPerms()` was not replicating each row in a
+	within-block permutation matrix for all the rows in the other
+	block within-block permutation matrices. This is now achieved via
+	a new, non-exported utility function `cbindAllPerms()`.
+
 	Reported by: Joris Meys
 
 Version 0.8-1