[Vegan-commits] r385 - in pkg: R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jun 2 09:50:19 CEST 2008
Author: jarioksa
Date: 2008-06-02 09:50:18 +0200 (Mon, 02 Jun 2008)
New Revision: 385
Added:
pkg/R/ade2vegancca.R
Modified:
pkg/R/print.cca.R
pkg/R/scores.cca.R
pkg/R/summary.cca.R
pkg/inst/ChangeLog
pkg/man/plot.cca.Rd
Log:
added partial handling of ade4:::cca objects within vegan
Added: pkg/R/ade2vegancca.R
===================================================================
--- pkg/R/ade2vegancca.R (rev 0)
+++ pkg/R/ade2vegancca.R 2008-06-02 07:50:18 UTC (rev 385)
@@ -0,0 +1,30 @@
+`ade2vegancca` <-
+ function(object)
+{
+ nf <- object$nf
+ CCA <- list(eig = object$eig,
+ u = as.matrix(object$l1),
+ v = as.matrix(object$c1),
+ u.eig = as.matrix(object$li),
+ v.eig = as.matrix(object$co),
+ wa.eig = as.matrix(object$ls),
+ biplot = as.matrix(object$cor)[-1,],
+ rank = object$rank,
+ tot.chi = sum(object$eig),
+ QR = NA,
+ envcentre = NA,
+ Xbar = NA)
+ CCA$wa <- sweep(CCA$wa.eig, 2, sqrt(object$eig[1:nf]), "*")
+ out <- list(call = object$call,
+ grand.total = NA,
+ rowsum = object$lw,
+ colsum = object$cw,
+ tot.chi = NA,
+ pCCA = NULL,
+ CCA = CCA,
+ CA = NULL,
+ method = "cca",
+ inertia = "mean square contigency coefficient")
+ class(out) = c("ade4cca", "cca")
+ out
+}
Modified: pkg/R/print.cca.R
===================================================================
--- pkg/R/print.cca.R 2008-06-02 07:47:53 UTC (rev 384)
+++ pkg/R/print.cca.R 2008-06-02 07:50:18 UTC (rev 385)
@@ -1,35 +1,39 @@
-"print.cca" <-
- function (x, digits = max(3, getOption("digits") - 3), ...)
+`print.cca` <-
+ function (x, digits = max(3, getOption("digits") - 3), ...)
{
- cat("\nCall:\n")
- cat(deparse(x$call), "\n\n")
- chi <- rbind(x$tot.chi, x$pCCA$tot.chi, x$CCA$tot.chi, x$CA$tot.chi)
- rnk <- rbind(NA, x$pCCA$rank, x$CCA$rank, x$CA$rank)
- tbl <- cbind(chi, rnk)
- tbl <- cbind(chi, rnk)
- colnames(tbl) <- c("Inertia", "Rank")
- rn <- c("Total", "Conditional", "Constrained", "Unconstrained")
- rownames(tbl) <- rn[c(TRUE, !is.null(x$pCCA), !is.null(x$CCA),
- !is.null(x$CA))]
- printCoefmat(tbl, digits = digits, na.print = "")
- cat("Inertia is", x$inertia, "\n")
- if (!is.null(x$CCA$alias))
- cat("Some constraints were aliased because they were collinear (redundant)\n")
- if (!is.null(x$CCA)) {
- cat("\nEigenvalues for constrained axes:\n")
- print(x$CCA$eig, digits = digits, ...)
- }
- if (!is.null(x$CA)) {
- ax.lim <- 8
- ax.trig <- 16
- cat("\nEigenvalues for unconstrained axes:\n")
- if (x$CA$rank > ax.trig) {
- print(x$CA$eig[1:ax.lim], digits = digits, ...)
- cat("(Showed only", ax.lim, "of all", x$CA$rank,
- "unconstrained eigenvalues)\n")
+ if (inherits(x, "pcaiv")) {
+ warning("this is an ade4 object which vegan cannot handle")
+ x <- ade2vegancca(x)
}
- else print(x$CA$eig, digits = digits, ...)
- }
- cat("\n")
- invisible(x)
+ cat("\nCall:\n")
+ cat(deparse(x$call), "\n\n")
+ chi <- rbind(x$tot.chi, x$pCCA$tot.chi, x$CCA$tot.chi, x$CA$tot.chi)
+ rnk <- rbind(NA, x$pCCA$rank, x$CCA$rank, x$CA$rank)
+ tbl <- cbind(chi, rnk)
+ tbl <- cbind(chi, rnk)
+ colnames(tbl) <- c("Inertia", "Rank")
+ rn <- c("Total", "Conditional", "Constrained", "Unconstrained")
+ rownames(tbl) <- rn[c(TRUE, !is.null(x$pCCA), !is.null(x$CCA),
+ !is.null(x$CA))]
+ printCoefmat(tbl, digits = digits, na.print = "")
+ cat("Inertia is", x$inertia, "\n")
+ if (!is.null(x$CCA$alias))
+ cat("Some constraints were aliased because they were collinear (redundant)\n")
+ if (!is.null(x$CCA)) {
+ cat("\nEigenvalues for constrained axes:\n")
+ print(x$CCA$eig, digits = digits, ...)
+ }
+ if (!is.null(x$CA)) {
+ ax.lim <- 8
+ ax.trig <- 16
+ cat("\nEigenvalues for unconstrained axes:\n")
+ if (x$CA$rank > ax.trig) {
+ print(x$CA$eig[1:ax.lim], digits = digits, ...)
+ cat("(Showed only", ax.lim, "of all", x$CA$rank,
+ "unconstrained eigenvalues)\n")
+ }
+ else print(x$CA$eig, digits = digits, ...)
+ }
+ cat("\n")
+ invisible(x)
}
Modified: pkg/R/scores.cca.R
===================================================================
--- pkg/R/scores.cca.R 2008-06-02 07:47:53 UTC (rev 384)
+++ pkg/R/scores.cca.R 2008-06-02 07:50:18 UTC (rev 385)
@@ -1,27 +1,23 @@
-"scores.cca" <-
+`scores.cca` <-
function (x, choices = c(1, 2), display = c("sp", "wa", "cn"),
scaling = 2, ...)
{
+ if(inherits(x, "pcaiv")) {
+ warning("looks like ade4::cca object: you better use ade4 functions")
+ x <- ade2vegancca(x)
+ }
tabula <- c("species", "sites", "constraints", "biplot",
"centroids")
names(tabula) <- c("sp", "wa", "lc", "bp", "cn")
if (is.null(x$CCA))
tabula <- tabula[1:2]
- #if (length(display) == 1) {
- # display <- match.arg(display, c("sites", "species", "wa",
- # "lc", "bp", "cn"))
- # if (display == "sites")
- # display <- "wa"
- # else if (display == "species")
- # display <- "sp"
- #}
display <- match.arg(display, c("sites", "species", "wa",
"lc", "bp", "cn"),
several.ok = TRUE)
if("sites" %in% display)
- display[display == "sites"] <- "wa"
+ display[display == "sites"] <- "wa"
if("species" %in% display)
- display[display == "species"] <- "sp"
+ display[display == "species"] <- "sp"
take <- tabula[display]
slam <- sqrt(c(x$CCA$eig, x$CA$eig)[choices])
rnk <- x$CCA$rank
Modified: pkg/R/summary.cca.R
===================================================================
--- pkg/R/summary.cca.R 2008-06-02 07:47:53 UTC (rev 384)
+++ pkg/R/summary.cca.R 2008-06-02 07:50:18 UTC (rev 385)
@@ -2,6 +2,11 @@
function (object, scaling = 2, axes = 6, display=c("sp","wa","lc","bp","cn"),
digits = max(3, getOption("digits") - 3), ...)
{
+ if (inherits(object, "pcaiv")) {
+ warning("this is an ade4 object which vegan cannot handle")
+ axes <- min(axes, object$nf)
+ object <- ade2vegancca(object)
+ }
axes <- min(axes, sum(object$CCA$rank, object$CA$rank))
summ <- list()
if (axes && length(display) && (!is.na(display) && !is.null(display)))
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2008-06-02 07:47:53 UTC (rev 384)
+++ pkg/inst/ChangeLog 2008-06-02 07:50:18 UTC (rev 385)
@@ -14,6 +14,13 @@
* lines.spantree: did not pass graphical arguments to lines
(broken in 1.12-15).
+
+ * ade2vegancca: a new function which tries to change an ade4:::cca
+ object to vegan:::cca object (and manages partially). This is used
+ internally in print.cca, scores.cca and summary.cca so that vegan
+ can display some information from ade4:::cca (with a warning).
+ Since scores.cca works for ade4, so do plot, orditkplot etc which
+ rely on scores.
Version 1.14-1 (closed May 29, 2008)
Modified: pkg/man/plot.cca.Rd
===================================================================
--- pkg/man/plot.cca.Rd 2008-06-02 07:47:53 UTC (rev 384)
+++ pkg/man/plot.cca.Rd 2008-06-02 07:50:18 UTC (rev 385)
@@ -6,6 +6,7 @@
\alias{scores.rda}
\alias{summary.cca}
\alias{print.summary.cca}
+\alias{ade2vegancca}
\title{Plot or Extract Results of Constrained Correspondence Analysis
or Redundancy Analysis}
@@ -119,6 +120,16 @@
the points or other functions in the \code{\link{ordiplot}} family.
}
+\note{Package \pkg{ade4} has function \code{\link[ade4]{cca}} which
+ returns constrained correspondence analysis of the same class as the
+ \pkg{vegan} function. If you have results of \pkg{ade4} in your
+ working environment, \pkg{vegan} functions may try to handle them and
+ fail with cryptic error messages. However, there is a simple utility
+ function \code{ade2vegancca} which tries to translate \pkg{ade4}
+ \code{cca} results to \pkg{vegan} \code{cca} results so that some
+ \pkg{vegan} functions may work partially with \pkg{ade4} objects
+ (with a warning).}
+
\author{Jari Oksanen }
\seealso{\code{\link{cca}}, \code{\link{rda}} and \code{\link{capscale}}
More information about the Vegan-commits
mailing list