From noreply at r-forge.r-project.org  Wed Dec 11 06:11:28 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed, 11 Dec 2013 06:11:28 +0100 (CET)
Subject: [Analogue-commits] r388 - in pkg: R man
Message-ID: <20131211051129.70B4218131F@r-forge.r-project.org>

Author: gsimpson
Date: 2013-12-11 06:11:28 +0100 (Wed, 11 Dec 2013)
New Revision: 388

Modified:
   pkg/R/crossval.pcr.R
   pkg/R/predict.pcr.R
   pkg/man/predict.pcr.Rd
Log:
updated CV methods

Modified: pkg/R/crossval.pcr.R
===================================================================
--- pkg/R/crossval.pcr.R	2013-11-27 15:45:48 UTC (rev 387)
+++ pkg/R/crossval.pcr.R	2013-12-11 05:11:28 UTC (rev 388)
@@ -21,6 +21,8 @@
             if(ncomp < 1 || ncomp > (newcomp <- min(nr - 1, M))) {
                 warning("'ncomp' inappropriate for LOO CV. Resetting to max possible.")
                 newcomp
+            } else {
+                ncomp
             }
         }
         ## matrix of predictions
@@ -54,7 +56,6 @@
                 pred[i, j] <- Xi %*% FIT$B[, j, drop = FALSE] + B0
             }
         }
-        ##pred <- rowMeans(pred, na.rm = TRUE)
     }
     if(identical(method, "kfold")) {
         ## form ncomp, as k-fold we have ceiling(N / nfold) fewer sites
@@ -65,6 +66,8 @@
             if(ncomp < 1 || ncomp > maxComp) {
                 warning("'ncomp' inappropriate for k-fold CV. Resetting to max possible.")
                 maxComp
+            } else {
+                ncomp
             }
         }
         pred <- array(NA, dim = c(N, ncomp, folds))
@@ -108,17 +111,18 @@
                 }
             }
         }
-        pred <- rowMeans(pred, na.rm = TRUE, dims = 2)
     }
     if(identical(method, "bootstrap")) {
-        ## form ncomp, as k-fold we have ceiling(N / nfold) fewer sites
+        ## form ncomp, as if this was a standard training set setting.
         maxComp <- min(N - 1, M)
         ncomp <- if(missing(ncomp)) {
-            maxComp## uses nr which already has 1 removed
+            maxComp
         } else {
             if(ncomp < 1 || ncomp > maxComp) {
                 warning("'ncomp' inappropriate for bootstrap CV. Resetting to max possible.")
                 maxComp
+            } else {
+                ncomp
             }
         }
         pred <- array(NA, dim = c(N, ncomp, nboot))
@@ -136,28 +140,78 @@
             bSamp <- sample.int(N, N, replace = TRUE)
             sel <- which(!ind %in% bSamp) ## need indices!!!
             N.oob <- NROW(x[sel, , drop = FALSE])
-            N.mod <- N - N.oob ## not sure I need this
+            ##N.mod <- N - N.oob ## not sure I need this
             ## apply transformation to X[-sel, ]
-            TRAN <- obj$tranFun(x[-sel, , drop = FALSE])
+            TRAN <- obj$tranFun(x[bSamp, , drop = FALSE])
             X <- TRAN$data
             ## apply transformation to OOB samples, using parms from above
             Xi <- obj$tranFun(x[sel, , drop = FALSE], apply = TRUE,
                               parms = TRAN$parms)$data
             ## centre the training data
             Xbar <- colMeans(X)
-            ybar <- mean(y[-sel])
+            ybar <- mean(y[bSamp])
             X <- sweep(X, 2, Xbar, "-")
-            Y <- y[-sel] - ybar
+            Y <- y[bSamp] - ybar
             ## fit model to subset
-            FIT <- fitPCR(X = X, Y = Y, ncomp = ncomp, n = N.mod, m = M)
+            FIT <- fitPCR(X = X, Y = Y, ncomp = ncomp, n = N, m = M)
             ## predict for 1:ncomps components
             for(j in nc) {
                 B0 <- obj$yMean - obj$xMeans %*% FIT$B[, j, drop = FALSE]
-                pred[sel, j, i] <- Xi %*% FIT$B[, j, drop = FALSE] + rep(B0, N.oob)
+                pred[sel, j, i] <- Xi %*% FIT$B[, j, drop = FALSE] +
+                    rep(B0, N.oob)
             }
         }
-        pred <- rowMeans(pred, na.rm = TRUE, dims = 2)
     }
-    class(pred) <- "crossval"
-    pred
+
+    ## fitted values and derived stats
+    if(identical(method, "none")) {
+        fitted <- pred
+    } else if(method %in% c("","")) {
+        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)
+    ## 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 <- 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)))
+
+    ## 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,
+                              R2 = r2,
+                              avgBias = avgBias,
+                              maxBias = maxBias,
+                              RMSEP = rmsep,
+                              RMSEP2 = rmsep2,
+                              s1 = s1,
+                              s2 = s2)
+
+    ## more additions to the call
+    .call <- match.call()
+    .call[[1]] <- as.name("crossval")
+
+    ## return object
+    out <- list(fitted.values = fitted,
+                residuals = residuals,
+                rmsep = rmsep.train,
+                s1 = s1.train,
+                s2 = s2.train,
+                performance = performance,
+                call = .call,
+                CVparams = list(method = method, nboot = nboot,
+                nfold = nfold, folds = folds))
+
+    class(out) <- "crossval"
+    out
 }

