From noreply at r-forge.r-project.org  Tue Feb 11 18:42:55 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue, 11 Feb 2014 18:42:55 +0100 (CET)
Subject: [Analogue-commits] r401 - pkg/R
Message-ID: <20140211174255.7E0301859CD@r-forge.r-project.org>

Author: gsimpson
Date: 2014-02-11 18:42:54 +0100 (Tue, 11 Feb 2014)
New Revision: 401

Modified:
   pkg/R/internal.R
   pkg/R/plot.timetrack.R
Log:
clean up (remove) some commented code chunks

Modified: pkg/R/internal.R
===================================================================
--- pkg/R/internal.R	2014-01-02 05:28:49 UTC (rev 400)
+++ pkg/R/internal.R	2014-02-11 17:42:54 UTC (rev 401)
@@ -53,19 +53,6 @@
 ## drop              - drop spurious zero distance                       ##
 ##                                                                       ##
 ###########################################################################
-#cummean <- function(dis, y, drop = TRUE)
-#  {
-#    nas <- is.na(dis)
-#    ord <- order(dis[!nas])
-#    if(drop) {
-#      dis <- dis[!nas][ord][-1]
-#      y <- y[!nas][ord][-1]
-#    } else {
-#      dis <- dis[!nas][ord]
-#      y <- y[!nas][ord]
-#    }
-#    cumsum(y) / 1:length(dis)
-#  }
 cummean <- function(dis, y, drop = TRUE, kmax) {
     if(missing(kmax))
         kmax <- length(y)
@@ -118,12 +105,6 @@
 ## n                 - number of sections to break env gradient into     ##
 ##                                                                       ##
 ###########################################################################
-##maxBias <- function(error, y, n = 10)
-##  {
-##    groups <- cut(y, breaks = n, labels = 1:n)
-##    bias <- aggregate(error, list(group = groups), mean)$x
-##    bias[which.max(abs(bias))]
-##  }
 maxBias <- function(error, y, n = 10)
   {
     groups <- cut.default(y, breaks = n, labels = 1:n)
@@ -167,12 +148,11 @@
 ## w.avg - fast weighted mean function with no checks
 `w.avg` <- function(x, env) {
     opt <- ColSums(x * env) / ColSums(x)
-    ##opt <- .colSums(x * env) / .colSums(x)
     names(opt) <- colnames(x)
     opt
 }
 
-## fast rowSums and colSums functiosn without the checking
+## fast rowSums and colSums functions without the checking
 `RowSums` <- function(x, na.rm = FALSE) {
     dn <- dim(x)
     p <- dn[2]
@@ -187,17 +167,11 @@
     .colSums(x, n, dn, na.rm)
 }
 
-## deshrinking function given deshrinking coefs and a method
-##`deshrink.pred` <- function(x, coef) {
-##    coef[1] + x * coef[2]
-##}
-
 ## w.tol --- computes weighted standard deviations AKA tolerances
 w.tol <- function(x, env, opt, useN2 = TRUE) {
     ## x   = species abundances
     ## env = vector of response var
     ## opt = weighted average optima
-    ##tol <- sqrt(ColSums(x * outer(env, opt, "-")^2) / ColSums(x))
     nr <- NROW(x)
     nc <- NCOL(x)
     tol <- .C("WTOL", x = as.double(env), w = as.double(x),

Modified: pkg/R/plot.timetrack.R
===================================================================
--- pkg/R/plot.timetrack.R	2014-01-02 05:28:49 UTC (rev 400)
+++ pkg/R/plot.timetrack.R	2014-02-11 17:42:54 UTC (rev 401)
@@ -1,4 +1,4 @@
-`plot.timetrack` <- function(x, choices = 1:2, 
+`plot.timetrack` <- function(x, choices = 1:2,
                              display = c("wa","lc"),
                              order,
                              ptype = c("l", "p", "o", "b"),
@@ -13,13 +13,9 @@
     pass <- fitted(x, type = "passive", choices = choices)
     xlim <- range(scrs[,1], pass[,1])
     ylim <- range(scrs[,2], pass[,2])
-    ## plt <- plot(x$ord, choices = choices, scaling = x$scaling,
-    ##             type = "p", display = display, ...,
-    ##             ylim = ylim, xlim = xlim,
-    ##             pch = pch[1], col = col[1])
     plt <- plot(x$ord, choices = choices, scaling = x$scaling,
                 type = "n", display = display, ...,
-                 ylim = ylim, xlim = xlim)
+                ylim = ylim, xlim = xlim)
     points(scrs, pch = pch[1], col = col[1], ...)
     if(!missing(order)) {
         if(length(order) != NROW(pass))


From noreply at r-forge.r-project.org  Tue Feb 11 19:10:07 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue, 11 Feb 2014 19:10:07 +0100 (CET)
Subject: [Analogue-commits] r402 - pkg/R
Message-ID: <20140211181007.1ADE6184490@r-forge.r-project.org>

Author: gsimpson
Date: 2014-02-11 19:10:06 +0100 (Tue, 11 Feb 2014)
New Revision: 402

Modified:
   pkg/R/plot.timetrack.R
Log:
now invisibly returns the ordination object

Modified: pkg/R/plot.timetrack.R
===================================================================
--- pkg/R/plot.timetrack.R	2014-02-11 17:42:54 UTC (rev 401)
+++ pkg/R/plot.timetrack.R	2014-02-11 18:10:06 UTC (rev 402)
@@ -28,5 +28,5 @@
     } else {
         points(pass, pch = pch[2], col = col[2], ...)
     }
-    invisible()
+    invisible(x$ord)
 }


From noreply at r-forge.r-project.org  Tue Feb 11 19:10:37 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue, 11 Feb 2014 19:10:37 +0100 (CET)
Subject: [Analogue-commits] r403 - pkg/R
Message-ID: <20140211181037.D4D55184633@r-forge.r-project.org>

Author: gsimpson
Date: 2014-02-11 19:10:37 +0100 (Tue, 11 Feb 2014)
New Revision: 403

Modified:
   pkg/R/timetrack.R
Log:
remove redundant code to set a default value for method argument

Modified: pkg/R/timetrack.R
===================================================================
--- pkg/R/timetrack.R	2014-02-11 18:10:06 UTC (rev 402)
+++ pkg/R/timetrack.R	2014-02-11 18:10:37 UTC (rev 403)
@@ -22,8 +22,8 @@
     X <- X[, tmp]
     passive <- passive[, tmp]
     ## check what type of ordination is required
-    if(isTRUE(missing(method)))
-        method <- "cca"
+    ##if(isTRUE(missing(method)))
+    ##    method <- "cca"
     method <- match.arg(method)
     FUN <- match.fun(method)
     ## if no env do unconstrained


From noreply at r-forge.r-project.org  Tue Feb 11 21:04:32 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue, 11 Feb 2014 21:04:32 +0100 (CET)
Subject: [Analogue-commits] r404 - in pkg: . R inst man tests/Examples
Message-ID: <20140211200432.488CC1868F6@r-forge.r-project.org>

Author: gsimpson
Date: 2014-02-11 21:04:31 +0100 (Tue, 11 Feb 2014)
New Revision: 404

Added:
   pkg/R/points.timetrack.R
   pkg/R/predict.timetrack.R
Modified:
   pkg/DESCRIPTION
   pkg/NAMESPACE
   pkg/R/plot.timetrack.R
   pkg/R/timetrack.R
   pkg/inst/ChangeLog
   pkg/man/timetrack.Rd
   pkg/tests/Examples/analogue-Ex.Rout.save
Log:
Enhancements to timetrack; new points and predict methods; plot method enhanced; new example; bump to 0.13-3; update reference materials for checks.

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2014-02-11 18:10:37 UTC (rev 403)
+++ pkg/DESCRIPTION	2014-02-11 20:04:31 UTC (rev 404)
@@ -1,7 +1,7 @@
 Package: analogue
 Type: Package
 Title: Analogue and weighted averaging methods for palaeoecology
-Version: 0.13-2
+Version: 0.13-3
 Date: $Date$
 Depends: R (>= 2.15.0), vegan (>= 1.17-12), lattice, rgl
 Imports: mgcv, MASS, stats, graphics, grid, brglm, princurve

Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE	2014-02-11 18:10:37 UTC (rev 403)
+++ pkg/NAMESPACE	2014-02-11 20:04:31 UTC (rev 404)
@@ -187,6 +187,7 @@
 S3method(predict, mat)
 S3method(predict, pcr)
 S3method(predict, prcurve)
+S3method(predict, timetrack)
 S3method(predict, wa)
 S3method(residuals, bootstrap.mat)
 S3method(residuals, mat)
@@ -214,6 +215,7 @@
 S3method(plot, roc)
 S3method(plot, sppResponse)
 S3method(plot, timetrack)
+S3method(points, timetrack)
 S3method(plot, wa)
 S3method(plot, weightedCor)
 S3method(plot3d, prcurve)

Modified: pkg/R/plot.timetrack.R
===================================================================
--- pkg/R/plot.timetrack.R	2014-02-11 18:10:37 UTC (rev 403)
+++ pkg/R/plot.timetrack.R	2014-02-11 20:04:31 UTC (rev 404)
@@ -1,22 +1,30 @@
 `plot.timetrack` <- function(x, choices = 1:2,
                              display = c("wa","lc"),
                              order,
-                             ptype = c("l", "p", "o", "b"),
+                             type = c("p", "n"),
+                             ptype = c("l", "p", "o", "b", "n"),
                              pch = c(1,2),
                              col = c("black","red"),
                              lty = "solid", lwd = 1,
-                             ...) {
+                             xlim = NULL, ylim = NULL, ...) {
     ptype <- match.arg(ptype)
+    type <- match.arg(type)
     display <- match.arg(display)
     scrs <- scores(x$ord, choices = choices, scaling = x$scaling,
                    display = display, ...)
     pass <- fitted(x, type = "passive", choices = choices)
-    xlim <- range(scrs[,1], pass[,1])
-    ylim <- range(scrs[,2], pass[,2])
+    if (is.null(xlim)) {
+        xlim <- range(scrs[,1], pass[,1])
+    }
+    if (is.null(ylim)) {
+        ylim <- range(scrs[,2], pass[,2])
+    }
     plt <- plot(x$ord, choices = choices, scaling = x$scaling,
                 type = "n", display = display, ...,
                 ylim = ylim, xlim = xlim)
-    points(scrs, pch = pch[1], col = col[1], ...)
+    if (isTRUE(all.equal(type, "p"))) {
+        points(scrs, pch = pch[1], col = col[1], ...)
+    }
     if(!missing(order)) {
         if(length(order) != NROW(pass))
             stop("'length(order)' not equal to number of passive samples.")
@@ -25,7 +33,7 @@
     if(ptype %in% c("l", "o", "b")) {
         lines(pass, pch = pch[2], col = col[2],
               lty = lty, lwd = lwd, type = ptype, ...)
-    } else {
+    } else if (isTRUE(all.equal(ptype, "p"))) {
         points(pass, pch = pch[2], col = col[2], ...)
     }
     invisible(x$ord)

Added: pkg/R/points.timetrack.R
===================================================================
--- pkg/R/points.timetrack.R	                        (rev 0)
+++ pkg/R/points.timetrack.R	2014-02-11 20:04:31 UTC (rev 404)
@@ -0,0 +1,23 @@
+`points.timetrack` <- function(x, choices = 1:2,
+                               which = c("passive", "ordination"),
+                               display = c("wa","lc"),
+                               order,
+                               ...) {
+    display <- match.arg(display)
+    which <- match.arg(which)
+
+    ## Select the coordinates for the relevant type of sample
+    if (isTRUE(all.equal(which, "ordination"))) {
+        scrs <- scores(x$ord, choices = choices, scaling = x$scaling,
+                       display = display, ...)
+    } else {
+        scrs <- fitted(x, type = "passive", choices = choices)
+        if(!missing(order)) {
+            if(length(order) != NROW(scrs))
+                stop("'length(order)' not equal to number of passive samples.")
+            scrs[order, ]
+        }
+    }
+
+    points(scrs, ...)
+}

Added: pkg/R/predict.timetrack.R
===================================================================
--- pkg/R/predict.timetrack.R	                        (rev 0)
+++ pkg/R/predict.timetrack.R	2014-02-11 20:04:31 UTC (rev 404)
@@ -0,0 +1,31 @@
+`predict.timetrack` <- function(object, newdata, ...) {
+    namNew <- deparse(substitute(newdata))
+    ## Apply a transformation - let tran deal with arg matching
+    if(!isTRUE(all.equal(transform, "none"))) {
+        newdata <- tran(newdata, method = object$transform, ...)
+    }
+    ## merge X and passive
+    dat <- join(object$X, newdata, type = "left")
+    X <- dat[[1]]
+    newdata <- dat[[2]]
+    ## common set of species
+    tmp <- colSums(X > 0) > 0
+    X <- X[, tmp]
+    newdata <- newdata[, tmp]
+
+    ## fitted values for newdata
+    pred <- predict(object$ordination, newdata = newdata, type = "wa",
+                    scaling = object$scaling, model = "CCA",
+                    rank = object$rank)
+    pred2 <- predict(object$ordination, newdata = newdata, type = "wa",
+                     scaling = object$scaling, model = "CA",
+                     rank = object$rank)
+    pred <- cbind(pred, pred2)
+    ## return object
+    nams <- object$labels
+    nams[["passive"]] <- namNew
+    ## update object with the new passive data predictions
+    object$fitted.values <- pred
+    object$labels <- nams
+    object
+}

Modified: pkg/R/timetrack.R
===================================================================
--- pkg/R/timetrack.R	2014-02-11 18:10:37 UTC (rev 403)
+++ pkg/R/timetrack.R	2014-02-11 20:04:31 UTC (rev 404)
@@ -5,7 +5,9 @@
                         transform = "none",
                         formula, ##type = c("wa","lc"),
                         scaling = 3, rank = "full",
-                        model = c("CCA", "CA"), ...) {
+                        ##model = c("CCA", "CA"),
+                        ...) {
+    origX <- X ## store for later
     namX <- deparse(substitute(X))
     namP <- deparse(substitute(passive))
     ## Apply a transformation - let tran deal with arg matching
@@ -56,9 +58,9 @@
         }
     }
     ## process predict args
-    if(isTRUE(missing(model)))
-        model <- "CCA"
-    model <- match.arg(model)
+    ##if(isTRUE(missing(model)))
+    ##    model <- "CCA"
+    ##model <- match.arg(model)
     ## fitted values for passive
     pred <- predict(ord, newdata = passive, type = "wa",
                     scaling = scaling, model = "CCA", rank = rank)
@@ -69,10 +71,11 @@
     ## return object
     res <- list(ordination = ord, fitted.values = pred,
                 method = method, formula = formula, #type = type,
-                scaling = scaling, rank = rank, model = model,
-                labels = nams, call = match.call())
+                scaling = scaling, rank = rank, ##model = model,
+                labels = nams, call = match.call(),
+                X = origX, transform = transform)
     class(res) <- "timetrack"
-    return(res)
+    res
 }
 
 `print.timetrack` <- function(x, ...) {

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2014-02-11 18:10:37 UTC (rev 403)
+++ pkg/inst/ChangeLog	2014-02-11 20:04:31 UTC (rev 404)
@@ -1,5 +1,21 @@
 analogue Change Log
 
+Version 0.13-3 Opened 11 Feb 2014
+
+	* timetrack: A number of additions added and improvements made:
+
+		o New `predict()` method allows additional passive points
+		  to be located in the timetrack space.
+
+		o New `points()` method to allow drawing of points for
+		  training or passive samples on an existing plot.
+
+		o The `plot()` method can now suppress plotting of all
+		  points, for a clean canvas with axes/labelling ready to
+		  accept additional plotting function calls.
+
+	These changes were made following a query by Andrew Medeiros.
+
 Version 0.13-2 Opened 1 Jan 2014
 
 	* prcurve: uses `dev.hold()` & `dev.flush()` to smooth graphics

Modified: pkg/man/timetrack.Rd
===================================================================
--- pkg/man/timetrack.Rd	2014-02-11 18:10:37 UTC (rev 403)
+++ pkg/man/timetrack.Rd	2014-02-11 20:04:31 UTC (rev 404)
@@ -2,8 +2,10 @@
 \alias{timetrack}
 \alias{print.timetrack}
 \alias{plot.timetrack}
+\alias{points.timetrack}
 \alias{fitted.timetrack}
 \alias{scores.timetrack}
+\alias{predict.timetrack}
 
 \title{Timetracks of change in species composition}
 
@@ -15,17 +17,23 @@
 \usage{
 timetrack(X, passive, env, method = c("cca", "rda"),
           transform = "none", formula, scaling = 3,
-          rank = "full", model = c("CCA", "CA"), \dots)
+          rank = "full", \dots)
 
 \method{fitted}{timetrack}(object, which = c("passive", "ordination"),
        model = NULL, choices = 1:2, \dots)
 
+\method{predict}{timetrack}(object, newdata, \dots)
+
 \method{scores}{timetrack}(x, which = c("ordination", "passive"),
        scaling = x$scaling, choices = 1:2, display = "sites", \dots)
 
 \method{plot}{timetrack}(x, choices = 1:2, display = c("wa", "lc"),
-     order, ptype = c("l", "p", "o", "b"), pch = c(1,2),
-     col = c("black","red"), lty = "solid", lwd = 1, \dots)
+     order, type = c("p", "n"), ptype = c("l", "p", "o", "b", "n"),
+     pch = c(1,2), col = c("black","red"), lty = "solid", lwd = 1,
+     xlim = NULL, ylim = NULL, \dots)
+
+\method{points}{timetrack}(x, choices = 1:2, which = c("passive", "ordination"),
+      display = c("wa","lc"), order, \dots)
 }
 
 \arguments{
@@ -55,21 +63,37 @@
     the samples.}
   \item{rank}{character; see argument of same name in function
     \code{\link[vegan]{cca}} or \code{\link[vegan]{rda}}.}
-  \item{model}{character; see argument of same name in function
-    \code{\link[vegan]{cca}} or \code{\link[vegan]{rda}}.}
   \item{object, x}{an object of class \code{"timetrack"}.}
   \item{which}{character; which fitted values should be returned?}
+  \item{model}{character; which ordination component should be used for
+    the fitted values; the constrained or unconstrained part? See
+    \code{\link{fitted.cca}} for details, but essentially, one of
+    \code{"CCA"} for the constrained part and \code{"CA"} for the
+    unconstrained part. If \code{NULL}, the default, \code{"CA"} is used
+    unless the underlying ordination was constrained, in which case
+    \code{"CCA"} is used.}
   \item{choices}{numeric; the length-2 vector of ordination axes to
     plot.}
+  \item{newdata}{a data frame of new observations for which locations in
+    the plot (or a timetrack) are required. This need not have exactly
+    the same set of species as the fitted ordination as internally only
+    those species in \code{newdata} that were included in the data used
+    for the ordination will be retained. In addition, if a
+    transformation was applied to the species data used to fit the
+    ordination, the same transformation will be automatically applied to
+    \code{newdata} using \code{\link{tran}}.}
   \item{display}{character; which type of sites scores to display? See
     \code{\link{scores.cca}} for details.}
   \item{order}{numeric; vector of indices to use to reorder the passive
     samples. Useful to get passive samples into temporal order for
     plotting with a line.}
+  \item{type}{character; the type of plotting required for the training
+    set samples. Options are \code{"p"} for points or \code{"n"} to not
+    draw training set samples.}
   \item{ptype}{character; controls how the time track should be
     drawn. Default is draw the passive samples connected by a line in
     the order in which they appear in the data. With \code{ptype = "p"}
-    no line is drawn. The other two types have their usual meaning from
+    no line is drawn. The other types have their usual meaning from
     \code{\link{plot.default}}.}
   \item{pch}{The length-2 vector of plotting characters. The first
     element is used for the ordination samples, the second for the
@@ -79,12 +103,14 @@
     passive samples.}
   \item{lty, lwd}{graphical parameters for the plotted time track for
     \code{ptype != "p"}.}
+  \item{xlim, ylim}{user specified axis limits for the plot.}
   \item{\dots}{arguments passed to other methods.
     \code{timetrack} passes arguments on to \code{tran} and the
     ordination function given in \code{method}. \code{fitted} passes
     arguments on to other \code{fitted} methods as
     appropriate. \code{plot} passes arguments on to the underlying
-    plotting functions.}
+    plotting functions. \code{predict} passes arguments on to
+    \code{\link{tran}} for use in applyign the transformation.}
 }
 
 \details{
@@ -132,22 +158,14 @@
   \item{labels }{a list of names for the \code{X}, \code{passive}, and
     \code{env} arguments.}
   \item{call }{The matched function call.}
+  \item{X}{The training data.}
+  \item{transform}{The transformation applied, if any.}
 }
 
