From noreply at r-forge.r-project.org Mon Mar 18 03:40:41 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 18 Mar 2013 03:40:41 +0100 (CET) Subject: [Analogue-commits] r303 - in pkg: R man Message-ID: <20130318024041.2F98F183263@r-forge.r-project.org> Author: gsimpson Date: 2013-03-18 03:40:39 +0100 (Mon, 18 Mar 2013) New Revision: 303 Added: pkg/R/lines.prcurve.R Modified: pkg/R/plot.prcurve.R pkg/man/plot.prcurve.Rd Log: add lines.prcurve, modify arguments to plot.prcurve Added: pkg/R/lines.prcurve.R =================================================================== --- pkg/R/lines.prcurve.R (rev 0) +++ pkg/R/lines.prcurve.R 2013-03-18 02:40:39 UTC (rev 303) @@ -0,0 +1,15 @@ +lines.prcurve <- function(x, data, axes = 1:2, segments = TRUE, + col = "red", col.seg = "forestgreen", + lwd = 2, lwd.seg = 1, + ...) { + scl <- 0 + ordi <- rda(data) + pred <- predict(ordi, x$s, type = "wa", scaling = scl)[, axes] + scrs <- scores(ordi, display = "sites", scaling = scl, choices = axes) + if(segments) + segments(scrs[, 1], scrs[, 2], pred[, 1], pred[, 2], + col = col.seg, lwd = lwd.seg) + lines(pred[x$tag, 1:2], lwd = lwd, col = col, + ...) + invisible() +} Modified: pkg/R/plot.prcurve.R =================================================================== --- pkg/R/plot.prcurve.R 2013-01-16 22:06:10 UTC (rev 302) +++ pkg/R/plot.prcurve.R 2013-03-18 02:40:39 UTC (rev 303) @@ -1,9 +1,9 @@ ## plot a principle curve in PCA space plot.prcurve <- function(x, data, axes = 1:2, - seg = TRUE, + segments = TRUE, + col = "red", col.seg = "forestgreen", - col.curve = "red", - lwd.curve = 2, ...) { + lwd = 2, lwd.seg = 1, ...) { scl <- 0 ordi <- rda(data) pred <- predict(ordi, x$s, type = "wa", scaling = scl)[,axes] @@ -14,8 +14,8 @@ plot(ordi, display = "sites", scaling = scl, type = "n", xlim = xlim, ylim = ylim, choices = axes, ...) points(scrs, ...) - if(seg) + if(segments) segments(scrs[,1], scrs[,2], pred[,1], pred[,2], - col = col.seg) - lines(pred[x$tag, 1:2], lwd = lwd.curve, col = col.curve) + col = col.seg, lwd = lwd.seg) + lines(pred[x$tag, 1:2], lwd = lwd, col = col, ...) } Modified: pkg/man/plot.prcurve.Rd =================================================================== --- pkg/man/plot.prcurve.Rd 2013-01-16 22:06:10 UTC (rev 302) +++ pkg/man/plot.prcurve.Rd 2013-03-18 02:40:39 UTC (rev 303) @@ -1,5 +1,6 @@ \name{plot.prcurve} \alias{plot.prcurve} +\alias{lines.prcurve} \title{ Plot a fitted principal curve in PCA space } @@ -8,8 +9,13 @@ underlying data in a biplot. } \usage{ -\method{plot}{prcurve}(x, data, axes = 1:2, seg = TRUE, col.seg = "forestgreen", - col.curve = "red", lwd.curve = 2, ...) +\method{plot}{prcurve}(x, data, axes = 1:2, segments = TRUE, + col = "red", col.seg = "forestgreen", lwd = 2, + lwd.seg = 1, ...) + +\method{lines}{prcurve}(x, data, axes = 1:2, segments = TRUE, + col = "red", col.seg = "forestgreen", lwd = 2, + lwd.seg = 1, ...) } %- maybe also 'usage' for other objects documented here. \arguments{ @@ -17,12 +23,13 @@ \item{data}{The data the principal curve was fitted to.} \item{axes}{numeric vector of length 2; this is passed to the \code{choices} argument of the \code{\link[vegan]{scores}} function.} - \item{seg}{logical; should segments be drawn between the observed + \item{segments}{logical; should segments be drawn between the observed points to the location on the principal curve on to which they - project.} + project.} + \item{col}{The colour to draw the principal curve in.} \item{col.seg}{The colour to draw the segments in.} - \item{col.curve}{The colour to draw the principal curve in.} - \item{lwd.curve}{The line thickness used to draw the principal curve.} + \item{lwd, lwd.seg}{The line thickness used to draw the + principal curve and segments respectively.} \item{\dots}{additional arguments passed on to \code{points} when drawing the observations in PCA space.} } @@ -39,9 +46,11 @@ \author{ Gavin L. Simpson } -%\note{ -%% ~~further notes~~ -%} +\note{ + Note that all plotting is done using \code{scaling == 0} at the + moment, and as such the \code{lines()} method only makes sense when + added to an underlying PCA in the same scaling. See the Examples. +} %% ~Make other sections like Warning with \section{Warning }{....} ~ @@ -58,11 +67,17 @@ ## Fit the principal curve using varying complexity of smoothers ## for each species -aber.pc2 <- prcurve(abernethy2, method = "ca", trace = TRUE, - vary = TRUE, penalty = 1.4) +aber.pc <- prcurve(abernethy2, method = "ca", trace = TRUE, + vary = TRUE, penalty = 1.4) ## Plot the curve -plot(aber.pc2, abernethy2) +plot(aber.pc, abernethy2) + +## The lines() method can be used to add the principal curve to an +## existing plot +ord <- rda(abernethy2) +plot(ord) +lines(aber.pc, data = abernethy2) } % Add one or more standard keywords, see file 'KEYWORDS' in the % R documentation directory. From noreply at r-forge.r-project.org Mon Mar 18 03:41:22 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 18 Mar 2013 03:41:22 +0100 (CET) Subject: [Analogue-commits] r304 - pkg/R Message-ID: <20130318024122.BEFD3183C01@r-forge.r-project.org> Author: gsimpson Date: 2013-03-18 03:41:22 +0100 (Mon, 18 Mar 2013) New Revision: 304 Added: pkg/R/scores.prcurve.R Log: adds a scores method for class 'prcurve' Added: pkg/R/scores.prcurve.R =================================================================== --- pkg/R/scores.prcurve.R (rev 0) +++ pkg/R/scores.prcurve.R 2013-03-18 02:41:22 UTC (rev 304) @@ -0,0 +1,4 @@ +## `scores` extractor function for prcurve class +`scores.prcurve` <- function(x, ...) { + matrix(x$lambda, ncol = 1) +} From noreply at r-forge.r-project.org Mon Mar 18 03:42:27 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 18 Mar 2013 03:42:27 +0100 (CET) Subject: [Analogue-commits] r305 - in pkg: R man Message-ID: <20130318024227.5C922180586@r-forge.r-project.org> Author: gsimpson Date: 2013-03-18 03:42:26 +0100 (Mon, 18 Mar 2013) New Revision: 305 Modified: pkg/R/gradientDist.R pkg/man/gradientDist.Rd Log: fix a silly bug in prcurve method, removes 'order' argument Modified: pkg/R/gradientDist.R =================================================================== --- pkg/R/gradientDist.R 2013-03-18 02:41:22 UTC (rev 304) +++ pkg/R/gradientDist.R 2013-03-18 02:42:26 UTC (rev 305) @@ -6,11 +6,8 @@ UseMethod("gradientDist") } -gradientDist.default <- function(object, order, na.rm = TRUE, ...) { +gradientDist.default <- function(object, na.rm = TRUE, ...) { object <- as.vector(object) - if(missing(order)) - order <- seq_along(object) - object <- object[order] minD <- min(object, na.rm = na.rm) k <- if(any(object < 0, na.rm = na.rm)) { minD @@ -30,6 +27,7 @@ scaling = 0, ...) { if(length(axis) > 1L) { axis <- axis[1L] + warning("Only the first element of `axis` used.") } scrs <- as.vector(scores(object, choices = axis, scaling = scaling, display = "sites", ...)) @@ -37,7 +35,6 @@ } gradientDist.prcurve <- function(object, na.rm = TRUE, ...) { - order <- object$tag - scrs <- object$lambda - gradientDist.default(scrs, order, na.rm = na.rm, ...) + scrs <- scores(object) + gradientDist.default(scrs, na.rm = na.rm, ...) } Modified: pkg/man/gradientDist.Rd =================================================================== --- pkg/man/gradientDist.Rd 2013-03-18 02:41:22 UTC (rev 304) +++ pkg/man/gradientDist.Rd 2013-03-18 02:42:26 UTC (rev 305) @@ -16,7 +16,7 @@ \usage{ gradientDist(object, \dots) -\method{gradientDist}{default}(object, order, na.rm = TRUE, \dots) +\method{gradientDist}{default}(object, na.rm = TRUE, \dots) \method{gradientDist}{cca}(object, na.rm = TRUE, axis = 1L, scaling = 0, \dots) @@ -27,8 +27,6 @@ \arguments{ \item{object}{an R object of an appropriate type. For the default method, any R object that can be coerced to a vector.} - \item{order}{numeric vector indicating the ordering of points along - the gradient.} \item{na.rm}{logical; should missing values be removed?} \item{axis}{numeric, length 1; the ordination axis to take as the gradient.} From noreply at r-forge.r-project.org Mon Mar 18 03:43:58 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 18 Mar 2013 03:43:58 +0100 (CET) Subject: [Analogue-commits] r306 - pkg Message-ID: <20130318024358.3A207180586@r-forge.r-project.org> Author: gsimpson Date: 2013-03-18 03:43:57 +0100 (Mon, 18 Mar 2013) New Revision: 306 Modified: pkg/DESCRIPTION pkg/NAMESPACE Log: update namespace due to recent additions to pkg, 'grid' moved to Imports, bump to 0.11-1 Modified: pkg/DESCRIPTION =================================================================== --- pkg/DESCRIPTION 2013-03-18 02:42:26 UTC (rev 305) +++ pkg/DESCRIPTION 2013-03-18 02:43:57 UTC (rev 306) @@ -1,11 +1,10 @@ Package: analogue Type: Package Title: Analogue and weighted averaging methods for palaeoecology -Version: 0.11-0 +Version: 0.11-1 Date: $Date$ -Depends: R (>= 2.15.0), vegan (>= 1.17-12), lattice, grid, - princurve -Imports: mgcv, MASS, stats, graphics +Depends: R (>= 2.15.0), vegan (>= 1.17-12), princurve, lattice +Imports: mgcv, MASS, stats, graphics, grid Author: Gavin L. Simpson, Jari Oksanen Maintainer: Gavin L. Simpson Description: Fits Modern Analogue Technique and Weighted Averaging transfer Modified: pkg/NAMESPACE =================================================================== --- pkg/NAMESPACE 2013-03-18 02:42:26 UTC (rev 305) +++ pkg/NAMESPACE 2013-03-18 02:43:57 UTC (rev 306) @@ -4,21 +4,34 @@ ## Imports ## ## vegan -importFrom(vegan, pasteCall, eigenvals, tolerance) +importFrom(vegan, pasteCall, eigenvals, tolerance, scores) ## mgcv importFrom(mgcv, gam, s, smoothCon, mono.con, pcls, Predict.matrix) ## MASS importFrom(MASS, dose.p) ## lattice -importFrom(lattice, densityplot, histogram, panel.refline, panel.grid, - panel.lines, panel.points, panel.polygon, panel.abline, - trellis.par.get) +## -- need here *only* those funs that we define S3 methods for +## not the functions from lattice we use as they are covered +## by Depends: lattice in DESCRIPTION +importFrom(lattice, densityplot, histogram) ## stats import(stats) ## utils importFrom(utils, head, tail) ## graphics import(graphics) +## grid +importFrom(grid, + convertWidth, + gpar, + grid.layout, + grobWidth, + frameGrob, + placeGrob, + rectGrob, + textGrob, + unit, + unit.c) ## Exports export(analog, @@ -124,6 +137,7 @@ S3method(roc, default) S3method(roc, analog) S3method(roc, mat) +S3method(scores, prcurve) S3method(stdError, mat) S3method(stdError, predict.mat) S3method("setK<-", default) @@ -164,6 +178,7 @@ S3method(plot, dissimilarities) S3method(plot, gradientDist) S3method(lines, gradientDist) +S3method(lines, prcurve) S3method(points, gradientDist) S3method(plot, logitreg) S3method(plot, mat) From noreply at r-forge.r-project.org Mon Mar 18 03:44:50 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 18 Mar 2013 03:44:50 +0100 (CET) Subject: [Analogue-commits] r307 - pkg/inst Message-ID: <20130318024450.84937180586@r-forge.r-project.org> Author: gsimpson Date: 2013-03-18 03:44:49 +0100 (Mon, 18 Mar 2013) New Revision: 307 Modified: pkg/inst/ChangeLog Log: Document recent changes... Modified: pkg/inst/ChangeLog =================================================================== --- pkg/inst/ChangeLog 2013-03-18 02:43:57 UTC (rev 306) +++ pkg/inst/ChangeLog 2013-03-18 02:44:49 UTC (rev 307) @@ -1,5 +1,23 @@ analogue Change Log +Version 0.11-1 + + * scores.prcurve: new function to extract "axis" scores for + samples on the fitted principal curve. + + * lines.prcurve: new lower-level plotting function allows + a fitted principal curve to be added to an existing PCA + plot. + + * gradientDist: the "prcurve" method was ordering the samples + such that they were smooth. No need for the `order` argument + now either. + + * Namespace: simplified the import from lattice. Added more + imports from grid as this package no-longer in Dependencies. + + * Dependencies: grid moved to Imports: + Version 0.11-0 * timetrack: fitted method gains argument `choices` with From noreply at r-forge.r-project.org Mon Mar 18 06:14:49 2013 From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org) Date: Mon, 18 Mar 2013 06:14:49 +0100 (CET) Subject: [Analogue-commits] r308 - in pkg: R inst tests/Examples Message-ID: <20130318051449.37E2A184E19@r-forge.r-project.org> Author: gsimpson Date: 2013-03-18 06:14:48 +0100 (Mon, 18 Mar 2013) New Revision: 308 Modified: pkg/R/prcurve.R pkg/R/smoothSpline.R pkg/inst/ChangeLog pkg/tests/Examples/analogue-Ex.Rout.save Log: prcurve now returns a 'smooths' component, a list of smoothers, one per variable. Modified: pkg/R/prcurve.R =================================================================== --- pkg/R/prcurve.R 2013-03-18 02:44:49 UTC (rev 307) +++ pkg/R/prcurve.R 2013-03-18 05:14:48 UTC (rev 308) @@ -80,12 +80,15 @@ converged <- (abs((dist.old - config$dist)/dist.old) <= thresh) ## Start iterations ---------------------------------------------- + ### - store fitted smoothers in list + smooths <- vector(mode = "list", length = m) while (!converged && iter < maxit) { iter <- iter + 1L for(j in seq_len(m)) { - s[, j] <- fitted(smoother(config$lambda, X[, j], - complexity = complexity[j], - choose = FALSE, ...)) + smooths[[j]] <- smoother(config$lambda, X[, j], + complexity = complexity[j], + choose = FALSE, ...) + s[, j] <- fitted(smooths[[j]]) } ## dist.old <- config$dist @@ -113,19 +116,28 @@ if(finalCV) { iter <- iter + 1L for(j in seq_len(n)) { - sFit <- smoother(config$lambda, X[, j], - cv = TRUE, choose = TRUE, ...) - s[, j] <- if(sFit$complexity > maxComp) { - ## too complex, turn of CV and refit with max df allowed - fitted(smoother(config$lambda, X[, j], cv = FALSE, - choose = FALSE, - complexity = maxComp, - ...)) - } else { - fitted(sFit) - } + smooths[[j]] <- smoother(config$lambda, X[, j], + cv = TRUE, choose = TRUE, ...) + if(smooths[[j]]$complexity > maxComp) { + smooths[[j]] <- smoother(config$lambda, X[, j], cv = FALSE, + choose = FALSE, + complexity = maxComp, + ...) + } + s[, j] <- fitted(smooths[[j]]) + ## sFit <- smoother(config$lambda, X[, j], + ## cv = TRUE, choose = TRUE, ...) + ## s[, j] <- if(sFit$complexity > maxComp) { + ## ## too complex, turn of CV and refit with max df allowed + ## fitted(smoother(config$lambda, X[, j], cv = FALSE, + ## choose = FALSE, + ## complexity = maxComp, + ## ...)) + ## } else { + ## fitted(sFit) + ## } } - config <- get.lam(X, s = config$s, stretch = stretch) + config <- get.lam(X, s = s, stretch = stretch) class(config) <- "prcurve" if(plotit) { ## plot the iteration @@ -154,6 +166,7 @@ config$totalDist <- startConfig$dist config$complexity <- complexity ## config$fitFUN <- fitFUN + config$smooths <- smooths config$call <- match.call() class(config) <- c("prcurve") return(config) Modified: pkg/R/smoothSpline.R =================================================================== --- pkg/R/smoothSpline.R 2013-03-18 02:44:49 UTC (rev 307) +++ pkg/R/smoothSpline.R 2013-03-18 05:14:48 UTC (rev 308) @@ -24,7 +24,7 @@ } p <- predict(f, x=lambda)$y res <- list(lambda = lambda, x = x, fitted.values = p, - complexity = f$df) + complexity = f$df, model = f) class(res) <- "prcurveSmoother" return(res) } Modified: pkg/inst/ChangeLog =================================================================== --- pkg/inst/ChangeLog 2013-03-18 02:44:49 UTC (rev 307) +++ pkg/inst/ChangeLog 2013-03-18 05:14:48 UTC (rev 308) @@ -9,6 +9,11 @@ a fitted principal curve to be added to an existing PCA plot. + * prcurve, smoothSpline: `prcurve` now returns a component + `smooths`, a list containing the fitted smoothers, one per + variable. As a result `smoothSpline` now also returns the + fitted `smooth.spline` model. + * gradientDist: the "prcurve" method was ordering the samples such that they were smooth. No need for the `order` argument now either. Modified: pkg/tests/Examples/analogue-Ex.Rout.save =================================================================== --- pkg/tests/Examples/analogue-Ex.Rout.save 2013-03-18 02:44:49 UTC (rev 307) +++ pkg/tests/Examples/analogue-Ex.Rout.save 2013-03-18 05:14:48 UTC (rev 308) @@ -1,6 +1,6 @@ -R version 2.15.2 Patched (2012-12-05 r61228) -- "Trick or Treat" -Copyright (C) 2012 The R Foundation for Statistical Computing +R version 2.15.3 RC (2013-02-25 r62062) -- "Security Blanket" +Copyright (C) 2013 The R Foundation for Statistical Computing ISBN 3-900051-07-0 Platform: x86_64-unknown-linux-gnu (64-bit) @@ -24,11 +24,10 @@ > library('analogue') Loading required package: vegan Loading required package: permute -This is vegan 2.0-5 +This is vegan 2.0-6 +Loading required package: princurve Loading required package: lattice -Loading required package: grid -Loading required package: princurve -This is analogue 0.11-0 +This is analogue 0.11-1 > > assign(".oldSearch", search(), pos = 'CheckExEnv') > cleanEx() @@ -5882,7 +5881,7 @@ > > ### Name: plot.prcurve > ### Title: Plot a fitted principal curve in PCA space -> ### Aliases: plot.prcurve +> ### Aliases: plot.prcurve lines.prcurve > ### Keywords: hplot > > ### ** Examples @@ -5895,8 +5894,8 @@ > > ## Fit the principal curve using varying complexity of smoothers > ## for each species -> aber.pc2 <- prcurve(abernethy2, method = "ca", trace = TRUE, -+ vary = TRUE, penalty = 1.4) +> aber.pc <- prcurve(abernethy2, method = "ca", trace = TRUE, ++ vary = TRUE, penalty = 1.4) -------------------------------------------------------------------------------- Initial curve: d.sq: 103233.4502 Iteration 1: d.sq: 4283.4308 @@ -5910,10 +5909,16 @@ -------------------------------------------------------------------------------- > > ## Plot the curve -> plot(aber.pc2, abernethy2) +> plot(aber.pc, abernethy2) > +> ## The lines() method can be used to add the principal curve to an +> ## existing plot +> ord <- rda(abernethy2) +> plot(ord) +> lines(aber.pc, data = abernethy2) > > +> > cleanEx() > nameEx("plot.residLen") > ### * plot.residLen @@ -7361,7 +7366,7 @@ > ### *