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

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

Author: gsimpson
Date: 2013-11-05 22:03:53 +0100 (Tue, 05 Nov 2013)
New Revision: 2651

Modified:
   pkg/permute/R/numPerms.R
   pkg/permute/inst/ChangeLog
Log:
fixes a bug whereby numPerms ignored the Blocking structure when computing the total number of permutations for the specified design

Modified: pkg/permute/R/numPerms.R
===================================================================
--- pkg/permute/R/numPerms.R	2013-11-05 15:12:11 UTC (rev 2650)
+++ pkg/permute/R/numPerms.R	2013-11-05 21:03:53 UTC (rev 2651)
@@ -91,22 +91,27 @@
   spl <- split(indv, BLOCKS)
 
   ## loop over the components of spl & apply doNumPerms
-  np <- lapply(spl, doNumPerms, mult.p, mult.wi, typeP, typeW, PSTRATA,
+  np <- sapply(spl, doNumPerms, mult.p, mult.wi, typeP, typeW, PSTRATA,
                mirrorP, mirrorW, constantW)
 
   ## multiply up n perms per block
-  do.call(prod, np)
+  prod(np)
 }
 
 `doNumPerms` <- function(obs, mult.p, mult.wi, typeP, typeW, PSTRATA,
                          mirrorP, mirrorW, constantW) {
     n <- nobs(obs) ## obs is index vector for object, split by blocks
 
-    ## need only those strata for the current block. As obs is the index
-    ## vector, split by block, this now gives nobs per plot strata
-    tab <- table(PSTRATA)#[obs] # table(PSTRATA[obs])
-    same.n <- length(unitab <- unique(tab))
+    if(!is.null(PSTRATA)) {
+        ## take only the PSTRATA needed for this block, drop unused levels
+        PSTRATA <- droplevels(PSTRATA[obs])
 
+        ## need only those strata for the current block. As obs is the index
+        ## vector, split by block, this now gives nobs per plot strata
+        tab <- table(PSTRATA)
+        same.n <- length(unitab <- unique(tab))
+    }
+
     ## plots
     num.p <- if(isTRUE(all.equal(typeP, "free"))) {
         exp(lfactorial(length(levels(PSTRATA))))

Modified: pkg/permute/inst/ChangeLog
===================================================================
--- pkg/permute/inst/ChangeLog	2013-11-05 15:12:11 UTC (rev 2650)
+++ pkg/permute/inst/ChangeLog	2013-11-05 21:03:53 UTC (rev 2651)
@@ -8,6 +8,9 @@
 	`update()` to update elements of a stored permutation design object.
 	Suggested by Jari Oksanen.
 
+	* numPerms: fixed a bug where `numPerms()` was ignoring Blocks when
+	computing the number of possible permutations.
+
 Version 0.7-4
 
 	* Deprecated functions: Completed the deprecation of `permCheck()`