[Vegan-commits] r2485 - in pkg/vegan: R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Apr 7 22:19:34 CEST 2013
Author: gsimpson
Date: 2013-04-07 22:19:34 +0200 (Sun, 07 Apr 2013)
New Revision: 2485
Modified:
pkg/vegan/R/betadisper.R
pkg/vegan/R/eigenvals.R
pkg/vegan/R/print.betadisper.R
pkg/vegan/inst/ChangeLog
pkg/vegan/man/betadisper.Rd
Log:
redo fix applied in r2484 in a different way, print 'mediod' when using type = "median", reduce number of eigenvalues printed, add eigenvals method for betadisper
Modified: pkg/vegan/R/betadisper.R
===================================================================
--- pkg/vegan/R/betadisper.R 2013-04-07 06:00:57 UTC (rev 2484)
+++ pkg/vegan/R/betadisper.R 2013-04-07 20:19:34 UTC (rev 2485)
@@ -18,6 +18,18 @@
spMedNeg <- ordimedian(vectors, group, choices = axes[!pos])
cbind(spMedPos, spMedNeg)
}
+ ## inline function for centroids
+ centroidFUN <- function(vec, group) {
+ cent <- apply(vec, 2,
+ function(x, group) tapply(x, INDEX = group, FUN = mean),
+ group = group)
+ if(!is.matrix(cent)) { ## if only 1 group, cent is vector
+ cent <- matrix(cent, nrow = 1,
+ dimnames = list(as.character(levels(group)),
+ paste0("Dim", seq_len(NCOL(vec)))))
+ }
+ cent
+ }
## inline function for distance computation
Resids <- function(x, c) {
if(is.matrix(c))
@@ -69,7 +81,6 @@
warning("Missing observations due to 'd' removed.")
}
x <- x + t(x)
- storage.mode(x) <- "double"
x <- dblcen(x)
e <- eigen(-x/2, symmetric = TRUE)
vectors <- e$vectors
@@ -84,7 +95,7 @@
## group centroids in PCoA space
centroids <-
switch(type,
- centroid = apply(vectors, 2, function(x) tapply(x, group, mean)),
+ centroid = centroidFUN(vectors, group),
median = spatialMed(vectors, group, pos)
)
## for each of the groups, calculate distance to centroid for
@@ -92,13 +103,11 @@
## 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],
- if (is.vector(centroids)) centroids[pos]
- else centroids[group, pos, drop=FALSE])
+ centroids[group, pos, drop=FALSE])
dist.neg <- 0
if(any(!pos))
dist.neg <- Resids(vectors[, !pos, drop=FALSE],
- if (is.vector(centroids)) centroids[!pos]
- else centroids[group, !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))
Modified: pkg/vegan/R/eigenvals.R
===================================================================
--- pkg/vegan/R/eigenvals.R 2013-04-07 06:00:57 UTC (rev 2484)
+++ pkg/vegan/R/eigenvals.R 2013-04-07 20:19:34 UTC (rev 2485)
@@ -28,7 +28,7 @@
out
}
-## squares of sdev
+## squares of sdev
`eigenvals.prcomp` <-
function(x, ...)
{
@@ -78,6 +78,13 @@
out
}
+## betadisper (vegan)
+`eigenvals.betadisper` <- function(x, ...) {
+ out <- x$eig
+ class(out) <- "eigenvals"
+ out
+}
+
## dudi objects of ade4
`eigenvals.dudi` <-
@@ -112,8 +119,8 @@
class(out) <- "eigenvals"
out
}
-
+
`print.eigenvals` <-
function(x, ...)
{
Modified: pkg/vegan/R/print.betadisper.R
===================================================================
--- pkg/vegan/R/print.betadisper.R 2013-04-07 06:00:57 UTC (rev 2484)
+++ pkg/vegan/R/print.betadisper.R 2013-04-07 20:19:34 UTC (rev 2485)
@@ -1,6 +1,9 @@
`print.betadisper` <- function(x, digits = max(3, getOption("digits") - 3),
- ...)
+ ...)
{
+ ## limit number of eignvals to 8
+ ax.lim <- 8
+ ##
cat("\n")
writeLines(strwrap("Homogeneity of multivariate dispersions\n",
prefix = "\t"))
@@ -9,10 +12,12 @@
cat(paste("\nNo. of Positive Eigenvalues:", sum(x$eig > 0)))
cat(paste("\nNo. of Negative Eigenvalues:", sum(x$eig < 0)))
cat("\n\n")
- writeLines(strwrap("Average distance to centroid:\n"))
+ type <- ifelse(isTRUE(all.equal(attr(x, "type"), "median")),
+ "mediod", "centroid")
+ writeLines(strwrap(paste0("Average distance to ", type, ":\n")))
print.default(tapply(x$distances, x$group, mean), digits = digits)
cat("\n")
writeLines(strwrap("Eigenvalues for PCoA axes:\n"))
- print.default(round(x$eig, digits = digits))
+ print.default(round(x$eig[seq_len(ax.lim)], digits = digits))
invisible(x)
}
Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog 2013-04-07 06:00:57 UTC (rev 2484)
+++ pkg/vegan/inst/ChangeLog 2013-04-07 20:19:34 UTC (rev 2485)
@@ -8,6 +8,12 @@
one group (i.e., in estimating the overall beta diversity in the
data). Reported by Pierre Legendre.
+ Now correctly reports distance to "mediod" in the print method
+ when type = "median". Reported by Pierre Legendre. The print
+ method also now shows only the first 8 eigenvalues.
+
+ * eigenvals: new method for class "betadisper".
+
* rda: eigenvalues are now regarded as zero if they are very small
compared to the first eigenvalue. Earlier we used fixed limit of
1e-4, but now the limit is first eigenvalues * 1e-5. Similar
Modified: pkg/vegan/man/betadisper.Rd
===================================================================
--- pkg/vegan/man/betadisper.Rd 2013-04-07 06:00:57 UTC (rev 2484)
+++ pkg/vegan/man/betadisper.Rd 2013-04-07 20:19:34 UTC (rev 2485)
@@ -6,6 +6,7 @@
\alias{plot.betadisper}
\alias{boxplot.betadisper}
\alias{TukeyHSD.betadisper}
+\alias{eigenvals.betadisper}
\alias{ordimedian}
\title{Multivariate homogeneity of groups dispersions (variances)}
@@ -33,6 +34,8 @@
\method{scores}{betadisper}(x, display = c("sites", "centroids"),
choices = c(1,2), \dots)
+\method{eigenvals}{betadisper}(x, \dots)
+
\method{plot}{betadisper}(x, axes = c(1,2), cex = 0.7, hull = TRUE,
ylab, xlab, main, sub, \dots)
@@ -160,6 +163,8 @@
The \code{boxplot} function invisibly returns a list whose components
are documented in \code{\link[graphics]{boxplot}}.
+ \code{eigenvals.betadisper} returns a named vector of eigenvalues.
+
\code{TukeyHSD.betadisper} returns a list. See \code{\link{TukeyHSD}}
for further details.
@@ -251,6 +256,23 @@
## Draw a boxplot of the distances to centroid for each group
boxplot(mod)
+## `scores` and `eigenvals` also work
+scrs <- scores(mod)
+str(scrs)
+head(scores(mod, 1:4, display = "sites"))
+# group centroids/mediods
+scores(mod, 1:4, display = "centroids")
+# eigenvalues from the underlying principal coordinates analysis
+eigenvals(mod)
+
+## try out bias correction; compare with mod3
+(mod3B <- betadisper(dis, groups, type = "median", bias.adjust=TRUE))
+
+## should always work for a single group
+group <- factor(rep("grazed", NROW(varespec)))
+(tmp <- betadisper(dis, group, type = "median"))
+(tmp <- betadisper(dis, group, type = "centroid"))
+
## simulate missing values in 'd' and 'group'
## using spatial medians
groups[c(2,20)] <- NA
@@ -272,9 +294,6 @@
boxplot(mod3)
plot(TukeyHSD(mod3))
-## try out bias correction; compare with mod3
-(mod3B <- betadisper(dis, groups, type = "median", bias.adjust=TRUE))
-
}
\keyword{methods}
\keyword{multivariate}
More information about the Vegan-commits
mailing list