Modified: pkg/R/predict.pcr.R
===================================================================
--- pkg/R/predict.pcr.R	2013-11-27 15:45:48 UTC (rev 387)
+++ pkg/R/predict.pcr.R	2013-12-11 05:11:28 UTC (rev 388)
@@ -1,7 +1,12 @@
 `predict.pcr` <- function(object, newdata, ncomp = seq_along(object$ncomp),
-                          CV = c("none", "LOO", "bootstrap", "nfold"),
-                          verbose = FALSE, nboot = 100, nfold = 5,
-                          ...) {
+                          CV = c("none", "LOO", "bootstrap", "kfold"),
+                          verbose = FALSE, nboot = 100, kfold = 10,
+                          folds = 5, ...) {
+    takeData <- function(x, new) {
+        want <- (spp.names <- colnames(x$data$x)) %in% colnames(new)
+        want <- spp.names[want]
+        new[, want, drop = FALSE]
+    }
     if(missing(newdata))
         return(fitted(object))
     ## store names of new samples
@@ -10,28 +15,165 @@
     if (missing(CV))
         CV <- "none"
     CV <- match.arg(CV)
-    Np <- NROW(newdata)
-    B <- coef(object)
+    Nnew <- NROW(newdata)
+    N <- nrow(object$data$x)
+    M <- ncol(object$data$x)
+
+    ind <- seq_len(N) ## indicator for samples
+
+    ## extract the training data & transformation fun
+    trainX <- object$data$x
+    trainY <- object$data$y
+    tranFun <- object$tranFun
+
     if(identical(CV, "none")) {
-        want <- (spp.names <- colnames(object$data$x)) %in% colnames(newdata)
-        want <- spp.names[want]
-        newdata <- newdata[, want, drop = FALSE]
+        B <- coef(object)
+        newdata <- takeData(object, newdata)
         ## apply transformation to newdata
         tf <- object$tranFun(newdata)
         newdata <- tf$data
         ## do predictions
         ## matrix of predictions
-        pred <- matrix(ncol = length(ncomp), nrow = Np)
-        for(j in seq_along(ncomp)) {
-            comp <- ncomp[j]
-            B0 <- object$yMean - object$xMeans %*% B[, comp]
-            pred[, j] <- newdata %*% B[, comp] + rep(B0, Np)
+        pred <- matrix(ncol = ncomp, nrow = Nnew)
+        for(j in seq_len(ncomp)) {
+            B0 <- object$yMean - object$xMeans %*% B[, j]
+            pred[, j] <- newdata %*% B[, j] + rep(B0, Nnew)
         }
-    } else {
-        stop("Other methods of crossvalidation not yet implemented")
+    } else if (identical(CV, "LOO")) {
+        nr <- N-1 ## for LOO
+        M <- ncol(object$data$x)
+        ## form ncomp, as LOO we have potentially 1 less component than usual
+        ncomp <- if(missing(ncomp)) {
+            min(nr - 1, M) ## uses nr which already has 1 removed
+        } else {
+            if(ncomp < 1 || ncomp > (newcomp <- min(nr - 1, M))) {
+                warning("'ncomp' inappropriate for LOO CV.
+Resetting to max possible.")
+                newcomp
+            } else {
+                ncomp
+            }
+        }
+
+        pred <- array(NA, dim = c(Nnew, ncomp, N))
+        comps <- seq_len(ncomp)
+
+        for (i in seq_len(N)) {
+            ## which samples are in the training set
+            loo <- ind[-i]
+
+            ## do the heavy lifting
+            pred[, , i] <-
+                pcrCVfit(trainX, trainY, tf = tranFun, newdata,
+                         parray = pred[, , i], take = loo,
+                         N = nr, Nnew = Nnew, M = M, ncomp = ncomp,
+                         comps = comps)
+        }
+        fitted <- rowMeans(pred, na.rm = TRUE, dims = 2)
+        ## other computations on `pred` needed for SEs etc
+        pred <- fitted
+    } else if (identical(CV, "bootstrap")) {
+        ## form ncomp, as if this was a standard training set setting.
+        maxComp <- min(N - 1, M)
+        ncomp <- if(missing(ncomp)) {
+            maxComp
+        } else {
+            if(ncomp < 1 || ncomp > maxComp) {
+                warning("'ncomp' inappropriate for bootstrap CV.
+Resetting to max possible.")
+                maxComp
+            } else {
+                ncomp
+            }
+        }
+
+        pred <- array(NA, dim = c(Nnew, ncomp, nboot))
+        comps <- seq_len(ncomp)
+
+        for (i in seq_len(nboot)) {
+            bSamp <- sample.int(N, N, replace = TRUE)
+
+            ## do the heavy lifting
+            pred[, , i] <-
+                pcrCVfit(trainX, trainY, tf = tranFun, newdata,
+                         parray = pred[, , i], take = bSamp,
+                         N = N, Nnew = Nnew, M = M, ncomp = ncomp,
+                         comps = comps)
+        }
+        fitted <- rowMeans(pred, na.rm = TRUE, dims = 2)
+        ## other computations on `pred` needed for SEs etc
+        pred <- fitted
+    } else if (identical(CV, "kfold")) {
+        ## form ncomp, as k-fold we have ceiling(N / nfold) fewer sites
+        maxComp <- min((N - ceiling(N / kfold)) - 1, M)
+        ncomp <- if(missing(ncomp)) {
+            maxComp## uses nr which already has 1 removed
+        } else {
+            if(ncomp < 1 || ncomp > maxComp) {
+                warning("'ncomp' inappropriate for k-fold CV.
+Resetting to max possible.")
+                maxComp
+            } else {
+                ncomp
+            }
+        }
+
+        comps <- seq_len(ncomp)
+
+        ## array for prediction
+        pred <- array(NA, dim = c(Nnew, ncomp, folds, kfold))
+        ind <- rep(seq_len(kfold), length = N) ## k-fold group indicator
+
+        ## this is the n in n k-fold CV, allowing n repeated k-folds
+        ##ii <- 0
+        for(i in seq_len(folds)) {
+            ## do a k-fold CV
+            pind <- ind[sample.int(N, N, replace = FALSE)]
+            ## the main k-fold CV loop
+            for(k in seq_len(kfold)) {
+                ##ii <- ii + 1
+                kSamp <- pind != k
+                Nk <- sum(kSamp) ## number of samples in training set
+                kSamp <- which(kSamp)
+
+                ## do the heavy lifting
+                pred[, , i, k] <-
+                    pcrCVfit(trainX, trainY, tf = tranFun,
+                             newdata, parray = pred[, , i, k],
+                             take = kSamp, N = Nk, Nnew = Nnew,
+                             M = M, ncomp = ncomp, comps = comps)
+            }
+        }
+        fitted <- rowMeans(pred, na.rm = TRUE, dims = 2)
+        ## other computations on `pred` needed for SEs etc
+        pred <- fitted
+    }else {
+        stop("Unknown crossvalidation method.")
     }
     rownames(pred) <- newSamp
-    colnames(pred) <- paste0("PC", ncomp)
+    colnames(pred) <- paste0("PC", seq_len(ncomp))
     pred
 }
 
+## take is a vector of indices for samples to include in the training
+## set during prediction
+`pcrCVfit` <- function(X, Y, tf, newdata, parray, take, N, Nnew, M,
+                       ncomp, comps) {
+    ## apply transformation to training data
+    TRAN <- tf(X[take, , drop = FALSE])
+    X <- TRAN$data
+    ## apply transformation to newdata, using parms from above
+    Xnew <- tf(newdata, apply = TRUE, parms = TRAN$parms)$data
+    ## centre the training data
+    Xbar <- colMeans(X)
+    ybar <- mean(Y[take])
+    X <- sweep(X, 2, Xbar, "-")
+    Y <- Y[take] - ybar
+    ## fit model to subset
+    FIT <- analogue:::fitPCR(X = X, Y = Y, ncomp = ncomp, n = N, m = M)
+    for(j in comps) {
+        B0 <- ybar - Xbar %*% FIT$B[, j]
+        parray[ , j] <- Xnew %*% FIT$B[, j] + rep(B0, Nnew)
+    }
+    parray
+}

Modified: pkg/man/predict.pcr.Rd
===================================================================
--- pkg/man/predict.pcr.Rd	2013-11-27 15:45:48 UTC (rev 387)
+++ pkg/man/predict.pcr.Rd	2013-12-11 05:11:28 UTC (rev 388)
@@ -5,14 +5,15 @@
 
 \description{
   Calculates predicted values from a fitted principal components
-  regression model. Leave-one-out, bootstrap of n-fold crossvalidated
-  predictions are also intended (but not yet implemented).
+  regression model. Leave-one-out, bootstrap or n k-fold crossvalidated
+  predictions are also implemented.
 }
 
 \usage{
 \method{predict}{pcr}(object, newdata, ncomp = seq_along(object$ncomp),
-        CV = c("none", "LOO", "bootstrap", "nfold"),
-        verbose = FALSE, nboot = 100, nfold = 5, \dots)
+        CV = c("none", "LOO", "bootstrap", "kfold"),
+        verbose = FALSE, nboot = 100, kfold = 10, folds = 5,
+        \dots)
 }
 
 \arguments{
@@ -21,16 +22,15 @@
   \item{newdata}{data frame of new observations for which predictions
     are sought.}
   \item{ncomp}{numeric; the PCR components for which predictions are
-    sought. Can be a vector in which case predictions for multiple
-    components are computed.}
+    sought. If \code{ncomp = c}, predictions for components \code{1:c}
+    are produced.}
   \item{CV}{character; the type of crossvalidation required. Currently,
     no crossvalidation methods are implemented.}
   \item{verbose}{logical; should progress on crossvalidation be printed
     to the console?}
-  \item{nboot}{numeric; the number of bootstrap samples to draw, or in
-    the case of \code{CV = "nfold"} the number of repeats of n-fold CV
-    to perform.}
-  \item{nfold}{numeric; the number of folds to split data into.}
+  \item{nboot}{numeric; the number of bootstrap samples to draw.}
+  \item{kfold}{numeric; the number of folds to split data into.}
+  \item{folds}{numeric; the number of repetitions of k-fold CV.}
   \item{\dots}{arguments passed to other methods.}
 }
 
@@ -63,7 +63,12 @@
 mod <- pcr(ImbrieKipp[-take, ], SumSST[-take], tranFun = Hellinger)
 
 ## predictions
-predict(mod, ImbrieKipp[take, ], ncomp = 1:4)
+predict(mod, ImbrieKipp[take, ], ncomp = 4)
 
+## predictions
+set.seed(123)
+predict(mod, ImbrieKipp[take, ], ncomp = 4, CV = "bootstrap",
+        nboot = 100)
+
 }
 \keyword{methods}
\ No newline at end of file


From noreply at r-forge.r-project.org  Wed Dec 11 06:19:37 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed, 11 Dec 2013 06:19:37 +0100 (CET)
Subject: [Analogue-commits] r389 - pkg/inst
Message-ID: <20131211051937.66165185E0A@r-forge.r-project.org>

Author: gsimpson
Date: 2013-12-11 06:19:36 +0100 (Wed, 11 Dec 2013)
New Revision: 389

Modified:
   pkg/inst/ChangeLog
Log:
document changes to predict and crossval methods for class "pcr"

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2013-12-11 05:11:28 UTC (rev 388)
+++ pkg/inst/ChangeLog	2013-12-11 05:19:36 UTC (rev 389)
@@ -20,11 +20,11 @@
 	are effectively 0. Only affects vectors of performance statistics
 	not data frames of stats.
 
-	* predict.pcr: Apply transformation function and stop is any form
-	of crossvalidation is selected (as not yet implemented).
+	* predict.pcr: Apply transformation function and perform
+	predictions for LOO, n k-fold, and bootstrap predictions
 
 	* crossval.pcr: leave-one-out CV was incorrectly averaging over
-	components.
+	components. Now does bootstrap and n k-fold CV.
 
 Version 0.11-5
 


From noreply at r-forge.r-project.org  Wed Dec 11 15:23:00 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed, 11 Dec 2013 15:23:00 +0100 (CET)
Subject: [Analogue-commits] r390 - pkg
Message-ID: <20131211142300.F19C118535F@r-forge.r-project.org>

Author: gsimpson
Date: 2013-12-11 15:22:59 +0100 (Wed, 11 Dec 2013)
New Revision: 390

Removed:
   pkg/test
Log:
remove the stupid test file the R-forge people polluted my source tree with

Deleted: pkg/test
===================================================================

From noreply at r-forge.r-project.org  Fri Dec 13 05:08:51 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Fri, 13 Dec 2013 05:08:51 +0100 (CET)
Subject: [Analogue-commits] r391 - pkg/man
Message-ID: <20131213040851.E7486186B99@r-forge.r-project.org>

Author: gsimpson
Date: 2013-12-13 05:08:51 +0100 (Fri, 13 Dec 2013)
New Revision: 391

Modified:
   pkg/man/analogue-package.Rd
Log:
update the package documentation page

Modified: pkg/man/analogue-package.Rd
===================================================================
--- pkg/man/analogue-package.Rd	2013-12-11 14:22:59 UTC (rev 390)
+++ pkg/man/analogue-package.Rd	2013-12-13 04:08:51 UTC (rev 391)
@@ -3,72 +3,149 @@
 \alias{analogue}
 \docType{package}
 \title{
-Analogue methods for palaeoecology
+Analogue and weighted averaging methods for palaeoecology
 }
 \description{
-Fits Modern Analogue Technique transfer function models
-for prediction of environmental data from species data. Also
-performs analogue matching, a related technique used in palaeo
-ecological restoration.
+Fits Modern Analogue Technique and Weighted Averaging transfer 
+  	     function models for prediction of environmental data from species 
+	     data, and related methods used in palaeoecology.
 }
 \details{
 \tabular{ll}{
 Package: \tab analogue\cr
 Type: \tab Package\cr
-Version: \tab 0.4-3\cr
-Date: \tab 2007-09-15\cr
-Depends: \tab R (>= 2.5.0), stats, graphics, vegan\cr
-License: \tab GPL Version 2\cr
-Built: \tab R 2.5.1; ; 2007-08-03 13:44:47; unix\cr
+Version: \tab 0.11-6\cr
+Date: \tab $Date: 2013-10-05 15:11:52 -0600 (Sat, 05 Oct 2013) $\cr
+Depends: \tab R (>= 2.15.0), vegan (>= 1.17-12), lattice, rgl\cr
+Imports: \tab mgcv, MASS, stats, graphics, grid, brglm, princurve\cr
+Suggests: \tab testthat\cr
+Authors at R: \tab c(person(given = c("Gavin", "L."), family = "Simpson",
+                    role = c("aut", "cre"),
+                    email = "ucfagls at gmail.com"),
+             person(given = "Jari", family = "Oksanen",
+                    role = "aut"))\cr
+BugReports: \tab 
+http://r-forge.r-project.org/tracker/?func=browse&group_id=69&atid=338\cr
+NeedsCompilation: \tab yes\cr
+License: \tab GPL-2\cr
+ByteCompile: \tab true\cr
+URL: \tab http://analogue.r-forge.r-project.org\cr
+Packaged: \tab 2013-10-14 20:41:41 UTC; gavin\cr
+Built: \tab R 3.0.2; x86_64-unknown-linux-gnu; 2013-10-14 20:41:48 UTC; unix\cr
 }
 
 Index:
 \preformatted{
+ImbrieKipp              Imbrie and Kipp foraminifera training set
+Pollen                  North American Modern Pollen Database
 RMSEP                   Root mean square error of prediction
+Stratiplot              Palaeoecological stratigraphic diagrams
+abernethy               Abernethy Forest Pollen Sequence
 analog                  Analogue matching
 analogue-package        Analogue methods for palaeoecology
 bayesF                  Bayes factors
 bootstrap               Bootstrap estimation and errors
+bootstrap.wa            Bootstrap estimation and errors for WA models
 bootstrapObject         Bootstrap object description
+caterpillarPlot         Caterpillar plot of species' WA optima and
+                        tolerance range.
+chooseTaxa              Select taxa (variables) on basis of maximum
+                        abundance attained and number of occurrences.
 cma                     Close modern analogues
+crossval                Cross-validation of palaeoecological transfer
+                        function models
+densityplot.residLen    Lattice density plot for residual lengths
+deshrink                Deshrinking techniques for WA transfer
+                        functions
 dissimilarities         Extract dissimilarity coefficients from models
 distance                Flexibly calculate dissimilarity or distance
                         measures
+fitted.logitreg         Fitted values for the training set from
+                        logistic regression models
+fuse                    Fused dissimilarities
 getK                    Extract and set the number of analogues
+gradientDist            Positions of samples along a unit-length
+                        ordination gradient.
+hist.residLen           Histogram plot for residual lengths
+histogram.residLen      Lattice histogram plot for residual lengths
 join                    Merge species data sets on common columns
                         (species)
+logitreg                Logistic regression models for assessing
+                        analogues/non-analogues
 mat                     Modern Analogue Technique transfer function
                         models
 mcarlo                  Monte Carlo simulation of dissimilarities
 minDC                   Extract minimum dissimilarities
-plot.bayesF             Bayes factor plots
+optima                  Weighted averaging optima and tolerance ranges
+panel.Loess             Loess smooths to stratigraphic diagrams
+panel.Stratiplot        Panel function for stratigraphic diagrams
+pcr                     Prinicpal component regression transfer
+                        function models
+performance             Transfer function model performance statistics
 plot.dissimilarities    Plots the distribution of extracted
                         dissimilarities
+plot.logitreg           Produces plots of analogue logistic regression
+                        models
 plot.mat                Plot diagnostics for a mat object
-plot.mcarlo             Plott Monte Carlo simulated dissimilarity
+plot.mcarlo             Plot Monte Carlo simulated dissimilarity
                         distributions
 plot.minDC              Plot of minimum dissimilarity per sample
+plot.prcurve            Plot a fitted principal curve in PCA space
+plot.residLen           Plot method for residual lengths
 plot.roc                Plot ROC curves and associated diagnostics
+plot.wa                 Plot diagnostics for a weighted averaging model
+plot3d.prcurve          Interactive 3D plof of a principal curve in
+                        principal coordinate space
+prcurve                 Fits a principal curve to m-dimensional data
+predict.logitreg        Posterior probability of analogue-ness for
+                        fossil samples
 predict.mat             Predict method for Modern Analogue Technique
                         models
+predict.pcr             Predicted values from a principal components
+                        regression
+predict.wa              Predict from a weighted average model
+rankDC                  Rank correlation between environmental and
+                        species dissimilarities.
 reconPlot               Stratigraphic plots of palaeoenvironmental
                         reconstructions
+residLen                Squared residual length diagnostics
+residuals.prcurve       Residuals of a principal curve fit.
 rlgh                    Round Loch of Glenhead Diatoms
 roc                     ROC curve analysis
+scores.prcurve          'scores' method for principal curve objects of
+                        class '"prcurve"'.
 screeplot.mat           Screeplots of model results
+smoothSpline            Smoother plugin function for use in fitting a
+                        principal curve
+splitSample             Select samples from along an environmental
+                        gradient
+sppResponse             Species responses along gradients.
+stdError                Standard error of MAT fitted and predicted
+                        values
 summary.analog          Summarise analogue matching results
 summary.bootstrap.mat   Summarise bootstrap resampling for MAT models
 summary.cma             Summarise the extraction of close modern
                         analogues
 summary.mat             Summarise Modern Analogue Technique models
 summary.predict.mat     Summarise MAT model predictions
-swapdiat                SWAP sub-fossil diatom training set
-swappH                  SWAP pH training set
+swapdiat                SWAP sub-fossil diatom and pH training set
+swappH                  SWAP sub-fossil diatom and pH training set
+timetrack               Timetracks of change in species composition
+tran                    Common data transformations and
+                        standardizations
+varExpl                 Variance explained by ordination axes
+wa                      Weighted averaging transfer functions
+weightedCor             Weighted correlation test of WA reconstruction
 }
+
+Further information is available in the following vignettes:
+\tabular{ll}{
+\code{analogue_methods} \tab Analogue Methods in Palaeoecology (source, pdf)\cr
 }
+}
 \author{
-Gavin L. Simpson.
+Gavin L. Simpson, Jari Oksanen
 
-Maintainer: Gavin L. Simpson <gavin.simpson at ucl.ac.uk>
+Maintainer: Gavin L. Simpson <ucfagls at gmail.com>
 }
 \keyword{ package }


From noreply at r-forge.r-project.org  Fri Dec 13 06:35:21 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Fri, 13 Dec 2013 06:35:21 +0100 (CET)
Subject: [Analogue-commits] r392 - in pkg: . inst man tests/Examples
Message-ID: <20131213053521.331E91869FE@r-forge.r-project.org>

Author: gsimpson
Date: 2013-12-13 06:35:20 +0100 (Fri, 13 Dec 2013)
New Revision: 392

Modified:
   pkg/DESCRIPTION
   pkg/inst/ChangeLog
   pkg/man/analogue-package.Rd
   pkg/tests/Examples/analogue-Ex.Rout.save
Log:
prepare for 0.12-0 release; update reference material, bump to 0.11-99

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2013-12-13 04:08:51 UTC (rev 391)
+++ pkg/DESCRIPTION	2013-12-13 05:35:20 UTC (rev 392)
@@ -1,7 +1,7 @@
 Package: analogue
 Type: Package
 Title: Analogue and weighted averaging methods for palaeoecology
-Version: 0.11-6
+Version: 0.11-99
 Date: $Date$
 Depends: R (>= 2.15.0), vegan (>= 1.17-12), lattice, rgl
 Imports: mgcv, MASS, stats, graphics, grid, brglm, princurve

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2013-12-13 04:08:51 UTC (rev 391)
+++ pkg/inst/ChangeLog	2013-12-13 05:35:20 UTC (rev 392)
@@ -1,5 +1,9 @@
 analogue Change Log
 
+Version 0.11-99
+
+	* Preparing for the 0.12-0 release.
+
 Version 0.11-6
 
 	* distance3: removed - redundant attempt to improve `distance()`.

Modified: pkg/man/analogue-package.Rd
===================================================================
--- pkg/man/analogue-package.Rd	2013-12-13 04:08:51 UTC (rev 391)
+++ pkg/man/analogue-package.Rd	2013-12-13 05:35:20 UTC (rev 392)
@@ -14,7 +14,7 @@
 \tabular{ll}{
 Package: \tab analogue\cr
 Type: \tab Package\cr
-Version: \tab 0.11-6\cr
+Version: \tab 0.11-99\cr
 Date: \tab $Date: 2013-10-05 15:11:52 -0600 (Sat, 05 Oct 2013) $\cr
 Depends: \tab R (>= 2.15.0), vegan (>= 1.17-12), lattice, rgl\cr
 Imports: \tab mgcv, MASS, stats, graphics, grid, brglm, princurve\cr
@@ -30,8 +30,8 @@
 License: \tab GPL-2\cr
 ByteCompile: \tab true\cr
 URL: \tab http://analogue.r-forge.r-project.org\cr
-Packaged: \tab 2013-10-14 20:41:41 UTC; gavin\cr
-Built: \tab R 3.0.2; x86_64-unknown-linux-gnu; 2013-10-14 20:41:48 UTC; unix\cr
+Packaged: \tab 2013-12-13 05:23:57 UTC; gavin\cr
+Built: \tab R 3.0.2; x86_64-unknown-linux-gnu; 2013-12-13 05:27:27 UTC; unix\cr
 }
 
 Index:
@@ -42,7 +42,8 @@
 Stratiplot              Palaeoecological stratigraphic diagrams
 abernethy               Abernethy Forest Pollen Sequence
 analog                  Analogue matching
-analogue-package        Analogue methods for palaeoecology
+analogue-package        Analogue and weighted averaging methods for
+                        palaeoecology
 bayesF                  Bayes factors
 bootstrap               Bootstrap estimation and errors
 bootstrap.wa            Bootstrap estimation and errors for WA models

Modified: pkg/tests/Examples/analogue-Ex.Rout.save
===================================================================
--- pkg/tests/Examples/analogue-Ex.Rout.save	2013-12-13 04:08:51 UTC (rev 391)
+++ pkg/tests/Examples/analogue-Ex.Rout.save	2013-12-13 05:35:20 UTC (rev 392)
@@ -24,9 +24,9 @@
 Loading required package: vegan
 Loading required package: permute
 Loading required package: lattice
-This is vegan 2.0-9
+This is vegan 2.0-10
 Loading required package: rgl
-This is analogue 0.11-6
+This is analogue 0.11-99
 > 
 > base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')
 > cleanEx()
@@ -5749,7 +5749,7 @@
 > mod <- pcr(ImbrieKipp[-take, ], SumSST[-take], tranFun = Hellinger)
 > 
 > ## predictions
-> predict(mod, ImbrieKipp[take, ], ncomp = 1:4)
+> predict(mod, ImbrieKipp[take, ], ncomp = 4)
              PC1       PC2       PC3       PC4
 V14.47  10.34383  8.964025  8.816845  8.700079
 V20.7   28.37448 26.720456 26.781783 26.619102
@@ -5762,9 +5762,25 @@
 V23.29  11.45795 11.373413 11.816852 12.136959
 A180.76 28.15434 26.970442 27.221069 27.230316
 > 
+> ## predictions
+> set.seed(123)
+> predict(mod, ImbrieKipp[take, ], ncomp = 4, CV = "bootstrap",
++         nboot = 100)
+             PC1       PC2       PC3       PC4
+V14.47  10.86146  9.108554  8.796106  8.721006
+V20.7   27.93000 26.680977 26.738630 26.619345
+V12.18  26.09875 26.452455 26.273816 26.340640
+V15.164 28.31861 27.344207 27.415372 27.455231
+V22.204 26.44229 26.237016 26.479955 26.523139
+V19.222 22.69438 23.664213 23.651692 23.626940
+V16.189 26.56779 26.665168 26.550892 26.443218
+V20.230 27.67475 26.752244 27.058222 27.096922
+V23.29  12.11350 11.412378 11.789892 12.165228
+A180.76 27.79627 26.907033 27.191718 27.251444
 > 
 > 
 > 
+> 
 > cleanEx()
 > nameEx("predict.wa")
 > ### * predict.wa
@@ -7300,9 +7316,9 @@
 Call: rda(X = X, Y = mf)
 
               Inertia Proportion Rank
-Total         0.61631    1.00000     
-Constrained   0.09743    0.15808    1
-Unconstrained 0.51888    0.84192  165
+Total          0.6163     1.0000     
+Constrained    0.0974     0.1581    1
+Unconstrained  0.5189     0.8419  165
 Inertia is variance 
 
 Eigenvalues for constrained axes:
@@ -7767,7 +7783,7 @@
 > ###
 > options(digits = 7L)
 > base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed:  23.269 0.335 24.256 0.001 0.003 
+Time elapsed:  22.285 0.434 23.459 0.001 0.003 
 > grDevices::dev.off()
 null device 
           1 


From noreply at r-forge.r-project.org  Fri Dec 13 22:08:43 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Fri, 13 Dec 2013 22:08:43 +0100 (CET)
Subject: [Analogue-commits] r393 - pkg/inst
Message-ID: <20131213210843.7CC2B186B6E@r-forge.r-project.org>

Author: gsimpson
Date: 2013-12-13 22:08:43 +0100 (Fri, 13 Dec 2013)
New Revision: 393

Added:
   pkg/inst/NEWS.Rd
Modified:
   pkg/inst/ChangeLog
Log:
add a NEWS.Rd file containing highlights on the upcoming 0.12-0 release

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2013-12-13 05:35:20 UTC (rev 392)
+++ pkg/inst/ChangeLog	2013-12-13 21:08:43 UTC (rev 393)
@@ -4,6 +4,9 @@
 
 	* Preparing for the 0.12-0 release.
 
+	* NEWS: analogue now has an `inst/NEWS.Rd` file highlight the major
+	changes in the upcoming 0.12-0 release.
+
 Version 0.11-6
 
 	* distance3: removed - redundant attempt to improve `distance()`.

Added: pkg/inst/NEWS.Rd
===================================================================
--- pkg/inst/NEWS.Rd	                        (rev 0)
+++ pkg/inst/NEWS.Rd	2013-12-13 21:08:43 UTC (rev 393)
@@ -0,0 +1,148 @@
+\name{NEWS}
+\title{Latest changes to the \pkg{analogue} package}
+\encoding{UTF-8}
+
+\section{Changes in version 0.12-0}{
+
+  \subsection{General summary}{
+
+    \itemize{
+      \item Version 0.12-0 represents a major update of \pkg{analogue},
+      including the addition of new functionality and long-required
+      improvements to the computation of dissimilarity matrices which
+      now uses faster C code.
+
+      \item Several of the dependencies are now only imported into the
+      namespace for \pkg{analogue}. As a result, existing code that did
+      not already load these packages will need to be updated to load
+      them via a call to \code{library()}.
+
+      \item Highlights of the release are listed below. For a full
+      record of changes made during the development leading up to this
+      release see the ChangeLog in the package sources.
+    }
+
+  } % general
+
+  \subsection{New Features}{
+
+    \itemize{
+      \item Dissimilarities are now computed using fast C code in
+      function \code{distance()}. The new functions are tested against
+      the old code (now available as function \code{oldDistance()}) to
+      ensure the new code performs correctly.
+
+      \item Fitting principal curves to palaeo data and working with the
+      fitted objects is now much easier.
+
+      \code{prcurve()} now returns each of the fitted smooth models as
+      part of component \code{smooths}, allowing further examination of
+      the the individual fits.
+
+      There are now methods for \code{lines()} and \code{points} to
+      allow greater flexibility in producing plots of the fitted
+      principal curve. A \code{scores()} method to extract ordination
+      scores for prcinipal curves is also available. A \code{resid()}
+      method is also available to return various types of residuals for
+      the principal curve.
+
+      \code{smoothGAM()} is a new plugin smoother function for use with
+      \code{prcurve()}, which allows GAMs to be used as smoothers fitted
+      to individual variables. It is significantly slower than
+      \code{smoothSpline()}, but can handle non-Gaussian responses. The
+      underlying models are fitted using \code{gam()} from \pkg{mgcv}.
+
+      As principal curves are smooth curves in high-dimensions it makes
+      sense to view them in 3D. \pkg{analogue} has a function for that:
+      the \code{plot3d.prcurve()} method uses the underlying
+      functionality of the \pkg{rgl} package to provide an interactive
+      3D representation of the data and the fitted principal curve.
+
+      \code{prcurve()} also returns the fitted ordination and the
+      original data, making it much easier to predict where passive
+      samples should lay and simpler to plot the curve.
+
+      \item New function (and S3 generic), \code{sppResponse()} for
+      species responses along gradients. Currently the only supplied
+      method is for the results of \code{prcurve()} fits, where the
+      function returns the fitted response curves along the principal
+      curve. A \code{plot()} method is also available.
+
+      \item \code{logitreg()} can now fit the logistic regression via
+      Firth's bias reduction method. This helps in cases where there is
+      complete or quasi-complete separation, and for cases where there
+      are far more no-analogues than analogues.
+
+      \item This release sees much improved functionality for fitting
+      principal component regression calibration models where the data
+      are subject to an "ecologically meaningful" transformation (such
+      as the Hellinger transformation). Models fitted with \code{pcr()}
+      can be cross-validated using the new \code{crossval()} method, and
+      predictions from the fitted model can be computed using the
+      \code{predict()} method. Both ensure that the transformation is
+      applied to the test or new data samples in the appropriate manner.
+
+      \item New function \code{rankDC()} to compute the rank correlation
+      between gradient distances (e.g. environmental variables) and
+      distances in species composition. Has both base and Lattice
+      graphics plot methods (the latter via \code{dotplot()}).
+
+      \item \code{Stratiplot()} gains two new arguments: \code{labelAt}
+      and \code{labelRot}, which allows control of the placement and
+      rotation of variable labels on the panels of the plot when not
+      using the strip.
+
+      \item The \code{plot()} method for \code{timetrack()} now allows
+      the plotting of linear combination or weighted average site
+      scores.
+
+      \item The \code{fitted()} method for \code{timetrack()} now has
+      argument \code{which}, replacing the original \code{type}.
+
+      \item There is a new \code{scores()} method for objects eturned by
+      \code{timetrack()}.
+
+      \item \code{analog()} gains a method allowing it to work directly
+      on objects of class \code{"distance"}, as returned by
+      \code{distance()}. This avoids recomputing the dissimilarity
+      matrix if a suitable one is already available.
+    }
+
+  } % new features
+
+  \subsection{Bug Fixes}{
+
+    \itemize{
+      \item \code{chooseTaxa()} no longer drops empty dimensions if the
+      conditions supplied result in a single species being
+      returned. Reported by Michael Burstert.
+
+      A warning about presence of \code{NA}s when \code{na.rm = TRUE}
+      was supplied is also fixed.
+
+      \item The \code{formula} method of \code{timetrack()} was not
+      well-implemented for various reasons, and could result in the
+      species data not being transformed and other mistakes.
+
+      The new code takes a one-sided formula describing the constraints
+      for the underlying ordination, and variables in this formula will
+      be searched for in the data frame supplied as argument \code{env}.
+
+      \item \code{predict.wa()} would sometimes produce a 1-column
+      matrix during the deshrinking step, which would result in an
+      error. This empty dimension is now dropped so that a vector is
+      always returned from the deshrinking function.
+  
+    }
+    
+  } % deprecated
+
+  %% \subsection{DEPRECATED}{
+
+  %%   \itemize{
+  %%     \item
+  
+  %%   }
+    
+  %% } % deprecated
+}
\ No newline at end of file


From noreply at r-forge.r-project.org  Sat Dec 14 03:28:59 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sat, 14 Dec 2013 03:28:59 +0100 (CET)
Subject: [Analogue-commits] r394 - in pkg: . inst tests/Examples
Message-ID: <20131214022859.93F0C1865BF@r-forge.r-project.org>

Author: gsimpson
Date: 2013-12-14 03:28:57 +0100 (Sat, 14 Dec 2013)
New Revision: 394

Modified:
   pkg/DESCRIPTION
   pkg/inst/ChangeLog
   pkg/tests/Examples/analogue-Ex.Rout.save
Log:
wrap up the 0.12-0 release for CRAN & submit

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2013-12-13 21:08:43 UTC (rev 393)
+++ pkg/DESCRIPTION	2013-12-14 02:28:57 UTC (rev 394)
@@ -1,7 +1,7 @@
 Package: analogue
 Type: Package
 Title: Analogue and weighted averaging methods for palaeoecology
-Version: 0.11-99
+Version: 0.12-0
 Date: $Date$
 Depends: R (>= 2.15.0), vegan (>= 1.17-12), lattice, rgl
 Imports: mgcv, MASS, stats, graphics, grid, brglm, princurve

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2013-12-13 21:08:43 UTC (rev 393)
+++ pkg/inst/ChangeLog	2013-12-14 02:28:57 UTC (rev 394)
@@ -1,5 +1,9 @@
 analogue Change Log
 
+Version 0.12-0
+
+	* Released to CRAN December 13th 2013
+
 Version 0.11-99
 
 	* Preparing for the 0.12-0 release.

Modified: pkg/tests/Examples/analogue-Ex.Rout.save
===================================================================
--- pkg/tests/Examples/analogue-Ex.Rout.save	2013-12-13 21:08:43 UTC (rev 393)
+++ pkg/tests/Examples/analogue-Ex.Rout.save	2013-12-14 02:28:57 UTC (rev 394)
@@ -26,7 +26,7 @@
 Loading required package: lattice
 This is vegan 2.0-10
 Loading required package: rgl
-This is analogue 0.11-99
+This is analogue 0.12-0
 > 
 > base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')
 > cleanEx()
@@ -7783,7 +7783,7 @@
 > ###
 > options(digits = 7L)
 > base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed:  22.285 0.434 23.459 0.001 0.003 
+Time elapsed:  22.357 0.334 23.687 0.003 0.003 
 > grDevices::dev.off()
 null device 
           1 


From noreply at r-forge.r-project.org  Mon Dec 16 19:55:09 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Mon, 16 Dec 2013 19:55:09 +0100 (CET)
Subject: [Analogue-commits] r395 - pkg/R
Message-ID: <20131216185509.6E6A2186826@r-forge.r-project.org>

Author: gsimpson
Date: 2013-12-16 19:55:09 +0100 (Mon, 16 Dec 2013)
New Revision: 395

Modified:
   pkg/R/predict.pcr.R
Log:
remove the use of analogue:::; hangover from development

Modified: pkg/R/predict.pcr.R
===================================================================
--- pkg/R/predict.pcr.R	2013-12-14 02:28:57 UTC (rev 394)
+++ pkg/R/predict.pcr.R	2013-12-16 18:55:09 UTC (rev 395)
@@ -170,7 +170,7 @@
     X <- sweep(X, 2, Xbar, "-")
     Y <- Y[take] - ybar
     ## fit model to subset
-    FIT <- analogue:::fitPCR(X = X, Y = Y, ncomp = ncomp, n = N, m = M)
+    FIT <- fitPCR(X = X, Y = Y, ncomp = ncomp, n = N, m = M)
     for(j in comps) {
         B0 <- ybar - Xbar %*% FIT$B[, j]
         parray[ , j] <- Xnew %*% FIT$B[, j] + rep(B0, Nnew)


From noreply at r-forge.r-project.org  Mon Dec 16 19:58:00 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Mon, 16 Dec 2013 19:58:00 +0100 (CET)
Subject: [Analogue-commits] r396 - in pkg: . inst
Message-ID: <20131216185800.E5D76186894@r-forge.r-project.org>

Author: gsimpson
Date: 2013-12-16 19:58:00 +0100 (Mon, 16 Dec 2013)
New Revision: 396

Modified:
   pkg/DESCRIPTION
   pkg/inst/ChangeLog
Log:
bump to 0.13-0 for development

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2013-12-16 18:55:09 UTC (rev 395)
+++ pkg/DESCRIPTION	2013-12-16 18:58:00 UTC (rev 396)
@@ -1,7 +1,7 @@
 Package: analogue
 Type: Package
 Title: Analogue and weighted averaging methods for palaeoecology
-Version: 0.12-0
+Version: 0.13-0
 Date: $Date$
 Depends: R (>= 2.15.0), vegan (>= 1.17-12), lattice, rgl
 Imports: mgcv, MASS, stats, graphics, grid, brglm, princurve

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2013-12-16 18:55:09 UTC (rev 395)
+++ pkg/inst/ChangeLog	2013-12-16 18:58:00 UTC (rev 396)
@@ -1,5 +1,11 @@
 analogue Change Log
 
+Version 0.13-0 Development branch opened 16 December 2013
+
+	* predict.pcr: internal function was calling `fitPCR()` via
+	`analogue:::fitPCR()`, which is not required nor was it intended.
+	Reported by Brian Ripley.
+
 Version 0.12-0
 
 	* Released to CRAN December 13th 2013


From noreply at r-forge.r-project.org  Sun Dec 22 03:03:05 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sun, 22 Dec 2013 03:03:05 +0100 (CET)
Subject: [Analogue-commits] r397 - in pkg: . R inst man
Message-ID: <20131222020305.75EE518689C@r-forge.r-project.org>

Author: gsimpson
Date: 2013-12-22 03:03:02 +0100 (Sun, 22 Dec 2013)
New Revision: 397

Added:
   pkg/R/predict.prcurve.R
   pkg/man/predict.prcurve.Rd
Modified:
   pkg/NAMESPACE
   pkg/R/prcurve.R
   pkg/inst/ChangeLog
   pkg/man/prcurve.Rd
Log:
add first pass at a predict method for principal curves

Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE	2013-12-16 18:58:00 UTC (rev 396)
+++ pkg/NAMESPACE	2013-12-22 02:03:02 UTC (rev 397)
@@ -185,6 +185,7 @@
 S3method(predict, logitreg)
 S3method(predict, mat)
 S3method(predict, pcr)
+S3method(predict, prcurve)
 S3method(predict, wa)
 S3method(residuals, bootstrap.mat)
 S3method(residuals, mat)

Modified: pkg/R/prcurve.R
===================================================================
--- pkg/R/prcurve.R	2013-12-16 18:58:00 UTC (rev 396)
+++ pkg/R/prcurve.R	2013-12-22 02:03:02 UTC (rev 397)
@@ -23,7 +23,7 @@
                     ## latent = FALSE,
                     ...) {
     ## X should be a matrix, attempt to coerce
-    if(!isTRUE(all.equal(class(X), "matrix")))
+    if(!isTRUE(inherits(X, "matrix")))
         X <- data.matrix(X)
     ## set/select default method for starting configuration
     if(missing(method))
@@ -208,6 +208,7 @@
     config$call <- match.call()
     config$ordination <- ord
     config$data <- X
+    config$stretch <- stretch
     class(config) <- c("prcurve")
     config
 }

Added: pkg/R/predict.prcurve.R
===================================================================
--- pkg/R/predict.prcurve.R	                        (rev 0)
+++ pkg/R/predict.prcurve.R	2013-12-22 02:03:02 UTC (rev 397)
@@ -0,0 +1,24 @@
+`predict.prcurve` <- function(object, newdata, ...) {
+    if(missing(newdata))
+        return(fitted(object))
+
+    ## check the variable names in newdata match with original data
+    ## essentially, this will only work if the names match, hence
+    ## join() likely useful for the user
+    nNew <- colnames(newdata)
+    nData <- colnames(object$data)
+    if (!isTRUE(all.equal(nNew, nData))) {
+        if (isTRUE(all.equal(sort(nNew), sort(nData)))) {
+            newdata <- newdata[, nData]
+        } else {
+            stop("Variables in 'newdata' don't match with training datat.")
+        }
+    }
+
+    ## otherwise project points on to the curve
+    p <- get.lam(data.matrix(newdata), s = object$s, tag = object$tag,
+                 stretch = object$stretch)
+    out <- p$s
+    attr(out, "tag") <- p$tag
+    out
+}

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2013-12-16 18:58:00 UTC (rev 396)
+++ pkg/inst/ChangeLog	2013-12-22 02:03:02 UTC (rev 397)
@@ -6,6 +6,10 @@
 	`analogue:::fitPCR()`, which is not required nor was it intended.
 	Reported by Brian Ripley.
 
+	* predict.prcurve: new function to predict locations on the curve
+	for new observations on the same set of variables. Useful for
+	adding passive species.
+
 Version 0.12-0
 
 	* Released to CRAN December 13th 2013

Modified: pkg/man/prcurve.Rd
===================================================================
--- pkg/man/prcurve.Rd	2013-12-16 18:58:00 UTC (rev 396)
+++ pkg/man/prcurve.Rd	2013-12-22 02:03:02 UTC (rev 397)
@@ -132,6 +132,10 @@
 aber.pc2 <- prcurve(abernethy2, method = "ca", trace = TRUE,
                     vary = TRUE, penalty = 1.4)
 
+## Predict new locations
+take <- abernethy2[1:10, ]
+pred <- predict(aber.pc2, take)
+
 \dontrun{
 ## Fit principal curve using a GAM - currently slow ~10secs
 aber.pc3 <- prcurve(abernethy2, method = "ca", trace = TRUE,

Added: pkg/man/predict.prcurve.Rd
===================================================================
--- pkg/man/predict.prcurve.Rd	                        (rev 0)
+++ pkg/man/predict.prcurve.Rd	2013-12-22 02:03:02 UTC (rev 397)
@@ -0,0 +1,57 @@
+\name{predict.prcurve}
+\alias{predict.prcurve}
+
+\title{Predict locations 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.
+}
+\usage{
+\method{predict}{prcurve}(object, newdata, \dots)
+}
+
+\arguments{
+  \item{object}{
+    an object of class \code{\link{prcurve}}.
+  }
+  \item{newdata}{
+    a matrix or data frame of new observations within the space of the
+    orginal data. Variables are matched against those of the original
+    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{\dots}{
+    other arguments passed to other methods. Not currently used.
+  }
+}
+\details{
+  Fitting a principal curve involves two procedures. In one, the current
+  curve is bent towards the data via the fitting of spline functions
+  with distance along the curve as the predictor variable and each
+  variable in turn as the response. The second procedure, a projection
+  step, involves projecting the observed points in \eqn{m} dimensions on
+  to locations along the current curve to which they are closest in the
+  hyperspace.
+
+  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.
+}
+\value{
+  A matrix of points in the space of the original data. Rows correspond
+  to the new samples and columns to the variables (ordered as per the
+  original data used to fit the curve).
+
+  How these points are ordered along the fitted curve is contained in
+  attributed \code{tag}.
+}
+\author{
+  Gavin L. Simpson
+}
+\seealso{
+  See \code{\link{prcurve}} for details on fitting principal curves and
+  an example.
+}
+
+\keyword{ methods }


From noreply at r-forge.r-project.org  Sun Dec 22 06:23:45 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sun, 22 Dec 2013 06:23:45 +0100 (CET)
Subject: [Analogue-commits] r398 - in pkg: . R inst man tests/Examples
Message-ID: <20131222052345.99BCA1866A4@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 


From noreply at r-forge.r-project.org  Tue Dec 31 06:27:27 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue, 31 Dec 2013 06:27:27 +0100 (CET)
Subject: [Analogue-commits] r399 - in pkg: . R inst man tests/Examples
Message-ID: <20131231052727.8AD69186982@r-forge.r-project.org>

Author: gsimpson
Date: 2013-12-31 06:27:26 +0100 (Tue, 31 Dec 2013)
New Revision: 399

Modified:
   pkg/DESCRIPTION
   pkg/R/plot3d.prcurve.R
   pkg/inst/ChangeLog
   pkg/man/plot3d.prcurve.Rd
   pkg/tests/Examples/analogue-Ex.Rout.save
Log:
Update plot3d.prcurve to use the data and ordination stored in the fitted prcurve object.

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2013-12-22 05:23:44 UTC (rev 398)
+++ pkg/DESCRIPTION	2013-12-31 05:27:26 UTC (rev 399)
@@ -1,7 +1,7 @@
 Package: analogue
 Type: Package
 Title: Analogue and weighted averaging methods for palaeoecology
-Version: 0.13-0
+Version: 0.13-1
 Date: $Date$
 Depends: R (>= 2.15.0), vegan (>= 1.17-12), lattice, rgl
 Imports: mgcv, MASS, stats, graphics, grid, brglm, princurve

Modified: pkg/R/plot3d.prcurve.R
===================================================================
--- pkg/R/plot3d.prcurve.R	2013-12-22 05:23:44 UTC (rev 398)
+++ pkg/R/plot3d.prcurve.R	2013-12-31 05:27:26 UTC (rev 399)
@@ -1,5 +1,4 @@
-`plot3d.prcurve` <- function(x, data, scale = FALSE,
-                             choices = 1:3, display = "sites",
+`plot3d.prcurve` <- function(x, choices = 1:3, display = "sites",
                              scaling = 0,
                              lcol = "darkorange", lwd = 2,
                              decorate = TRUE,
@@ -17,7 +16,8 @@
         }
     }
     ## do ordination
-    ord <- rda(data, scale = scale)
+    ## ord <- rda(x$data, scale = scale)
+    ord <- x$ordination ## this is now stored
     ## process labels
     if(missing(xlab) || is.null(xlab))
         xlab <- paste0("PC", choices[1])

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2013-12-22 05:23:44 UTC (rev 398)
+++ pkg/inst/ChangeLog	2013-12-31 05:27:26 UTC (rev 399)
@@ -1,5 +1,10 @@
 analogue Change Log
 
+Version 0.13-1 Opened 24 December 2013
+
+	* plot3d.prcuve: was not using the `data` & `ordination` objects
+	stored within the fitted `prcurve` object.
+
 Version 0.13-0 Development branch opened 16 December 2013
 
 	* predict.pcr: internal function was calling `fitPCR()` via

Modified: pkg/man/plot3d.prcurve.Rd
===================================================================
--- pkg/man/plot3d.prcurve.Rd	2013-12-22 05:23:44 UTC (rev 398)
+++ pkg/man/plot3d.prcurve.Rd	2013-12-31 05:27:26 UTC (rev 399)
@@ -8,10 +8,9 @@
   using the \pkg{rgl} package and functions from \pkg{vegan}.
 }
 \usage{
-\method{plot3d}{prcurve}(x, data, scale = FALSE, choices = 1:3,
-       display = "sites", scaling = 0, lcol = "darkorange", lwd = 2,
-       decorate = TRUE, xlab = NULL, ylab = NULL, zlab = NULL,
-       main = NULL, ...)
+\method{plot3d}{prcurve}(x, choices = 1:3, display = "sites", scaling = 0,
+       lcol = "darkorange", lwd = 2, decorate = TRUE, xlab = NULL,
+       ylab = NULL, zlab = NULL, main = NULL, ...)
 }
 %- maybe also 'usage' for other objects documented here.
 \arguments{
@@ -19,13 +18,6 @@
     an object of class \code{"prcurve"} resulting from a call to
     \code{\link{prcurve}}.
   }
-  \item{data}{
-    the data used to fit the principal curve.
-  }
-  \item{scale}{
-    logical; should the variables in \code{data} be scaled to zero mean
-    and unit variance?
-  }
   \item{choices}{
     numeric vector of length 3; the ordination axes to plot.
   }
@@ -89,7 +81,7 @@
                    vary = FALSE, penalty = 1.4)
 
 ## 3D plot of data with curve superimposed
-plot3d(aber.pc, abernethy2)
+plot3d(aber.pc)
 
 }
 % Add one or more standard keywords, see file 'KEYWORDS' in the

Modified: pkg/tests/Examples/analogue-Ex.Rout.save
===================================================================
--- pkg/tests/Examples/analogue-Ex.Rout.save	2013-12-22 05:23:44 UTC (rev 398)
+++ pkg/tests/Examples/analogue-Ex.Rout.save	2013-12-31 05:27:26 UTC (rev 399)
@@ -26,7 +26,7 @@
 Loading required package: lattice
 This is vegan 2.0-10
 Loading required package: rgl
-This is analogue 0.13-0
+This is analogue 0.13-1
 > 
 > base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')
 > cleanEx()
@@ -5388,7 +5388,7 @@
 
 > 
 > ## 3D plot of data with curve superimposed
-> plot3d(aber.pc, abernethy2)
+> plot3d(aber.pc)
 > 
 > 
 > 
@@ -7791,7 +7791,7 @@
 > ###
 > options(digits = 7L)
 > base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed:  21.822 0.288 23.53 0.002 0.002 
+Time elapsed:  22.251 0.337 24.003 0.001 0.002 
 > grDevices::dev.off()
 null device 
           1