[Vegan-commits] r2459 - in pkg/vegan: . R

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

Author: jarioksa
Date: 2013-03-03 17:00:30 +0100 (Sun, 03 Mar 2013)
New Revision: 2459

Modified:
   pkg/vegan/NAMESPACE
   pkg/vegan/R/fitspecaccum.R
Log:
fitspecaccum handles weighted models

Modified: pkg/vegan/NAMESPACE
===================================================================
--- pkg/vegan/NAMESPACE	2013-03-03 15:35:16 UTC (rev 2458)
+++ pkg/vegan/NAMESPACE	2013-03-03 16:00:30 UTC (rev 2459)
@@ -192,6 +192,7 @@
 # labels: base
 S3method(labels, envfit)
 # lines: graphics
+S3method(lines, fitspecaccum)
 S3method(lines, humpfit)
 S3method(lines, permat)
 S3method(lines, preston)

Modified: pkg/vegan/R/fitspecaccum.R
===================================================================
--- pkg/vegan/R/fitspecaccum.R	2013-03-03 15:35:16 UTC (rev 2458)
+++ pkg/vegan/R/fitspecaccum.R	2013-03-03 16:00:30 UTC (rev 2459)
@@ -15,6 +15,7 @@
         x <- object$individuals
     else
         x <- object$sites
+    hasWeights <- !is.null(object$weights)
     NLSFUN <- function(y, x, model, ...) {
         switch(model,
         "arrhenius" = nls(y ~ SSarrhenius(x, k, z),  ...),
@@ -28,7 +29,10 @@
         "weibull" = nls(y ~ SSweibull(x, Asym, Drop, lrc, par), ...))
     }
     mods <- lapply(seq_len(NCOL(SpeciesRichness)),
-                  function(i, ...) NLSFUN(SpeciesRichness[,i], x, model, ...))
+                  function(i, ...)
+                   NLSFUN(SpeciesRichness[,i],
+                          if (hasWeights) object$weights[,i] else x,
+                          model, ...))
     object$fitted <- drop(sapply(mods, fitted))
     object$residuals <- drop(sapply(mods, residuals))
     object$coefficients <- drop(sapply(mods, coef))
@@ -44,8 +48,22 @@
     function(x, col = par("fg"), lty = 1, 
              xlab = "Sites", ylab = x$method, ...)
 {
-    fv <- fitted(x)
+    if (is.null(x$weights))
+        fv <- fitted(x)
+    else
+        fv <- sapply(x$models, predict, newdata = list(x = x$effort))
     matplot(x$sites, fv, col = col, lty = lty, pch = NA,
             xlab = xlab, ylab = ylab, type = "l", ...)
     invisible()
 }
+
+`lines.fitspecaccum` <-
+    function(x, col = par("fg"), lty = 1, ...)
+{
+    if (is.null(x$weights))
+        fv <- fitted(x)
+    else
+        fv <- sapply(x$models, predict, newdata= list(x = x$effort))
+    matlines(x$sites, fv, col = col, lty = lty, pch = NA, type = "l", ...)
+    invisible()
+}