-%\references{
-%% ~put references to the literature/web site here ~
-%}
-
 \author{
-Gavin L. Simpson
+  Gavin L. Simpson
 }
 
-%\note{
-%%  ~~further notes~~
-%}
-
-%% ~Make other sections like Warning with \section{Warning }{....} ~
-
 \seealso{
   \code{\link[vegan]{cca}} and \code{\link[vegan]{rda}} for the
   underlying ordination functions.
@@ -181,9 +199,22 @@
 ## scores and fitted methods
 head(fitted(mod, type = "passive"))
 head(scores(mod, type = "passive"))
+
+## predict locations in timetrack for new observations
+take <- rlgh[1:50, ]
+take <- take[ , colSums(take) > 0]
+mod3 <- predict(mod, newdata = take)
+class(mod3) ## returns a timetrack object
+take <- rlgh[-(1:50), ]
+take <- take[ , colSums(take) > 0]
+mod4 <- predict(mod, newdata = take)
+
+## build a plot up from base parts
+plot(mod, type = "n", ptype = "n")
+points(mod, which = "ordination", col = "grey", pch = 19, cex = 0.7)
+points(mod3, which = "passive", col = "red")
+points(mod4, which = "passive", col = "blue")
 }
 
-% Add one or more standard keywords, see file 'KEYWORDS' in the
-% R documentation directory.
 \keyword{methods}
 \keyword{hplot}

