[Vegan-commits] r306 - in branches/1.11-0: . R inst man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Tue Apr 8 10:14:50 CEST 2008


Author: jarioksa
Date: 2008-04-08 10:14:49 +0200 (Tue, 08 Apr 2008)
New Revision: 306

Added:
   branches/1.11-0/R/ordiArrowMul.R
Modified:
   branches/1.11-0/DESCRIPTION
   branches/1.11-0/R/anova.cca.R
   branches/1.11-0/R/ordiplot3d.R
   branches/1.11-0/R/plot.cca.R
   branches/1.11-0/R/plot.envfit.R
   branches/1.11-0/R/plot.procrustes.R
   branches/1.11-0/R/points.cca.R
   branches/1.11-0/R/text.cca.R
   branches/1.11-0/R/varpart4.R
   branches/1.11-0/inst/ChangeLog
   branches/1.11-0/inst/NEWS
   branches/1.11-0/man/vegan-internal.Rd
Log:
merged bug fixes from the 'trunk' to the release branches/1.11-0

Modified: branches/1.11-0/DESCRIPTION
===================================================================
--- branches/1.11-0/DESCRIPTION	2008-04-06 20:32:20 UTC (rev 305)
+++ branches/1.11-0/DESCRIPTION	2008-04-08 08:14:49 UTC (rev 306)
@@ -1,7 +1,7 @@
 Package: vegan
 Title: Community Ecology Package
-Version: 1.11-2
-Date: March 20, 2008
+Version: 1.11-3
+Date: April 8, 2008
 Author: Jari Oksanen, Roeland Kindt, Pierre Legendre, Bob O'Hara, Gavin L. Simpson, 
   M. Henry H. Stevens  
 Maintainer: Jari Oksanen <jari.oksanen at oulu.fi>

Modified: branches/1.11-0/R/anova.cca.R
===================================================================
--- branches/1.11-0/R/anova.cca.R	2008-04-06 20:32:20 UTC (rev 305)
+++ branches/1.11-0/R/anova.cca.R	2008-04-08 08:14:49 UTC (rev 306)
@@ -7,6 +7,8 @@
     if (is.null(object$CCA))
         stop("Nothing to analyse: no constrained component")
     perm.max <- max(step-1, perm.max)
+    if (perm.max %% step == 0)
+        perm.max <- perm.max - 1
     if (!is.null(by)) {
         by <- match.arg(by, c("axis", "terms", "margin"))
         if (by == "axis") 
@@ -59,4 +61,3 @@
     structure(table, heading = c(head, mod), Random.seed = seed, 
               class = c("anova.cca", "anova", "data.frame"))
 }
-

Copied: branches/1.11-0/R/ordiArrowMul.R (from rev 302, pkg/R/ordiArrowMul.R)
===================================================================
--- branches/1.11-0/R/ordiArrowMul.R	                        (rev 0)
+++ branches/1.11-0/R/ordiArrowMul.R	2008-04-08 08:14:49 UTC (rev 306)
@@ -0,0 +1,19 @@
+### Scaling of arrows to 'fill' a plot with vectors centred at 'at'.
+### Plot dims from 'par("usr")' and arrow heads are in 'x'.
+`ordiArrowMul` <-
+    function (x, at = c(0,0), fill=0.75) 
+{
+    u <- par("usr")
+    u <- u - rep(at, each = 2)
+    r <- c(range(x[,1]), range(x[,2]))
+    ## 'rev' takes care of reversed axes like xlim(1,-1)
+    rev <- sign(diff(u))[-2]
+    if (rev[1] < 0)
+        u[1:2] <- u[2:1]
+    if (rev[2] < 0)
+        u[3:4] <- u[4:3]
+    u <- u/r 
+    u <- u[is.finite(u) & u > 0]
+    fill * min(u)
+}
+

Modified: branches/1.11-0/R/ordiplot3d.R
===================================================================
--- branches/1.11-0/R/ordiplot3d.R	2008-04-06 20:32:20 UTC (rev 305)
+++ branches/1.11-0/R/ordiplot3d.R	2008-04-08 08:14:49 UTC (rev 306)
@@ -1,4 +1,4 @@
-"ordiplot3d" <-
+`ordiplot3d` <-
     function (object, display = "sites", choices = 1:3, ax.col = 2, 
               arr.len = 0.1, arr.col = 4, envfit, xlab, ylab, zlab, ...) 
 {
@@ -27,9 +27,7 @@
         }
         if (!is.null(bp) && nrow(bp) > 0) {
             tmp <- pl$xyz.convert(bp)
-            mul <- par("usr")/c(range(tmp$x), range(tmp$y))
-            mul <- mul[is.finite(mul) & mul > 0]
-            mul <- min(mul)
+            mul <- ordiArrowMul(cbind(tmp$x, tmp$y), fill=1)
             bp.xyz <- pl$xyz.convert(bp * mul)
             orig <- pl$xyz.convert(0, 0, 0)
             arrows(orig$x, orig$y, bp.xyz$x, bp.xyz$y, len = arr.len, 

Modified: branches/1.11-0/R/plot.cca.R
===================================================================
--- branches/1.11-0/R/plot.cca.R	2008-04-06 20:32:20 UTC (rev 305)
+++ branches/1.11-0/R/plot.cca.R	2008-04-08 08:14:49 UTC (rev 306)
@@ -1,4 +1,4 @@
-"plot.cca" <-
+`plot.cca` <-
     function (x, choices = c(1, 2), display = c("sp", "wa", "cn"), 
               scaling = 2, type, xlim, ylim,  ...) 
 {
@@ -27,10 +27,10 @@
     else type <- match.arg(type, TYPES)
     if (missing(xlim))
         xlim <- range(g$spe[, 1], g$sit[, 1], g$con[, 1], g$default[, 
-                                                                1])
+                                                                    1])
     if (missing(ylim))
         ylim <- range(g$spe[, 2], g$sit[, 2], g$con[, 2], g$default[, 
-                                                                2])
+                                                                    2])
     plot(g[[1]], xlim = xlim, ylim = ylim, type = "n", asp = 1, 
          ...)
     abline(h = 0, lty = 3)
