[Vegan-commits] r2065 - in pkg/vegan: R inst man

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

Author: jarioksa
Date: 2012-02-05 17:27:16 +0100 (Sun, 05 Feb 2012)
New Revision: 2065

Modified:
   pkg/vegan/R/nesteddisc.R
   pkg/vegan/inst/ChangeLog
   pkg/vegan/man/nestedtemp.Rd
Log:
number of iterations to order tied columns was exposed as an argument in nesteddisc

Modified: pkg/vegan/R/nesteddisc.R
===================================================================
--- pkg/vegan/R/nesteddisc.R	2012-02-05 07:58:49 UTC (rev 2064)
+++ pkg/vegan/R/nesteddisc.R	2012-02-05 16:27:16 UTC (rev 2065)
@@ -1,5 +1,5 @@
 `nesteddisc` <-
-    function(comm)
+    function(comm, niter = 200)
 {
     ## The original discrepancy method orders columns by frequencies,
     ## but does not consider ties. The current function tries to order
@@ -10,7 +10,6 @@
 
     ## starting values and CONSTANTS
     NALL <- 7
-    NITER <- 200
     ties <- FALSE
     trace <- FALSE
     ## Code
@@ -28,6 +27,7 @@
     rs <- range(rowSums(comm))
     ## Function to evaluate discrepancy
     FUN <- function(x) sum(comm[col(comm)[,x] <= rowSums(comm)] == 0) 
+    Ad <- FUN(x)
     ## Go through all le-items and permute ties
     for (i in 1:length(le)) {
         if (le[i] > 1) {
@@ -36,13 +36,12 @@
             ## Can swaps influence discrepancy?
             if (idx[1] > rs[2] || idx[le[i]] < rs[1])
                 next
-            Ad <- FUN(x)
             ## 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.int(nrow(perm), NITER),]
+                if (nrow(perm) > niter) {
+                    perm <- perm[sample.int(nrow(perm), niter),]
                     ties <- TRUE
                 }
             }
@@ -50,20 +49,17 @@
             ## duplicated orders
             else {
                 ties <- TRUE
-                perm <- matrix(0, nrow=NITER, ncol=le[i])
-                for (j in 1:NITER)
-                    perm[j,] <- permuted.index(le[i])
+                perm <- t(replicate(niter, permuted.index(le[i])))
                 perm <- perm + cle[i]
             }
-            for (j in 1:nrow(perm)) {
+            vals <- sapply(1:nrow(perm), function(j) {
                 take[idx] <- perm[j,]
-                val <- FUN(take)
-                if (val < Ad) {
-                    x <- take
-                    Ad <- val
-                    if (trace)
-                        cat(Ad, ":", perm[j,], "\n")
-                }
+                FUN(take)
+            })
+            jmin <- which.min(vals)
+            if (vals[jmin] < Ad) {
+                x[idx] <- perm[jmin,]
+                Ad <- vals[jmin]
             }
         }
     }

Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog	2012-02-05 07:58:49 UTC (rev 2064)
+++ pkg/vegan/inst/ChangeLog	2012-02-05 16:27:16 UTC (rev 2065)
@@ -7,6 +7,9 @@
 	* adonis, anosim, mantel, mantel.partial, mrpp, permutest.cca: do
 	not need clusterEvalQ(parallel, library(vegan)) for socket
 	clusters. 
+
+	* nesteddisc: new argument 'niter' to give the number of
+	iterations to reorder tied columns.
 	
 Version 2.1-10 (closed February 5, 2012)
 

Modified: pkg/vegan/man/nestedtemp.Rd
===================================================================
--- pkg/vegan/man/nestedtemp.Rd	2012-02-05 07:58:49 UTC (rev 2064)
+++ pkg/vegan/man/nestedtemp.Rd	2012-02-05 16:27:16 UTC (rev 2065)
@@ -21,7 +21,7 @@
 \usage{
 nestedchecker(comm)
 nestedn0(comm)
-nesteddisc(comm)
+nesteddisc(comm, niter = 200)
 nestedtemp(comm, ...)
 nestednodf(comm, order = TRUE, weighted = FALSE)
 nestedbetasor(comm)
@@ -31,7 +31,8 @@
 }
 
 \arguments{
-  \item{comm}{Community data. }
+  \item{comm}{Community data.}
+  \item{niter}{Number of iterations to reorder tied columns.}			
   \item{x}{Result object for a \code{plot}.}
   \item{col}{Colour scheme for matrix temperatures.}
   \item{kind}{The kind of plot produced.}
@@ -58,19 +59,18 @@
   which are richer than the most pauperate site species occurs
   (Patterson & Atmar 1986).
 
-  Function \code{nesteddisc} implements
-  discrepancy index which is the number of ones that should be shifted
-  to fill a row with ones in a table arranged by species frequencies
-  (Brualdi & Sanderson 1999). The original definition arranges species
-  (columns) by their frequencies, but did not have any method of
-  handling tied frequencies.
+  Function \code{nesteddisc} implements discrepancy index which is the
+  number of ones that should be shifted to fill a row with ones in a
+  table arranged by species frequencies (Brualdi & Sanderson
+  1999). The original definition arranges species (columns) by their
+  frequencies, but did not have any method of handling tied
+  frequencies.  The \code{nesteddisc} function tries to order tied
+  columns to minimize the discrepancy statistic but this is rather
+  slow, and with a large number of tied columns there is no guarantee
+  that the best ordering was found (argument \code{niter} gives the
+  maximum number of tried orders). In that case a warning of tied
+  columns will be issued.
 
-  The \code{nesteddisc} function tries to
-  order tied columns to minimize the discrepancy statistic but this is
-  rather slow, and with a large number of tied columns there is no
-  guarantee that the best ordering was found. In that case a warning
-  of tied columns will be issued.
-
   Function \code{nestedtemp} finds the matrix temperature which is
   defined as the sum of \dQuote{surprises} in arranged matrix.  In
   arranged unsurprising matrix all species within proportion given by