[Vegan-commits] r1947 - branches/2.0 branches/2.0/R branches/2.0/inst pkg/vegan/inst

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Oct 10 21:10:27 CEST 2011


Author: jarioksa
Date: 2011-10-10 21:10:24 +0200 (Mon, 10 Oct 2011)
New Revision: 1947

Added:
   branches/2.0/R/plot.preston.R
Modified:
   branches/2.0/NAMESPACE
   branches/2.0/R/capscale.R
   branches/2.0/R/nesteddisc.R
   branches/2.0/R/rda.default.R
   branches/2.0/R/simulate.rda.R
   branches/2.0/inst/ChangeLog
   branches/2.0/inst/NEWS.Rd
   pkg/vegan/inst/ChangeLog
Log:
merge r1939 (slackeer and faster nesteddisc), r1944 (adapt to changed 
sd() in R 2.14.0), r1945 (add plot/lines for as.preston/as.fisher)


Modified: branches/2.0/NAMESPACE
===================================================================
--- branches/2.0/NAMESPACE	2011-10-10 18:18:00 UTC (rev 1946)
+++ branches/2.0/NAMESPACE	2011-10-10 19:10:24 UTC (rev 1947)
@@ -172,6 +172,7 @@
 # lines: graphics
 S3method(lines, humpfit)
 S3method(lines, permat)
+S3method(lines, preston)
 S3method(lines, prestonfit)
 S3method(lines, procrustes)
 S3method(lines, radline)
@@ -213,6 +214,7 @@
 S3method(plot, clamtest)
 S3method(plot, decorana)
 S3method(plot, envfit)
+S3method(plot, fisher)
 S3method(plot, fisherfit)
 S3method(plot, fitspecaccum)
 S3method(plot, humpfit)
@@ -227,6 +229,7 @@
 S3method(plot, permat)
 S3method(plot, poolaccum)
 S3method(plot, prc)
+S3method(plot, preston)
 S3method(plot, prestonfit)
 S3method(plot, procrustes)
 S3method(plot, profile.fisherfit)