Modified: pkg/tests/Examples/analogue-Ex.Rout.save
===================================================================
--- pkg/tests/Examples/analogue-Ex.Rout.save	2014-02-11 18:10:37 UTC (rev 403)
+++ pkg/tests/Examples/analogue-Ex.Rout.save	2014-02-11 20:04:31 UTC (rev 404)
@@ -1,5 +1,5 @@
 
-R version 3.0.2 Patched (2013-09-26 r64005) -- "Frisbee Sailing"
+R version 3.0.2 Patched (2013-10-07 r64035) -- "Frisbee Sailing"
 Copyright (C) 2013 The R Foundation for Statistical Computing
 Platform: x86_64-unknown-linux-gnu (64-bit)
 
@@ -26,7 +26,7 @@
 Loading required package: lattice
 This is vegan 2.0-10
 Loading required package: rgl
-This is analogue 0.13-2
+This is analogue 0.13-3
 > 
 > base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')
 > cleanEx()
@@ -7267,8 +7267,8 @@
 > 
 > ### Name: timetrack
 > ### Title: Timetracks of change in species composition
-> ### Aliases: timetrack print.timetrack plot.timetrack fitted.timetrack
-> ###   scores.timetrack
+> ### Aliases: timetrack print.timetrack plot.timetrack points.timetrack
+> ###   fitted.timetrack scores.timetrack predict.timetrack
 > ### Keywords: methods hplot
 > 
 > ### ** Examples
