[Vegan-commits] r302 - in pkg: . R inst man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Apr 6 16:46:34 CEST 2008


Author: jarioksa
Date: 2008-04-06 16:46:33 +0200 (Sun, 06 Apr 2008)
New Revision: 302

Added:
   pkg/R/ordiArrowMul.R
Modified:
   pkg/DESCRIPTION
   pkg/R/ordiplot3d.R
   pkg/R/plot.cca.R
   pkg/R/plot.envfit.R
   pkg/R/points.cca.R
   pkg/R/text.cca.R
   pkg/inst/ChangeLog
   pkg/man/vegan-internal.Rd
Log:
scaling of biplot arrows and fitted vectors more robust: xlim=c(1,-1) work and at=c(1,1) taken into account

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2008-04-02 17:03:22 UTC (rev 301)
+++ pkg/DESCRIPTION	2008-04-06 14:46:33 UTC (rev 302)
@@ -1,7 +1,7 @@
 Package: vegan
 Title: Community Ecology Package
-Version: 1.12-8
-Date: Mar 30, 2008
+Version: 1.12-9
+Date: Apr 6, 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>

Added: pkg/R/ordiArrowMul.R
===================================================================
--- pkg/R/ordiArrowMul.R	                        (rev 0)
+++ pkg/R/ordiArrowMul.R	2008-04-06 14:46:33 UTC (rev 302)
@@ -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: pkg/R/ordiplot3d.R
===================================================================
--- pkg/R/ordiplot3d.R	2008-04-02 17:03:22 UTC (rev 301)
+++ pkg/R/ordiplot3d.R	2008-04-06 14:46:33 UTC (rev 302)
@@ -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: pkg/R/plot.cca.R
===================================================================
--- pkg/R/plot.cca.R	2008-04-02 17:03:22 UTC (rev 301)
+++ pkg/R/plot.cca.R	2008-04-06 14:46:33 UTC (rev 302)
@@ -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: pkg/R/plot.envfit.R
===================================================================
--- pkg/R/plot.envfit.R	2008-04-02 17:03:22 UTC (rev 301)
+++ pkg/R/plot.envfit.R	2008-04-06 14:46:33 UTC (rev 302)
@@ -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: pkg/R/points.cca.R
===================================================================
--- pkg/R/points.cca.R	2008-04-02 17:03:22 UTC (rev 301)
+++ pkg/R/points.cca.R	2008-04-06 14:46:33 UTC (rev 302)
@@ -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: pkg/R/text.cca.R
===================================================================
--- pkg/R/text.cca.R	2008-04-02 17:03:22 UTC (rev 301)
+++ pkg/R/text.cca.R	2008-04-06 14:46:33 UTC (rev 302)
@@ -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: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2008-04-02 17:03:22 UTC (rev 301)
+++ pkg/inst/ChangeLog	2008-04-06 14:46:33 UTC (rev 302)
@@ -2,8 +2,16 @@
 
 VEGAN DEVEL VERSIONS at http://r-forge.r-project.org/
 
-Version 1.12-8 (opened Mar 30, 2008)
+Version 1.12-9 (opened April 6, 2008)
 
+	* ordiArrowMul: added function 'ordiArrowMul' to improve automatic
+	scaling of biplot arrows (in plot.cca, text.cca, points.cca) and
+	fitted vectors (in plot.envfit). Reversed axes 'xlim=c(1,-1)' work
+	now, and shifted origin 'at = c(1,1)' taken into account in
+	plot.envfit. 
+	
+Version 1.12-8 (closed April 6, 2008)
+
 	* permute: New high-level untility function for facilitating
 	the production of permutation tests using the new permutation
 	designs allowed by permuted.index2(). An example of the new

Modified: pkg/man/vegan-internal.Rd
===================================================================
--- pkg/man/vegan-internal.Rd	2008-04-02 17:03:22 UTC (rev 301)
+++ pkg/man/vegan-internal.Rd	2008-04-06 14:46:33 UTC (rev 302)
@@ -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