Modified: branches/2.0/R/capscale.R
===================================================================
--- branches/2.0/R/capscale.R	2011-10-10 18:18:00 UTC (rev 1946)
+++ branches/2.0/R/capscale.R	2011-10-10 19:10:24 UTC (rev 1947)
@@ -111,7 +111,7 @@
     }
     if (!is.null(comm)) {
         comm <- scale(comm, center = TRUE, scale = FALSE)
-        sol$colsum <- sd(comm)
+        sol$colsum <- apply(comm, 2, sd)
         ## take a 'subset' of the community after scale()
         if (!is.null(d$subset))
             comm <- comm[d$subset, , drop = FALSE]

Modified: branches/2.0/R/nesteddisc.R
===================================================================
--- branches/2.0/R/nesteddisc.R	2011-10-10 18:18:00 UTC (rev 1946)
+++ branches/2.0/R/nesteddisc.R	2011-10-10 19:10:24 UTC (rev 1947)
@@ -10,7 +10,7 @@
 
     ## starting values and CONSTANTS
     NALL <- 7
-    NITER <- 1000
+    NITER <- 200
     ties <- FALSE
     trace <- FALSE
     ## Code

Copied: branches/2.0/R/plot.preston.R (from rev 1945, pkg/vegan/R/plot.preston.R)
===================================================================
--- branches/2.0/R/plot.preston.R	                        (rev 0)
+++ branches/2.0/R/plot.preston.R	2011-10-10 19:10:24 UTC (rev 1947)
@@ -0,0 +1,50 @@
+### Similar plotting functions as plot.prestonfit/fisherfit, but only
+### for the data without the fitted models. These can be used with the
+### result of as.preston(), as.fisher().
+
+## as plot.prestonfit, but plots only the bars of as.preston()
+
+`plot.preston` <-
+        function (x, xlab = "Frequency", ylab = "Species", bar.col = "skyblue", 
+                  ...) 
+{
+    freq <- x
+    oct <- as.numeric(names(freq))
+    noct <- max(oct) + 1
+    plot(oct, freq, type = "n", ylim = c(0, max(freq)),
+         xlim = c(-1, max(oct)), ylab = ylab, xlab = xlab, axes = FALSE, ...)
+    axis(2)
+    axis(1, at = 0:noct, labels = 2^(0:noct))
+    box()
+    rect(oct - 1, 0, oct, freq, col = bar.col, ...)
+    invisible()
+}
+
+
+`lines.preston` <-
+    function(x, xadjust = 0.5, ...)
+{
+    oct <- as.numeric(names(x)) - xadjust 
+    lines(oct, x, ...)
+}
+
+## as plot.fisherfit, but plots only the bars of as.fisherfit
+
+`plot.fisher` <-
+    function(x, xlab = "Frequency", ylab = "Species", bar.col = "skyblue",
+             kind = c("bar", "hiplot", "points", "lines"), add = FALSE,
+             ...)
+{
+    kind <- match.arg(kind)
+    freq <- as.numeric(names(x))
+    if (!add)
+        plot(freq, x, ylab=ylab, xlab=xlab,
+             ylim=c(0,max(x)),  xlim=c(0.5, max(freq)+0.5), type="n", ...)
+    switch(kind,
+           "bar" = rect(freq-0.5,0,freq+0.5,x, col=bar.col, ...),
+           "hiplot" = points(freq, x, col =bar.col, type = "h",  ...),
+           "points" = points(freq, x, col =bar.col, ...),
+           "lines" = lines(freq, x, col =bar.col, ...)
+       )
+    invisible()
+}

Modified: branches/2.0/R/rda.default.R
===================================================================
--- branches/2.0/R/rda.default.R	2011-10-10 18:18:00 UTC (rev 1946)
+++ branches/2.0/R/rda.default.R	2011-10-10 19:10:24 UTC (rev 1947)
@@ -8,7 +8,7 @@
     X <- as.matrix(X)
     NR <- nrow(X) - 1
     Xbar <- scale(X, center = TRUE, scale = scale)
-    SD <- sd(Xbar)
+    SD <- apply(Xbar, 2, sd)
     if (scale) 
         Xbar[is.nan(Xbar)] <- 0
     tot.chi <- sum(svd(Xbar, nu = 0, nv = 0)$d^2)/NR

Modified: branches/2.0/R/simulate.rda.R
===================================================================
--- branches/2.0/R/simulate.rda.R	2011-10-10 18:18:00 UTC (rev 1946)
+++ branches/2.0/R/simulate.rda.R	2011-10-10 19:10:24 UTC (rev 1947)
@@ -22,7 +22,7 @@
         ftd <- ftd + object$pCCA$Fit
     if (is.null(indx))
         ans <- as.data.frame(ftd + matrix(rnorm(length(ftd), 
-               sd = outer(rep(1,nrow(ftd)), sd(object$CA$Xbar))), 
+               sd = outer(rep(1,nrow(ftd)), apply(object$CA$Xbar, 2, sd))), 
                nrow = nrow(ftd)))
     else
         ans <- as.data.frame(ftd + object$CA$Xbar[indx,])
@@ -67,8 +67,8 @@
     Xbar <- sweep(object$CA$Xbar, 1, sq.r, "*")
     if (is.null(indx)) {
         ans <- matrix(rnorm(length(ftd), 
-               sd = outer(rep(1,nrow(ftd)), sd(Xbar))), 
-               nrow = nrow(ftd))
+               sd = outer(rep(1,nrow(ftd)), apply(Xbar, 2, sd))), 
+                          nrow = nrow(ftd))
         ans <- as.data.frame(ftd + sweep(ans, 1, sq.r, "/"))
     }
     else 
