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

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

Author: jarioksa
Date: 2011-08-25 14:14:27 +0200 (Thu, 25 Aug 2011)
New Revision: 1757

Modified:
   pkg/vegan/R/adonis.R
   pkg/vegan/R/anosim.R
   pkg/vegan/R/betadisper.R
   pkg/vegan/R/mrpp.R
   pkg/vegan/inst/ChangeLog
Log:
check that input dissimilarities really are dissimilarities (= non-negative)

Modified: pkg/vegan/R/adonis.R
===================================================================
--- pkg/vegan/R/adonis.R	2011-08-24 14:57:43 UTC (rev 1756)
+++ pkg/vegan/R/adonis.R	2011-08-25 12:14:27 UTC (rev 1757)
@@ -31,8 +31,11 @@
                                Q <- qr.Q(qrX)
                                tcrossprod(Q[,1:qrX$rank])
                            })
-    if (inherits(lhs, "dist"))
+    if (inherits(lhs, "dist")) {
+        if (any(lhs < -TOL))
+            stop("dissimilarities must be non-negative")
         dmat <- as.matrix(lhs^2)
+    }
     else {
         dist.lhs <- as.matrix(vegdist(lhs, method=method, ...))
         dmat <- dist.lhs^2

Modified: pkg/vegan/R/anosim.R
===================================================================
--- pkg/vegan/R/anosim.R	2011-08-24 14:57:43 UTC (rev 1756)
+++ pkg/vegan/R/anosim.R	2011-08-25 12:14:27 UTC (rev 1757)
@@ -10,6 +10,8 @@
         attr(x, "method") <- "user supplied square matrix"
     }
     else x <- vegdist(dat, method = distance)
+    if (any(x < -sqrt(.Machine$double.eps)))
+        stop("dissimilarities must be non-negative")
     sol <- c(call = match.call())
     grouping <- as.factor(grouping)
     matched <- function(irow, icol, grouping) {

Modified: pkg/vegan/R/betadisper.R
===================================================================
--- pkg/vegan/R/betadisper.R	2011-08-24 14:57:43 UTC (rev 1756)
+++ pkg/vegan/R/betadisper.R	2011-08-25 12:14:27 UTC (rev 1757)
@@ -21,6 +21,9 @@
     ## uses code from stats:::cmdscale by R Core Development Team
     if(!inherits(d, "dist"))
         stop("distances 'd' must be a 'dist' object")
+    ## Someone really tried to analyse correlation like object in range -1..+1
+    if (any(d < -TOL, na.rm = TRUE))
+        stop("dissimilarities 'd' must be non-negative")
     if(missing(type))
         type <- "median"
     type <- match.arg(type)

Modified: pkg/vegan/R/mrpp.R
===================================================================
--- pkg/vegan/R/mrpp.R	2011-08-24 14:57:43 UTC (rev 1756)
+++ pkg/vegan/R/mrpp.R	2011-08-25 12:14:27 UTC (rev 1757)
@@ -18,6 +18,8 @@
         attr(dmat, "method") <- "user supplied square matrix"
     }
     else dmat <- vegdist(dat, method = distance)
+    if (any(dmat < -sqrt(.Machine$double.eps)))
+        stop("dissimilarities must be non-negative")
     distance <- attr(dmat, "method")
     dmat <- as.matrix(dmat)
     diag(dmat) <- NA

Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog	2011-08-24 14:57:43 UTC (rev 1756)
+++ pkg/vegan/inst/ChangeLog	2011-08-25 12:14:27 UTC (rev 1757)
@@ -4,6 +4,14 @@
 
 Version 1.92-1 (opened August 23, 2011)
 
+	* adonis, anosim, betadisper, mrpp: check that dissimilarities are
+	non-negative (small negative values are tolerated). The test was
+	not added to meandist: there may be legitimate usages for
+	correlation-like objects although summary.meandist() is
+	invalid. The addition was triggered by a user who tried to analyse
+	Chase et al. Raup-Crick values in the range -1 .. +1 in
+	betadisper(). 
+
 	* specaccum, fitspecaccum: gained predict() methods. With
 	specaccum() predict(..., newdata) can estimate values for
 	'newdata' with linear or spline interpolation if necessary.