[Vegan-commits] r1704 - pkg/vegan/R

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

Author: gsimpson
Date: 2011-08-10 01:12:30 +0200 (Wed, 10 Aug 2011)
New Revision: 1704

Modified:
   pkg/vegan/R/plot.envfit.R
Log:
when not adding, make sure plot axis limits are sufficient to contain the labels

Modified: pkg/vegan/R/plot.envfit.R
===================================================================
--- pkg/vegan/R/plot.envfit.R	2011-08-09 18:52:00 UTC (rev 1703)
+++ pkg/vegan/R/plot.envfit.R	2011-08-09 23:12:30 UTC (rev 1704)
@@ -1,6 +1,6 @@
 `plot.envfit` <-
-    function (x, choices = c(1, 2), arrow.mul, at = c(0, 0), 
-              axis = FALSE, p.max = NULL, col = "blue", add = TRUE, ...) 
+    function (x, choices = c(1, 2), arrow.mul, at = c(0, 0),
+              axis = FALSE, p.max = NULL, col = "blue", add = TRUE, ...)
 {
     formals(arrows) <- c(formals(arrows), alist(... = ))
     vect <- NULL
@@ -9,16 +9,16 @@
             take <- x$vectors$pvals <= p.max
             x$vectors$arrows <- x$vectors$arrows[take, , drop = FALSE]
             x$vectors$r <- x$vectors$r[take]
-            if (nrow(x$vectors$arrows) == 0) 
+            if (nrow(x$vectors$arrows) == 0)
                 x$vectors <- vect <- NULL
         }
         if (!is.null(x$factors)) {
             tmp <- x$factors$pvals <= p.max
             nam <- names(tmp)[tmp]
             take <- x$factors$var.id %in% nam
-            x$factors$centroids <- x$factors$centroids[take, 
+            x$factors$centroids <- x$factors$centroids[take,
                                                        , drop = FALSE]
-            if (nrow(x$factors$centroids) == 0) 
+            if (nrow(x$factors$centroids) == 0)
                 x$factors <- NULL
         }
     }
@@ -27,7 +27,7 @@
         if (missing(arrow.mul)) {
             if(!add)
                 arrow.mul <- 1
-            else 
+            else
                 arrow.mul <- ordiArrowMul(vect, at = at)
         }
         if (axis) {
@@ -39,30 +39,63 @@
         vect <- sweep(vect, 2, at, "+")
     }
     if (!add) {
-        xlim <- range(at[1], vect[,1], x$factors$centroids[,1])
-        ylim <- range(at[2], vect[,2], x$factors$centroids[,2])
-        if (!is.null(vect)) 
-            plot(vect, xlim = xlim, ylim = ylim, asp = 1, type = "n", 
-                 ...)
-        else if (!is.null(x$factors)) 
-            plot(x$factors$centroids[, choices, drop = FALSE], 
-                 asp = 1, xlim = xlim, ylim = ylim, type = "n", 
-                 ...)
-        else stop("Nothing to plot")
+        plot.new() ## needed for string widths and heights
+        if(!is.null(vect)) {
+            ## compute axis limits allowing space for labels
+            labs <- rownames(x$vectors$arrows)
+            sw <- strwidth(labs)
+            sh <- strheight(labs)
+            xlim <- range(at[1], vtext[,1] + sw, vtext[,1] - sw)
+            ylim <- range(at[2], vtext[,2] + sh, vtext[,2] - sh)
+            if(!is.null(x$factors)) {
+                ## if factors, also need to consider them
+                labs <- rownames(x$factors$centroids)
+                sw <- strwidth(labs)
+                sh <- strheight(labs)
+                xlim <- range(xlim, x$factors$centroids[, choices[1]] + sw,
+                              x$factors$centroids[, choices[1]] - sw)
+                ylim <- range(ylim, x$factors$centroids[, choices[2]] + sh,
+                              x$factors$centroids[, choices[2]] - sh)
+            }
+            ## these plotting calls will prob. generate warnings
+            ## because of passing ... everywhere. localFoo needed?
+            plot.window(xlim = xlim, ylim = ylim, asp = 1, ...)
+            axis(side = 1, ...)
+            axis(side = 2, ...)
+            box(...)
+            alabs <- colnames(vect)
+            title(..., ylab = alabs[2], xlab = alabs[1])
+        } else if (!is.null(x$factors)) {
+            labs <- rownames(x$factors$centroids)
+            sw <- strwidth(labs)
+            sh <- strheight(labs)
+            xlim <- range(at[1], x$factors$centroids[, choices[1]] + sw,
+                          x$factors$centroids[, choices[1]] - sw)
+            ylim <- range(at[2], x$factors$centroids[, choices[2]] + sh,
+                          x$factors$centroids[, choices[2]] - sh)
+            ## these plotting calls will prob. generate warnings
+            ## because of passing ... everywhere. localFoo needed?
+            plot.window(xlim = xlim, ylim = ylim, asp = 1, ...)
+            axis(side = 1, ...)
+            axis(side = 2, ...)
+            box(...)
+            alabs <- colnames(x$factors$centroids[, choices, drop = FALSE])
+            title(..., ylab = alabs[2], xlab = alabs[1])
+        } else stop("Nothing to plot")
     }
     if (!is.null(vect)) {
-        arrows(at[1], at[2], vect[, 1], vect[, 2], len = 0.05, 
+        arrows(at[1], at[2], vect[, 1], vect[, 2], len = 0.05,
                col = col)
         text(vtext, rownames(x$vectors$arrows), col = col, ...)
     }
     if (!is.null(x$factors)) {
-        text(x$factors$centroids[, choices, drop = FALSE], rownames(x$factors$centroids), 
+        text(x$factors$centroids[, choices, drop = FALSE], rownames(x$factors$centroids),
              col = col, ...)
     }
     if (axis && !is.null(vect)) {
-        axis(3, at = ax + at[1], labels = c(maxarr, 0, maxarr), 
+        axis(3, at = ax + at[1], labels = c(maxarr, 0, maxarr),
              col = col)
-        axis(4, at = ax + at[2], labels = c(maxarr, 0, maxarr), 
+        axis(4, at = ax + at[2], labels = c(maxarr, 0, maxarr),
              col = col)
     }
     invisible()