@@ -7358,8 +7358,24 @@
 115.11  0.0907404572 -0.015968707
 12.11   0.1220684180 -0.237747308
 > 
+> ## predict locations in timetrack for new observations
+> take <- rlgh[1:50, ]
+> take <- take[ , colSums(take) > 0]
+> mod3 <- predict(mod, newdata = take)
+> class(mod3) ## returns a timetrack object
+[1] "timetrack"
+> take <- rlgh[-(1:50), ]
+> take <- take[ , colSums(take) > 0]
+> mod4 <- predict(mod, newdata = take)
 > 
+> ## build a plot up from base parts
+> plot(mod, type = "n", ptype = "n")
+> points(mod, which = "ordination", col = "grey", pch = 19, cex = 0.7)
+> points(mod3, which = "passive", col = "red")
+> points(mod4, which = "passive", col = "blue")
 > 
+> 
+> 
 > cleanEx()
 > nameEx("tran")
 > ### * tran
@@ -7791,7 +7807,7 @@
 > ###
 > options(digits = 7L)
 > base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed:  21.712 0.38 23.116 0.001 0.002 
+Time elapsed:  17.35 0.299 17.92 0.001 0.002 
 > grDevices::dev.off()
 null device 
           1 


From noreply at r-forge.r-project.org  Thu Feb 13 23:26:44 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Thu, 13 Feb 2014 23:26:44 +0100 (CET)
Subject: [Analogue-commits] r405 - in pkg: . R inst man tests/Examples
Message-ID: <20140213222644.A3C7B186F7D@r-forge.r-project.org>

Author: gsimpson
Date: 2014-02-13 23:26:44 +0100 (Thu, 13 Feb 2014)
New Revision: 405

Modified:
   pkg/DESCRIPTION
   pkg/R/crossval.pcr.R
   pkg/R/pcr.R
   pkg/inst/ChangeLog
   pkg/man/crossval.Rd
   pkg/tests/Examples/analogue-Ex.Rout.save
Log:
fix several bugs in crossval method for pcr() fits

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2014-02-11 20:04:31 UTC (rev 404)
+++ pkg/DESCRIPTION	2014-02-13 22:26:44 UTC (rev 405)
@@ -1,7 +1,7 @@
 Package: analogue
 Type: Package
 Title: Analogue and weighted averaging methods for palaeoecology
-Version: 0.13-3
+Version: 0.13-4
 Date: $Date$
 Depends: R (>= 2.15.0), vegan (>= 1.17-12), lattice, rgl
 Imports: mgcv, MASS, stats, graphics, grid, brglm, princurve

Modified: pkg/R/crossval.pcr.R
===================================================================
--- pkg/R/crossval.pcr.R	2014-02-11 20:04:31 UTC (rev 404)
+++ pkg/R/crossval.pcr.R	2014-02-13 22:26:44 UTC (rev 405)
@@ -42,7 +42,8 @@
             TRAN <- obj$tranFun(x[-i, , drop = FALSE])
             X <- TRAN$data
             ## apply transformation to X[i, ], using parms from above
