[Vegan-commits] r1166 - in branches/1.17: R inst

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

Author: jarioksa
Date: 2010-03-04 16:53:39 +0100 (Thu, 04 Mar 2010)
New Revision: 1166

Modified:
   branches/1.17/R/nesteddisc.R
   branches/1.17/inst/ChangeLog
Log:
merged 1158, 1159 & 1163: nesteddisc tie fix & speed-up

Modified: branches/1.17/R/nesteddisc.R
===================================================================
--- branches/1.17/R/nesteddisc.R	2010-03-04 15:39:52 UTC (rev 1165)
+++ branches/1.17/R/nesteddisc.R	2010-03-04 15:53:39 UTC (rev 1166)
@@ -10,7 +10,7 @@
 
     ## starting values and CONSTANTS
     NALL <- 7
-    NITER <- 5000
+    NITER <- 1000
     ties <- FALSE
     trace <- FALSE
     ## Code
@@ -22,7 +22,7 @@
     comm <- comm[, k]
     ## run lengths: numbers of tied values
     le <- rle(cs)$lengths
-    cle <- cumsum(le)
+    cle <- c(0, cumsum(le))
     x <- seq(along=cs)
     ## Range of row sums: only swaps between these have an effect
     rs <- range(rowSums(comm))
@@ -32,19 +32,28 @@
     for (i in 1:length(le)) {
         if (le[i] > 1) {
             take <- x
-            idx <- (1:le[i]) + if(i == 1) 0 else  cle[i-1]
+            idx <- (1:le[i]) + cle[i]
             ## Can swaps influence discrepancy?
             if (idx[1] > rs[2] || idx[le[i]] < rs[1])
                 next
             Ad <- FUN(x)
-            if (le[i] <= NALL)
-                perm <- matrix(allPerms(le[i]), ncol=le[i]) + cle[i-1]
+            ## Complete enumeration if no. of tied value <= NALL
+            if (le[i] <= NALL) {
+                perm <- matrix(allPerms(le[i]), ncol=le[i]) + cle[i]
+                ## Take at maximum NITER cases from complete enumeration
+                if (nrow(perm) >= NITER) {
+                    perm <- perm[sample(nrow(perm), NITER),]
+                    ties <- TRUE
+                }
+            }
+            ## No complete enumeration, but a sample and potentially
+            ## duplicated orders
             else {
                 ties <- TRUE
                 perm <- matrix(0, nrow=NITER, ncol=le[i])
                 for (j in 1:NITER)
-                    perm[j,] <- permuted.index2(le[i])
-                perm <- perm + if(i==1) 0 else  cle[i-1]
+                    perm[j,] <- permuted.index(le[i])
+                perm <- perm + cle[i]
             }
             for (j in 1:nrow(perm)) {
                 take[idx] <- perm[j,]

Modified: branches/1.17/inst/ChangeLog
===================================================================
--- branches/1.17/inst/ChangeLog	2010-03-04 15:39:52 UTC (rev 1165)
+++ branches/1.17/inst/ChangeLog	2010-03-04 15:53:39 UTC (rev 1166)
@@ -4,6 +4,9 @@
 
 Version 1.17-2
 
+	* nesteddisc: failed if the most species rich sites were tied. Is
+	no faster but slaker. Revs 1158, 1159, 1163.
+
 	* permutest.betadisper: print method got ordering of permutation
 	p-values wrong in displaying the matrix of pairwise tests. The
 	computed values were correct. The formatting for printing contained