[Vegan-commits] r1297 - in pkg/gravy: . R inst man

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

Author: jarioksa
Date: 2010-09-02 15:28:55 +0200 (Thu, 02 Sep 2010)
New Revision: 1297

Added:
   pkg/gravy/R/residuals.HOF.R
Modified:
   pkg/gravy/DESCRIPTION
   pkg/gravy/R/HOF.default.R
   pkg/gravy/inst/ChangeLog
   pkg/gravy/man/HOF.Rd
Log:
residuals() to HOF models

Modified: pkg/gravy/DESCRIPTION
===================================================================
--- pkg/gravy/DESCRIPTION	2010-08-31 13:26:24 UTC (rev 1296)
+++ pkg/gravy/DESCRIPTION	2010-09-02 13:28:55 UTC (rev 1297)
@@ -1,7 +1,7 @@
 Package: gravy
 Title: Gradient Analysis of Vegetation
-Version: 0.1-2
-Date: March 18, 2010
+Version: 0.1-3
+Date: September 2, 2010
 Author: Jari Oksanen
 Maintainer: Jari Oksanen <jari.oksanen at oulu.fi>
 Suggests: lattice 

Modified: pkg/gravy/R/HOF.default.R
===================================================================
--- pkg/gravy/R/HOF.default.R	2010-08-31 13:26:24 UTC (rev 1296)
+++ pkg/gravy/R/HOF.default.R	2010-09-02 13:28:55 UTC (rev 1297)
@@ -34,7 +34,8 @@
                   y = spec, M = M, model = "IV", ...)
     fv <- HOF1(x, "IV", IV.res$estimate, M, ...)
     IV.res$fitted <- fv
-    IV.res$deviance <- sum(dev.resids(spec/div, fv/div, wt))
+    IV.res$residuals <- dev.resids(spec/div, fv/div, wt)
+    IV.res$deviance <- sum(IV.res$residuals)
     III.res <- nlm(mlHOF, p = ssHOF(grad, spec, M, 3), x = grad, 
                    y = spec, M = M, model = "III", ...)
     tmp <- nlm(mlHOF, p = c(IV.res$est[1:2], 0), x = grad, y = spec, 
@@ -46,7 +47,8 @@
     if (tmp$min < III.res$min) 
         III.res <- tmp
     III.res$fitted <- fv <- HOF1(x, "III", III.res$estimate, M, ...)
-    III.res$deviance <- sum(dev.resids(spec/div, fv/div, wt))
+    III.res$residuals <- dev.resids(spec/div, fv/div, wt)
+    III.res$deviance <- sum(III.res$residuals)
     V.res <- nlm(mlHOF, p = c(IV.res$est, IV.res$est[2]), x = grad, 
                  y = spec, M = M, model = "V", ...)
     second <- nlm(mlHOF, p = c(III.res$est, 0), x = grad, y = spec, 
@@ -55,15 +57,18 @@
         V.res <- second
     V.res$fitted <-
         fv <- HOF1(x, model = "V", V.res$estimate, M, ...)
-    V.res$deviance <- sum(dev.resids(spec/div, fv/div, wt))
+    V.res$residuals <- dev.resids(spec/div, fv/div, wt)
+    V.res$deviance <- sum(V.res$residuals) 
     II.res <- nlm(mlHOF, p = ssHOF(grad, spec, M, 2), x = grad, 
                   y = spec, M = M, model = "II", ...)
     II.res$fitted <- fv <- HOF1(x, "II", II.res$estimate, M, ...)
-    II.res$deviance <- sum(dev.resids(spec/div, fv/div, wt))
+    II.res$residuals <- dev.resids(spec/div, fv/div, wt)
+    II.res$deviance <- sum(II.res$residuals)
     I.res <- nlm(mlHOF, p = ssHOF(grad, spec, M, 1), x = grad, 
                  y = spec, M = M, model = "I", ...)
     I.res$fitted <- fv <- HOF1(x, "I", I.res$estimate, M, ...)
-    I.res$deviance <- sum(dev.resids(spec/div, fv/div, wt))
+    I.res$residuals <- dev.resids(spec/div, fv/div, wt)
+    I.res$deviance <- sum(I.res$residuals)
     models <- list(V = V.res, IV = IV.res, III = III.res, II = II.res, 
                    I = I.res)
     out <- list(call = match.call(), x = x.orig, y = spec, x.name = x.name, 

Added: pkg/gravy/R/residuals.HOF.R
===================================================================
--- pkg/gravy/R/residuals.HOF.R	                        (rev 0)
+++ pkg/gravy/R/residuals.HOF.R	2010-09-02 13:28:55 UTC (rev 1297)
@@ -0,0 +1,15 @@
+`residuals.HOF` <-
+    function(object, type = c("deviance", "working", "response"), model, ...)
+{
+    type <- match.arg(type)
+    y <- object$y
+    mu <- sapply(object$models, fitted)
+    r <- sapply(object$models, residuals)
+    res <- switch(type,
+                  deviance = ifelse(sweep(mu, 1, y, "<"), sqrt(r), -sqrt(r)),
+                  working = r,
+                  response = -sweep(mu, 1, y, "-"))
+    if (!missing(model))
+        res <- res[, model]
+    res
+}

Modified: pkg/gravy/inst/ChangeLog
===================================================================
--- pkg/gravy/inst/ChangeLog	2010-08-31 13:26:24 UTC (rev 1296)
+++ pkg/gravy/inst/ChangeLog	2010-09-02 13:28:55 UTC (rev 1297)
@@ -1,3 +1,7 @@
+Version 0.1-3 September 2, 2010
+	* HOF: gained residuals() method with (useful) alternatives 'type
+	= "deviance"' and 'type = "response"' plue (useless) 'type =
+	"working"'. 
 Version 0.1-2 March 18, 2010
 	* ssHOF: HOF gave unnecesarry warnings when used with non-integer
 	data. 

Modified: pkg/gravy/man/HOF.Rd
===================================================================
--- pkg/gravy/man/HOF.Rd	2010-08-31 13:26:24 UTC (rev 1296)
+++ pkg/gravy/man/HOF.Rd	2010-09-02 13:28:55 UTC (rev 1297)
@@ -3,6 +3,7 @@
 \alias{HOF.default}
 \alias{HOF.data.frame}
 \alias{fitted.HOF}
+\alias{residuals.HOF}
 \alias{plot.HOF}
 \alias{plot.HOF.frame}
 \alias{predict.HOF}
@@ -26,6 +27,8 @@
 \method{plot}{HOF}(x, ...)
 \method{plot}{HOF.frame}(x, level = 0.95, test ="F", species, ...) 
 \method{fitted}{HOF}(object, model, ...)
+\method{residuals}{HOF}(object, type = c("deviance", "working", "response"), 
+    model, ...)
 \method{predict}{HOF}(object, newdata, model, ...)
 \method{GaussPara}{HOF}(resp, model, ...)
 }
@@ -44,6 +47,8 @@
   \item{level}{Probability for model selection (1-P).}
   \item{test}{Test for model selection. Alternatives are \code{"F"},
     \code{"Chisq"}, \code{"AIC"}, \code{"BIC"}. }
+  \item{type}{the type of residuals which should be returned (see
+    \code{\link{predict.glm}}).}
   \item{species}{Names of the species displayed in graphs.}
   \item{x, object}{An object from \code{HOF(spec, \dots)}.}
   \item{newdata}{Vector of gradient values for prediction.}