[Vegan-commits] r590 - in pkg/vegan: R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Nov 23 16:11:00 CET 2008
Author: gsimpson
Date: 2008-11-23 16:11:00 +0100 (Sun, 23 Nov 2008)
New Revision: 590
Modified:
pkg/vegan/R/anova.betadisper.R
pkg/vegan/R/betadisper.R
pkg/vegan/R/permutest.betadisper.R
pkg/vegan/R/plot.betadisper.R
pkg/vegan/R/scores.betadisper.R
pkg/vegan/inst/ChangeLog
pkg/vegan/man/betadisper.Rd
Log:
betadisper and related functions now work with a single group level
Modified: pkg/vegan/R/anova.betadisper.R
===================================================================
--- pkg/vegan/R/anova.betadisper.R 2008-11-23 07:07:15 UTC (rev 589)
+++ pkg/vegan/R/anova.betadisper.R 2008-11-23 15:11:00 UTC (rev 590)
@@ -2,5 +2,8 @@
{
model.dat <- with(object, data.frame(Distances = distances,
Groups = group))
+ n.grps <- with(model.dat, length(unique(as.numeric(Groups))))
+ if(n.grps < 2)
+ stop("anova() only applicable to 2 or more groups")
anova(lm(Distances ~ Groups, data = model.dat))
}
Modified: pkg/vegan/R/betadisper.R
===================================================================
--- pkg/vegan/R/betadisper.R 2008-11-23 07:07:15 UTC (rev 589)
+++ pkg/vegan/R/betadisper.R 2008-11-23 15:11:00 UTC (rev 590)
@@ -23,20 +23,37 @@
centroids <- apply(vectors, 2, function(x) tapply(x, group, mean))
## for each of the groups, calculate distance to centroid for
## observation in the group
- 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)
+ 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.neg <- 0
+ dist.pos <- vectors[, pos, drop=FALSE] -
+ centroids[pos]
+ dist.pos <- rowSums(dist.pos^2)
+ if (any(!pos)) {
+ dist.neg <- vectors[, !pos, drop=FALSE] -
+ centroids[!pos]
+ dist.neg <- rowSums(dist.neg^2)
+ } else {
+ dist.neg <- 0
+ }
}
## zij are the distances of each point to its group centroid
zij <- sqrt(abs(dist.pos - dist.neg))
## add in correct labels
- colnames(vectors) <- colnames(centroids) <- names(eig) <-
- paste("PCoA", 1:n, sep = "")
+ colnames(vectors) <- names(eig) <- paste("PCoA", 1:n, sep = "")
+ if(is.matrix(centroids))
+ colnames(centroids) <- names(eig)
+ else
+ names(centroids) <- names(eig)
rownames(vectors) <- names(zij) <- attr(d, "Labels")
retval <- list(eig = eig, vectors = vectors, distances = zij,
group = group, centroids = centroids, call = match.call())
Modified: pkg/vegan/R/permutest.betadisper.R
===================================================================
--- pkg/vegan/R/permutest.betadisper.R 2008-11-23 07:07:15 UTC (rev 589)
+++ pkg/vegan/R/permutest.betadisper.R 2008-11-23 15:11:00 UTC (rev 590)
@@ -13,6 +13,8 @@
}
if(!inherits(x, "betadisper"))
stop("Only for class \"betadisper\"")
+ ## will issue error if only a single group
+ mod.aov <- anova(x)
nobs <- length(x$distances)
mod <- lm(x$distances ~ x$group)
mod.Q <- mod$qr
@@ -62,7 +64,6 @@
} else {
pairwise <- NULL
}
- mod.aov <- anova(x)
retval <- cbind(mod.aov[, 1:4], c(control$nperm, NA), c(pval, NA))
dimnames(retval) <- list(c("Groups", "Residuals"),
c("Df", "Sum Sq", "Mean Sq", "F", "N.Perm",
Modified: pkg/vegan/R/plot.betadisper.R
===================================================================
--- pkg/vegan/R/plot.betadisper.R 2008-11-23 07:07:15 UTC (rev 589)
+++ pkg/vegan/R/plot.betadisper.R 2008-11-23 15:11:00 UTC (rev 590)
@@ -14,20 +14,37 @@
ylab <- paste("PCoA", axes[2])
g <- scores(x, choices = axes)
plot(g$sites, asp = 1, type = "n", axes = FALSE, ann = FALSE, ...)
- for(i in levels(x$group)) {
- j <- which(levels(x$group) == i)
- segments(g$centroids[j, axes[1]],
- g$centroids[j, axes[2]],
- g$sites[x$group == i, axes[1]],
- g$sites[x$group == i, axes[2]], col = "blue", ...)
- if(hull) {
- ch <- chull(g$sites[x$group == i, axes])
- ch <- c(ch, ch[1])
- lines(x$vectors[x$group == i, axes][ch, ],
- col = "black", lty = "dashed", ...)
+ ## if more than 1 group level
+ if(is.matrix(g$centroids)) {
+ for(i in levels(x$group)) {
+ j <- which(levels(x$group) == i)
+ segments(g$centroids[j, axes[1]],
+ g$centroids[j, axes[2]],
+ g$sites[x$group == i, axes[1]],
+ g$sites[x$group == i, axes[2]], col = "blue", ...)
+ if(hull) {
+ ch <- chull(g$sites[x$group == i, axes])
+ ch <- c(ch, ch[1])
+ lines(x$vectors[x$group == i, axes][ch, ],
+ col = "black", lty = "dashed", ...)
+ }
}
+ points(g$centroids, pch = 16, cex = 1, col = "red", ...)
+ } else {
+ ## single group
+ segments(g$centroids[axes[1]],
+ g$centroids[axes[2]],
+ g$sites[, axes[1]],
+ g$sites[, axes[2]], col = "blue", ...)
+ if(hull) {
+ ch <- chull(g$sites[, axes])
+ ch <- c(ch, ch[1])
+ lines(x$vectors[, axes][ch, ],
+ col = "black", lty = "dashed", ...)
+ }
+ points(g$centroids[axes[1]], g$centroids[axes[1]],
+ pch = 16, cex = 1, col = "red", ...)
}
- points(g$centroids, pch = 16, cex = 1, col = "red", ...)
points(g$sites, pch = as.numeric(x$group),
cex = cex, ...)
localTitle(main = main, xlab = xlab, ylab = ylab, sub = sub, ...)
Modified: pkg/vegan/R/scores.betadisper.R
===================================================================
--- pkg/vegan/R/scores.betadisper.R 2008-11-23 07:07:15 UTC (rev 589)
+++ pkg/vegan/R/scores.betadisper.R 2008-11-23 15:11:00 UTC (rev 590)
@@ -2,21 +2,16 @@
choices = c(1,2), ...)
{
display <- match.arg(display, several.ok = TRUE)
- #tabula <- c("sites", "centroids")
- #names(tabula) <- c("sites", "centroids")
- #if(length(display) == 1) {
- # display <- match.arg(display, c("sites", "centroids",
- # "wa", "cn"))
- # if(display == "sites")
- # display <- "wa"
- #}
- #take <- tabula[display]
sol <- list()
if("sites" %in% display)
sol$sites <- x$vectors[, choices]
- if("centroids" %in% display)
- sol$centroids <- x$centroids[, choices]
- if (length(sol) == 1)
+ if("centroids" %in% display) {
+ if(is.matrix(x$centroids))
+ sol$centroids <- x$centroids[, choices]
+ else
+ sol$centroids <- x$centroids[choices]
+ }
+ if (length(sol) == 1)
sol <- sol[[1]]
return(sol)
}
Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog 2008-11-23 07:07:15 UTC (rev 589)
+++ pkg/vegan/inst/ChangeLog 2008-11-23 15:11:00 UTC (rev 590)
@@ -4,9 +4,9 @@
Version 1.16-4 (opened November 1, 2008)
- * oecosimu: got a new control argument for quantitative null
- model analyses, and this is available if method = "permat".
- The print method and help file modified accordingly.
+ * oecosimu: got a new control argument for quantitative null
+ model analyses, and this is available if method = "permat".
+ The print method and help file modified accordingly.
* vignettes: Figures with narrower margins. Vignetted
"diversity-vegan" adds functional diversity ('treedive'), 'beals'
@@ -46,6 +46,12 @@
vegan). With this code, the discrepancy statistic of the 'sipoo'
data is 50 (cf. notes on 1.16-3) instead of the original 55.
+ * betadisper: now works for cases where there is only a single
+ group. 'scores', 'plot' and 'boxplot' methods updated to work in
+ such cases. 'anova' and 'permutest' methods stop with an error if
+ used for such cases as they implement tests that do not make sense
+ for a single group.
+
Version 1.16-3 (closed November 1, 2008)
* spantree: saves labels of points, and 'cophenetic' and 'plot'
Modified: pkg/vegan/man/betadisper.Rd
===================================================================
--- pkg/vegan/man/betadisper.Rd 2008-11-23 07:07:15 UTC (rev 589)
+++ pkg/vegan/man/betadisper.Rd 2008-11-23 15:11:00 UTC (rev 590)
@@ -47,7 +47,8 @@
\code{\link{vegdist}}.}
\item{group}{vector describing the group structure, usually a factor
or an object that can be coerced to a factor using
- \code{\link[base]{as.factor}}.}
+ \code{\link[base]{as.factor}}. Can consist of a factor with a single
+ level (i.e.~one group).}
\item{type}{the type of analysis to perform. Only \code{type =
"centroid"} is currently supported.}
\item{display}{character; partial match to access scores for
@@ -165,6 +166,11 @@
principal coordinates.}
\item{call}{the matched function call.}
}
+\note{
+ If \code{group} consists of a single level or group, then the
+ \code{anova} and \code{permutest} methods are not appropriate and if
+ used on such data will stop with an error.
+}
\references{
Anderson, M.J. (2006) Distance-based tests for homogeneity of
multivariate dispersions. \emph{Biometrics} \strong{62(1)}, 245--253.
More information about the Vegan-commits
mailing list