[Vegan-commits] r407 - branches/1.13/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jun 9 09:19:54 CEST 2008
Author: jarioksa
Date: 2008-06-09 09:19:54 +0200 (Mon, 09 Jun 2008)
New Revision: 407
Modified:
branches/1.13/R/cca.default.R
branches/1.13/R/rda.default.R
Log:
merged overlooked r398 (add qran to cca.object)
Modified: branches/1.13/R/cca.default.R
===================================================================
--- branches/1.13/R/cca.default.R 2008-06-09 06:24:24 UTC (rev 406)
+++ branches/1.13/R/cca.default.R 2008-06-09 07:19:54 UTC (rev 407)
@@ -1,4 +1,4 @@
-"cca.default" <-
+`cca.default` <-
function (X, Y, Z, ...)
{
ZERO <- 1e-04
@@ -50,8 +50,11 @@
if (is.null(pCCA))
rank <- Q$rank
else rank <- Q$rank - pCCA$rank
+ ## save rank of constraints
+ qrank <- rank
Y <- qr.fitted(Q, Xbar)
sol <- svd(Y)
+ ## rank of svd can be < qrank
rank <- min(rank, sum(sol$d > ZERO))
ax.names <- paste("CCA", 1:length(sol$d), sep = "")
colnames(sol$u) <- ax.names
@@ -73,7 +76,7 @@
oo <- Q$pivot
if (!is.null(pCCA$rank))
oo <- oo[-(1:pCCA$rank)] - ncol(Z.r)
- oo <- oo[1:rank]
+ oo <- oo[1:qrank]
if (length(oo) < ncol(Y.r))
CCA$alias <- colnames(Y.r)[-oo]
CCA$biplot <- cor(Y.r[, oo, drop = FALSE], sol$u[,
Modified: branches/1.13/R/rda.default.R
===================================================================
--- branches/1.13/R/rda.default.R 2008-06-09 06:24:24 UTC (rev 406)
+++ branches/1.13/R/rda.default.R 2008-06-09 07:19:54 UTC (rev 407)
@@ -1,4 +1,4 @@
-"rda.default" <-
+`rda.default` <-
function (X, Y, Z, scale = FALSE, ...)
{
ZERO <- 1e-04
@@ -33,8 +33,11 @@
if (is.null(pCCA))
rank <- Q$rank
else rank <- Q$rank - pCCA$rank
+ ## qrank saves the rank of the constraints
+ qrank <- rank
Y <- qr.fitted(Q, Xbar)
sol <- svd(Y)
+ ## it can happen that rank < qrank
rank <- min(rank, sum(sol$d > ZERO))
sol$d <- sol$d/sqrt(NR)
ax.names <- paste("RDA", 1:length(sol$d), sep = "")
@@ -57,7 +60,7 @@
oo <- Q$pivot
if (!is.null(pCCA$rank))
oo <- oo[-(1:pCCA$rank)] - ncol(Z.r)
- oo <- oo[1:rank]
+ oo <- oo[1:qrank]
if (length(oo) < ncol(Y.r))
CCA$alias <- colnames(Y.r)[-oo]
CCA$biplot <- cor(Y.r[, oo, drop = FALSE], sol$u[,
More information about the Vegan-commits
mailing list