[Vegan-commits] r2470 - pkg/vegan/R

[noreply at r-forge.r-project.org]

Author: jarioksa
Date: 2013-03-06 09:43:40 +0100 (Wed, 06 Mar 2013)
New Revision: 2470

Modified:
   pkg/vegan/R/goodness.cca.R
   pkg/vegan/R/goodness.rda.R
Log:
sweep() keeps column names

Modified: pkg/vegan/R/goodness.cca.R
===================================================================
--- pkg/vegan/R/goodness.cca.R	2013-03-05 18:26:09 UTC (rev 2469)
+++ pkg/vegan/R/goodness.cca.R	2013-03-06 08:43:40 UTC (rev 2470)
@@ -16,8 +16,7 @@
         if (is.null(object$CCA)) 
             Xbar <- object$CA$Xbar
         else Xbar <- object$CCA$Xbar
-        v <- object[[model]]$v %*% diag(lambda2)
-        colnames(v) <- colnames(object[[model]]$v)
+        v <- sweep(object[[model]]$v, 2, lambda2, "*")
         tot <- diag(crossprod(Xbar))
     }
     else {
@@ -27,8 +26,7 @@
             Xbar <- qr.fitted(object$CCA$QR, Xbar)
             tot <- tot + diag(crossprod(t(Xbar)))
         }
-        v <- object[[model]]$u %*% diag(lambda2)
-        colnames(v) <- colnames(object[[model]]$u)
+        v <- sweep(object[[model]]$u, 2, lambda2, "*")
     }
     if (!missing(choices)) 
         v <- v[, choices, drop = FALSE]

Modified: pkg/vegan/R/goodness.rda.R
===================================================================
--- pkg/vegan/R/goodness.rda.R	2013-03-05 18:26:09 UTC (rev 2469)
+++ pkg/vegan/R/goodness.rda.R	2013-03-06 08:43:40 UTC (rev 2470)
@@ -18,8 +18,7 @@
         if (is.null(object$CCA)) 
             Xbar <- object$CA$Xbar
         else Xbar <- object$CCA$Xbar
-        v <- object[[model]]$v %*% diag(lambda2)
-        colnames(v) <- colnames(object[[model]]$v)
+        v <- sweep(object[[model]]$v, 2, lambda2, "*")
         tot <- diag(crossprod(Xbar)/(nrow(Xbar) - 1))
     }
     else {
@@ -33,8 +32,7 @@
             tot <- tot + diag(crossprod(t(Xbar)))/(nrow(Xbar) - 
                                                    1)
         }
-        v <- object[[model]]$u %*% diag(lambda2)
-        colnames(v) <- colnames(object[[model]]$u)
+        v <- sweep(object[[model]]$u, 2, lambda2, "*")
     }
     if (!missing(choices)) 
         v <- v[, choices, drop = FALSE]