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

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

Author: jarioksa
Date: 2012-05-22 17:53:27 +0200 (Tue, 22 May 2012)
New Revision: 2175

Modified:
   pkg/vegan/R/ordihull.R
Log:
put ordihull labels *really* to the centroids

Modified: pkg/vegan/R/ordihull.R
===================================================================
--- pkg/vegan/R/ordihull.R	2012-05-22 15:33:34 UTC (rev 2174)
+++ pkg/vegan/R/ordihull.R	2012-05-22 15:53:27 UTC (rev 2175)
@@ -4,6 +4,18 @@
               col = NULL, show.groups, label = FALSE, ...)
 {
     draw <- match.arg(draw)
+    ## Internal function to find the polygon centre
+    polycentre <- function(x) {
+        n <- nrow(x)
+        if (n < 4) 
+            return(colMeans(x[-n, ]))
+        xy <- x[-n, 1] * x[-1, 2] - x[-1, 1] * x[-n, 2]
+        A <- sum(xy)/2
+        xc <- sum((x[-n, 1] + x[-1, 1]) * xy)/A/6
+        yc <- sum((x[-n, 2] + x[-1, 2]) * xy)/A/6
+        c(xc, yc)
+    }
+
     pts <- scores(ord, display = display, ...)
     if (!missing(show.groups)) {
         take <- groups %in% show.groups
@@ -29,7 +41,7 @@
             else if (draw == "polygon")
                 ordiArgAbsorber(X[hpts,], FUN = polygon, col = col, ...)
             if (label && draw != "none") {
-                cntrs <- rbind(cntrs, colMeans(X[hpts[-1],, drop = FALSE]))
+                cntrs <- rbind(cntrs, polycentre(X[hpts,]))
                 names <- c(names, is)
             }
             res[[is]] <- X[hpts,]