-            Xi <- obj$tranFun(x[i, , drop = FALSE], apply = TRUE, parms = TRAN$parms)$data
+            Xi <- obj$tranFun(x[i, , drop = FALSE], apply = TRUE,
+                              parms = TRAN$parms)$data
             ## centre the training data
             Xbar <- colMeans(X)
             ybar <- mean(y[-i])
@@ -166,36 +167,45 @@
     ## fitted values and derived stats
     if(identical(method, "none")) {
         fitted <- pred
-    } else if(method %in% c("","")) {
-        rowMeans(pred, na.rm = TRUE, dims = 2)
+    } else if(method %in% c("kfold","bootstrap")) {
+        fitted <- rowMeans(pred, na.rm = TRUE, dims = 2)
     } else {
         fitted <- rowMeans(pred)
     }
     residuals <- y - fitted                               ## residuals
     maxBias <- apply(residuals, 2, maxBias, y, n = 10)    ## maxBias
     avgBias <- colMeans(residuals)                        ## avgBias
-    r2 <- apply(fitted, cor, y)
+    r2 <- apply(fitted, 2, cor, y)
     ## s1 & s2 components for model and training set
     ns <- rowSums(!is.na(pred), dims = 2)
-    s1.train <- t(sqrt(rowSums((pred - as.vector(fitted))^2,
-                               na.rm = TRUE, dims = 2) / as.vector(ns - 1)))
+    s1.train <- sqrt(rowSums((pred - as.vector(fitted))^2,
+                             na.rm = TRUE, dims = 2) / as.vector(ns - 1))
     s1 <- sqrt(colMeans(s1.train^2))
     s2 <- sqrt(colMeans(residuals^2, na.rm = TRUE))
-    s2.train <- sweep(pred, c(2,1), y, "-")
-    s2.train <- sqrt(t(rowMeans(s2.train^2, na.rm = TRUE, dims = 2)))
+    ## s2.train <- sweep(pred, 1, y, "-")
+    ## s2.train <- sqrt(rowMeans(s2.train^2, na.rm = TRUE, dims = 2))
 
     ## RMSEP
-    rmsep.train <- sqrt(s1.train^2 + s2.train^2)
-    rmsep <- sqrt(s1^2 + s2^2)
-    rmsep2 <- sqrt(mean(residuals^2))
-    performance <- data.frame(comp = ncomp,
+    ## rmsep.train <- sqrt(s1.train^2 + s2.train^2)
+    rmsep2 <- sqrt(s1^2 + s2^2)
+    rmsep <- sqrt(colMeans(residuals^2, na.rm = TRUE))
+    fill <- rep(NA, ncomp)
+    performance <- data.frame(comp = seq_len(ncomp),
                               R2 = r2,
                               avgBias = avgBias,
                               maxBias = maxBias,
                               RMSEP = rmsep,
-                              RMSEP2 = rmsep2,
-                              s1 = s1,
-                              s2 = s2)
+                              RMSEP2 = fill,
+                              s1 = fill,
+                              s2 = fill)
+    ## add in the bits we can only do if bootstrapping or multiple fold
+    ## k-fold CV
+    if(identical(method, "bootstrap") ||
+       (identical(method, "kfold") && folds > 1)) {
+        performance$s1 <- s1
+        performance$s2 <- s2
+        performance$RMSEP2 <- rmsep2
+    }
 
     ## more additions to the call
     .call <- match.call()
