[Vegan-commits] r2913 - in pkg/vegan: . R man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Nov 24 11:44:01 CET 2014
Author: jarioksa
Date: 2014-11-24 11:44:01 +0100 (Mon, 24 Nov 2014)
New Revision: 2913
Modified:
pkg/vegan/NAMESPACE
pkg/vegan/R/alias.cca.R
pkg/vegan/R/as.mlm.R
pkg/vegan/R/biplot.rda.R
pkg/vegan/R/coef.cca.R
pkg/vegan/R/coef.rda.R
pkg/vegan/R/fitted.capscale.R
pkg/vegan/R/fitted.cca.R
pkg/vegan/R/fitted.rda.R
pkg/vegan/R/intersetcor.R
pkg/vegan/R/linestack.R
pkg/vegan/R/tolerance.cca.R
pkg/vegan/R/vif.cca.R
pkg/vegan/man/linestack.Rd
Log:
Squashed commit of the following:
commit 465dc0303fe4a756b9a0680457a28e474c546eed
Author: Gavin Simpson <ucfagls at gmail.com>
Date: Sat Nov 22 15:41:52 2014 -0600
linestack now handles labels arg without setting names(x); allows expressions as labels for example
commit 59564fb5e9a93b8a6b724b32ff77c18f8d183bae
Author: Gavin Simpson <ucfagls at gmail.com>
Date: Sat Nov 22 11:44:47 2014 -0600
fix bug in labels length conditional test
commit c9f6b8a93d4fe8bc8ec26352ebe8772263a925a8
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date: Wed Nov 19 13:38:05 2014 +0200
Fix reconstruction of response matrix in CA (no CCA) for tolerance.cca
(cherry picked from commit 0434ac4e653aeccb9b3f903a30a9fdfa55f6d7ee)
commit c9817cb9bd315847db10bb257085b206e4499530
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date: Tue Nov 18 15:04:36 2014 +0200
More comprehensible error message when user asks biplots of CA
There is no biplot for CA, and its results were handled by
biplot.default that gave weird error messages. Now biplot.cca() was
added to give an informative error message. An alternative to this
would be to rename biplot.rda to biplot.cca: it already has an
error message for non-rda objects, and would only handle rda.
(cherry picked from commit 543ead1092a37e5791408bfc771d66a9f89efe28)
commit dcf2399a79043b520f76a78b4beff85fea38a758
Author: Jari Oksanen <jari.oksanen at oulu.fi>
Date: Tue Nov 18 13:45:18 2014 +0200
Fail informatively if support functions for CCA are used with CA
Several cca/rda/capscale support functions only worked with
constrained ordination, but did not check their input. This resulted
in cryptic error messages such as
Error in chol2inv(Q$qr, size = rank) :
'size' argument must be a positive integer
Now they fail with more informative error message that tells that
the method can be used only with constrained models.
(cherry picked from commit 4d98639b1cd10a84ed41182a6e7123b84315e441)
Modified: pkg/vegan/NAMESPACE
===================================================================
--- pkg/vegan/NAMESPACE 2014-11-18 07:48:41 UTC (rev 2912)
+++ pkg/vegan/NAMESPACE 2014-11-24 10:44:01 UTC (rev 2913)
@@ -123,6 +123,7 @@
S3method(bioenv, formula)
# biplot: stats
S3method(biplot, CCorA)
+S3method(biplot, cca)
S3method(biplot, rda)
# boxplot: graphics
S3method(boxplot, betadisper)
Modified: pkg/vegan/R/alias.cca.R
===================================================================
--- pkg/vegan/R/alias.cca.R 2014-11-18 07:48:41 UTC (rev 2912)
+++ pkg/vegan/R/alias.cca.R 2014-11-24 10:44:01 UTC (rev 2913)
@@ -1,6 +1,8 @@
`alias.cca` <-
function (object, names.only = FALSE, ...)
{
+ if (is.null(object$CCA$alias))
+ stop("no constrained component, 'alias' cannot be applied")
if (names.only)
return(object$CCA$alias)
CompPatt <- function(x, ...) {
Modified: pkg/vegan/R/as.mlm.R
===================================================================
--- pkg/vegan/R/as.mlm.R 2014-11-18 07:48:41 UTC (rev 2912)
+++ pkg/vegan/R/as.mlm.R 2014-11-24 10:44:01 UTC (rev 2913)
@@ -1,3 +1,6 @@
`as.mlm` <-
-function(x) UseMethod("as.mlm")
-
+function(x) {
+ if (is.null(x$CCA))
+ stop("'as.mlm' can be used only for constrained ordination")
+ UseMethod("as.mlm")
+}
Modified: pkg/vegan/R/biplot.rda.R
===================================================================
--- pkg/vegan/R/biplot.rda.R 2014-11-18 07:48:41 UTC (rev 2912)
+++ pkg/vegan/R/biplot.rda.R 2014-11-24 10:44:01 UTC (rev 2913)
@@ -3,7 +3,16 @@
## draws pca biplots with species as arrows
##
-biplot.rda <- function(x, choices = c(1, 2), scaling = 2,
+`biplot.cca` <-
+ function(x, ...)
+{
+ if (!inherits(x, "rda"))
+ stop("biplot can be used only with linear ordination (e.g., PCA)")
+ else
+ NextMethod("biplot", x, ...)
+}
+
+`biplot.rda` <- function(x, choices = c(1, 2), scaling = 2,
display = c("sites", "species"),
type, xlim, ylim, col = c(1,2), const, ...) {
if(!inherits(x, "rda"))
Modified: pkg/vegan/R/coef.cca.R
===================================================================
--- pkg/vegan/R/coef.cca.R 2014-11-18 07:48:41 UTC (rev 2912)
+++ pkg/vegan/R/coef.cca.R 2014-11-24 10:44:01 UTC (rev 2913)
@@ -1,9 +1,11 @@
"coef.cca" <-
function (object, ...)
{
- Q <- object$CCA$QR
- u <- object$CCA$u
- u <- sweep(u, 1, sqrt(object$rowsum), "*")
- qr.coef(Q, u)
+ if(is.null(object$CCA))
+ stop("unconstrained models do not have coefficients")
+ Q <- object$CCA$QR
+ u <- object$CCA$u
+ u <- sweep(u, 1, sqrt(object$rowsum), "*")
+ qr.coef(Q, u)
}
Modified: pkg/vegan/R/coef.rda.R
===================================================================
--- pkg/vegan/R/coef.rda.R 2014-11-18 07:48:41 UTC (rev 2912)
+++ pkg/vegan/R/coef.rda.R 2014-11-24 10:44:01 UTC (rev 2913)
@@ -1,7 +1,9 @@
"coef.rda" <-
function (object, ...)
{
- Q <- object$CCA$QR
- qr.coef(Q, object$CCA$u)
+ if(is.null(object$CCA))
+ stop("unconstrained models do not have coefficients")
+ Q <- object$CCA$QR
+ qr.coef(Q, object$CCA$u)
}
Modified: pkg/vegan/R/fitted.capscale.R
===================================================================
--- pkg/vegan/R/fitted.capscale.R 2014-11-18 07:48:41 UTC (rev 2912)
+++ pkg/vegan/R/fitted.capscale.R 2014-11-24 10:44:01 UTC (rev 2913)
@@ -3,6 +3,8 @@
type = c("response", "working"), ...)
{
model <- match.arg(model)
+ if (is.null(object[[model]]))
+ stop("component ", model, " does not exist")
type <- match.arg(type)
## Return scaled eigenvalues
U <- switch(model,
Modified: pkg/vegan/R/fitted.cca.R
===================================================================
--- pkg/vegan/R/fitted.cca.R 2014-11-18 07:48:41 UTC (rev 2912)
+++ pkg/vegan/R/fitted.cca.R 2014-11-24 10:44:01 UTC (rev 2913)
@@ -4,6 +4,8 @@
{
type <- match.arg(type)
model <- match.arg(model)
+ if (is.null(object[[model]]))
+ stop("component ", model, " does not exist")
gtot <- object$grand.total
rc <- object$rowsum %o% object$colsum
if (model == "pCCA")
Modified: pkg/vegan/R/fitted.rda.R
===================================================================
--- pkg/vegan/R/fitted.rda.R 2014-11-18 07:48:41 UTC (rev 2912)
+++ pkg/vegan/R/fitted.rda.R 2014-11-24 10:44:01 UTC (rev 2913)
@@ -3,6 +3,8 @@
{
type <- match.arg(type)
model <- match.arg(model)
+ if (is.null(object[[model]]))
+ stop("component ", model, " does not exist")
if (model == "pCCA")
Xbar <- object$pCCA$Fit
else
Modified: pkg/vegan/R/intersetcor.R
===================================================================
--- pkg/vegan/R/intersetcor.R 2014-11-18 07:48:41 UTC (rev 2912)
+++ pkg/vegan/R/intersetcor.R 2014-11-24 10:44:01 UTC (rev 2913)
@@ -2,6 +2,8 @@
{
if (!inherits(object, "cca"))
stop("can be used only with objects inheriting from 'cca'")
+ if (is.null(object$CCA))
+ stop("can be used only with constrained ordination")
wa <- object$CCA$wa
if (!inherits(object, "rda")) { # is CCA
w <- object$rowsum
Modified: pkg/vegan/R/linestack.R
===================================================================
--- pkg/vegan/R/linestack.R 2014-11-18 07:48:41 UTC (rev 2912)
+++ pkg/vegan/R/linestack.R 2014-11-24 10:44:01 UTC (rev 2913)
@@ -1,23 +1,30 @@
"linestack" <-
- function (x, labels, cex = 0.8, side = "right", hoff = 2, air = 1.1,
- at = 0, add = FALSE, axis = FALSE, ...)
+ function (x, labels, cex = 0.8, side = "right", hoff = 2, air = 1.1,
+ at = 0, add = FALSE, axis = FALSE, ...)
{
- if (!missing(labels) && length(labels == 1) && pmatch(labels,
- c("right", "left"), nomatch = FALSE)) {
+ x <- drop(x)
+ n <- length(x)
+ misslab <- missing(labels)
+ if (misslab) {
+ labels <- names(x)
+ }
+ nlab <- length(labels)
+ if (!misslab && nlab == 1L && pmatch(labels, c("right", "left"), nomatch = FALSE)) {
side <- labels
labels <- NULL
warning("argument 'label' is deprecated: use 'side'")
}
+ if (!misslab && n != nlab) {
+ msg <- paste("Wrong number of supplied 'labels'.\nExpected:",
+ n, "Got:", nlab, sep = " ")
+ stop(msg)
+ }
side <- match.arg(side, c("right", "left"))
- x <- drop(x)
- if (!missing(labels) && !is.null(labels))
- names(x) <- labels
- else if (is.null(names(x)))
- names(x) <- rep("", length(x))
op <- par(xpd = TRUE)
+ on.exit(par(op))
ord <- order(x)
x <- x[ord]
- n <- length(x)
+ labels <- labels[ord]
pos <- numeric(n)
if (!add) {
plot(pos, x, type = "n", axes = FALSE, xlab = "", ylab = "", ...)
@@ -38,19 +45,18 @@
}
segments(at, x[1], at, x[n])
if (side == "right") {
- text(at + hoff, pos, names(x), pos = 4, cex = cex, offset = 0.2,
+ text(at + hoff, pos, labels, pos = 4, cex = cex, offset = 0.2,
...)
segments(at, x, at + hoff, pos)
}
else if (side == "left") {
- text(at - hoff, pos, names(x), pos = 2, cex = cex, offset = 0.2,
+ text(at - hoff, pos, labels, pos = 2, cex = cex, offset = 0.2,
...)
segments(at, x, at - hoff, pos)
}
- if (axis)
- axis(if (side == "right")
+ if (axis)
+ axis(if (side == "right")
2
else 4, pos = at, las = 2)
- par(op)
invisible(pos[order(ord)])
}
Modified: pkg/vegan/R/tolerance.cca.R
===================================================================
--- pkg/vegan/R/tolerance.cca.R 2014-11-18 07:48:41 UTC (rev 2912)
+++ pkg/vegan/R/tolerance.cca.R 2014-11-24 10:44:01 UTC (rev 2913)
@@ -32,7 +32,11 @@
which <- "species"
## reconstruct species/response matrix Y - up to machine precision!
partialFit <- ifelse(is.null(x$pCCA$Fit), 0, x$pCCA$Fit)
- Y <- ((partialFit + x$CCA$Xbar) * sqrt(x$rowsum %o% x$colsum) +
+ if (is.null(x$CCA))
+ Xbar <- x$CA$Xbar
+ else
+ Xbar <- x$CCA$Xbar
+ Y <- ((partialFit + Xbar) * sqrt(x$rowsum %o% x$colsum) +
x$rowsum %o% x$colsum) * x$grand.total
which <- match.arg(which)
siteScrTypes <- if(is.null(x$CCA)){ "sites" } else {"lc"}
Modified: pkg/vegan/R/vif.cca.R
===================================================================
--- pkg/vegan/R/vif.cca.R 2014-11-18 07:48:41 UTC (rev 2912)
+++ pkg/vegan/R/vif.cca.R 2014-11-24 10:44:01 UTC (rev 2913)
@@ -1,6 +1,8 @@
`vif.cca` <-
function(object)
{
+ if (is.null(object$CCA))
+ stop("can be used only with constrained ordination")
Q <- object$CCA$QR
out <- rep(NA, NCOL(Q$qr))
names(out)[Q$pivot] <- colnames(Q$qr)
Modified: pkg/vegan/man/linestack.Rd
===================================================================
--- pkg/vegan/man/linestack.Rd 2014-11-18 07:48:41 UTC (rev 2912)
+++ pkg/vegan/man/linestack.Rd 2014-11-24 10:44:01 UTC (rev 2913)
@@ -9,18 +9,20 @@
}
\usage{
linestack(x, labels, cex = 0.8, side = "right", hoff = 2, air = 1.1,
- at = 0, add = FALSE, axis = FALSE, ...)
+ at = 0, add = FALSE, axis = FALSE, ...)
}
\arguments{
\item{x}{Numeric vector to be plotted. }
- \item{labels}{Text labels used instead of default (names of \code{x}).}
+ \item{labels}{Labels used instead of default (names of \code{x}). May
+ be expressions to be drawn with \code{\link{plotmath}}.}
\item{cex}{Size of the labels. }
- \item{side}{Put labels to the \code{"right"} or
- \code{"left"} of the axis. }
+ \item{side}{Put labels to the \code{"right"} or \code{"left"} of the
+ axis.}
\item{hoff}{Distance from the vertical axis to the label in units of
the width of letter \dQuote{m}. }
- \item{air}{Multiplier to string height to leave empty space between labels. }
+ \item{air}{Multiplier to string height to leave empty space between
+ labels.}
\item{at}{Position of plot in horizontal axis. }
\item{add}{Add to an existing plot. }
\item{axis}{Add axis to the plot. }
@@ -30,7 +32,7 @@
The function returns invisibly the shifted positions of labels in
user coordinates.
}
-\author{Jari Oksanen }
+\author{Jari Oksanen with modifications by Gavin L. Simpson}
\note{ The function always draws labelled diagrams. If you want to have
unlabelled diagrams, you can use, e.g., \code{\link{plot}},
\code{\link{stripchart}} or \code{\link{rug}}.
@@ -43,6 +45,23 @@
linestack(scores(ord, choices=1, display="sp"))
linestack(scores(ord, choices=1, display="si"), side="left", add=TRUE)
title(main="DCA axis 1")
+
+## Expressions as labels
+N <- 10 # Number of sites
+df <- data.frame(Ca = rlnorm(N, 2), NO3 = rlnorm(N, 4),
+ SO4 = rlnorm(N, 10), K = rlnorm(N, 3))
+ord <- rda(df, scale = TRUE)
+### vector of expressions for labels
+labs <- expression(Ca^{2+phantom()},
+ NO[3]^{-phantom()},
+ SO[4]^{-2},
+ K^{+phantom()})
+scl <- 1
+linestack(scores(ord, choices = 1, display = "species", scaling = scl),
+ labels = labs, air = 2)
+linestack(scores(ord, choices = 1, display = "site", scaling = scl),
+ side = "left", add = TRUE)
+title(main = "PCA axis 1")
}
\keyword{ hplot }
\keyword{ aplot }
More information about the Vegan-commits
mailing list