[Vegan-commits] r972 - in pkg/vegan: R man

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

Author: jarioksa
Date: 2009-09-01 15:08:50 +0200 (Tue, 01 Sep 2009)
New Revision: 972

Modified:
   pkg/vegan/R/ordiNAexclude.R
   pkg/vegan/R/ordiParseFormula.R
   pkg/vegan/man/vegan-internal.Rd
Log:
infrastructure for NA handling in constrained ordination ready for use

Modified: pkg/vegan/R/ordiNAexclude.R
===================================================================
--- pkg/vegan/R/ordiNAexclude.R	2009-09-01 07:36:28 UTC (rev 971)
+++ pkg/vegan/R/ordiNAexclude.R	2009-09-01 13:08:50 UTC (rev 972)
@@ -2,10 +2,13 @@
 ### in constrained ordination WA scores can be found for observations
 ### with NA values in constraints.
 `ordiNAexclude` <-
-    function(object, newdata)
+    function(object, excluded)
 {
+    ## Check that there is a na.action of class "exclude"
+    nas <- object$na.action
+    if (is.null(nas) || !inherits(nas, "exclude"))
+        return(object)
     ## Embed NA for excluded cases
-    nas <- object$na.action
     object$rowsum <- napredict(nas, object$rowsum)
     object$CCA$u <- napredict(nas, object$CCA$u)
     object$CCA$u.eig <- napredict(nas, object$CCA$u.eig)
@@ -14,14 +17,26 @@
     object$CA$u <- napredict(nas, object$CA$u)
     object$CA$u.eig <- napredict(nas, object$CA$u.eig)
     ## Estimate WA scores for NA cases with newdata of excluded
-    ## obseravations
-    wa <- predict(object, newdata = newdata, type = "wa", model = "CCA")
+    ## observations
+    wa <- predict(object, newdata = excluded, type = "wa", model = "CCA")
     wa.eig <- sweep(wa, 2, sqrt(object$CCA$eig), "*")
     object$CCA$wa[nas,] <- wa
     object$CCA$wa.eig[nas,] <- wa.eig
-    wa <- predict(object, newdata = newdata, type = "wa", model = "CA")
+    wa <- predict(object, newdata = excluded, type = "wa", model = "CA")
     wa.eig <- sweep(wa, 2, sqrt(object$CA$eig), "*")
     object$CA$u[nas,] <- wa
     object$CA$u.eig[nas,] <- wa.eig
+    ## Use NA also for excluded species with this option
+    nap <- if (!is.null(object$CCA))
+        attr(object$CCA$v, "na.action")
+    else
+        attr(object$CA$v, "na.action")
+    if (!is.null(nap)) {
+        object$colsum <- napredict(nap, object$colsum)
+        object$CCA$v <- napredict(nap, object$CCA$v)
+        object$CCA$v.eig <- napredict(nap, object$CCA$v.eig)
+        object$CA$v <- napredict(nap, object$CA$v)
+        object$CA$v.eig <- napredict(nap, object$CA$v.eig)
+    }
     object
 }

Modified: pkg/vegan/R/ordiParseFormula.R
===================================================================
--- pkg/vegan/R/ordiParseFormula.R	2009-09-01 07:36:28 UTC (rev 971)
+++ pkg/vegan/R/ordiParseFormula.R	2009-09-01 13:08:50 UTC (rev 972)
@@ -49,12 +49,15 @@
     ## Check and remove NA
     if (!is.null(nas)) {
         X <- X[-nas,, drop=FALSE]
+        excluded <- X[nas, , drop = FALSE]
         if (!is.null(Y)) {
             Y <- Y[-nas,, drop=FALSE]
             mf <- mf[-nas,, drop=FALSE]
         }
         if (!is.null(Z))
             Z <- Z[-nas,, drop=FALSE]
+    } else {
+        excluded <-  NULL
     }
     rownames(X) <- rownames(X, do.NULL = FALSE)
     colnames(X) <- colnames(X, do.NULL = FALSE)
@@ -67,6 +70,6 @@
         colnames(Z) <- colnames(Z, do.NULL = FALSE)
     }
     list(X = X, Y = Y, Z = Z, terms = terms(fla, width.cutoff = 500), 
-        terms.expand = terms(flapart, width.cutoff = 500), modelframe = mf,
-         na.action = nas)
+         terms.expand = terms(flapart, width.cutoff = 500), modelframe = mf,
+         na.action = nas, excluded = excluded)
 }

Modified: pkg/vegan/man/vegan-internal.Rd
===================================================================
--- pkg/vegan/man/vegan-internal.Rd	2009-09-01 07:36:28 UTC (rev 971)
+++ pkg/vegan/man/vegan-internal.Rd	2009-09-01 13:08:50 UTC (rev 972)
@@ -18,7 +18,7 @@
 ordiGetData(call, env)
 ordiParseFormula(formula, data, xlev = NULL, envdepth = 2, na.action = na.fail)
 ordiTerminfo(d, data)
-ordiNAexclude(object, newdata)
+ordiNAexclude(object, exluded)
 ordiArrowMul(x, at = c(0,0), fill = 0.75)
 ordiArgAbsorber(..., shrink, origin, scaling, triangular,
                 display, choices, const, FUN)
@@ -48,7 +48,7 @@
   \code{\link{cca.object}}. \code{ordiNAexclude} implements
   \code{na.action = na.exclude} for constrained ordination finding WA
   scores of CCA components and site scores of unconstrained component
-  from \code{newdata} of excluded observations.
+  from \code{excluded} rows of observations.
 
   \code{ordiArgAbsorber} absorbs arguments of \code{\link{scores}}
   function of \pkg{vegan} so that these do not cause superfluous