@@ -127,7 +127,7 @@
         ftd <- ftd + object$pCCA$Fit
     if (is.null(indx))
         ans <- as.data.frame(ftd + matrix(rnorm(length(ftd), 
-               sd = outer(rep(1,nrow(ftd)), sd(object$CA$Xbar))), 
+               sd = outer(rep(1,nrow(ftd)), apply(object$CA$Xbar, 2, sd))), 
                nrow = nrow(ftd)))
     else
         ans <- ftd + object$CA$Xbar[indx,]

Modified: branches/2.0/inst/ChangeLog
===================================================================
--- branches/2.0/inst/ChangeLog	2011-10-10 18:18:00 UTC (rev 1946)
+++ branches/2.0/inst/ChangeLog	2011-10-10 19:10:24 UTC (rev 1947)
@@ -4,6 +4,11 @@
 
 Version 2.0-1 (opened September 8, 2011)
 
+	* merge r1945: add plot & lines for as.preston & as.fisher.
+	* merge r1944: R 2.14.0 (r52709) gives a message() when sd() is
+	used for matrices -- now fixed for rda.default, capscale and
+	simulate.rda/cca/capscale. 
+	* merge r1939: slacker and faster nesteddisc.
 	* merge r1928: permutest.cca result could not be update()d.
  	* merge r1927: reset 'tries' when 'previous.best' was a different
 	model.

Modified: branches/2.0/inst/NEWS.Rd
===================================================================
--- branches/2.0/inst/NEWS.Rd	2011-10-10 18:18:00 UTC (rev 1946)
+++ branches/2.0/inst/NEWS.Rd	2011-10-10 19:10:24 UTC (rev 1947)
@@ -13,6 +13,12 @@
       habitat types or sampling units, and is applicable only to count
       data with no over-dispersion.
 
+      \item \code{as.preston} gained \code{plot} and \code{lines}, and
+      \code{as.fisher} gained \code{plot} method (which also can add
+      items to existing plots). These are similar as these methods for
+      \code{prestonfit} and \code{fisherfit}, but without the fitted
+      model.
+
       \item \code{raupcrick}: new function to implement Raup-Crick
       dissimilarity as a probability of number of co-occurring species
       with occurrence probabilities proportional to species
@@ -45,8 +51,26 @@
       \item The result from \code{permutest.cca} could not be
       \code{update}d because of a \file{NAMESPACE} issue.
 
+      \item \R 2.14.0 changed so that it does not accept using
+      \code{sd()} function for matrices, and several \pkg{vegan}
+      functions were changed to adapt to these changes (\code{rda},
+      \code{capscale}, \code{simulate} methods for \code{rda},
+      \code{cca} and \code{capscale}).
+
     }	
   } % end BUG FIXES
+
+  \subsection{ANALYSES}{
+    \itemize{
+
+      \item \code{nesteddisc} is slacker and hence faster when trying
+      to optimize the statistic for tied column frequencies. Tracing
+      showed that in most cases an improved ordering was found rather
+      early in tries, and the results are equally good in most cases.
+
+    }
+  } % end ANALYSES 
+
 } % end version 2.0-1
 
 \section{Changes in version 2.0-0}{

Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog	2011-10-10 18:18:00 UTC (rev 1946)
+++ pkg/vegan/inst/ChangeLog	2011-10-10 19:10:24 UTC (rev 1947)
@@ -16,8 +16,11 @@
 	solution the R developers decided to take care that mean() or sd()
 	will not work either (it would be nice to understand how these
 	people think). Fixed in rda.default, capscale and
-	simulate.rda/cca/capscale.
-
+	simulate.rda/cca/capscale. It seems that this was also implemented
+	in soon released R 2.14.0 as r57209 | maechler | 2011-10-10
+	19:28:33 +0300 (Mon, 10 Oct 2011), but as message() instead of a
+	warning(). 
+	
 	* nesteddisc: use only max 200 tries to reorder columns: tracing
 	showed that in most cases an improved ordering is found rather
 	quickly, and trying up to 1000 times takes awfully long. Now



More information about the Vegan-commits mailing list