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

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

Author: jarioksa
Date: 2013-06-22 14:51:56 +0200 (Sat, 22 Jun 2013)
New Revision: 2535

Added:
   pkg/vegan/R/ordiArrowTextXY.R
Modified:
   pkg/vegan/R/plot.cca.R
   pkg/vegan/R/plot.envfit.R
   pkg/vegan/R/text.cca.R
   pkg/vegan/inst/ChangeLog
   pkg/vegan/man/vegan-internal.Rd
Log:
improve position of labels to biplot arrows: add internal ordiArrowTextXY

Added: pkg/vegan/R/ordiArrowTextXY.R
===================================================================
--- pkg/vegan/R/ordiArrowTextXY.R	                        (rev 0)
+++ pkg/vegan/R/ordiArrowTextXY.R	2013-06-22 12:51:56 UTC (rev 2535)
@@ -0,0 +1,27 @@
+### Location of the text at the point of the arrow. 'vect' are the
+### coordinates of the arrow heads, and 'labels' are the text used to
+### label these heads, '...' passes arguments (such as 'cex') to
+### strwidth() and strheight().
+`ordiArrowTextXY` <-
+    function (vect, labels, ...) 
+{
+    w <- strwidth(labels, ...)
+    h <- strheight(labels, ...)
+    ## slope of arrows
+    b <- vect[,2]/vect[,1]
+    ## offset based on string dimensions
+    off <- cbind(sign(vect[,1]) * (w/2 + h/4), 0.75 * h * sign(vect[,2]))
+    ## move the centre of the string to the continuation of the arrow
+    for(i in 1:nrow(vect)) {
+        move <- off[i,2] / b[i]
+        ## arrow points to the top/bottom of the text box
+        if (is.finite(move) && abs(move) <= abs(off[i, 1]))
+            off[i, 1] <- move
+        else {
+            ## arrow points to a side of the text box
+            move <- b[i] * off[i,1]
+            off[i, 2] <- move
+        }  
+    }
+    off + vect
+}

Modified: pkg/vegan/R/plot.cca.R
===================================================================
--- pkg/vegan/R/plot.cca.R	2013-06-21 04:20:10 UTC (rev 2534)
+++ pkg/vegan/R/plot.cca.R	2013-06-22 12:51:56 UTC (rev 2535)
@@ -93,7 +93,8 @@
         attr(g$biplot, "arrow.mul") <- mul
         arrows(0, 0, mul * g$biplot[, 1], mul * g$biplot[, 2], 
                length = 0.05, col = "blue")
-        text(1.1 * mul * g$biplot, rownames(g$biplot), col = "blue")
+        biplabs <- ordiArrowTextXY(mul * g$biplot, rownames(g$biplot))
+        text(biplabs, rownames(g$biplot), col = "blue")
         axis(3, at = c(-mul, 0, mul), labels = rep("", 3), col = "blue")
         axis(4, at = c(-mul, 0, mul), labels = c(-1, 0, 1), col = "blue")
     }

Modified: pkg/vegan/R/plot.envfit.R
===================================================================
--- pkg/vegan/R/plot.envfit.R	2013-06-21 04:20:10 UTC (rev 2534)
+++ pkg/vegan/R/plot.envfit.R	2013-06-22 12:51:56 UTC (rev 2535)
@@ -59,7 +59,8 @@
             ax <- -c(-1, 0, 1) * arrow.mul * maxarr
         }
         vect <- arrow.mul * vect
-        vtext <- sweep(1.1 * vect, 2, at, "+")
+        vtext <- ordiArrowTextXY(vect, labs$v, ...)
+        vtext <- sweep(vtext, 2, at, "+")
         vect <- sweep(vect, 2, at, "+")
     }
     if (!add) {

Modified: pkg/vegan/R/text.cca.R
===================================================================
--- pkg/vegan/R/text.cca.R	2013-06-21 04:20:10 UTC (rev 2534)
+++ pkg/vegan/R/text.cca.R	2013-06-22 12:51:56 UTC (rev 2535)
@@ -29,7 +29,7 @@
         pts <- pts * arrow.mul
         arrows(0, 0, pts[, 1], pts[, 2], length = head.arrow,
                ...)
-        pts <- pts * 1.1
+        pts <- ordiArrowTextXY(pts, rownames(pts), ...)
         if (axis.bp) {
             axis(side = 3, at = c(-arrow.mul, 0, arrow.mul),
                  labels = rep("", 3))

Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog	2013-06-21 04:20:10 UTC (rev 2534)
+++ pkg/vegan/inst/ChangeLog	2013-06-22 12:51:56 UTC (rev 2535)
@@ -23,6 +23,15 @@
 	* ordisurf: can now pass in a line width for the contours via
 	argument `lwd.cl`.
 
+	* ordiArrowTextXY: New (internal) support function that finds
+	coordinates of text box at the point of the arrow so that the
+	arrow point just touches the text.  This should improve
+	positioning of the arrow labels and avoid writing labels over the
+	arrows. 
+
+	* plot.envfit, plot.cca, text.cca: use ordiArrowTextXY() for arrow
+	labels instead of expanding arrow heads by 10%.
+
 Version 2.1-30 (opened May 5, 2013)
 
 	* bioenv: can now use Mahalanobis, Manhattan and Gower distances

Modified: pkg/vegan/man/vegan-internal.Rd
===================================================================
--- pkg/vegan/man/vegan-internal.Rd	2013-06-21 04:20:10 UTC (rev 2534)
+++ pkg/vegan/man/vegan-internal.Rd	2013-06-22 12:51:56 UTC (rev 2535)
@@ -8,6 +8,7 @@
 \alias{ordiTerminfo}
 \alias{pasteCall}
 \alias{ordiArrowMul}
+\alias{oridArrowTextXY}
 \alias{ordiArgAbsorber}
 \alias{veganCovEllipse}
 \alias{hierParseFormula}
@@ -27,6 +28,7 @@
 ordiNAexclude(x, excluded)
 ordiNApredict(omit, x)
 ordiArrowMul(x, at = c(0,0), fill = 0.75)
+ordiArrowTextXY(vect, labels, ...)
 ordiArgAbsorber(..., shrink, origin, scaling, triangular,
                 display, choices, const, FUN)
 centroids.cca(x, mf, wt)
@@ -64,6 +66,11 @@
   \code{ordiNApredict} puts pads the result object with these or with
   WA scores similarly as \code{\link{napredict}}.
 
+  \code{ordiArrowMul} finds a multiplier to scale a bunch of arrows to
+  fill an ordination plot, and \code{ordiArrowTextXY} finds the
+  coordinates for labels of these arrows.  See \code{\link{envfit}}
+  for an application.
+
   \code{ordiArgAbsorber} absorbs arguments of \code{\link{scores}}
   function of \pkg{vegan} so that these do not cause superfluous
   warnings in graphical function \code{FUN}. If you implement