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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat May 30 12:20:58 CEST 2009


Author: jarioksa
Date: 2009-05-30 12:20:58 +0200 (Sat, 30 May 2009)
New Revision: 838

Modified:
   pkg/vegan/R/mantel.R
   pkg/vegan/R/mantel.partial.R
   pkg/vegan/R/print.mantel.R
   pkg/vegan/inst/ChangeLog
   pkg/vegan/man/mantel.Rd
Log:
observed value is now one of the permutations in mantel & mantel.partial (+ incidental change in indentation depth)

Modified: pkg/vegan/R/mantel.R
===================================================================
--- pkg/vegan/R/mantel.R	2009-05-30 09:14:37 UTC (rev 837)
+++ pkg/vegan/R/mantel.R	2009-05-30 10:20:58 UTC (rev 838)
@@ -1,33 +1,35 @@
 "mantel" <-
-  function (xdis, ydis, method = "pearson", permutations = 1000, 
+  function (xdis, ydis, method = "pearson", permutations = 999, 
             strata) 
 {
-  xdis <- as.dist(xdis)
-  ydis <- as.vector(as.dist(ydis))
-  tmp <- cor.test(as.vector(xdis), ydis, method = method)
-  statistic <- as.numeric(tmp$estimate)
-  variant <- tmp$method
-  if (permutations) {
-    N <- attributes(xdis)$Size
-    perm <- rep(0, permutations)
-    for (i in 1:permutations) {
-      take <- permuted.index(N, strata)
-      permvec <- as.vector(as.dist(as.matrix(xdis)[take, 
-                                                   take]))
-      perm[i] <- cor(permvec, ydis, method = method)
+    xdis <- as.dist(xdis)
+    ydis <- as.vector(as.dist(ydis))
+    tmp <- cor.test(as.vector(xdis), ydis, method = method)
+    statistic <- as.numeric(tmp$estimate)
+    variant <- tmp$method
+    if (permutations) {
+        if (permutations %% 100 == 0)
+            permutatoins <- permutations - 1
+        N <- attributes(xdis)$Size
+        perm <- rep(0, permutations)
+        for (i in 1:permutations) {
+            take <- permuted.index(N, strata)
+            permvec <- as.vector(as.dist(as.matrix(xdis)[take, 
+                                                         take]))
+            perm[i] <- cor(permvec, ydis, method = method)
+        }
+        signif <- (sum(perm >= statistic) + 1)/(permutations + 1)
+     }
+    else {
+        signif <- NA
+        perm <- NULL
     }
-    signif <- sum(perm >= statistic)/permutations
-  }
-  else {
-    signif <- NA
-    perm <- NULL
-  }
-  res <- list(call = match.call(), method = variant, statistic = statistic, 
-              signif = signif, perm = perm, permutations = permutations)
-  if (!missing(strata)) {
-    res$strata <- deparse(substitute(strata))
-    res$stratum.values <- strata
-  }
-  class(res) <- "mantel"
-  res
+    res <- list(call = match.call(), method = variant, statistic = statistic, 
+                signif = signif, perm = perm, permutations = permutations)
+    if (!missing(strata)) {
+        res$strata <- deparse(substitute(strata))
+        res$stratum.values <- strata
+    }
+    class(res) <- "mantel"
+    res
 }

Modified: pkg/vegan/R/mantel.partial.R
===================================================================
--- pkg/vegan/R/mantel.partial.R	2009-05-30 09:14:37 UTC (rev 837)
+++ pkg/vegan/R/mantel.partial.R	2009-05-30 10:20:58 UTC (rev 838)
@@ -1,43 +1,43 @@
 "mantel.partial" <-
-  function (xdis, ydis, zdis, method = "pearson", permutations = 1000, 
+  function (xdis, ydis, zdis, method = "pearson", permutations = 999, 
             strata) 
 {
-  part.cor <- function(rxy, rxz, ryz) {
-    (rxy - rxz * ryz)/sqrt(1-rxz*rxz)/sqrt(1-ryz*ryz)
-  }
-  xdis <- as.dist(xdis)
-  ydis <- as.vector(as.dist(ydis))
-  zdis <- as.vector(as.dist(zdis))
-  rxy <- cor.test(as.vector(xdis), ydis, method = method)
-  rxz <- cor(as.vector(xdis), zdis, method = method)
-  ryz <- cor(ydis, zdis, method = method)
-  variant <- rxy$method
-  rxy <- rxy$estimate
-  statistic <- part.cor(rxy, rxz, ryz)
-  if (permutations) {
-    N <- attributes(xdis)$Size
-    perm <- rep(0, permutations)
-    for (i in 1:permutations) {
-      take <- permuted.index(N, strata)
-      permvec <- as.vector(as.dist(as.matrix(xdis)[take, 
-                                                   take]))
-      rxy <- cor(permvec, ydis, method = method)
-      rxz <- cor(permvec, zdis, method = method)
-      perm[i] <- part.cor(rxy, rxz, ryz)
+    part.cor <- function(rxy, rxz, ryz) {
+        (rxy - rxz * ryz)/sqrt(1-rxz*rxz)/sqrt(1-ryz*ryz)
     }
-    signif <- sum(perm >= statistic)/permutations
-  }
-  else {
-    signif <- NA
-    perm <- NULL
-  }
-  res <- list(call = match.call(), method = variant, statistic = statistic, 
-              signif = signif, perm = perm, permutations = permutations)
-  if (!missing(strata)) {
-    res$strata <- deparse(substitute(strata))
-    res$stratum.values <- strata
-  }
-  class(res) <- c("mantel.partial", "mantel")
-  res
+    xdis <- as.dist(xdis)
+    ydis <- as.vector(as.dist(ydis))
+    zdis <- as.vector(as.dist(zdis))
+    rxy <- cor.test(as.vector(xdis), ydis, method = method)
+    rxz <- cor(as.vector(xdis), zdis, method = method)
+    ryz <- cor(ydis, zdis, method = method)
+    variant <- rxy$method
+    rxy <- rxy$estimate
+    statistic <- part.cor(rxy, rxz, ryz)
+    if (permutations) {
+        N <- attributes(xdis)$Size
+        perm <- rep(0, permutations)
+        for (i in 1:permutations) {
+            take <- permuted.index(N, strata)
+            permvec <- as.vector(as.dist(as.matrix(xdis)[take, 
+                                                         take]))
+            rxy <- cor(permvec, ydis, method = method)
+            rxz <- cor(permvec, zdis, method = method)
+            perm[i] <- part.cor(rxy, rxz, ryz)
+        }
+        signif <- (sum(perm >= statistic)+1)/(permutations + 1)
+    }
+    else {
+        signif <- NA
+        perm <- NULL
+    }
+    res <- list(call = match.call(), method = variant, statistic = statistic, 
+                signif = signif, perm = perm, permutations = permutations)
+    if (!missing(strata)) {
+        res$strata <- deparse(substitute(strata))
+        res$stratum.values <- strata
+    }
+    class(res) <- c("mantel.partial", "mantel")
+    res
 }
 

Modified: pkg/vegan/R/print.mantel.R
===================================================================
--- pkg/vegan/R/print.mantel.R	2009-05-30 09:14:37 UTC (rev 837)
+++ pkg/vegan/R/print.mantel.R	2009-05-30 10:20:58 UTC (rev 838)
@@ -11,7 +11,7 @@
   cat(formatC(x$statistic, digits = digits), "\n")
   nperm <- x$permutations
   if (nperm) {
-    cat("      Significance:", format.pval(x$signif, eps = 1/nperm), 
+    cat("      Significance:", format.pval(x$signif), 
         "\n\n")
     out <- quantile(x$perm, c(0.9, 0.95, 0.975, 0.99))
     cat("Empirical upper confidence limits of r:\n")

Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog	2009-05-30 09:14:37 UTC (rev 837)
+++ pkg/vegan/inst/ChangeLog	2009-05-30 10:20:58 UTC (rev 838)
@@ -26,6 +26,9 @@
 	* envfit (vectorfit, factorfit): observed value of test statistic
 	is now considered as one of the permutations.
 
+	* mantel, mantel.partial: observed value of test statistic is now
+	considered as one of the permutations.
+
 Version 1.16-18 (closed May 14, 2009)
 
 	* tsallis: got new argument 'hill' similar to that of renyi.

Modified: pkg/vegan/man/mantel.Rd
===================================================================
--- pkg/vegan/man/mantel.Rd	2009-05-30 09:14:37 UTC (rev 837)
+++ pkg/vegan/man/mantel.Rd	2009-05-30 10:20:58 UTC (rev 838)
@@ -14,8 +14,8 @@
 
 }
 \usage{
-mantel(xdis, ydis, method="pearson", permutations=1000, strata)
-mantel.partial(xdis, ydis, zdis, method = "pearson", permutations = 1000, 
+mantel(xdis, ydis, method="pearson", permutations=999, strata)
+mantel.partial(xdis, ydis, zdis, method = "pearson", permutations = 999, 
     strata)
 }
 



More information about the Vegan-commits mailing list