[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