@@ -57,10 +57,7 @@
     }
     if (!is.null(g$biplot) && type != "none") {
         if (length(display) > 1) {
-            mul <- par("usr")/c(range(g$biplot[, 1]), range(g$biplot[, 
-                                                                     2]))
-            mul <- mul[is.finite(mul) & mul > 0]
-            mul <- 0.75 * min(mul)
+            mul <- ordiArrowMul(g$biplot)
         }
         else mul <- 1
         arrows(0, 0, mul * g$biplot[, 1], mul * g$biplot[, 2], 

Modified: branches/1.11-0/R/plot.envfit.R
===================================================================
--- branches/1.11-0/R/plot.envfit.R	2008-04-06 20:32:20 UTC (rev 305)
+++ branches/1.11-0/R/plot.envfit.R	2008-04-08 08:14:49 UTC (rev 306)
@@ -1,4 +1,4 @@
-"plot.envfit" <-
+`plot.envfit` <-
     function (x, choices = c(1, 2), arrow.mul, at = c(0, 0), 
               axis = FALSE, p.max = NULL, col = "blue", add = TRUE, ...) 
 {
@@ -27,11 +27,8 @@
         if (missing(arrow.mul)) {
             if(!add)
                 arrow.mul <- 1
-            else {
-                mul <- par("usr")/c(range(vect[,1]), range(vect[,2]))
-                mul <- mul[is.finite(mul) & mul > 0]
-                arrow.mul <- 0.75 * min(mul)
-            }
+            else 
+                arrow.mul <- ordiArrowMul(vect, at = at)
         }
         if (axis) {
             maxarr <- round(sqrt(max(x$vectors$r)), 1)

Modified: branches/1.11-0/R/plot.procrustes.R
===================================================================
--- branches/1.11-0/R/plot.procrustes.R	2008-04-06 20:32:20 UTC (rev 305)
+++ branches/1.11-0/R/plot.procrustes.R	2008-04-08 08:14:49 UTC (rev 306)
@@ -1,5 +1,5 @@
 "plot.procrustes" <-
-function (x, kind = 1, choices = c(1,2), xlab, ylab, main, ar.col = "blue", 
+    function (x, kind = 1, choices = c(1,2), xlab, ylab, main, ar.col = "blue", 
           len = 0.05,  ...) 
 {
     Yrot <- x$Yrot[, choices]
@@ -20,6 +20,8 @@
 	        abline(v = 0, lty = 2)
             abline(h = 0, lty = 2)
             if (ncol(x$rotation) == 2) {
+                ## Sometimes rotation[1,1] is 2.2e-16 above one
+                x$rotation[1,1] <- min(x$rotation[1,1], 1)
                 abline(0, tan(acos(x$rotation[1, 1])), lty = 1)
                 abline(0, 1/tan(acos(-x$rotation[1, 1])), lty = 1)
             }

Modified: branches/1.11-0/R/points.cca.R
===================================================================
--- branches/1.11-0/R/points.cca.R	2008-04-06 20:32:20 UTC (rev 305)
+++ branches/1.11-0/R/points.cca.R	2008-04-08 08:14:49 UTC (rev 306)
@@ -1,4 +1,4 @@
-"points.cca" <-
+`points.cca` <-
     function (x, display = "sites", choices = c(1, 2), scaling = 2, 
               arrow.mul, head.arrow = 0.05, select, ...) 
 {
@@ -20,9 +20,7 @@
     }
     if (display == "bp") {
     	if (missing(arrow.mul)) {
-            mul <- par("usr")/c(range(pts[,1]), range(pts[,2]))
-            mul <- mul[is.finite(mul) & mul > 0]
-            arrow.mul <- 0.75 * min(mul)
+            arrow.mul <- ordiArrowMul(pts)
     	}
         pts <- pts * arrow.mul
         arrows(0, 0, pts[, 1], pts[, 2], length = head.arrow, 

Modified: branches/1.11-0/R/text.cca.R
===================================================================
--- branches/1.11-0/R/text.cca.R	2008-04-06 20:32:20 UTC (rev 305)
+++ branches/1.11-0/R/text.cca.R	2008-04-08 08:14:49 UTC (rev 306)
@@ -1,4 +1,4 @@
-"text.cca" <-
+`text.cca` <-
     function (x, display = "sites", labels, choices = c(1, 2), scaling = 2, 
               arrow.mul, head.arrow = 0.05, select, ...) 
 {
@@ -22,10 +22,7 @@
     }
     if (display == "bp") {
         if (missing(arrow.mul)) {
-            mul <- par("usr")/c(range(pts[, 1]), range(pts[, 
-                                                           2]))
-            mul <- mul[is.finite(mul) & mul > 0]
-            arrow.mul <- 0.75 * min(mul)
+            arrow.mul <- ordiArrowMul(pts)
         }
         pts <- pts * arrow.mul
         arrows(0, 0, pts[, 1], pts[, 2], length = head.arrow, 

Modified: branches/1.11-0/R/varpart4.R
===================================================================
--- branches/1.11-0/R/varpart4.R	2008-04-06 20:32:20 UTC (rev 305)
+++ branches/1.11-0/R/varpart4.R	2008-04-08 08:14:49 UTC (rev 306)
@@ -24,12 +24,12 @@
         stop("Y and X3 do not have the same number of rows")
     if (n4 != n) 
         stop("Y and X4 do not have the same number of rows")
-    SS.Y <- sum(Y * Y)
     Y <- scale(Y, center = TRUE, scale = FALSE)
     X1 <- scale(X1, center = TRUE, scale = TRUE)
     X2 <- scale(X2, center = TRUE, scale = TRUE)
     X3 <- scale(X3, center = TRUE, scale = TRUE)
     X4 <- scale(X4, center = TRUE, scale = TRUE)
+    SS.Y <- sum(Y * Y)
     dummy <- simpleRDA2(Y, X1, SS.Y)
     aeghklno.ua <- dummy$Rsquare
     m1 <- dummy$m

Modified: branches/1.11-0/inst/ChangeLog
===================================================================
--- branches/1.11-0/inst/ChangeLog	2008-04-06 20:32:20 UTC (rev 305)
+++ branches/1.11-0/inst/ChangeLog	2008-04-08 08:14:49 UTC (rev 306)
@@ -2,6 +2,17 @@
 
 VEGAN DEVEL VERSIONS at http://r-forge.r-project.org/
 
+Version 1.11-3 (April 8, 2008)
+
+	* ordiArrowMul & associates: merged Rev 302 (scaling of arrows). 
+
+	* varpart4: merged Rev 289 (wrong sum of squares).
+
+	* anova.cca: merged Rev 288 (no. perms could exceed perm.max)
+
+	* plot.procrustes: merged Rev 278 (fails with two identical
+	configs). 
+	
 Version 1.11-2 (March 20, 2008)
 
         * numPerms: bugfix revision 265

Modified: branches/1.11-0/inst/NEWS
===================================================================
--- branches/1.11-0/inst/NEWS	2008-04-06 20:32:20 UTC (rev 305)
+++ branches/1.11-0/inst/NEWS	2008-04-08 08:14:49 UTC (rev 306)
@@ -2,6 +2,27 @@
 
 			VEGAN RELEASE VERSIONS 
 
+		   CHANGES IN VEGAN VERSION 1.11-3
+
+GENERAL
+
+    - Bug fixes from Rev. 305 on http://r-forge.r-project.org/.
+
+FIXES
+
+    - anova.cca: number of permutations could exceed perm.max.
+
+    - plot.cca, plot.envfit and associates: automatic scaling of
+      biplot arrows and fitted vectors was wrong when axes were
+      reversed (like 'xlim = c(1,-1)') or the origin was shifted in
+      plot.envfit (like 'at = c(1,1)'). Added internal function
+      'ordiArrowMul'.
+
+    - plot.procrustes: failed if two configurations were identical.
+
+    - varpart4: sum of squares was wrong if called directly instead of
+      being called via varpart(). Reported by Guillaume Blanchet.
+
 		   CHANGES IN VEGAN VERSION 1.11-2
 
 GENERAL

Modified: branches/1.11-0/man/vegan-internal.Rd
===================================================================
--- branches/1.11-0/man/vegan-internal.Rd	2008-04-06 20:32:20 UTC (rev 305)
+++ branches/1.11-0/man/vegan-internal.Rd	2008-04-08 08:14:49 UTC (rev 306)
@@ -6,6 +6,7 @@
 \alias{ordiTerminfo}
 \alias{ordispantree}
 \alias{pasteCall}
+\alias{ordiArrowMul}
 \title{Internal vegan functions}
 
 \description{
@@ -15,6 +16,7 @@
 ordiGetData(call, env)
 ordiParseFormula(formula, data, xlev = NULL)
 ordiTerminfo(d, data)
+ordiArrowMul(x, at = c(0,0), fill = 0.75)
 centroids.cca(x, mf, wt)
 permuted.index(n, strata)
 ordispantree(ord, tree, display = "sites", ...)



More information about the Vegan-commits mailing list