[Vegan-commits] r775 - in pkg/vegan: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Apr 2 18:26:53 CEST 2009
Author: jarioksa
Date: 2009-04-02 18:26:53 +0200 (Thu, 02 Apr 2009)
New Revision: 775
Added:
pkg/vegan/R/meandist.R
pkg/vegan/R/plot.meandist.R
pkg/vegan/R/print.summary.meandist.R
pkg/vegan/R/summary.meandist.R
Modified:
pkg/vegan/DESCRIPTION
pkg/vegan/inst/ChangeLog
pkg/vegan/man/mrpp.Rd
Log:
added meandist (a sister of mrpp): finds matrix of within and between groups means, all mrpp() statistics, and plots a dendrogram
Modified: pkg/vegan/DESCRIPTION
===================================================================
--- pkg/vegan/DESCRIPTION 2009-04-01 11:47:59 UTC (rev 774)
+++ pkg/vegan/DESCRIPTION 2009-04-02 16:26:53 UTC (rev 775)
@@ -1,7 +1,7 @@
Package: vegan
Title: Community Ecology Package
-Version: 1.16-16
-Date: March 25, 2009
+Version: 1.16-17
+Date: April 2, 2009
Author: Jari Oksanen, Roeland Kindt, Pierre Legendre, Bob O'Hara, Gavin L. Simpson,
Peter Solymos, M. Henry H. Stevens, Helene Wagner
Maintainer: Jari Oksanen <jari.oksanen at oulu.fi>
Added: pkg/vegan/R/meandist.R
===================================================================
--- pkg/vegan/R/meandist.R (rev 0)
+++ pkg/vegan/R/meandist.R 2009-04-02 16:26:53 UTC (rev 775)
@@ -0,0 +1,27 @@
+`meandist` <-
+ function(dist, grouping, ...)
+{
+ ## merge levels so that lower is always first (filling lower triangle)
+ mergenames <- function(X, Y, ...) {
+ xy <- cbind(X, Y)
+ xy <- apply(xy, 1, sort)
+ apply(xy, 2, paste, collapse = " ")
+ }
+ grouping <- factor(grouping, exclude = NULL)
+ cl <- outer(grouping, grouping, mergenames)
+ cl <- cl[lower.tri(cl)]
+ ## Cannot have within-group dissimilarity for group size 1
+ n <- table(grouping)
+ take <- matrix(TRUE, nlevels(grouping), nlevels(grouping))
+ diag(take) <- n > 1
+ take[upper.tri(take)] <- FALSE
+ ## Get output matrix
+ out <- matrix(NA, nlevels(grouping), nlevels(grouping))
+ out[take] <- tapply(dist, cl, mean)
+ out[upper.tri(out)] <- t(out)[upper.tri(out)]
+ rownames(out) <- colnames(out) <- levels(grouping)
+ class(out) <- c("meandist", "matrix")
+ attr(out, "n") <- table(grouping)
+ out
+}
+
Added: pkg/vegan/R/plot.meandist.R
===================================================================
--- pkg/vegan/R/plot.meandist.R (rev 0)
+++ pkg/vegan/R/plot.meandist.R 2009-04-02 16:26:53 UTC (rev 775)
@@ -0,0 +1,17 @@
+`plot.meandist` <-
+ function(x, cluster = "average", ...)
+{
+ n <- attr(x, "n")
+ cl <- hclust(as.dist(x), method = cluster, members = n)
+ cl <- as.dendrogram(cl, hang = 0)
+ w <- diag(x)[labels(cl)]
+ tr <- unlist(dendrapply(cl, function(n) attr(n, "height")))
+ root <- attr(cl, "height")
+ plot(cl, ylim = range(c(w, tr, root), na.rm = TRUE), leaflab = "none", ...)
+ for (i in 1:length(w)) segments(i, tr[i], i, w[i])
+ pos <- ifelse(w < tr, 1, 3)
+ pos[is.na(pos)] <- 1
+ w[is.na(w)] <- tr[is.na(w)]
+ text(1:length(w), w, labels = labels(cl), pos = pos, srt = 0)
+}
+
Added: pkg/vegan/R/print.summary.meandist.R
===================================================================
--- pkg/vegan/R/print.summary.meandist.R (rev 0)
+++ pkg/vegan/R/print.summary.meandist.R 2009-04-02 16:26:53 UTC (rev 775)
@@ -0,0 +1,19 @@
+`print.summary.meandist` <-
+ function(x, ...)
+{
+ cat("\nMean distances:\n")
+ tab <- rbind("within groups" = x$W,
+ "between groups" = x$B,
+ "overall" = x$D)
+ colnames(tab) <- "Average"
+ print(tab, ...)
+ cat("\nSummary statistics:\n")
+ tab <- rbind("MRPP A weights n" = x$A1,
+ "MRPP A weights n-1" = x$A2,
+ "MRPP A weights n(n-1)"= x$A3,
+ "Classification strength"=x$CS)
+ colnames(tab) <- "Statistic"
+ print(tab, ...)
+ invisible(x)
+}
+
Added: pkg/vegan/R/summary.meandist.R
===================================================================
--- pkg/vegan/R/summary.meandist.R (rev 0)
+++ pkg/vegan/R/summary.meandist.R 2009-04-02 16:26:53 UTC (rev 775)
@@ -0,0 +1,22 @@
+`summary.meandist` <-
+ function(object, ...)
+{
+ n <- attr(object, "n")
+ wmat <- n %o% n
+ diag(wmat) <- diag(wmat) - n
+ ## mean distances within, between groups and in total
+ W <- weighted.mean(diag(object), w = diag(wmat), na.rm = TRUE)
+ B <- weighted.mean(object[lower.tri(object)],
+ w = wmat[lower.tri(wmat)], na.rm = TRUE)
+ D <- weighted.mean(object, w = wmat, na.rm = TRUE)
+ ## Variants of MRPP statistics
+ A1 <- weighted.mean(diag(object), w = n, na.rm = TRUE)
+ A2 <- weighted.mean(diag(object), w = n - 1, na.rm = TRUE)
+ A3 <- weighted.mean(diag(object), w = n * (n - 1), na.rm = TRUE)
+ ##
+ out <- list(W = W, B = B, D = D, CS = B-W,
+ A1 = 1 - A1/D, A2 = 1 - A2/D, A3 = 1 - A3/D)
+ class(out) <- "summary.meandist"
+ out
+}
+
Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog 2009-04-01 11:47:59 UTC (rev 774)
+++ pkg/vegan/inst/ChangeLog 2009-04-02 16:26:53 UTC (rev 775)
@@ -2,8 +2,18 @@
VEGAN DEVEL VERSIONS at http://r-forge.r-project.org/
-Version 1.16-16 (openen Mar 25, 2009)
+Version 1.16-17
+ * meandist: a new sister function for mrpp. Function meandist
+ calculates a matrix of mean within and between group
+ dissimilarities. Its summary function returns the overall averages
+ of those distances, and all three variants of MRPP A statistic,
+ and classification strength. The plot method draws a dendrogram
+ based on the mean dissimilarity matrix, with leafs hanging to
+ within-group dissimilarity.
+
+Version 1.16-16 (closed April 2, 2009)
+
* metaMDS: scales ordination scores to the same range as input
dissimilarities if halfchange = FALSE. Better heuristics to decide
whether to use halfchange scaling: the old heuristics failed if
Modified: pkg/vegan/man/mrpp.Rd
===================================================================
--- pkg/vegan/man/mrpp.Rd 2009-04-01 11:47:59 UTC (rev 774)
+++ pkg/vegan/man/mrpp.Rd 2009-04-02 16:26:53 UTC (rev 775)
@@ -1,6 +1,10 @@
\name{mrpp}
\alias{mrpp}
\alias{print.mrpp}
+\alias{meandist}
+\alias{summary.meandist}
+\alias{print.summary.meandist}
+\alias{plot.meandist}
\title{ Multi Response Permutation Procedure of Within- versus
Among-Group Dissimilarities}
@@ -12,6 +16,9 @@
\usage{
mrpp(dat, grouping, permutations = 1000, distance = "euclidean",
weight.type = 1, strata)
+meandist(dist, grouping, ...)
+\method{summary}{meandist}(object, ...)
+\method{plot}{meandist}(x, cluster = "average", ...)
}
\arguments{
@@ -29,6 +36,12 @@
\item{strata}{An integer vector or factor specifying the strata for
permutation. If supplied, observations are permuted only within the
specified strata.}
+ \item{dist}{A \code{\link{dist}} object of dissimilarities, such as
+ produced by functions \code{\link{dist}}, \code{\link{vegdist}} or
+ \code{\link{designdist}}.}.
+ \item{cluster}{A clustering method for the \code{\link{hclust}}
+ function. Any \code{hclust} method can be used, but perhaps only
+ \code{"average"} and \code{"single"} make sense.}
}
\details{ Multiple Response Permutation Procedure (MRPP) provides a test
@@ -75,8 +88,23 @@
\code{dat} as observations, and uses \code{\link{vegdist}} to find
the dissimilarities. The default \code{distance} is Euclidean as in the
traditional use of the method, but other dissimilarities in
-\code{\link{vegdist}} also are available. }
+\code{\link{vegdist}} also are available.
+Function \code{meandist} calculates a matrix of mean within-cluster
+dissimilarities (diagonal) and between-cluster dissimilarites
+(off-diagonal elements), and an attribute \code{n} of \code{grouping
+counts}. Function \code{summary} finds the within-class, between-class
+and overall means of these dissimilarities, and the MRPP statistics
+with all \code{weight.type} options and the classification
+strength. The function does not allow significance tests for these
+statistics, but you must use \code{mrpp} with appropriate
+\code{weight.type}. Function \code{plot} draws a dendrogram of the
+result matrix with given \code{cluster} method (see
+\code{\link{hclust}}). The terminal segments hang to within-cluster
+dissimilarity. If some of the clusters is more heterogeneous than the
+combined class, the leaf segment is reversed.
+}
+
\value{
The function returns a list of class mrpp with following items:
\item{call }{ Function call.}
@@ -154,6 +182,11 @@
expression(bold(delta)), cex=1.5 ) }
)
par(def.par)
+## meandist
+dune.md <- meandist(vegdist(dune), dune.env$Management)
+dune.md
+summary(dune.md)
+plot(dune.md)
}
\keyword{ multivariate }
\keyword{ nonparametric }
More information about the Vegan-commits
mailing list