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

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

Author: gsimpson
Date: 2011-02-06 23:50:46 +0100 (Sun, 06 Feb 2011)
New Revision: 1480

Modified:
   pkg/vegan/R/betadisper.R
   pkg/vegan/inst/ChangeLog
Log:
streamlined code

Modified: pkg/vegan/R/betadisper.R
===================================================================
--- pkg/vegan/R/betadisper.R	2011-02-06 13:13:26 UTC (rev 1479)
+++ pkg/vegan/R/betadisper.R	2011-02-06 22:50:46 UTC (rev 1480)
@@ -1,6 +1,4 @@
-`betadisper` <-
-    function(d, group, type = c("median","centroid"))
-{
+`betadisper` <- function(d, group, type = c("median","centroid")) {
     ## inline function for spatial medians
     spatialMed <- function(vectors, group, pos) {
         axes <- seq_len(NCOL(vectors))
@@ -8,6 +6,14 @@
         spMedNeg <- ordimedian(vectors, group, choices = axes[!pos])
         return(cbind(spMedPos, spMedNeg))
     }
+    ## inline function for distance computation
+    Resids <- function(x, c) {
+        if(is.matrix(c))
+            d <- x - c
+        else
+            d <- sweep(x, 2, c)
+        return(rowSums(d^2))
+    }
     ## Tolerance for zero Eigenvalues
     TOL <- 1e-7
     ## uses code from stats:::cmdscale by R Core Development Team
@@ -64,28 +70,15 @@
                )
     ## for each of the groups, calculate distance to centroid for
     ## observation in the group
-    if(is.matrix(centroids)) {
-        dist.pos <- vectors[, pos, drop=FALSE] -
-            centroids[group, pos, drop=FALSE]
-        dist.pos <- rowSums(dist.pos^2)
-        if (any(!pos)) {
-            dist.neg <- vectors[, !pos, drop=FALSE] -
-                centroids[group, !pos, drop=FALSE]
-            dist.neg <- rowSums(dist.neg^2)
-        } else {
-            dist.neg <- 0
-        }
-    } else {
-        dist.pos <- sweep(vectors[, pos, drop=FALSE], 2, centroids[pos])
-        dist.pos <- rowSums(dist.pos^2)
-        if (any(!pos)) {
-            dist.neg <- sweep(vectors[, !pos, drop=FALSE], 2,
-                              centroids[!pos])
-            dist.neg <- rowSums(dist.neg^2)
-        } else {
-            dist.neg <- 0
-        }
-    }
+    ## Uses in-line Resids function as we want LAD residuals for
+    ## median method, and LSQ residuals for centroid method
+    dist.pos <- Resids(vectors[, pos, drop=FALSE],
+                       centroids[group, pos, drop=FALSE])
+    dist.neg <- 0
+    if(any(!pos))
+        dist.neg <- Resids(vectors[, !pos, drop=FALSE],
+                           centroids[group, !pos, drop=FALSE])
+
     ## zij are the distances of each point to its group centroid
     zij <- sqrt(abs(dist.pos - dist.neg))
     ## add in correct labels

Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog	2011-02-06 13:13:26 UTC (rev 1479)
+++ pkg/vegan/inst/ChangeLog	2011-02-06 22:50:46 UTC (rev 1480)
@@ -4,6 +4,8 @@
 
 Version 1.18-22 (opened January 19, 2011)
 
+	* betadisper: streamlined code somewhat.
+
 	* prestonfit: implemented splitting "tied" counts (1, 2, 4, 8 etc)
 	between octaves following Williamson & Gaston (J Anim Ecol 43,
 	381-399; 2005) with argument 'tiesplit = TRUE'