@@ -204,9 +214,9 @@
     ## return object
     out <- list(fitted.values = fitted,
                 residuals = residuals,
-                rmsep = rmsep.train,
-                s1 = s1.train,
-                s2 = s2.train,
+                ##rmsep = rmsep.train, ## technically not in crossval.wa
+                ##s1 = s1.train,       ## so shoould they be in here?
+                ##s2 = s2.train,       ## need to formalise the crossval class
                 performance = performance,
                 call = .call,
                 CVparams = list(method = method, nboot = nboot,

Modified: pkg/R/pcr.R
===================================================================
--- pkg/R/pcr.R	2014-02-11 20:04:31 UTC (rev 404)
+++ pkg/R/pcr.R	2014-02-13 22:26:44 UTC (rev 405)
@@ -41,12 +41,12 @@
     y <- y - yMean
 
     ## How many components?
-    ncomp <- if(missing(ncomp)) {
-        min(Nx - 1, Mx)
+    if(missing(ncomp)) {
+        ncomp <- min(Nx - 1, Mx)
     } else {
         if(ncomp < 1 || ncomp > (newcomp <- min(Nx - 1, Mx))) {
             warning("Invalid 'ncomp'. Resetting to max possible.")
-            newcomp
+            ncomp <- newcomp
         }
     }
 

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2014-02-11 20:04:31 UTC (rev 404)
+++ pkg/inst/ChangeLog	2014-02-13 22:26:44 UTC (rev 405)
@@ -1,5 +1,10 @@
 analogue Change Log
 
+Version 0.13-4 13 Feb 2014
+
+	* crossval.pcr: Fixed a number of bugs in the method for PCR
+	related to k-fold cross validation, which were causing errors.
+
 Version 0.13-3 Opened 11 Feb 2014
 
 	* timetrack: A number of additions added and improvements made:

Modified: pkg/man/crossval.Rd
===================================================================
--- pkg/man/crossval.Rd	2014-02-11 20:04:31 UTC (rev 404)
+++ pkg/man/crossval.Rd	2014-02-13 22:26:44 UTC (rev 405)
@@ -1,9 +1,10 @@
 \name{crossval}
 \alias{crossval}
 \alias{crossval.wa}
+\alias{crossval.pcr}
 \alias{print.crossval}
-\alias{predWA}
-\alias{predWAT}
+%\alias{predWA}
+%\alias{predWAT}
 \title{Cross-validation of palaeoecological transfer function models}
 \description{
   Performs leave-one-out, \emph{k}-fold, \emph{n} \emph{k}-fold and
@@ -16,11 +17,17 @@
          nboot = 100, nfold = 10, folds = 5,
          verbose = getOption("verbose"), ...)
 
+\method{crossval}{pcr}(obj, method = c("LOO","kfold","bootstrap"),
+         ncomp, nboot = 100, nfold = 10, folds = 5,
+         verbose = getOption("verbose"), ...)
+
 }
 \arguments{
   \item{obj}{A fitted transfer function model. Currently, only objects
-    of class \code{"wa"} are supported.}
+    of class \code{\link{wa}} and \code{\link{pcr}} are supported.}
   \item{method}{character; type of cross-validation.}
+  \item{ncomp}{numeric; number of components to fit, as in models with
+    \code{1:ncomp} components.}
   \item{nboot}{numeric; number of bootstrap samples.}
   \item{nfold}{numeric; number of chunks into which the training data
     are split. The \emph{k} in \emph{k}-fold.}
@@ -66,11 +73,11 @@
 cv.loo
 
 ## k-fold CV (k == 10)
-cv.kfold <- crossval(mod, kfold = 10, folds = 1, method = "kfold")
+cv.kfold <- crossval(mod, method = "kfold", kfold = 10, folds = 1)
 cv.kfold
 
 ## n k-fold CV (k == 10, n = 10)
-cv.nkfold <- crossval(mod, kfold = 10, folds = 10, method = "kfold")
+cv.nkfold <- crossval(mod, method = "kfold", kfold = 10, folds = 10)
 cv.nkfold
 
 ## bootstrap with 250 bootstrap samples
@@ -81,5 +88,10 @@
 fitted(cv.boot)
 resid(cv.boot)
 
+## Principal Components Regression
+mpcr <- pcr(SumSST ~., data = ImbrieKipp, ncomp = 10)
+crossval(mpcr, method = "kfold", kfold = 10, folds = 2, ncomp = 10)
+
+crossval(mpcr, method = "bootstrap", nboot = 250, ncomp = 10)
 }
 \keyword{methods}

Modified: pkg/tests/Examples/analogue-Ex.Rout.save
===================================================================
--- pkg/tests/Examples/analogue-Ex.Rout.save	2014-02-11 20:04:31 UTC (rev 404)
+++ pkg/tests/Examples/analogue-Ex.Rout.save	2014-02-13 22:26:44 UTC (rev 405)
@@ -1758,7 +1758,7 @@
 > 
 > ### Name: crossval
 > ### Title: Cross-validation of palaeoecological transfer function models
-> ### Aliases: crossval crossval.wa print.crossval predWA predWAT
+> ### Aliases: crossval crossval.wa crossval.pcr print.crossval
 > ### Keywords: methods
 > 
 > ### ** Examples
@@ -1800,7 +1800,7 @@
 1 0.90028 -0.013652 -4.5985 2.2179     NA NA NA
 > 
 > ## k-fold CV (k == 10)
-> cv.kfold <- crossval(mod, kfold = 10, folds = 1, method = "kfold")
+> cv.kfold <- crossval(mod, method = "kfold", kfold = 10, folds = 1)
 > cv.kfold
 	Model Cross-validation:
 
@@ -1814,7 +1814,7 @@
 1 0.90107 0.0070881 -4.4826 2.2102     NA NA NA
 > 
 > ## n k-fold CV (k == 10, n = 10)
-> cv.nkfold <- crossval(mod, kfold = 10, folds = 10, method = "kfold")
+> cv.nkfold <- crossval(mod, method = "kfold", kfold = 10, folds = 10)
 > cv.nkfold
 	Model Cross-validation:
 
@@ -1864,6 +1864,29 @@
 [55]  2.06405926  1.47563233  0.88025973  0.30226739  0.22736763  0.07008432
 [61]  1.18109032
 > 
+> ## Principal Components Regression
+> mpcr <- pcr(SumSST ~., data = ImbrieKipp, ncomp = 10)
+> crossval(mpcr, method = "kfold", kfold = 10, folds = 2, ncomp = 10)
+	Model Cross-validation:
+
+crossval(obj = mpcr, method = "kfold", ncomp = 10, folds = 2, 
+    kfold = 10)
+
+Method: kfold
+k: 10
+No. of folds: 2
+
+   comp      R2   avgBias maxBias  RMSEP RMSEP2      s1     s2
+1     1 0.93102 -0.082069 -6.0751 2.5707 2.6306 0.55799 2.5707
+2     2 0.95154 -0.034190 -5.3449 2.1593 2.1665 0.17708 2.1593
+3     3 0.95452 -0.071033 -4.7328 2.0950 2.1092 0.24471 2.0950
+4     4 0.95506 -0.054893 -4.7586 2.0822 2.0957 0.23782 2.0822
+5     5 0.95565 -0.054278 -5.1491 2.0684 2.0891 0.29338 2.0684
+6     6 0.95568 -0.088115 -5.1732 2.0689 2.0916 0.30691 2.0689
+7     7 0.95473 -0.045325 -4.8739 2.0887 2.1143 0.32838 2.0887
+8     8 0.95818 -0.039048 -5.0150 2.0097 2.0350 0.31945 2.0097
+9     9 0.95742 -0.083771 -5.1489 2.0288 2.0585 0.34841 2.0288
+10   10 0.95784 -0.055376 -4.9774 2.0176 2.0499 0.36230 2.0176
 > 
 > 
 > 
@@ -7807,7 +7830,7 @@
 > ###
 > options(digits = 7L)
 > base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed:  17.35 0.299 17.92 0.001 0.002 
+Time elapsed:  17.431 0.285 17.846 0 0.003 
 > grDevices::dev.off()
 null device 
           1 


From noreply at r-forge.r-project.org  Fri Feb 14 20:27:27 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Fri, 14 Feb 2014 20:27:27 +0100 (CET)
Subject: [Analogue-commits] r406 - in pkg: R inst man tests/Examples
Message-ID: <20140214192727.6EBAF186D8C@r-forge.r-project.org>

Author: gsimpson
Date: 2014-02-14 20:27:27 +0100 (Fri, 14 Feb 2014)
New Revision: 406

Modified:
   pkg/R/predict.pcr.R
   pkg/inst/ChangeLog
   pkg/man/predict.pcr.Rd
   pkg/tests/Examples/analogue-Ex.Rout.save
Log:
predict.pcr was setting ncomp incorrectly if not specified by the user.

Modified: pkg/R/predict.pcr.R
===================================================================
--- pkg/R/predict.pcr.R	2014-02-13 22:26:44 UTC (rev 405)
+++ pkg/R/predict.pcr.R	2014-02-14 19:27:27 UTC (rev 406)
@@ -1,4 +1,4 @@
-`predict.pcr` <- function(object, newdata, ncomp = seq_along(object$ncomp),
+`predict.pcr` <- function(object, newdata, ncomp = object$ncomp,
                           CV = c("none", "LOO", "bootstrap", "kfold"),
                           verbose = FALSE, nboot = 100, kfold = 10,
                           folds = 5, ...) {

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2014-02-13 22:26:44 UTC (rev 405)
+++ pkg/inst/ChangeLog	2014-02-14 19:27:27 UTC (rev 406)
@@ -5,6 +5,9 @@
 	* crossval.pcr: Fixed a number of bugs in the method for PCR
 	related to k-fold cross validation, which were causing errors.
 
+	* predict.pcr: would set argument `ncomp` incorrectly (in the
+	wrong form) if not supplied.
+
 Version 0.13-3 Opened 11 Feb 2014
 
 	* timetrack: A number of additions added and improvements made:

Modified: pkg/man/predict.pcr.Rd
===================================================================
--- pkg/man/predict.pcr.Rd	2014-02-13 22:26:44 UTC (rev 405)
+++ pkg/man/predict.pcr.Rd	2014-02-14 19:27:27 UTC (rev 406)
@@ -10,7 +10,7 @@
 }
 
 \usage{
-\method{predict}{pcr}(object, newdata, ncomp = seq_along(object$ncomp),
+\method{predict}{pcr}(object, newdata, ncomp = object$ncomp,
         CV = c("none", "LOO", "bootstrap", "kfold"),
         verbose = FALSE, nboot = 100, kfold = 10, folds = 5,
         \dots)

Modified: pkg/tests/Examples/analogue-Ex.Rout.save
===================================================================
--- pkg/tests/Examples/analogue-Ex.Rout.save	2014-02-13 22:26:44 UTC (rev 405)
+++ pkg/tests/Examples/analogue-Ex.Rout.save	2014-02-14 19:27:27 UTC (rev 406)
@@ -26,7 +26,7 @@
 Loading required package: lattice
 This is vegan 2.0-10
 Loading required package: rgl
-This is analogue 0.13-3
+This is analogue 0.13-4
 > 
 > base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')
 > cleanEx()
@@ -1888,8 +1888,28 @@
 9     9 0.95742 -0.083771 -5.1489 2.0288 2.0585 0.34841 2.0288
 10   10 0.95784 -0.055376 -4.9774 2.0176 2.0499 0.36230 2.0176
 > 
+> crossval(mpcr, method = "bootstrap", nboot = 250, ncomp = 10)
+	Model Cross-validation:
+
+crossval(obj = mpcr, method = "bootstrap", ncomp = 10, nboot = 250)
+
+Method: bootstrap
+No. Bootstraps: 250
+
+   comp      R2   avgBias maxBias  RMSEP RMSEP2      s1     s2
+1     1 0.94633 -0.098164 -6.3331 2.3477 2.7404 1.41352 2.3477
+2     2 0.95203 -0.041775 -5.3330 2.1490 2.2467 0.65548 2.1490
+3     3 0.95520 -0.044662 -4.4128 2.0789 2.1797 0.65524 2.0789
+4     4 0.95557 -0.047229 -4.4156 2.0703 2.1880 0.70792 2.0703
+5     5 0.95740 -0.047406 -4.9908 2.0281 2.1796 0.79856 2.0281
+6     6 0.95716 -0.055633 -4.8585 2.0336 2.2021 0.84479 2.0336
+7     7 0.95816 -0.052451 -4.7913 2.0102 2.1975 0.88769 2.0102
+8     8 0.95978 -0.031075 -4.8303 1.9712 2.1437 0.84254 1.9712
+9     9 0.96015 -0.031626 -4.9102 1.9622 2.1470 0.87149 1.9622
+10   10 0.96116 -0.029623 -4.8634 1.9379 2.1373 0.90148 1.9379
 > 
 > 
+> 
 > cleanEx()
 > nameEx("densityplot.residLen")
 > ### * densityplot.residLen
@@ -7830,7 +7850,7 @@
 > ###
 > options(digits = 7L)
 > base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed:  17.431 0.285 17.846 0 0.003 
+Time elapsed:  17.799 0.401 18.495 0 0.002 
 > grDevices::dev.off()
 null device 
           1 


From noreply at r-forge.r-project.org  Fri Feb 14 23:40:46 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Fri, 14 Feb 2014 23:40:46 +0100 (CET)
Subject: [Analogue-commits] r407 - in pkg: . R
Message-ID: <20140214224046.5701E18450B@r-forge.r-project.org>

Author: gsimpson
Date: 2014-02-14 23:40:45 +0100 (Fri, 14 Feb 2014)
New Revision: 407

Added:
   pkg/R/performance.crossval.R
Modified:
   pkg/NAMESPACE
Log:
adds a performance method for crossval objects.

Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE	2014-02-14 19:27:27 UTC (rev 406)
+++ pkg/NAMESPACE	2014-02-14 22:40:45 UTC (rev 407)
@@ -145,6 +145,7 @@
 S3method(pcr, default)
 S3method(pcr, formula)
 S3method(performance, bootstrap.wa)
+S3method(performance, crossval)
 S3method(performance, predict.wa)
 S3method(performance, pcr)
 S3method(performance, wa)

Added: pkg/R/performance.crossval.R
===================================================================
--- pkg/R/performance.crossval.R	                        (rev 0)
+++ pkg/R/performance.crossval.R	2014-02-14 22:40:45 UTC (rev 407)
@@ -0,0 +1,5 @@
+`performance.crossval` <- function(object, ...) {
+    retval <- object$performance
+    class(retval) <- c("performance","data.frame")
+    retval
+}


From noreply at r-forge.r-project.org  Fri Feb 14 23:43:03 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Fri, 14 Feb 2014 23:43:03 +0100 (CET)
Subject: [Analogue-commits] r408 - in pkg: inst man
Message-ID: <20140214224303.9949018603D@r-forge.r-project.org>

Author: gsimpson
Date: 2014-02-14 23:43:03 +0100 (Fri, 14 Feb 2014)
New Revision: 408

Modified:
   pkg/inst/ChangeLog
   pkg/man/performance.Rd
Log:
two further changes that should have gone with r407; documentation tweaked for performance()

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2014-02-14 22:40:45 UTC (rev 407)
+++ pkg/inst/ChangeLog	2014-02-14 22:43:03 UTC (rev 408)
@@ -8,6 +8,9 @@
 	* predict.pcr: would set argument `ncomp` incorrectly (in the
 	wrong form) if not supplied.
 
+	* performance.crossval: A new emthod for objects of class
+	`"crossval"`.
+
 Version 0.13-3 Opened 11 Feb 2014
 
 	* timetrack: A number of additions added and improvements made:

Modified: pkg/man/performance.Rd
===================================================================
--- pkg/man/performance.Rd	2014-02-14 22:40:45 UTC (rev 407)
+++ pkg/man/performance.Rd	2014-02-14 22:43:03 UTC (rev 408)
@@ -4,6 +4,7 @@
 \alias{performance.wa}
 \alias{performance.predict.wa}
 \alias{performance.bootstrap.wa}
+\alias{performance.crossval}
 \title{Transfer function model performance statistics}
 \description{
   A simple extractor function to access the model performance statistics
@@ -11,20 +12,26 @@
 }
 \usage{
 performance(object, ...)
-
-\method{performance}{wa}(object, ...)
-
-\method{performance}{predict.wa}(object, ...)
-
-\method{performance}{bootstrap.wa}(object, ...)
 }
 \arguments{
   \item{object}{A transfer function object.}
   \item{\dots}{Arguments passed to other methods. Currently ignored.}
 }
-%\details{
-%  ~~ If necessary, more details than the description above ~~
-%}
+\details{
+  \code{performance} is a generic function for use with a number of
+  fitted models objects in \pkg{analogue}. The available methods are:
+
+  \itemize{
+    \item{\code{\link{wa}}}{Weighted Averaging Models.}
+    \item{\code{\link{predict.wa}}}{Predictions from a Weighted Average
+      Model.}
+    \item{\code{\link{pcr}}}{Principal Component Regression models.}
+    \item{\code{\link{bootstrap.wa}}}{Bootstrapped Weighted Averaging
+      Models.}
+    \item{\code{\link{crossval}}}{Cross-validated models fitted via
+      \code{\link{crossval}}.}
+  }
+}
 \value{
   A named vector containing the extracted model performance statistics.
 }


From noreply at r-forge.r-project.org  Fri Feb 14 23:52:27 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Fri, 14 Feb 2014 23:52:27 +0100 (CET)
Subject: [Analogue-commits] r409 - pkg/man
Message-ID: <20140214225228.12B09186A5B@r-forge.r-project.org>

Author: gsimpson
Date: 2014-02-14 23:52:27 +0100 (Fri, 14 Feb 2014)
New Revision: 409

Modified:
   pkg/man/performance.Rd
Log:
minor documentation tweak

Modified: pkg/man/performance.Rd
===================================================================
--- pkg/man/performance.Rd	2014-02-14 22:43:03 UTC (rev 408)
+++ pkg/man/performance.Rd	2014-02-14 22:52:27 UTC (rev 409)
@@ -22,13 +22,13 @@
   fitted models objects in \pkg{analogue}. The available methods are:
 
   \itemize{
-    \item{\code{\link{wa}}}{Weighted Averaging Models.}
-    \item{\code{\link{predict.wa}}}{Predictions from a Weighted Average
+    \item{\code{\link{wa}} }{Weighted Averaging Models.}
+    \item{\code{\link{predict.wa}} }{Predictions from a Weighted Average
       Model.}
-    \item{\code{\link{pcr}}}{Principal Component Regression models.}
-    \item{\code{\link{bootstrap.wa}}}{Bootstrapped Weighted Averaging
+    \item{\code{\link{pcr}} }{Principal Component Regression models.}
+    \item{\code{\link{bootstrap.wa}} }{Bootstrapped Weighted Averaging
       Models.}
-    \item{\code{\link{crossval}}}{Cross-validated models fitted via
+    \item{\code{\link{crossval}} }{Cross-validated models fitted via
       \code{\link{crossval}}.}
   }
 }


From noreply at r-forge.r-project.org  Fri Feb 14 23:58:40 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Fri, 14 Feb 2014 23:58:40 +0100 (CET)
Subject: [Analogue-commits] r410 - pkg/R
Message-ID: <20140214225841.0D820186ED3@r-forge.r-project.org>

Author: gsimpson
Date: 2014-02-14 23:58:40 +0100 (Fri, 14 Feb 2014)
New Revision: 410

Modified:
   pkg/R/pcr.R
Log:
ChiSquare function wasn't returning the list it generated

Modified: pkg/R/pcr.R
===================================================================
--- pkg/R/pcr.R	2014-02-14 22:52:27 UTC (rev 409)
+++ pkg/R/pcr.R	2014-02-14 22:58:40 UTC (rev 410)
@@ -164,7 +164,7 @@
         res <- list(data = sqrt(gsum) * x/outer(rsum, sqrt(csum)),
                     parms = list(gsum = gsum, rsum = rsum, csum = csum))
     }
-    x
+    res ##return
 }
 
 `print.pcr` <- function(x, digits = min(getOption("digits"), 4), ...) {


From noreply at r-forge.r-project.org  Sat Feb 15 00:00:41 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sat, 15 Feb 2014 00:00:41 +0100 (CET)
Subject: [Analogue-commits] r411 - pkg/inst
Message-ID: <20140214230041.22261186EED@r-forge.r-project.org>

Author: gsimpson
Date: 2014-02-15 00:00:39 +0100 (Sat, 15 Feb 2014)
New Revision: 411

Modified:
   pkg/inst/ChangeLog
Log:
document r410

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2014-02-14 22:58:40 UTC (rev 410)
+++ pkg/inst/ChangeLog	2014-02-14 23:00:39 UTC (rev 411)
@@ -11,6 +11,9 @@
 	* performance.crossval: A new emthod for objects of class
 	`"crossval"`.
 
+	* ChiSquare: Wasn't returning the list it created including
+	transformation parameters.
+
 Version 0.13-3 Opened 11 Feb 2014
 
 	* timetrack: A number of additions added and improvements made:


From noreply at r-forge.r-project.org  Sat Feb 15 00:07:09 2014
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sat, 15 Feb 2014 00:07:09 +0100 (CET)
Subject: [Analogue-commits] r412 - in pkg: R inst
Message-ID: <20140214230709.B5CB7186F1F@r-forge.r-project.org>

Author: gsimpson
Date: 2014-02-15 00:07:08 +0100 (Sat, 15 Feb 2014)
New Revision: 412

Modified:
   pkg/R/crossval.pcr.R
   pkg/inst/ChangeLog
Log:
the progressbar was resetting between repeats of k-fold CV

Modified: pkg/R/crossval.pcr.R
===================================================================
--- pkg/R/crossval.pcr.R	2014-02-14 23:00:39 UTC (rev 411)
+++ pkg/R/crossval.pcr.R	2014-02-14 23:07:08 UTC (rev 412)
@@ -74,6 +74,7 @@
         pred <- array(NA, dim = c(N, ncomp, folds))
         if(verbose) {
             writeLines("\n   n k-fold Cross-validation:")
+            ii <- 1
             pb <- txtProgressBar(min = 0, max = folds * nfold, style = 3)
             on.exit(close(pb))
             on.exit(cat("\n"), add = TRUE)
@@ -86,8 +87,10 @@
             pind <- ind[sample.int(N, N, replace = FALSE)]
             ## the main k-fold CV loop
             for(k in seq_len(nfold)) {
-                if(verbose)
-                    setTxtProgressBar(pb, i * k)
+                if(verbose) {
+                    setTxtProgressBar(pb, ii)
+                    ii <- ii + 1
+                }
                 sel <- pind == k   ## sel is samples in leave out group
                 N.oob <- sum(sel) ## N in leave out group
                 N.mod <- sum(!sel)  ## N in the model

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2014-02-14 23:00:39 UTC (rev 411)
+++ pkg/inst/ChangeLog	2014-02-14 23:07:08 UTC (rev 412)
@@ -5,6 +5,9 @@
 	* crossval.pcr: Fixed a number of bugs in the method for PCR
 	related to k-fold cross validation, which were causing errors.
 
+	Fix the verbose printing of the progress bar, which would reset
+	between repeats in k-fold CV.
+
 	* predict.pcr: would set argument `ncomp` incorrectly (in the
 	wrong form) if not supplied.