[Analogue-commits] r349 - in pkg: . R inst man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Jul 21 22:50:38 CEST 2013
Author: gsimpson
Date: 2013-07-21 22:50:38 +0200 (Sun, 21 Jul 2013)
New Revision: 349
Added:
pkg/R/residuals.prcurve.R
pkg/man/residuals.prcurve.Rd
Modified:
pkg/NAMESPACE
pkg/R/prcurve.R
pkg/inst/ChangeLog
pkg/man/prcurve.Rd
Log:
add a residuals method for prcurve; changes to prcurve as a result
Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE 2013-07-20 21:42:03 UTC (rev 348)
+++ pkg/NAMESPACE 2013-07-21 20:50:38 UTC (rev 349)
@@ -184,6 +184,7 @@
S3method(residuals, bootstrap.mat)
S3method(residuals, mat)
S3method(residuals, pcr)
+S3method(residuals, prcurve)
## plotting
S3method(caterpillarPlot, default)
S3method(caterpillarPlot, data.frame)
Modified: pkg/R/prcurve.R
===================================================================
--- pkg/R/prcurve.R 2013-07-20 21:42:03 UTC (rev 348)
+++ pkg/R/prcurve.R 2013-07-21 20:50:38 UTC (rev 349)
@@ -182,6 +182,9 @@
}
cat("\n")
}
+ ## fit a PCA and store in result
+ ord <- rda(X)
+ ## prepare objects for return
names(config$tag) <- names(config$lambda) <-
rownames(config$s) <- rownames(X)
colnames(config$s) <- names(complexity) <- colnames(X)
@@ -193,8 +196,10 @@
config$smooths <- smooths
names(config$smooths) <- colnames(X)
config$call <- match.call()
+ config$ordination <- ord
+ config$data <- X
class(config) <- c("prcurve")
- return(config)
+ config
}
`print.prcurve` <- function(x, digits = max(3, getOption("digits") - 3),
Added: pkg/R/residuals.prcurve.R
===================================================================
--- pkg/R/residuals.prcurve.R (rev 0)
+++ pkg/R/residuals.prcurve.R 2013-07-21 20:50:38 UTC (rev 349)
@@ -0,0 +1,24 @@
+`residuals.prcurve` <- function(object,
+ which = c("distance","raw","smooths","pca"),
+ ...) {
+ which <- match.arg(which)
+
+ ## predict locations of curve in PCA space and exctract the
+ ## site scores for each sample
+ if( isTRUE(all.equal(which, "pca"))) {
+ p <- predict(object[["ordination"]], object[["s"]],
+ which = "wa", scaling = 1) ## site scaling
+ scrs <- scores(object[["ordination"]], scaling = 1,
+ choices = seq_along(eigenvals(object[["ordination"]])),
+ display = "sites")
+ }
+
+ res <- switch(which,
+ distance = diag(distance(object$s, object$data,
+ method = "euclidean")),
+ raw = object[["data"]] - object[["s"]],
+ smooths = sapply(object$smooths, function(x, ...)
+ residuals(x$model, ...), ...),
+ pca = p - scrs)
+ res
+}
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2013-07-20 21:42:03 UTC (rev 348)
+++ pkg/inst/ChangeLog 2013-07-21 20:50:38 UTC (rev 349)
@@ -26,6 +26,10 @@
estimates of smooth complexities. Residual variance printed to
fewer decimal places.
+ * residuals.prcurve: new `residuals` method for principal curves
+ extracting or computing various types of residual for a fitted
+ curve.
+
* Streamlined some of the documentation to avoid runnning the same
code many times.
Modified: pkg/man/prcurve.Rd
===================================================================
--- pkg/man/prcurve.Rd 2013-07-20 21:42:03 UTC (rev 348)
+++ pkg/man/prcurve.Rd 2013-07-21 20:50:38 UTC (rev 349)
@@ -92,6 +92,10 @@
\item{complexity}{numeric vector; the complexity of the smoother
fitted to each variable in \code{X}.}
\item{call}{the matched call.}
+ \item{ordination}{an object of class \code{"rda"}, the result of a
+ call to \code{\link{rda}}. This is a principal components analysis
+ of the input data \code{X}.}
+ \item{data}{a copy of the data used to fit the principal curve.}
}
%\references{
%% ~put references to the literature/web site here ~
Added: pkg/man/residuals.prcurve.Rd
===================================================================
--- pkg/man/residuals.prcurve.Rd (rev 0)
+++ pkg/man/residuals.prcurve.Rd 2013-07-21 20:50:38 UTC (rev 349)
@@ -0,0 +1,105 @@
+\name{residuals.prcurve}
+\alias{residuals.prcurve}
+\alias{resid.prcurve}
+
+\title{
+ Residuals of a principal curve fit.
+}
+\description{
+ Returns various representations of the residuals of a principal curve
+ fit.
+}
+\usage{
+\method{residuals}{prcurve}(object, which = c("distance", "raw", "smooths", "pca"),
+ ...)
+}
+
+\arguments{
+ \item{object}{an object of class \code{"prcurve"}, the result of a
+ call to \code{\link{prcurve}}.}
+ \item{which}{character; the type of residuals to return. See Details.}
+ \item{\dots}{arguments passed to other methods. See Details.}
+}
+\details{
+ Various types of residual are available for the principal curve. In a
+ departure from the usual convention, which residuals are returned is
+ controlled via the \code{which} argument. This is to allow users to
+ pass a \code{type} argument to the \code{residuals} method for the
+ function used to fit the individual smooth functions when \code{which
+ = "smooths"}.
+
+ The types of residuals available are
+
+ \describe{
+ \item{\code{"distance"}}{the default residual for a principal
+ curve. This residual is taken as the Euclidean distance between each
+ observations and the point on the principal curve to which it
+ projects, in full multivariate space.}
+ \item{\code{"raw"}}{raw residuals are the basis for
+ \code{"distance"} residuals, and are the difference between the
+ observed and fitted values (position on the curve) for each
+ observation in terms of each variable in the data set. These
+ residuals are in the form of a matrix with number of observation
+ \emph{rows} and number of variables \emph{cols}.}
+ \item{\code{"smooths"}}{these residuals are the result of calling
+ \code{residuals()} on each of the smooth models fitted to the
+ individual variables. See below for further details. A matrix of
+ the same dimensions as for \code{which = "raw"} is returned.}
+ \item{\code{"pca"}}{similar to the raw residuals, but expressed in
+ terms of the principal components of the input data. Hence these
+ residuals are the difference between each observation's location
+ in PCA space and their corresponding location on the curve.}
+ }
+
+ For \code{"smooths"} residuals, what is returned is governed by the
+ \code{residuals} method available for the smooth model fitted to the
+ individual variables. For principal curves fitted using the
+ \code{\link{smoothSpline}} plugin, see
+ \code{\link{smooth.spline}}. For principal curves fitted via the
+ \code{\link{smoothGAM}} plugin, see
+ \code{\link[mgcv]{residuals.gam}}.
+
+ \dots can be used to pass additional arguments to these
+ \code{residuals} methods. In particular, the \code{type} argument is
+ commonly used to choose which type of residual is returned by the
+ specific methods.
+
+ In the case of principal curves fitted using the plugin
+ \code{\link{smoothSpline}}, residuals for \code{which = "smooths"} are
+ only available if the the additional argument \code{keep.data} was
+ specified during fitting via \code{\link{prcurve}}. See the examples
+ for an illustration of this usage.
+}
+\value{
+ A vector of residual distances (\code{which = "distance"}) or a matrix
+ of residuals (for the other options).
+}
+
+\author{Gavin L. Simpson}
+
+\seealso{
+ \code{\link{prcurve}} for fitting a principal curve.
+}
+
+\examples{
+ ## Load Abernethy Forest data set
+ data(abernethy)
+
+ ## Remove the Depth and Age variables
+ abernethy2 <- abernethy[, -(37:38)]
+
+ ## Fit the principal curve, preserving the data in the smooth.spline
+ ## smooth functions fitted via keep.data = TRUE
+ aber.pc <- prcurve(abernethy2, method = "ca", keep.data = TRUE)
+
+ ## default "distance" residuals
+ resid(aber.pc)
+
+ ## residuals from the underlying smooth models, also illustrates
+ ## how to select specific types of residual from the individual
+ ## method using argument 'type'
+ resid(aber.pc, which = "smooths", type = "deviance")
+
+}
+
+\keyword{ methods }
More information about the Analogue-commits
mailing list