[Analogue-commits] r398 - in pkg: . R inst man tests/Examples

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

Author: gsimpson
Date: 2013-12-22 06:23:44 +0100 (Sun, 22 Dec 2013)
New Revision: 398

Added:
   pkg/R/fitted.prcurve.R
Modified:
   pkg/NAMESPACE
   pkg/inst/ChangeLog
   pkg/man/prcurve.Rd
   pkg/man/predict.prcurve.Rd
   pkg/tests/Examples/analogue-Ex.Rout.save
Log:
add a fitted method for prcurve

Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE	2013-12-22 02:03:02 UTC (rev 397)
+++ pkg/NAMESPACE	2013-12-22 05:23:44 UTC (rev 398)
@@ -177,6 +177,7 @@
 S3method(coef, pcr)
 S3method(coef, wa)
 S3method(fitted, pcr)
+S3method(fitted, prcurve)
 S3method(fitted, bootstrap.mat)
 S3method(fitted, logitreg)
 S3method(fitted, mat)

Added: pkg/R/fitted.prcurve.R
===================================================================
--- pkg/R/fitted.prcurve.R	                        (rev 0)
+++ pkg/R/fitted.prcurve.R	2013-12-22 05:23:44 UTC (rev 398)
@@ -0,0 +1,13 @@
+`fitted.prcurve` <- function(object, type = c("curve","smooths"), ...) {
+    type <- match.arg(type)
+    if (isTRUE(all.equal(type, "curve"))) {
+        f <- object$s
+    } else if (isTRUE(all.equal(type, "smooths"))) {
+        f <- sapply(object$smooths, fitted)
+        dimnames(f) <- dimnames(object$data)
+        attr(f, "tag") <- object$tag
+    } else {
+        stop("Invalid 'type'")
+    }
+    f
+}

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2013-12-22 02:03:02 UTC (rev 397)
+++ pkg/inst/ChangeLog	2013-12-22 05:23:44 UTC (rev 398)
@@ -10,6 +10,9 @@
 	for new observations on the same set of variables. Useful for
 	adding passive species.
 
+	* fitted.prcurve: new function to return the fitted locations on
+	the principal curve or the fitted values of the response.
+
 Version 0.12-0
 
 	* Released to CRAN December 13th 2013

Modified: pkg/man/prcurve.Rd
===================================================================
--- pkg/man/prcurve.Rd	2013-12-22 02:03:02 UTC (rev 397)
+++ pkg/man/prcurve.Rd	2013-12-22 05:23:44 UTC (rev 398)
@@ -127,6 +127,10 @@
 aber.pc <- prcurve(abernethy2, method = "ca", trace = TRUE,
                    vary = FALSE, penalty = 1.4)
 
+## Extract fitted values
+fit <- fitted(aber.pc) ## locations on curve
+abun <- fitted(aber.pc, type = "smooths") ## fitted response
+
 ## Fit the principal curve using varying complexity of smoothers
 ## for each species
 aber.pc2 <- prcurve(abernethy2, method = "ca", trace = TRUE,

Modified: pkg/man/predict.prcurve.Rd
===================================================================
--- pkg/man/predict.prcurve.Rd	2013-12-22 02:03:02 UTC (rev 397)
+++ pkg/man/predict.prcurve.Rd	2013-12-22 05:23:44 UTC (rev 398)
@@ -1,14 +1,19 @@
 \name{predict.prcurve}
 \alias{predict.prcurve}
+\alias{fitted.prcurve}
 
-\title{Predict locations on a principal curve}
+\title{Predict news locations \& fitted values on a principal curve}
 \description{
   Locations on a fitted principal curve are predicted by projecting the
   new observations in \eqn{m} dimensions on to the corresponding closest
-  point on the curve.
+  point on the curve. Fitted values for data used to fit the curve are
+  available with respect to the principal curve or to the individual
+  smooth functions.
 }
 \usage{
 \method{predict}{prcurve}(object, newdata, \dots)
+
+\method{fitted}{prcurve}(object, type = c("curve","smooths"), \dots)
 }
 
 \arguments{
@@ -21,6 +26,9 @@
     data via their \code{names} or \code{colnames}. If a data frame is
     supplied, it is converted to a matrix via \code{\link{data.matrix}}.
   }
+  \item{type}{
+    character; the type of fitted values to return.
+  }
   \item{\dots}{
     other arguments passed to other methods. Not currently used.
   }
@@ -37,6 +45,12 @@
   Given a fitted curve, the projection step can be used to find new
   points on the fitted curve by projecting the new points located in the
   hyperspace on to points on the curve to which they are closest.
+
+  Fitted values are available for the data used to the fit the principal
+  curve. There are two types of fitted value available. For \code{type =
+  "curve"}, the fitted locations on the principal curve. For \code{type
+  = "smooths"}, the fitted values of the variables from the individual
+  smooth functions with respect to distance along the principal curve.
 }
 \value{
   A matrix of points in the space of the original data. Rows correspond

Modified: pkg/tests/Examples/analogue-Ex.Rout.save
===================================================================
--- pkg/tests/Examples/analogue-Ex.Rout.save	2013-12-22 02:03:02 UTC (rev 397)
+++ pkg/tests/Examples/analogue-Ex.Rout.save	2013-12-22 05:23:44 UTC (rev 398)
@@ -26,7 +26,7 @@
 Loading required package: lattice
 This is vegan 2.0-10
 Loading required package: rgl
-This is analogue 0.12-0
+This is analogue 0.13-0
 > 
 > base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')
 > cleanEx()
@@ -5507,6 +5507,10 @@
 PC Converged in 5 iterations.
 
 > 
+> ## Extract fitted values
+> fit <- fitted(aber.pc) ## locations on curve
+> abun <- fitted(aber.pc, type = "smooths") ## fitted response
+> 
 > ## Fit the principal curve using varying complexity of smoothers
 > ## for each species
 > aber.pc2 <- prcurve(abernethy2, method = "ca", trace = TRUE,
@@ -5603,6 +5607,10 @@
 PC Converged in 6 iterations.
 
 > 
+> ## Predict new locations
+> take <- abernethy2[1:10, ]
+> pred <- predict(aber.pc2, take)
+> 
 > ## Not run: 
 > ##D ## Fit principal curve using a GAM - currently slow ~10secs
 > ##D aber.pc3 <- prcurve(abernethy2, method = "ca", trace = TRUE,
@@ -7783,7 +7791,7 @@
 > ###
 > options(digits = 7L)
 > base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed:  22.357 0.334 23.687 0.003 0.003 
+Time elapsed:  21.822 0.288 23.53 0.002 0.002 
 > grDevices::dev.off()
 null device 
           1