[Vegan-commits] r2285 - in pkg/vegan: . R inst man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Sep 15 22:43:23 CEST 2012


Author: jarioksa
Date: 2012-09-15 22:43:23 +0200 (Sat, 15 Sep 2012)
New Revision: 2285

Added:
   pkg/vegan/R/predict.radline.R
Modified:
   pkg/vegan/NAMESPACE
   pkg/vegan/inst/ChangeLog
   pkg/vegan/man/radfit.Rd
Log:
predict methods for radline, radift & radfit.frame

Modified: pkg/vegan/NAMESPACE
===================================================================
--- pkg/vegan/NAMESPACE	2012-09-15 06:20:51 UTC (rev 2284)
+++ pkg/vegan/NAMESPACE	2012-09-15 20:43:23 UTC (rev 2285)
@@ -280,6 +280,9 @@
 S3method(predict, fitspecaccum)
 S3method(predict, humpfit)
 S3method(predict, procrustes)
+S3method(predict, radline)
+S3method(predict, radfit)
+S3method(predict, radfit.frame)
 S3method(predict, rda)
 S3method(predict, specaccum)
 # print: base

Added: pkg/vegan/R/predict.radline.R
===================================================================
--- pkg/vegan/R/predict.radline.R	                        (rev 0)
+++ pkg/vegan/R/predict.radline.R	2012-09-15 20:43:23 UTC (rev 2285)
@@ -0,0 +1,51 @@
+### predict method for radline, radfit & radfit.frame
+
+### All functions take 'newdata' argument which need not be integer:
+### the functions can interpolate, but not necessarily extrapolate, or
+### the extrapolations may be NaN.
+
+`predict.radline`  <-
+    function(object, newdata, ...)
+{
+    if (missing(newdata))
+        x <- seq_along(object$y)
+    else
+        x <- drop(as.matrix(newdata))
+    nobs <- length(object$y)
+    p <- coef(object)
+    switch(object$model,
+           ## linear interpolation, no extrapolation
+           `Brokenstick` = approx(seq_len(nobs), object$fitted.values, x, ...)$y,
+           `Preemption` = exp(log(sum(object$y)) + log(p) + log(1 - p)*(x-1)),
+           ## NaN when rank outside proportional rank 0...1 
+           `Log-Normal` = {
+               slope <- diff(range(ppoints(nobs)))/(nobs-1)
+               intcpt <- 0.5 - slope * (nobs + 1) / 2
+               xnorm <- -qnorm(intcpt + slope * x)
+               exp(p[1] + p[2]*xnorm)
+           },
+           `Zipf` = exp(log(sum(object$y)) + log(p[1]) + p[2]*log(x)),
+           `Zipf-Mandelbrot` = exp(log(sum(object$y)) + log(p[1]) +
+           p[2]*log(x + p[3]))
+           )
+}
+
+`predict.radfit`<-
+    function(object, newdata, ...)
+{
+    if (missing(newdata))
+        sapply(names(object$models), function(x, ...)
+               predict(object$models[[x]], ...))
+    else
+        sapply(names(object$models), function(x, ...)
+               predict(object$models[[x]], newdata, ...))
+}
+
+`predict.radfit.frame`  <-
+    function(object, newdata, ...)
+{
+    if(missing(newdata))
+        lapply(object, predict, ...)
+    else
+        lapply(object, predict, newdata = newdata)
+}

Modified: pkg/vegan/inst/ChangeLog
===================================================================
--- pkg/vegan/inst/ChangeLog	2012-09-15 06:20:51 UTC (rev 2284)
+++ pkg/vegan/inst/ChangeLog	2012-09-15 20:43:23 UTC (rev 2285)
@@ -58,6 +58,12 @@
 
 	* protest: do not return the observed statistic as one of the
 	permuted values but separately.
+
+	* radfit: gained a predict method which works for single models
+	('radline'), radfit, and radfit.frame. All predict functions
+	accept 'newdata' which need not be integer, but extrapolation may
+	fail for some models.  Needs still documentation. The function was
+	provided due to a user request.
 	
 Version 2.1-18 (closed August 20, 2012)
 

Modified: pkg/vegan/man/radfit.Rd
===================================================================
--- pkg/vegan/man/radfit.Rd	2012-09-15 06:20:51 UTC (rev 2284)
+++ pkg/vegan/man/radfit.Rd	2012-09-15 20:43:23 UTC (rev 2285)
@@ -19,6 +19,9 @@
 \alias{rad.zipf}
 \alias{rad.zipfbrot}
 \alias{rad.null}
+\alias{predict.radline}
+\alias{predict.radfit}
+\alias{predict.radfit.frame}
 
 \title{ Rank -- Abundance or Dominance / Diversity Models}
 \description{



More information about the Vegan-commits mailing list