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

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

Author: jarioksa
Date: 2009-10-28 10:33:25 +0100 (Wed, 28 Oct 2009)
New Revision: 1056

Modified:
   pkg/vegan/R/pcnm.R
   pkg/vegan/man/pcnm.Rd
Log:
Adding 'pcnm' from sedarVegan with history: first veganification

Modified: pkg/vegan/R/pcnm.R
===================================================================
--- pkg/vegan/R/pcnm.R	2009-10-28 09:31:51 UTC (rev 1055)
+++ pkg/vegan/R/pcnm.R	2009-10-28 09:33:25 UTC (rev 1056)
@@ -1,19 +1,28 @@
 "pcnm" <-
-function(matdist,thresh=give.thresh(as.dist(matdist)))
+    function(matdist, threshold, support = c("vegan", "ade4"))
 {
-    matdist <- as.matrix(matdist)
-   
-   
-            mattrunc <- ifelse(matdist >thresh, 4*thresh,matdist)
-    wa.old <- options()$warn
-    options(warn = -1)
-    mypcnm <- cmdscale(mattrunc,k=min(dim(matdist))-1,eig=TRUE)
-    eq0 <- apply(as.matrix(mypcnm$eig/max((mypcnm$eig))),1,function(x) identical(all.equal(x, 0), TRUE))
-    inf0 <- ifelse(mypcnm$eig<0,TRUE,FALSE)
+    EPS <- sqrt(.Machine$double.eps)
+    wa.old <- options(warn = -1)
+    on.exit(options(wa.old))
+    matdist <- as.dist(matdist)
+    if (missing(threshold)) {
+        support <- match.arg(support)
+        threshold <- 
+            switch(support,
+                   vegan =  max(spantree(matdist)$dist),
+                   ade4 = max(neig2mat(mstree(matdist)) * as.matrix(matdist))
+                   )
+    }
+    matdist[matdist > threshold] <- 4*threshold
+    k <- attr(matdist, "Size") - 1
+    mypcnm <- cmdscale(matdist, k = k, eig = TRUE)
+    eq0 <- abs(mypcnm$eig/max((mypcnm$eig))) <= EPS
+    inf0 <- mypcnm$eig < 0
     res <- list()
     res$values <- mypcnm$eig[!(eq0|inf0)]
-    res$vectors <- mypcnm$points[,!(eq0|inf0)]
-    res$vectors <- sweep(res$vectors,2,sqrt(res$values),"/")
-    options(warn = wa.old)
-    return(res)
+    res$vectors <- mypcnm$points[,!(eq0|inf0), drop = FALSE]
+    res$vectors <- sweep(res$vectors, 2, sqrt(res$values), "/")
+    res$threshold <- threshold
+    class(res) <- "pcnm"
+    res
 }

Modified: pkg/vegan/man/pcnm.Rd
===================================================================
--- pkg/vegan/man/pcnm.Rd	2009-10-28 09:31:51 UTC (rev 1055)
+++ pkg/vegan/man/pcnm.Rd	2009-10-28 09:33:25 UTC (rev 1056)
@@ -5,31 +5,36 @@
   This function computed classical PCNM by the principal coordinate analysis of a truncated distance matrix.
 }
 \usage{
-pcnm(matdist, thresh = give.thresh(as.dist(matdist)))
+pcnm(matdist, threshold, support = c("vegan", "ade4"))
 }
 
 \arguments{
   \item{matdist}{ A distance matrix. }
-  \item{thresh}{ A threshold value. }
+  \item{threshold}{ A threshold value or truncation distance. If missing,
+    minimum distance giving connected network will be used. This is found
+    as the longest distance in the minimum spanning tre of
+    \code{matdist}. }
+  \item{support}{Use either \pkg{vegan} or \pkg{ade4} function for the
+    minimum spanning tree.}
 }
 
 \value{
-  A list of two elements:
+  A list of three elements:
   \item{values }{Eigenvalues obtained by the principal coordinates analysis.}
   \item{vectors }{Eigenvectors obtained by the principal coordinates analysis. They have been normalized to unit norm.}
-  
+ \item{threshold}{Truncation distance.} 
 }
 \references{ Borcard D. and Legendre P. (2002) All-scale spatial analysis of ecological data by means of principal coordinates of neighbour matrices. \emph{Ecological Modelling} \bold{153}, 51--68. }
-\author{ Stephane Dray }
-\seealso{ \code{\link{give.thresh}} }
+\author{ Stephane Dray, adapted to vegan by Jari Oksanen }
+\seealso{ \code{\link[vegan]{spantree}}, \code{\link[ade4]{mstree}}. }
 \examples{
-data(oribatid)
-pcnm1 <- pcnm(dist(oribatid$xy))
-par(mfrow=c(1,3))
-s.value(oribatid$xy,pcnm1$vectors[,1],cleg=0, sub="PCNM 1",csub=3)
-s.value(oribatid$xy,pcnm1$vectors[,2],cleg=0, sub="PCNM 2",csub=3)
-s.value(oribatid$xy,pcnm1$vectors[,3],cleg=0, sub="PCNM 3",csub=3)
+data(mite.xy)
+pcnm1 <- pcnm(dist(mite.xy))
+op <- par(mfrow=c(1,3))
+ordisurf(mite.xy, pcnm1$vectors[,1])
+ordisurf(mite.xy, pcnm1$vectors[,2])
+ordisurf(mite.xy, pcnm1$vectors[,3])
+par(op)
 
-
 }
 \keyword{ spatial }