[Vegan-commits] r937 - in branches/1.15: . R inst man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Aug 22 07:42:44 CEST 2009


Author: jarioksa
Date: 2009-08-22 07:42:42 +0200 (Sat, 22 Aug 2009)
New Revision: 937

Modified:
   branches/1.15/DESCRIPTION
   branches/1.15/R/anova.cca.R
   branches/1.15/R/anova.ccabyterm.R
   branches/1.15/R/decorana.R
   branches/1.15/R/metaMDS.R
   branches/1.15/R/metaMDSdist.R
   branches/1.15/R/ordicluster.R
   branches/1.15/R/ordiellipse.R
   branches/1.15/R/ordihull.R
   branches/1.15/R/ordisurf.R
   branches/1.15/R/points.cca.R
   branches/1.15/R/rarefy.R
   branches/1.15/R/read.cep.R
   branches/1.15/R/specpool2vect.R
   branches/1.15/R/summary.cca.R
   branches/1.15/R/text.cca.R
   branches/1.15/R/text.orditkplot.R
   branches/1.15/inst/ChangeLog
   branches/1.15/man/metaMDS.Rd
   branches/1.15/man/ordihull.Rd
Log:
save merges between r902 and r931, and release candidate does not depend on the ellipse package

Modified: branches/1.15/DESCRIPTION
===================================================================
--- branches/1.15/DESCRIPTION	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/DESCRIPTION	2009-08-22 05:42:42 UTC (rev 937)
@@ -1,12 +1,11 @@
 Package: vegan
 Title: Community Ecology Package
 Version: 1.15-4
-Date: August 20, 2009
+Date: August 22, 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>
-Suggests: MASS, mgcv, lattice, cluster, scatterplot3d, rgl, ellipse,
-  tcltk 
+Suggests: MASS, mgcv, lattice, cluster, scatterplot3d, rgl, tcltk 
 Description: Ordination methods, diversity analysis and other
   functions for community and vegetation ecologists.
 License: GPL-2 

Modified: branches/1.15/R/anova.cca.R
===================================================================
--- branches/1.15/R/anova.cca.R	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/R/anova.cca.R	2009-08-22 05:42:42 UTC (rev 937)
@@ -53,7 +53,7 @@
     head <- paste("Permutation test for", tst$method, "under", 
                   tst$model, "model\n")
     if (!is.null(tst$strata)) 
