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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Jun 28 15:23:20 CEST 2009


Author: jarioksa
Date: 2009-06-28 15:23:20 +0200 (Sun, 28 Jun 2009)
New Revision: 881

Modified:
   pkg/vegan/R/biplot.rda.R
   pkg/vegan/R/ordilabel.R
   pkg/vegan/R/ordilattice.getEnvfit.R
   pkg/vegan/R/ordiplot3d.R
   pkg/vegan/R/ordixyplot.R
   pkg/vegan/R/plot.spantree.R
   pkg/vegan/R/points.cca.R
   pkg/vegan/R/summary.cca.R
   pkg/vegan/R/text.cca.R
   pkg/vegan/inst/ChangeLog
   pkg/vegan/man/biplot.rda.Rd
Log:
pass args of scores (like 'const' in scores.rda) to other functions, and clean output in summary.cca

Modified: pkg/vegan/R/biplot.rda.R
===================================================================
--- pkg/vegan/R/biplot.rda.R	2009-06-28 09:52:11 UTC (rev 880)
+++ pkg/vegan/R/biplot.rda.R	2009-06-28 13:23:20 UTC (rev 881)
@@ -5,7 +5,7 @@
 
 biplot.rda <- function(x, choices = c(1, 2), scaling = 2,
                        display = c("sites", "species"),
-                       type, xlim, ylim, col = c(1,2), ...) {
+                       type, xlim, ylim, col = c(1,2), const, ...) {
   if(!inherits(x, "rda"))
       stop("'biplot.rda' is only for objects of class 'rda'")
   if(!is.null(x$CCA))
@@ -15,7 +15,7 @@
   if (length(col) == 1)
       col <- c(col,col)
   g <- scores(x, choices = choices, display = display,
-              scaling = scaling)
+              scaling = scaling, const)
   if (!is.list(g)) {
       g <- list(default = g)
       names(g) <- display

Modified: pkg/vegan/R/ordilabel.R
===================================================================
--- pkg/vegan/R/ordilabel.R	2009-06-28 09:52:11 UTC (rev 880)
+++ pkg/vegan/R/ordilabel.R	2009-06-28 13:23:20 UTC (rev 881)
@@ -2,7 +2,9 @@
     function(x, display, labels, choices = c(1,2), priority,
              cex = 0.8, fill = "white", border = NULL,  ...)
 {
-    x <- scores(x, display = display, choices = choices, ...)
+    if (missing(display))
+        display <- "sites"
+    x <- scores(x, choices = choices, display = display, ...)
     if (missing(labels))
         labels <- rownames(x)
     if (!missing(priority)) {

Modified: pkg/vegan/R/ordilattice.getEnvfit.R
===================================================================
--- pkg/vegan/R/ordilattice.getEnvfit.R	2009-06-28 09:52:11 UTC (rev 880)
+++ pkg/vegan/R/ordilattice.getEnvfit.R	2009-06-28 13:23:20 UTC (rev 881)
@@ -3,8 +3,8 @@
 {
     if (!missing(envfit) && !is.null(envfit))
         object <- envfit
-    bp <- scores(object, display = "bp", choices = choices)
-    cn <- scores(object, display = "cn",  choices = choices)
+    bp <- scores(object, display = "bp", choices = choices, ...)
+    cn <- scores(object, display = "cn",  choices = choices, ...)
     bp <- bp[!(rownames(bp) %in% rownames(cn)),, drop=FALSE]
     left <- as.character(formula[[2]])
     right <- formula[[3]]

Modified: pkg/vegan/R/ordiplot3d.R
===================================================================
--- pkg/vegan/R/ordiplot3d.R	2009-06-28 09:52:11 UTC (rev 880)
+++ pkg/vegan/R/ordiplot3d.R	2009-06-28 13:23:20 UTC (rev 881)
@@ -3,12 +3,14 @@
               arr.len = 0.1, arr.col = 4, envfit, xlab, ylab, zlab, ...) 
 {
     require(scatterplot3d) || stop("Requires package 'scatterplot3d'")
-    x <- scores(object, display = display, choices = choices)
+    local
+    x <- scores(object, display = display, choices = choices, ...)
     if (missing(xlab)) xlab <- colnames(x)[1]
     if (missing(ylab)) ylab <- colnames(x)[2]
     if (missing(zlab)) zlab <- colnames(x)[3]
-    pl <- scatterplot3d(x[, 1], x[, 2], x[, 3],  
-                        xlab = xlab, ylab = ylab, zlab = zlab, ...)
+    pl <- ordiArgAbsorber(x[, 1], x[, 2], x[, 3],  
+                        xlab = xlab, ylab = ylab, zlab = zlab,
+                          FUN = "scatterplot3d", ...)
     pl$points3d(range(x[, 1]), c(0, 0), c(0, 0), type = "l", 
                 col = ax.col)
     pl$points3d(c(0, 0), range(x[, 2]), c(0, 0), type = "l", 
@@ -18,8 +20,8 @@
     if (!missing(envfit) || !is.null(object$CCA)) {
         if (!missing(envfit)) 
             object <- envfit
-        bp <- scores(object, dis = "bp", choices = choices)
-        cn <- scores(object, dis = "cn", choices = choices)
+        bp <- scores(object, dis = "bp", choices = choices, ...)
+        cn <- scores(object, dis = "cn", choices = choices, ...)
         if (!is.null(cn) && !any(is.na(cn))) {
             bp <- bp[!(rownames(bp) %in% rownames(cn)), , drop = FALSE]
             cn.xyz <- pl$xyz.convert(cn)

Modified: pkg/vegan/R/ordixyplot.R
===================================================================
--- pkg/vegan/R/ordixyplot.R	2009-06-28 09:52:11 UTC (rev 880)
+++ pkg/vegan/R/ordixyplot.R	2009-06-28 13:23:20 UTC (rev 881)
@@ -4,8 +4,6 @@
              type = c("p", "biplot"),  ...)
 {
   localXyplot <- function(..., shrink, origin, scaling) xyplot(...)
-  localOrdilattice.getEnvfit <-
-    function(..., shrink, origin, scaling) ordilattice.getEnvfit(...)
   require(lattice) || stop("requires package 'lattice'")
   p <- as.data.frame(scores(x, display = display, choices = choices, ...))
   if (!is.null(data))
@@ -17,7 +15,7 @@
   if ("biplot" %in% type && (!is.null(x$CCA) || !missing(envfit))) {
     if (missing(envfit))
       envfit <- NULL
-    env <- localOrdilattice.getEnvfit(formula, x, envfit, choices, ...)
+    env <- ordilattice.getEnvfit(formula, x, envfit, choices, ...)
     if (!is.null(env$arrows)) {
       mul <- apply(p[,colnames(env$arrows)], 2, range)/apply(env$arrows, 2, range)
       mul <- min(mul[is.finite(mul) & mul > 0])

Modified: pkg/vegan/R/plot.spantree.R
===================================================================
--- pkg/vegan/R/plot.spantree.R	2009-06-28 09:52:11 UTC (rev 880)
+++ pkg/vegan/R/plot.spantree.R	2009-06-28 13:23:20 UTC (rev 881)
@@ -19,15 +19,16 @@
             y[dup, ] <- y[dup,] + runif(2*sum(dup), -0.01, 0.01) 
         ord <- FUN(d, y)
     }
-    ord <- scores(ord, display = "sites")
-    plot(ord, asp = 1, type = "n", ...)
+    ord <- scores(ord, display = "sites", ...)
+    ordiArgAbsorber(ord, asp = 1, type = "n", FUN = "plot", ...)
     lines(x, ord)
     if (type == "p" || type == "b") 
-        points(ord, cex = cex, ...)
+        ordiArgAbsorber(ord, cex = cex, FUN = "points", ...)
     else if (type == "t") {
         if (missing(labels)) 
             labels <- x$labels
-        ordilabel(ord, display = "sites", labels = labels, cex = cex, ...)
+        x <- scores(ord, display = "sites", ...)
+        ordiArgAbsorber(x, labels = labels, cex = cex, FUN = "ordilabel", ...)
     }
     ord <- list(sites = ord)
     class(ord) <- "ordiplot"

Modified: pkg/vegan/R/points.cca.R
===================================================================
--- pkg/vegan/R/points.cca.R	2009-06-28 09:52:11 UTC (rev 880)
+++ pkg/vegan/R/points.cca.R	2009-06-28 13:23:20 UTC (rev 881)
@@ -1,17 +1,19 @@
 `points.cca` <-
     function (x, display = "sites", choices = c(1, 2), scaling = 2, 
-              arrow.mul, head.arrow = 0.05, select, ...) 
+              arrow.mul, head.arrow = 0.05, select, const, ...) 
 {
     formals(arrows) <- c(formals(arrows), alist(... = ))
     if (length(display) > 1) 
         stop("Only one `display' item can be added in one command.")
-    pts <- scores(x, choices = choices, display = display, scaling = scaling)
+    pts <- scores(x, choices = choices, display = display, scaling = scaling,
+                  const)
     if (!missing(select)) 
         pts <- pts[select, , drop = FALSE]
     if (display == "cn") {
         cnam <- rownames(pts)
         points(pts, ...)
-        pts <- scores(x, choices = choices, display = "bp", scaling = scaling)
+        pts <- scores(x, choices = choices, display = "bp", scaling = scaling,
+                      const)
         bnam <- rownames(pts)
         pts <- pts[!(bnam %in% cnam), , drop = FALSE]
         if (nrow(pts) == 0) 

Modified: pkg/vegan/R/summary.cca.R
===================================================================
--- pkg/vegan/R/summary.cca.R	2009-06-28 09:52:11 UTC (rev 880)
+++ pkg/vegan/R/summary.cca.R	2009-06-28 13:23:20 UTC (rev 881)
@@ -18,13 +18,20 @@
         summ <- list(summ)
         names(summ) <- nms[display]
     }
+    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))
+        }
+    }
     summ$call <- object$call
     summ$tot.chi <- object$tot.chi
     summ$partial.chi <- object$pCCA$tot.chi
     summ$constr.chi <- object$CCA$tot.chi
     summ$unconst.chi <- object$CA$tot.chi
     summ$cont <- summary(eigenvals(object))
-    summ$concont <- summary(eigenvals(object, constrained = TRUE))
+    if (!is.null(object$CCA))
+        summ$concont <- summary(eigenvals(object, constrained = TRUE))
     summ$ev.head <- c(summ$ev.con, summ$ev.uncon)[1:axes]
     summ$scaling <- scaling
     summ$digits <- digits

Modified: pkg/vegan/R/text.cca.R
===================================================================
--- pkg/vegan/R/text.cca.R	2009-06-28 09:52:11 UTC (rev 880)
+++ pkg/vegan/R/text.cca.R	2009-06-28 13:23:20 UTC (rev 881)
@@ -1,11 +1,12 @@
 `text.cca` <-
     function (x, display = "sites", labels, choices = c(1, 2), scaling = 2, 
-              arrow.mul, head.arrow = 0.05, select, ...) 
+              arrow.mul, head.arrow = 0.05, select, const, ...) 
 {
     formals(arrows) <- c(formals(arrows), alist(... = ))
     if (length(display) > 1) 
         stop("Only one `display' item can be added in one command.")
-    pts <- scores(x, choices = choices, display = display, scaling = scaling)
+    pts <- scores(x, choices = choices, display = display, scaling = scaling,
+                  const)
     if (!missing(labels))
         rownames(pts) <- labels
     if (!missing(select)) 
@@ -13,7 +14,8 @@
     if (display == "cn") {
         cnam <- rownames(pts)
         text(pts, labels = cnam, ...)
-        pts <- scores(x, choices = choices, display = "bp", scaling = scaling)
+        pts <- scores(x, choices = choices, display = "bp", scaling = scaling,
+                      const)
         bnam <- rownames(pts)
         pts <- pts[!(bnam %in% cnam), , drop = FALSE]
         if (nrow(pts) == 0) 

Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog	2009-06-28 09:52:11 UTC (rev 880)
+++ pkg/vegan/inst/ChangeLog	2009-06-28 13:23:20 UTC (rev 881)
@@ -11,6 +11,24 @@
 	communities.
 
 	* betadisper: fix bug in removal of (effectively) zero Eigenvalues.
+
+	* summary.cca: takes care that all scores have rownames --
+	head/tail fail without names. No  ugly printing for constrained
+	eigenvalues when these do not exist in unconstrained models.
+
+	* biplot.rda: honour args to scores ('scaling', 'const').
+
+	* points/text for cca: accept 'const' argument for rda scores.
+
+	* ordilabel: no superfluous warnigns when args ('scaling',
+	'const') are given to scores.
+
+	* ordiplot3d: honour args to scores ('scaling', 'const') and
+	without warnings.
+
+	* ordixyplot: honour ags to scores ('scaling', 'const'). 
+
+	* spantree: plot honours args to scores ('scaling', 'const'). 
 	
 Version 1.16-19 (closed June 17, 2009)
 

Modified: pkg/vegan/man/biplot.rda.Rd
===================================================================
--- pkg/vegan/man/biplot.rda.Rd	2009-06-28 09:52:11 UTC (rev 880)
+++ pkg/vegan/man/biplot.rda.Rd	2009-06-28 13:23:20 UTC (rev 881)
@@ -7,7 +7,8 @@
 }
 \usage{
 \method{biplot}{rda}(x, choices = c(1, 2), scaling = 2,
-       display = c("sites", "species"), type, xlim, ylim, col = c(1,2), ...)
+       display = c("sites", "species"), type, xlim, ylim, col = c(1,2), 
+       const, ...)
 }
 
 \arguments{
@@ -34,6 +35,7 @@
   \item{xlim, ylim}{the x and y limits (min, max) of the plot.}
   \item{col}{Colours used for sites and species (in this order). If only
     one colour is given, it is used for both.}
+  \item{dots}{General scaling constant for \code{\link{scores.rda}}.}
   \item{\dots}{Other parameters for plotting functions.}
 }
 \details{



More information about the Vegan-commits mailing list