-        head <- paste(head, "Permutations stratified within `", 
+        head <- paste(head, "Permutations stratified within '", 
                       tst$strata, "'\n", sep = "")
     mod <- paste("Model:", c(object$call))
     structure(table, heading = c(head, mod), Random.seed = seed, 

Modified: branches/1.15/R/anova.ccabyterm.R
===================================================================
--- branches/1.15/R/anova.ccabyterm.R	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/R/anova.ccabyterm.R	2009-08-22 05:42:42 UTC (rev 937)
@@ -56,7 +56,7 @@
     head <- paste("Permutation test for", sim$method, "under", 
                   sim$model, "model\nTerms added sequentially (first to last)\n")
     if (!is.null(sim$strata)) 
-        head <- paste(head, "Permutations stratified within `", 
+        head <- paste(head, "Permutations stratified within '", 
                       sim$strata, "'\n", sep = "")
     structure(out, heading = c(head, call), Random.seed = sim$Random.seed, 
               class = c("anova.cca", "anova", "data.frame"))

Modified: branches/1.15/R/decorana.R
===================================================================
--- branches/1.15/R/decorana.R	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/R/decorana.R	2009-08-22 05:42:42 UTC (rev 937)
@@ -23,9 +23,9 @@
         iresc <- 0
     if (!is.null(before)) {
         if (is.unsorted(before)) 
-            stop("`before' must be sorted")
+            stop("'before' must be sorted")
         if (length(before) != length(after)) 
-            stop("`before' and `after' must have same lengths")
+            stop("'before' and 'after' must have same lengths")
         for (i in 1:nr) {
             tmp <- veg[i, ] > 0
             veg[i, tmp] <- approx(before, after, veg[i, tmp], 

Modified: branches/1.15/R/metaMDS.R
===================================================================
--- branches/1.15/R/metaMDS.R	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/R/metaMDS.R	2009-08-22 05:42:42 UTC (rev 937)
@@ -4,11 +4,22 @@
               plot = FALSE, previous.best, old.wa = FALSE, ...) 
 {
     commname <- deparse(substitute(comm))
-    if (inherits(comm, "dist"))
-        stop("metaMDS does not accept dist objects, but needs original data frame")
-    dis <- metaMDSdist(comm, distance = distance, autotransform = autotransform, 
-                       noshare = noshare, trace = trace, commname = commname, 
-                       ...)
+    if (inherits(comm, "dist")) {
+        dis <- comm
+        if (is.null(attr(dis, "method")))
+            attr(dis, "method") <- "user supplied"
+        wascores <- FALSE
+    } else if (length(dim(comm) == 2) && ncol(comm) == nrow(comm) &&
+                all(comm == t(comm))) {
+        dis <- as.dist(comm)
+        attr(dis, "method") <- "user supplied"
+        wascores <- FALSE
+    } else {
+        dis <- metaMDSdist(comm, distance = distance,
+                           autotransform = autotransform, 
+                           noshare = noshare, trace = trace,
+                           commname = commname, ...)
+    }
     if (missing(previous.best)) 
         previous.best <- NULL
     out <- metaMDSiter(dis, k = k, trymax = trymax, trace = trace, 
@@ -27,6 +38,8 @@
     out$points <- points
     out$species <- wa
     out$call <- match.call()
+    if (is.null(out$data))
+        out$data <- commname
     class(out) <- "metaMDS"
     out
 }

Modified: branches/1.15/R/metaMDSdist.R
===================================================================
--- branches/1.15/R/metaMDSdist.R	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/R/metaMDSdist.R	2009-08-22 05:42:42 UTC (rev 937)
@@ -3,6 +3,11 @@
               trace = 1, commname, zerodist = "fail", distfun = vegdist, 
               ...) 
 {
+    ## metaMDSdist should get a raw data matrix, but if it gets a
+    ## 'dist' object return that unchanged and quit silently.
+    if (inherits(comm, "dist")  || ncol(comm) == nrow(comm) &&
+        all(comm == t(comm)))
+        return(comm)
     distname <- deparse(substitute(distfun))
     distfun <- match.fun(distfun)
     zerodist <- match.arg(zerodist, c("fail", "add", "ignore"))

Modified: branches/1.15/R/ordicluster.R
===================================================================
--- branches/1.15/R/ordicluster.R	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/R/ordicluster.R	2009-08-22 05:42:42 UTC (rev 937)
@@ -7,7 +7,7 @@
     mrg <- cluster$merge
     ord <- scores(ord, display = display, ...)
     if (nrow(mrg) != nrow(ord) - 1)
-        stop("Dimensions do not match in `ord' and `cluster'")
+        stop("Dimensions do not match in 'ord' and 'cluster'")
     if (length(w) == 1) w <- rep(w, nrow(ord))
     n <- if (is.null(w)) rep(1, nrow(ord)) else w
     go <- ord

Modified: branches/1.15/R/ordiellipse.R
===================================================================
--- branches/1.15/R/ordiellipse.R	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/R/ordiellipse.R	2009-08-22 05:42:42 UTC (rev 937)
@@ -1,10 +1,11 @@
 "ordiellipse" <-
     function (ord, groups, display = "sites", kind = c("sd", "se"),
               conf, draw = c("lines", "polygon"), w = weights(ord, display),
-              show.groups, ...)
+              show.groups, label = FALSE,  ...)
 {
-    if (!require(ellipse))
-        stop("Requires package `ellipse' (from CRAN)")
+    ## Define Circle for an ellipse: taken from the 'car' package
+    theta <- (0:51) * 2 * pi/51
+    Circle <- cbind(cos(theta), sin(theta))
     weights.default <- function(object, ...) NULL
     kind <- match.arg(kind)
     draw <- match.arg(draw)
@@ -22,6 +23,7 @@
     }
     out <- seq(along = groups)
     inds <- names(table(groups))
+    res <- list()
     for (is in inds) {
         gr <- out[groups == is]
         if (length(gr) > 2) {
@@ -33,16 +35,17 @@
             if (missing(conf))
                 t <- 1
             else t <- sqrt(qchisq(conf, 2))
+            xy <- t(mat$center + t * t(Circle %*% chol(mat$cov)))
             if (draw == "lines")
-                ordiArgAbsorber(ellipse(mat$cov, centre = mat$center, t = t),
-                      FUN = lines, ...)
-            else {
-                xy <- ellipse(mat$cov, center = mat$center, t = t)
-                ordiArgAbsorber(xy[, 1] + mat$center[1],
-                                xy[, 2] + mat$center[2],
-                                FUN = polygon, ...)
-            }
+                ordiArgAbsorber(xy, FUN = lines, ...)
+            else 
+                ordiArgAbsorber(xy[, 1], xy[, 2], FUN = polygon, ...)
+            if (label)
+                ordiArgAbsorber(mat$center[1], mat$center[2], labels=is,
+                               FUN = text, ...)
+            res[[is]] <- mat
         }
     }
-    invisible()
+    class(res) <- "ordiellipse"
+    invisible(res)
 }

Modified: branches/1.15/R/ordihull.R
===================================================================
--- branches/1.15/R/ordihull.R	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/R/ordihull.R	2009-08-22 05:42:42 UTC (rev 937)
@@ -1,6 +1,6 @@
 "ordihull" <-
     function (ord, groups, display = "sites", draw = c("lines", "polygon"),
-              show.groups, ...)
+              show.groups, label = FALSE, ...)
 {
     draw <- match.arg(draw)
     pts <- scores(ord, display = display, ...)
@@ -11,6 +11,7 @@
     }
     out <- seq(along = groups)
     inds <- names(table(groups))
+    res <- list()
     for (is in inds) {
         gr <- out[groups == is]
         if (length(gr) > 1) {
@@ -20,7 +21,14 @@
             if (draw == "lines")
                 ordiArgAbsorber(X[hpts, ], FUN = lines, ...)
             else ordiArgAbsorber(X[hpts,], FUN = polygon, ...)
+            if (label) {
+                cntr <- colMeans(X[hpts[-1],])
+                ordiArgAbsorber(cntr[1], cntr[2], labels = is,
+                                FUN = text, ...)
+            }
+            res[[is]] <- X[hpts,]
         }
     }
-    invisible()
+    class(res) <- "ordihull"
+    invisible(res)
 }

Modified: branches/1.15/R/ordisurf.R
===================================================================
--- branches/1.15/R/ordisurf.R	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/R/ordisurf.R	2009-08-22 05:42:42 UTC (rev 937)
@@ -9,8 +9,7 @@
     w <- eval(w)
     if (!is.null(w) && length(w) == 1) 
         w <- NULL
-    if (!require(mgcv)) 
-        stop("Requires package `mgcv'")
+    require(mgcv)  || stop("Requires package 'mgcv'")
     X <- scores(x, choices = choices, display = display, ...)
     x1 <- X[, 1]
     x2 <- X[, 2]

Modified: branches/1.15/R/points.cca.R
===================================================================
--- branches/1.15/R/points.cca.R	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/R/points.cca.R	2009-08-22 05:42:42 UTC (rev 937)
@@ -4,7 +4,7 @@
 {
     formals(arrows) <- c(formals(arrows), alist(... = ))
     if (length(display) > 1) 
-        stop("Only one `display' item can be added in one command.")
+        stop("Only one 'display' item can be added in one command.")
     pts <- scores(x, choices = choices, display = display, scaling = scaling,
                   const)
     if (!missing(select)) 

Modified: branches/1.15/R/rarefy.R
===================================================================
--- branches/1.15/R/rarefy.R	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/R/rarefy.R	2009-08-22 05:42:42 UTC (rev 937)
@@ -6,7 +6,7 @@
         stop("function accepts only integers (counts)")
     if (missing(sample)) {
         sample <- min(apply(x, MARGIN, sum))
-        info <- paste("The size of `sample' must be given --\nHint: Smallest site maximum", 
+        info <- paste("The size of 'sample' must be given --\nHint: Smallest site maximum", 
                       sample)
         stop(info)
     }

Modified: branches/1.15/R/read.cep.R
===================================================================
--- branches/1.15/R/read.cep.R	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/R/read.cep.R	2009-08-22 05:42:42 UTC (rev 937)
@@ -3,7 +3,7 @@
             force = FALSE) 
 {
   if (!force) {
-    stop("R may crash: if you want to try, save your session and use `force=T'")
+    stop("R may crash: if you want to try, save your session and use 'force=TRUE'")
   }
   if (is.loaded("_gfortran_ioparm"))
       warning("It seems that you have used gfortran: the input may be corrupted\n")

Modified: branches/1.15/R/specpool2vect.R
===================================================================
--- branches/1.15/R/specpool2vect.R	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/R/specpool2vect.R	2009-08-22 05:42:42 UTC (rev 937)
@@ -3,7 +3,5 @@
 {
     pool <- attr(X, "pool")
     index <- match.arg(index)
-    sel <- paste("X", index, sep = "$")
-    sel <- eval(parse(text=sel))
-    sel[pool]
+    X[[index]][pool]
 }

Modified: branches/1.15/R/summary.cca.R
===================================================================
--- branches/1.15/R/summary.cca.R	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/R/summary.cca.R	2009-08-22 05:42:42 UTC (rev 937)
@@ -20,8 +20,10 @@
     }
     if (length(display) > 0) {
         for (i in 1:length(summ)) {
-            rownames(summ[[i]]) <- rownames(summ[[i]], do.NULL = FALSE,
-                                            prefix = substr(names(summ)[i], 1, 3))
+            if (is.matrix(summ[[i]]))
+                rownames(summ[[i]]) <-
+                    rownames(summ[[i]], do.NULL = FALSE,
+                             prefix = substr(names(summ)[i], 1, 3))
         }
     }
     summ$call <- object$call

Modified: branches/1.15/R/text.cca.R
===================================================================
--- branches/1.15/R/text.cca.R	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/R/text.cca.R	2009-08-22 05:42:42 UTC (rev 937)
@@ -4,7 +4,7 @@
 {
     formals(arrows) <- c(formals(arrows), alist(... = ))
     if (length(display) > 1) 
-        stop("Only one `display' item can be added in one command.")
+        stop("Only one 'display' item can be added in one command.")
     pts <- scores(x, choices = choices, display = display, scaling = scaling,
                   const)
     if (!missing(labels))

Modified: branches/1.15/R/text.orditkplot.R
===================================================================
--- branches/1.15/R/text.orditkplot.R	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/R/text.orditkplot.R	2009-08-22 05:42:42 UTC (rev 937)
@@ -1,6 +1,6 @@
 `text.orditkplot` <-
     function(x, ...)
 {
-    text(x$labels, label = rownames(x$labels), ...)
+    text(x$labels, labels = rownames(x$labels), ...)
 }
 

Modified: branches/1.15/inst/ChangeLog
===================================================================
--- branches/1.15/inst/ChangeLog	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/inst/ChangeLog	2009-08-22 05:42:42 UTC (rev 937)
@@ -11,7 +11,7 @@
 
 	* merged r880: fix diversity.Rd warnings.
 
-	* merged r881, r882: pass args of 'scores' to other functions, clean
+	* merged r881, r882, r904: pass args of 'scores' to other functions, clean
 	summary.cca. 
 
 	* merged r883: orditorp works with reverse axes.
@@ -23,6 +23,20 @@
 
 	* merged r889: postMDS uses numeric palette.
 
+	* merged r902: orditkplot cleaning.
+
+	* merged r905-907, 910, 911: metaMDS takes distances.
+
+	* merged r908, 909, 925: remove backticks from messages.
+
+	* merged r918: cleaner specpool2vect.
+
+	* merged r929, 930: ordiellipse (and vegan 1.15) does not depend
+	on 'ellipse' package.
+
+	* merged r931: ordihull, ordiellipse gained arg 'label' and
+	invisibly return their result (summary() not yet merged).
+
 Version 1.15-3 (released June 17, 2009)
 
 	* merged revs 866 to 868: changed the way capscale displays

Modified: branches/1.15/man/metaMDS.Rd
===================================================================
--- branches/1.15/man/metaMDS.Rd	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/man/metaMDS.Rd	2009-08-22 05:42:42 UTC (rev 937)
@@ -45,7 +45,10 @@
 }
 
 \arguments{
-  \item{comm}{Community data.}
+  \item{comm}{Community data. Alternatively, dissimilarities either as
+    a \code{\link{dist}} structure or as a symmetric square matrix. 
+    In the latter case all other stages are skipped except random 
+    starts and centring and pc rotation of axes. }
   \item{distance}{Dissimilarity index used in \code{\link{vegdist}}.}
   \item{k}{Number of dimensions in \code{\link[MASS]{isoMDS}}.}
   \item{trymax}{Maximum number of random starts in search of stable
@@ -111,7 +114,7 @@
   other functions are intended to 
   help run NMDS wit \code{\link[MASS]{isoMDS}} like recommended by
   Minchin (1987).  Function \code{metaMDS} combines all recommendations
-  into one command for a shotgun style analysis. The steps in
+  into one command for a shotgun style analysis. The complete steps in
   \code{metaMDS} are:
   \enumerate{
     \item Transformation: If the data values are larger than common
@@ -165,7 +168,8 @@
     may have found good and relatively stable solutions although the
     function is not yet satisfied. Setting \code{trace = TRUE} will
     monitor the final stresses, and \code{plot = TRUE} will display
-    Procrustes overlay plots from each comparison.
+    Procrustes overlay plots from each comparison. This is the only
+    step performed if input data (\code{comm}) were dissimilarities. 
 
     \item Scaling of the results: \code{metaMDS} will run \code{postMDS}
     for the final result. Function \code{postMDS} provides the following

Modified: branches/1.15/man/ordihull.Rd
===================================================================
--- branches/1.15/man/ordihull.Rd	2009-08-21 12:38:45 UTC (rev 936)
+++ branches/1.15/man/ordihull.Rd	2009-08-22 05:42:42 UTC (rev 937)
@@ -21,17 +21,17 @@
 }
 \usage{
 ordihull(ord, groups, display = "sites", draw = c("lines","polygon"),
+         show.groups, label = FALSE,  ...)
+ordiellipse(ord, groups, display="sites", kind = c("sd","se"), conf,
+         draw = c("lines","polygon"), w = weights(ord, display),
+         show.groups, label = FALSE, ...)
+ordispider(ord, groups, display="sites", w = weights(ord, display),
          show.groups, ...)
 ordiarrows(ord, groups, levels, replicates, display = "sites",
          show.groups, startmark, ...)
 ordisegments(ord, groups, levels, replicates, display = "sites",
          show.groups, ...)
 ordigrid(ord, levels, replicates, display = "sites",  ...)
-ordispider(ord, groups, display="sites", w = weights(ord, display),
-         show.groups, ...)
-ordiellipse(ord, groups, display="sites", kind = c("sd","se"), conf,
-         draw = c("lines","polygon"), w = weights(ord, display),
-         show.groups, ...)
 ordicluster(ord, cluster, prune = 0, display = "sites",
          w = weights(ord, display), ...)
 }
@@ -55,6 +55,8 @@
     \code{TRUE}. This argument makes it possible to use different
     colours and line types for groups. The default is to show all
     groups. }
+  \item{label}{Label the centroid of the hull or the ellipse with the
+    group name.}
   \item{startmark}{plotting characer used to mark the first
     item. The default is to use no mark, and for instance, 
     \code{startmark = 1} will draw a circle.  For other plotting characters,
@@ -85,7 +87,15 @@
   Function \code{ordihull} draws \code{\link{lines}} or
   \code{\link{polygon}}s for the convex
   hulls found by function \code{\link{chull}} encircling
-  the items in the groups.
+  the items in the groups. 
+  
+  Function \code{ordiellipse} draws \code{\link{lines}} or
+  \code{\link{polygon}}s for dispersion \code{\link[ellipse]{ellipse}}
+  using either standard deviation of point scores or standard error of
+  the (weighted) average of scores, and the (weighted) correlation
+  defines the direction of the principal axis of the ellipse. 
+  An ellipsoid hull can be drawn with function
+  \code{\link[cluster]{ellipsoidhull}} of package \pkg{cluster}.
 
   Function \code{ordiarrows} draws
   \code{\link{arrows}} and \code{ordisegments} draws line
@@ -103,15 +113,6 @@
   \code{\link{rda}} result without \code{groups} argument, the function
   connects each `WA' scores to the correspoding `LC' score.
 
-  Function \code{ordiellipse} draws \code{\link{lines}} or
-  \code{\link{polygon}}s for dispersion
-  \code{\link[ellipse]{ellipse}} using either standard deviation of
-  point scores or standard error of the (weighted) average of
-  scores, and the (weighted) correlation defines the direction of the
-  principal axis of the ellipse. The function requires package
-  \pkg{ellipse}. An ellipsoid hull can be drawn with function
-  \code{\link[cluster]{ellipsoidhull}} of package \pkg{cluster}.
-
   Function \code{ordicluster} overlays a cluster dendrogram onto
   ordination. It needs the result from a hierarchic clustering such as
   \code{\link{hclust}} or \code{\link[cluster]{agnes}}, or other
@@ -130,26 +131,25 @@
   you may wish to change the default values in \code{\link{arrows}},
   \code{\link{lines}}, \code{\link{segments}} and
   \code{\link{polygon}}. You can pass
-  parameters to \code{\link{scores}} as well. Other underlying functions
-  are \code{\link{chull}} and \code{\link[ellipse]{ellipse}}.
+  parameters to \code{\link{scores}} as well. Umderlying function for
+  \code{ordihull} is \code{\link{chull}}.
 }
 
 
 \examples{
 data(dune)
 data(dune.env)
-mod <- cca(dune ~ Moisture, dune.env)
+mod <- cca(dune ~ Management, dune.env)
 attach(dune.env)
 ## pass non-graphical arguments without warnings
 plot(mod, type="n", scaling = 3)
-ordihull(mod, Moisture, scaling = 3)
+ordihull(mod, Management, scaling = 3, label = TRUE)
 ordispider(mod, col="red", scaling = 3)
 plot(mod, type = "p", display="sites")
 ordicluster(mod, hclust(vegdist(dune)), prune=3, col = "blue")
-# The following is not executed automatically because it needs
-# a non-standard library `ellipse'. 
-\dontrun{
-ordiellipse(mod, Moisture, kind="se", conf=0.95, lwd=2, col="blue")}
+plot(mod, type="n", display = "sites")
+text(mod, display="sites", labels = as.character(Management))
+ordiellipse(mod, Management, kind="se", conf=0.95, lwd=2, col="blue")
 }
 \keyword{aplot }
 



More information about the Vegan-commits mailing list