From noreply at r-forge.r-project.org  Tue Oct  1 05:06:45 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  1 Oct 2013 05:06:45 +0200 (CEST)
Subject: [Analogue-commits] r362 - in pkg: R inst
Message-ID: <20131001030646.237CB185D26@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-01 05:06:43 +0200 (Tue, 01 Oct 2013)
New Revision: 362

Modified:
   pkg/R/wa.R
   pkg/inst/ChangeLog
Log:
wa warns of species contain zero info

Modified: pkg/R/wa.R
===================================================================
--- pkg/R/wa.R	2013-09-30 16:19:05 UTC (rev 361)
+++ pkg/R/wa.R	2013-10-01 03:06:43 UTC (rev 362)
@@ -12,8 +12,10 @@
     x <- as.matrix(x)
     env <- as.numeric(env)
     ## drop species with no information
-    if(any(csum <- colSums(x) == 0))
+    if(any(csum <- colSums(x) == 0)) {
         x <- x[, !csum, drop = FALSE]
+        warning("Some species contained no data. These have been deleted.")
+    }
     if(missing(deshrink))
         deshrink <- "inverse"
     deshrink <- match.arg(deshrink)

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2013-09-30 16:19:05 UTC (rev 361)
+++ pkg/inst/ChangeLog	2013-10-01 03:06:43 UTC (rev 362)
@@ -55,6 +55,9 @@
 
 	* plot.sppResponse: accepts a logical vector for argument `which`.
 
+	* wa: now warns if species with no information are removed from
+	the analysis, which proceeds as it always has.
+
 Version 0.11-3
 
 	* chooseTaxa: new argument `value` controls whether the data for


From noreply at r-forge.r-project.org  Tue Oct  1 05:17:44 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  1 Oct 2013 05:17:44 +0200 (CEST)
Subject: [Analogue-commits] r363 - pkg/vignettes
Message-ID: <20131001031745.7B979185D26@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-01 05:17:41 +0200 (Tue, 01 Oct 2013)
New Revision: 363

Modified:
   pkg/vignettes/analogue_methods.Rnw
Log:
name some chunks

Modified: pkg/vignettes/analogue_methods.Rnw
===================================================================
--- pkg/vignettes/analogue_methods.Rnw	2013-10-01 03:06:43 UTC (rev 362)
+++ pkg/vignettes/analogue_methods.Rnw	2013-10-01 03:17:41 UTC (rev 363)
@@ -118,7 +118,7 @@
 \section[Using analogue]{Using \pkg{analogue}}\label{using_analogue}
 This section contains a worked example of how to use the \pkg{analogue} package to fit MAT transfer function models and to perform analogue matching. The \pkg{analogue} package first has to be loaded before it can be used:
 
-<<>>=
+<<loadPackage>>=
 library("analogue")
 @
 
@@ -126,7 +126,7 @@
 
 To illustrate \pkg{analogue}, the Surface Waters Acidification Project (SWAP) diatom:pH training set is used \citep{swapredbook}, along with diatom counts from a sediment core taken from the Round Loch of Glenhead, Galloway, Scotland \citep{604}. The data sets also need to be loaded before they can be used:
 \label{join}
-<<>>=
+<<loadData>>=
 data(swapdiat, swappH, rlgh, package = "analogue")
 @
 
@@ -141,7 +141,7 @@
 
 The data frame of diatom counts (\code{x}), must have the same columns (species) as the data frame of counts for the sediment core for which MAT reconstructions are required. To ensure that both data frames have the same set of columns, the \code{join} function is used to merge the two data sets.
 
-<<>>=
+<<joinData>>=
 dat <- join(swapdiat, rlgh, verbose = TRUE)
 @
 
@@ -151,14 +151,14 @@
 
 By convention, dissimilarity coefficients are defined for proportional data. As the data used in this example are percentages we need to convert them to proportions. We extract each of the merged data sets (the components of \code{dat}) back into the training set and the fossil set, converting the data into proportions as we do so.
 
-<<>>=
+<<convertToPercent>>=
 swapdiat <- dat$swapdiat / 100
 rlgh <- dat$rlgh / 100
 @
 
 The data are now ready for analysis. We will fit a MAT model to the SWAP training set using the squared chord distance (SCD) coefficient:
 
-<<>>=
+<<applyMat>>=
 swap.mat <- mat(swapdiat, swappH, method = "SQchord")
 @
 


From noreply at r-forge.r-project.org  Tue Oct  1 07:24:36 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  1 Oct 2013 07:24:36 +0200 (CEST)
Subject: [Analogue-commits] r364 - pkg/R
Message-ID: <20131001052436.CA5911858B4@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-01 07:24:36 +0200 (Tue, 01 Oct 2013)
New Revision: 364

Modified:
   pkg/R/distance.R
Log:
rearrange some of the code, simplify

Modified: pkg/R/distance.R
===================================================================
--- pkg/R/distance.R	2013-10-01 03:17:41 UTC (rev 363)
+++ pkg/R/distance.R	2013-10-01 05:24:36 UTC (rev 364)
@@ -140,60 +140,50 @@
                )
       }
     if(missing(method))
-      method <- "euclidean"
+        method <- "euclidean"
     method <- match.arg(method)
     y.miss <- FALSE
     if(missing(y)) {
-      y.miss <- TRUE
-      y <- x
+        y.miss <- TRUE
+        y <- x
     }
+    n.vars <- ncol(x)
     if(method == "mixed") {
-      ## sanity check: are same columns in x and y factors
-      facs.x <- sapply(as.data.frame(x), is.factor, USE.NAMES = FALSE)
-      facs.y <- sapply(as.data.frame(y), is.factor, USE.NAMES = FALSE)
-      if(sum(facs.x - facs.y) > 0)
-        stop("Different columns (species) are coded as factors in 'x' and 'y'")
-      ## sanity check: levels of factors also need to be the same
-      for(i in seq_along(facs.x)[facs.x]){
-        if(!identical(levels(x[,i]), levels(y[,i])))
-          stop("The levels of one or more factors in 'x' and 'y'\ndo not match.\nConsider using 'join(x, y)'. See '?join'")
-      }
+        ## are same columns in x and y factors
+        facs.x <- sapply(as.data.frame(x), is.factor, USE.NAMES = FALSE)
+        facs.y <- sapply(as.data.frame(y), is.factor, USE.NAMES = FALSE)
+        if(sum(facs.x - facs.y) > 0) {
+            stop("Different columns (species) are coded as factors in 'x' and 'y'")
+            ## levels of factors also need to be the same
+            for(i in seq_along(facs.x)[facs.x]){
+                if(!identical(levels(x[,i]), levels(y[,i])))
+                    stop("The levels of one or more factors in 'x' and 'y'\ndo not match.\nConsider using 'join(x, y)'. See '?join'")
+            }
+        }
+    } else {
+        ## we do this even if no y as it is harmless
+        facs.x <- facs.y <- rep(FALSE, n.vars)
     }
     x.names <- rownames(x)
     x <- data.matrix(x)
-    n.vars <- ncol(x)
+    y.names <- rownames(y)
+    y <- data.matrix(y)
     ## Do we want to remove NAs? Yes if gower, alt.gower and mixed,
     ## but fail for others
     NA.RM <- FALSE
     if(method %in% c("gower", "alt.gower", "mixed"))
-      NA.RM <- TRUE
-    #y.miss <- FALSE
-    if(missing(y)) {
-      #colsumx <- colSums(x, na.rm = NA.RM)
-      #if(any(colsumx <= 0)) {
-      #  x <- x[, colsumx > 0, drop = FALSE]
-      #  warning("some species contain no data and were removed from data matrix x\n")
-      #}
-      y.miss <- TRUE
-      y <- x
-      y.names <- x.names
-    } else {
-      #if(method == "mixed") {
-        ## sanity check: are same columns in x and y factors
-        #facs.y <- sapply(as.data.frame(y), is.factor)
-        #if(sum(facs.x - facs.y) > 0)
-        #  stop("Different columns (species) are coded as factors in 'x' and 'y'")
-        ## sanity check: levels of factors also need to be the same
-        #for(i in seq_along(facs.x)[facs.x]){
-        #  if(!identical(levels(x[,i]), levels(y[,i])))
-        #    stop("The levels of one or more factors in 'x' and 'y' do not match.\nConsider using 'join(x, y)'. See '?join'")
-        #}
-      #}
-      y.names <- rownames(y)
-      y <- data.matrix(y)
+        NA.RM <- TRUE
+    ## check if any empty species, drop them
+    colsumx <- colSums(x, na.rm = NA.RM)
+    colsumy <- colSums(y, na.rm = NA.RM)
+    ## NO - this causes problems if you merge data
+    if (any(DROP <- (colsumx <= 0 & colsumy <= 0) & !facs.x)) {
+        ##x <- x[, (colsumx > 0 | colsumy > 0) | facs.x, drop = FALSE]
+        ##y <- y[, (colsumx > 0 | colsumy > 0) | facs.x, drop = FALSE]
+        ##warning("Some species contain no data and were removed from data matrices.\n")
     }
     if(method == "chi.distance")
-      colsum <- colSums(join(as.data.frame(x),as.data.frame(y), split = FALSE))
+        colsum <- colSums(join(as.data.frame(x),as.data.frame(y), split = FALSE))
     if(method == "mixed") {
       ## sort out the weights used, eg the Kroneker's Deltas
       ## weights must be NULL or numeric vector of length == ncol(x)


From noreply at r-forge.r-project.org  Tue Oct  1 07:26:32 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  1 Oct 2013 07:26:32 +0200 (CEST)
Subject: [Analogue-commits] r365 - pkg/R
Message-ID: <20131001052632.BA1AB1858B4@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-01 07:26:32 +0200 (Tue, 01 Oct 2013)
New Revision: 365

Modified:
   pkg/R/mat.R
Log:
remove a redundant line of code

Modified: pkg/R/mat.R
===================================================================
--- pkg/R/mat.R	2013-10-01 05:24:36 UTC (rev 364)
+++ pkg/R/mat.R	2013-10-01 05:26:32 UTC (rev 365)
@@ -20,7 +20,7 @@
                         "information", "chi.distance", "manhattan",
                         "kendall", "gower", "alt.gower", "mixed"),
                         kmax, ...) {
-    dims <- dim(x) # the numbers of samples / species
+    ##dims <- dim(x) # the numbers of samples / species
     site.nams <- rownames(x) # store sample names for later
     .call <- match.call()
     ## need to reset due to method dispatch


From noreply at r-forge.r-project.org  Sat Oct  5 23:09:53 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sat,  5 Oct 2013 23:09:53 +0200 (CEST)
Subject: [Analogue-commits] r366 - pkg/vignettes
Message-ID: <20131005210953.D928E1860B9@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-05 23:09:53 +0200 (Sat, 05 Oct 2013)
New Revision: 366

Modified:
   pkg/vignettes/analogue_methods.Rnw
Log:
name some more chunks

Modified: pkg/vignettes/analogue_methods.Rnw
===================================================================
--- pkg/vignettes/analogue_methods.Rnw	2013-10-01 05:26:32 UTC (rev 365)
+++ pkg/vignettes/analogue_methods.Rnw	2013-10-05 21:09:53 UTC (rev 366)
@@ -172,7 +172,7 @@
 
 A more detailed summary of the results may be displayed using the \code{summary} method:
 
-<<results=hide>>=
+<<summarySwapMat, results=hide>>=
 summary(swap.mat)
 @
 
@@ -190,7 +190,7 @@
 
 Before using this model to reconstruct pH for the RLGH core, the number of analogues, $k$, to use in the reconstructions must be determined. A simple way of choosing $k$ is to select $k$ from the model with lowest RMSEP. In the printed results shown above, the model with the lowest RMSEP was a model with $k = 10$ closest analogues for both the mean and weighted mean indices. We should check this number however, as the displayed lists were restricted to show only the $k = 1,\ldots,10$ closest analogues. Whenever $k$ is not specified, the functions in \pkg{analogue} automatically choose the model with lowest RMSEP. The simplest way to check this is to the use the \code{getK} extractor function:
 
-<<>>=
+<<printSwapMat>>=
 getK(swap.mat)
 @
 
@@ -210,7 +210,7 @@
 
 This model can now be used to reconstruct past pH values for the RLGH core. The \code{predict} method of \code{mat} can be used for reconstructions:
 
-<<results=hide>>=
+<<rlghPred, results=hide>>=
 rlgh.mat <- predict(swap.mat, rlgh, k = 10)
 rlgh.mat
 @
@@ -233,7 +233,7 @@
 
 If we are interested in how reliable our reconstructed values are, a useful descriptor is the minimum dissimilarity between a core sample and the training set samples (minDC). If there are no close modern analogues in the training set for certain fossil samples, we will have less faith in the MAT reconstructions for those fossil samples than for samples that do have close modern analogues. The \code{minDC} function can be used to extract the minimum dissimilarity for each fossil sample:
 
-<<>>=
+<<minDijRLGH>>=
 rlgh.mdc <- minDC(rlgh.mat)
 @
 
@@ -258,7 +258,7 @@
 
 Returning to the RLGH example, in AM all we are interested in is identifying those samples from the modern training set that are close modern analogues for samples from the RLGH core. In particular, we define the reference condition or period for acidified lakes to be immediately prior to the onset of the industrial revolution, \emph{c.}~1800. We accept that this period is not the ``natural'' state of the RLGH as many UK surface waters have experienced several thousand years of human impact, but this reference condition is appropriate for assessing recovery from recent acidification resulting from the burning of fossil fuels for energy generation and industrial activities. We use \code{analog}, this time with the chord distance (CD) measure and select only those samples from the reference period of the RLGH (samples 25--37):
 
-<<>>=
+<<swapAnalogue>>=
 rlgh.ref <- rlgh[25:37, ]
 swap.ana <- analog(swapdiat, rlgh.ref, method = "chord")
 swap.ana


From noreply at r-forge.r-project.org  Sat Oct  5 23:10:47 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sat,  5 Oct 2013 23:10:47 +0200 (CEST)
Subject: [Analogue-commits] r367 - in pkg: inst inst/tests tests
Message-ID: <20131005211047.F0AF7185A5F@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-05 23:10:47 +0200 (Sat, 05 Oct 2013)
New Revision: 367

Added:
   pkg/inst/tests/
   pkg/inst/tests/test-new-distance.R
   pkg/tests/test-all.R
Log:
add tests

Added: pkg/inst/tests/test-new-distance.R
===================================================================
--- pkg/inst/tests/test-new-distance.R	                        (rev 0)
+++ pkg/inst/tests/test-new-distance.R	2013-10-05 21:10:47 UTC (rev 367)
@@ -0,0 +1,29 @@
+## Tests for the new distance compiled code
+
+## load packages
+library("testthat")
+library_if_available("analogue")
+
+context("Testing new distance compiled code functions")
+
+## simple example using dummy data
+train <- data.frame(matrix(abs(runif(200)), ncol = 10))
+rownames(train) <- LETTERS[1:20]
+colnames(train) <- as.character(1:10)
+fossil <- data.frame(matrix(abs(runif(100)), ncol = 10))
+colnames(fossil) <- as.character(1:10)
+rownames(fossil) <- letters[1:10]
+
+## test methods for x and y
+test_that("distance matches compiled versions for x and y", {
+
+    ## default settings
+    expect_equal(distance(train, fossil),
+                 oldDistance(train, fossil))
+
+    ## euclidean
+    method <- "euclidean"
+    expect_equal(distance(train, fossil, method = method),
+                 oldDistance(train, fossil, method = method))
+
+})

Added: pkg/tests/test-all.R
===================================================================
--- pkg/tests/test-all.R	                        (rev 0)
+++ pkg/tests/test-all.R	2013-10-05 21:10:47 UTC (rev 367)
@@ -0,0 +1,8 @@
+## Test `analogue` using the `testthat` package
+
+## Setup
+library(testthat)
+library(analogue)
+
+## Runs the tests in inst/tests
+test_package("analogue")


From noreply at r-forge.r-project.org  Sat Oct  5 23:11:53 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sat,  5 Oct 2013 23:11:53 +0200 (CEST)
Subject: [Analogue-commits] r368 - in pkg: . R inst man src
Message-ID: <20131005211153.5A56E185A5F@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-05 23:11:52 +0200 (Sat, 05 Oct 2013)
New Revision: 368

Added:
   pkg/R/new-distance.R
Removed:
   pkg/R/distance2.R
   pkg/R/distance_c.R
   pkg/man/distance3.Rd
   pkg/src/c_distx.c
   pkg/src/c_distxy.c
Modified:
   pkg/DESCRIPTION
   pkg/NAMESPACE
   pkg/R/distance.R
   pkg/inst/ChangeLog
   pkg/man/distance.Rd
   pkg/src/distx.c
   pkg/src/distxy.c
Log:
bump to 0.11-6; new distance function using compiled C code; cleanup old attempts to interface the C code

Modified: pkg/DESCRIPTION
===================================================================
--- pkg/DESCRIPTION	2013-10-05 21:10:47 UTC (rev 367)
+++ pkg/DESCRIPTION	2013-10-05 21:11:52 UTC (rev 368)
@@ -1,17 +1,18 @@
 Package: analogue
 Type: Package
 Title: Analogue and weighted averaging methods for palaeoecology
-Version: 0.11-4
+Version: 0.11-6
 Date: $Date$
 Depends: R (>= 2.15.0), vegan (>= 1.17-12), lattice, rgl
 Imports: mgcv, MASS, stats, graphics, grid, brglm, princurve
+Suggests: testthat
 Author: Gavin L. Simpson, Jari Oksanen
 Authors at R: c(person(given = c("Gavin", "L."), family = "Simpson",
                     role = c("aut", "cre"),
-                    email = "gavin.simpson at uregina.ca"),
+                    email = "ucfagls at gmail.com"),
              person(given = "Jari", family = "Oksanen",
                     role = "aut"))
-Maintainer: Gavin L. Simpson <gavin.simpson at uregina.ca>
+Maintainer: Gavin L. Simpson <ucfagls at gmail.com>
 BugReports: http://r-forge.r-project.org/tracker/?func=browse&group_id=69&atid=338
 NeedsCompilation: yes
 Description: Fits Modern Analogue Technique and Weighted Averaging transfer 

Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE	2013-10-05 21:10:47 UTC (rev 367)
+++ pkg/NAMESPACE	2013-10-05 21:11:52 UTC (rev 368)
@@ -57,9 +57,9 @@
        deshrink,
        dissim,
        dissimilarities,
-       distance,
-       distance3,
-       distanceX,
+       distance, oldDistance, ## oldDistance is the original R-only code
+       #distance3,
+       #distanceX,
        fuse,
        getK,
        gradientDist,
@@ -114,7 +114,9 @@
 S3method(dissimilarities, mat)
 S3method(distance, default)
 S3method(distance, join)
-S3method(distance3, default)
+S3method(oldDistance, default)
+S3method(oldDistance, join)
+#S3method(distance3, default)
 S3method(eigenvals, pcr)
 S3method(fuse, dist)
 S3method(fuse, matrix)

Modified: pkg/R/distance.R
===================================================================
--- pkg/R/distance.R	2013-10-05 21:10:47 UTC (rev 367)
+++ pkg/R/distance.R	2013-10-05 21:11:52 UTC (rev 368)
@@ -11,9 +11,9 @@
 ##                                                                       ##
 ###########################################################################
 ## x = training data, y = fossil data
-distance <- function(x, ...) UseMethod("distance")
+oldDistance <- function(x, ...) UseMethod("distance")
 
-distance.join <- function(x, ...)
+oldDistance.join <- function(x, ...)
   {
     if(!inherits(x, "join"))
       stop("This method should only be used on objects of class 'join'")
@@ -26,7 +26,7 @@
     }
   }
 
-distance.default <- function(x, y,
+oldDistance.default <- function(x, y,
                              method = c("euclidean", "SQeuclidean", "chord",
                                "SQchord", "bray", "chi.square", "SQchi.square",
                                "information", "chi.distance", "manhattan",

Deleted: pkg/R/distance2.R
===================================================================
--- pkg/R/distance2.R	2013-10-05 21:10:47 UTC (rev 367)
+++ pkg/R/distance2.R	2013-10-05 21:11:52 UTC (rev 368)
@@ -1,418 +0,0 @@
-## `distance2` <- function(x, ...)
-##     UseMethod("distance2")
-
-## `distance2.default` <- function(x, y,
-##                                 method = c("euclidean",
-##                                 "SQeuclidean", "chord",
-##                                 "SQchord", "bray", "chi.square",
-##                                 "SQchi.square", "information",
-##                                 "chi.distance", "manhattan",
-##                                 "kendall", "gower", "alt.gower",
-##                                 "mixed"),
-##                                 weights = NULL, R = NULL,
-##                                 type = list(),
-##                                 ordinal = c("gower","rank","metric"), ...) {
-##     pColl <- function(n) paste(n, collapse = ", ")
-##     ## Euclid?an could be spelled variously
-##     if(!is.na(pmatch(method, "euclidian")))
-## 	method <- "euclidean"
-##     if (missing(method))
-##         method <- "euclidean"
-##     METHODS <- c("euclidean", "SQeuclidean", "chord", "SQchord",
-##                  "bray", "chi.square", "SQchi.square",
-##                  "information","chi.distance", "manhattan",
-##                  "kendall", "gower", "alt.gower", "mixed")
-##     method <- match.arg(method)
-##     DCOEF <- pmatch(method, METHODS)
-##     ordinal <- match.arg(ordinal)
-##     ORDTYPES <- c("gower","rank","metric")
-##     if(missing(y)) { ## only a single matrix
-##         ## TODO
-##     } else { ## two matrices
-##         ## check x and y have same columns
-##         if(!isTRUE(all.equal(names(x), names(y))))
-##             stop("'x' and 'y' appear to have different variables.")
-##         if(!isTRUE(all.equal((n.vars <- ncol(x)), ncol(y))))
-##             stop("'x' and 'y' have different numbers of columns.")
-##         ## variables
-##         nrx <- nrow(x)
-##         nry <- nrow(y)
-##         d <- numeric(length = nrx * nry)
-##         ## object names (row names)
-##         x.names <- rownames(x)
-##         y.names <- rownames(y)
-##         ## some preprocessing steps required for some coefs
-##         ## so dealt with separately
-##         if(method %in% c("chi.distance", "gower", "alt.gower",
-##                          "mixed", "kendall")) {
-##             if(method == "chi.distance") {
-##                 x <- data.matrix(x)
-##                 y <- data.matrix(y)
-##                 csum <- colSums(rbind(x, y))
-##                 y <- y / rowSums(y)
-##                 x <- x / rowSums(x)
-##                 d <- .C("xy_chisq_dist", x = as.double(x), y = as.double(y),
-##                         nr1 = as.integer(nrx), nr2 = as.integer(nry),
-##                         nc = as.integer(n.vars), d = as.double(d),
-##                         csum = as.double(csum), NAOK = as.integer(FALSE),
-##                         PACKAGE = "analogue")$d
-##             }
-##             if(method %in% c("gower", "alt.gower", "mixed")) {
-##                 if(method == "mixed") {
-##                     if(is.null(weights))
-##                         weights <- rep(1, n.vars)
-##                     else {
-##                         if(length(weights) != n.vars)
-##                             stop("'weights' must be of length 'ncol(x)'")
-##                     }
-##                     ## process vtypes
-##                     if(length(type)) {
-##                         ## if 'type's supplied, validate
-##                     }
-##                     ## TODO
-##                     if(is.data.frame(x)) {
-##                         type2x <- sapply(x, data.class, USE.NAMES = FALSE)
-##                         ##x <- data.matrix(x)
-##                     } else {
-##                         type2x <- rep("numeric", n.vars)
-##                         names(type2x) <- colnames(x)
-##                     }
-##                     if(is.data.frame(y)) {
-##                         type2y <- sapply(y, data.class, USE.NAMES = FALSE)
-##                         ##y <- data.matrix(y)
-##                     } else {
-##                         type2y <- rep("numeric", n.vars)
-##                         names(type2y) <- colnames(y)
-##                     }
-##                     ## x and y should have same column types
-##                     if(!isTRUE(all.equal(type2x, type2y)))
-##                         stop("Variable types in 'x' and 'y' differ.
-## Did you forget  to 'join' 'x' and 'y' before calling 'distance'?")
-##                     type2x[tI <- type2x %in% c("numeric", "integer")] <- "Q"
-##                     ## save which are ordinal for rank conversion below
-##                     type2x[(ordinal <- type2x == "ordered")] <- "O"
-##                     type2x[type2x == "factor"] <- "N"
-##                     type2x[type2x == "logical"] <- "A"
-##                     typeCodes <- c("A", "S", "N", "O", "Q", "I", "T")
-##                     type3 <- match(type2x, typeCodes)
-##                     if (any(ina <- is.na(type3)))
-##                         stop("invalid type ", type2x[ina], " for column numbers ",
-##                              pColl(which(ina)))
-
-##                     ## Convert to matrices from now on
-##                     ## also takes care of ordinal == metric as all factors
-##                     ## are converted to internal numeric codes
-##                     x <- data.matrix(x)
-##                     y <- data.matrix(y)
-
-##                     ## Convert ordinal variables to ranks or numerics
-##                     ## implemented as per Podani 1999. Only do ranks here as
-##                     ## conversion to matrices above handled the standard case
-##                     x[, ordinal] <- apply(x[, ordinal], 2, rank, na.last = "keep")
-##                     y[, ordinal] <- apply(y[, ordinal], 2, rank, na.last = "keep")
-
-##                     ## Compute range Rj
-##                     XY <- rbind(x, y)
-##                     if(is.null(R)) {
-##                         maxi <- apply(XY, 2, max, na.rm = TRUE)
-##                         mini <- apply(XY, 2, min, na.rm = TRUE)
-##                         R <- maxi - mini
-##                     } else {
-##                         if(length(R) != n.vars)
-##                             stop("'R' must be of length 'ncol(x)'")
-##                     }
-
-##                     ## For Ordinal we need TiMin and TiMax
-##                     ## compute over all variables so they have same length as
-##                     ## everything else
-##                     doT <- function(X, which) {
-##                         val <- if(which == "min") {
-##                             min(X, na.rm = TRUE)
-##                         } else {
-##                             max(X, na.rm = TRUE)
-##                         }
-##                         nas <- is.na(X)
-##                         length(which(X[!nas] == val))
-##                     }
-##                     tmin <- apply(XY, 2, doT, which = "min")
-##                     tmax <- apply(XY, 2, doT, which = "max")
-
-##                     ## How do we want to handle ordinals - convert to interger code
-##                     ## for use in C
-##                     podani <- match(ordinal, ORDTYPES)
-
-##                     ## call the C code
-##                     d <- .C("xy_mixed", x = as.double(x), y = as.double(y),
-##                             nr1 = as.integer(nrx), nr2 = as.integer(nry),
-##                             nc = as.integer(n.vars), d = as.double(d),
-##                             vtype = as.integer(type3),
-##                             weights = as.double(weights), R = as.double(R),
-##                             tmin = as.integer(tmin), tmax = as.integer(tmax),
-##                             podani = as.integer(podani),
-##                             NAOK = as.integer(TRUE),
-##                             PACKAGE = "analogue")$d
-##                 } else {
-##                     if(is.null(R)) {
-##                         XY <- rbind(x, y)
-##                         maxi <- apply(XY, 2, max, na.rm = TRUE)
-##                         mini <- apply(XY, 2, min, na.rm = TRUE)
-##                         R <- maxi - mini
-##                     } else {
-##                         if(length(R) != n.vars)
-##                             stop("'R' must be of length 'ncol(x)'")
-##                     }
-##                     x <- data.matrix(x)
-##                     y <- data.matrix(y)
-
-##                     ## pre-process for gower and alt gower
-##                     ## but these handled by xy_distance below
-##                     x <- sweep(x, 2, R, "/")
-##                     y <- sweep(y, 2, R, "/")
-##                     d <- .C("xy_distance", x = as.double(x), y = as.double(y),
-##                             nr1 = as.integer(nrx), nr2 = as.integer(nry),
-##                             nc = as.integer(n.vars), d = as.double(d),
-##                             method = as.integer(DCOEF), NAOK = as.integer(FALSE),
-##                             PACKAGE = "analogue")$d
-##                 }
-##             }
-##             if(method == "kendall") {
-##                 x <- data.matrix(x)
-##                 y <- data.matrix(y)
-##                 XY <- rbind(x, y)
-##                 maxi <- apply(XY, 2, max)
-##                 d <- .C("xy_kendall", x = as.double(x), y = as.double(y),
-##                         nr1 = as.integer(nrx), nr2 = as.integer(nry),
-##                         nc = as.integer(n.vars), d = as.double(d),
-##                         maxi = as.double(maxi), NAOK = as.integer(FALSE),
-##                         PACKAGE = "analogue")$d
-##             }
-##         } else {
-##             ## must be one of the DC's handled by xy_distance
-##             x <- data.matrix(x)
-##             y <- data.matrix(y)
-##             d <- .C("xy_distance", x = as.double(x), y = as.double(y),
-##                     nr1 = as.integer(nrx), nr2 = as.integer(nry),
-##                     nc = as.integer(n.vars), d = as.double(d),
-##                     method = as.integer(DCOEF), NAOK = as.integer(FALSE),
-##                     PACKAGE = "analogue")$d
-##         }
-##         ## convert d to a matrix
-##         d <- matrix(d, ncol = n.vars, byrow = TRUE)
-##         colnames(d) <- y.names
-##         rownames(d) <- x.names
-##         attr(d, "method") <- method
-##         class(d) <- c("distance","matrix")
-##     }
-##     return(d)
-## }
-
-## set.seed(1)
-## bar <- matrix(sample(3, 9, replace = TRUE), ncol = 3)
-## foo <- matrix(sample(3, 9, replace = TRUE), ncol = 3)
-## foobar <- rbind(bar, foo)
-## out <- matrix(ncol = ncol(bar), nrow = nrow(foobar))
-## res <- numeric(length = nrow(foobar))
-## for(i in seq_len(nrow(foobar))) {
-##     for(j in seq_len(ncol(foobar))) {
-##         for(k in seq_along(foobar[,j])) {
-##             res[k] <- foobar[k,j] == foobar[i,j]
-##         }
-##         out[i, j] <- sum(res)
-##     }
-## }
-
-## set.seed(1)
-## bar <- matrix(sample(3, 9, replace = TRUE), ncol = 3)
-## foo <- matrix(sample(3, 9, replace = TRUE), ncol = 3)
-## outbar <- matrix(0, ncol = ncol(bar), nrow = nrow(bar))
-## outfoo <- matrix(0, ncol = ncol(foo), nrow = nrow(foo))
-## resbar <- numeric(length = nrow(bar))# + nrow(foo))
-## resfoo <- numeric(length = nrow(bar))# + nrow(foo))
-
-## for(i in seq_len(ncol(bar))) {
-##     for(j in seq_len(nrow(bar))) {
-##         for(k in seq_len(nrow(bar))) {
-##             resbar[k] <- bar[k, i] == bar[j, i]
-##         }
-##         outbar[j, i] <- sum(resbar)
-##     }
-##     for(j in seq_len(nrow(foo))) {
-##         for(k in seq_len(nrow(foo))) {
-##             resfoo[k] <- foo[k, i] == bar[j, i]
-##         }
-##         outfoo[j, i] <- sum(resfoo)
-##     }
-## }
-
-`distance3` <- function(x, ...)
-    UseMethod("distance3")
-
-`distance3.default` <-
-    function(x, y, method = "euclidean",
-             weights = NULL, R = NULL,
-             ...)
-{
-    METHODS <- c("euclidean", "SQeuclidean", "chord", "SQchord",
-                 "bray", "chi.square", "SQchi.square", "information",
-                 "chi.distance", "manhattan", "kendall", "gower", "alt.gower",
-                 "mixed")
-    pColl <- function(n) paste(n, collapse = ", ")
-    ## Euclid?an could be spelled variously
-    if(!is.na(pmatch(method, "euclidian")))
-	method <- "euclidean"
-    METHODS <- c("euclidean", "SQeuclidean", "chord", "SQchord",
-                 "bray", "chi.square", "SQchi.square",
-                 "information","chi.distance", "manhattan",
-                 "kendall", "gower", "alt.gower", "mixed")
-    DCOEF <- pmatch(method, METHODS)
-    if(missing(y)) { ## only a single matrix
-        ## TODO
-    } else { ## two matrices
-        ## check x and y have same columns
-        if(!isTRUE(all.equal(names(x), names(y))))
-            stop("'x' and 'y' appear to have different variables.")
-        if(!isTRUE(all.equal((n.vars <- ncol(x)), ncol(y))))
-            stop("'x' and 'y' have different numbers of columns.")
-        ## variables
-        nrx <- nrow(x)
-        nry <- nrow(y)
-        d <- numeric(length = nrx * nry)
-        ## object names (row names)
-        x.names <- rownames(x)
-        y.names <- rownames(y)
-        ## some preprocessing steps required for some coefs
-        ## so dealt with separately
-        if(method %in% c("chi.distance", "gower", "alt.gower",
-                         "mixed", "kendall")) {
-            if(method == "chi.distance") {
-                x <- data.matrix(x)
-                y <- data.matrix(y)
-                csum <- colSums(rbind(x, y))
-                y <- y / rowSums(y)
-                x <- x / rowSums(x)
-                d <- .C("xy_chisq_dist", x = as.double(x), y = as.double(y),
-                        nr1 = as.integer(nrx), nr2 = as.integer(nry),
-                        nc = as.integer(n.vars), d = as.double(d),
-                        csum = as.double(csum), NAOK = as.integer(FALSE),
-                        PACKAGE = "analogue")$d
-            }
-            if(method %in% c("gower", "alt.gower", "mixed")) {
-                if(method == "mixed") {
-                    if(is.null(weights))
-                        weights <- rep(1, n.vars)
-                    else {
-                        if(length(weights) != n.vars)
-                            stop("'weights' must be of length 'ncol(x)'")
-                    }
-                    ## process vtypes
-                    if(is.data.frame(x)) {
-                        type2x <- sapply(x, data.class, USE.NAMES = FALSE)
-                        ##x <- data.matrix(x)
-                    } else {
-                        type2x <- rep("numeric", n.vars)
-                        names(type2x) <- colnames(x)
-                    }
-                    if(is.data.frame(y)) {
-                        type2y <- sapply(y, data.class, USE.NAMES = FALSE)
-                        ##y <- data.matrix(y)
-                    } else {
-                        type2y <- rep("numeric", n.vars)
-                        names(type2y) <- colnames(y)
-                    }
-                    ## x and y should have same column types
-                    if(!isTRUE(all.equal(type2x, type2y)))
-                        stop("Variable types in 'x' and 'y' differ.
-Did you forget  to 'join' 'x' and 'y' before calling 'distance'?")
-
-                    ## Record the variable types
-                    type2x[tI <- type2x %in% c("numeric", "integer")] <- "Q"
-                    ## save which are ordinal for rank conversion below - TODO
-                    type2x[(ordinal <- type2x == "ordered")] <- "O"
-                    type2x[type2x == "factor"] <- "N"
-                    type2x[type2x == "logical"] <- "A"
-                    typeCodes <- c("A", "S", "N", "O", "Q", "I", "T")
-                    type3 <- match(type2x, typeCodes)
-                    if (any(ina <- is.na(type3)))
-                        stop("invalid type ", type2x[ina], " for column numbers ",
-                             pColl(which(ina)))
-
-                    ## Convert to matrices from now on
-                    ## also takes care of ordinal == metric as all factors
-                    ## are converted to internal numeric codes
-                    x <- data.matrix(x)
-                    y <- data.matrix(y)
-
-                    ## Compute range Rj
-                    XY <- rbind(x, y)
-                    if(is.null(R)) {
-                        maxi <- apply(XY, 2, max, na.rm = TRUE)
-                        mini <- apply(XY, 2, min, na.rm = TRUE)
-                        R <- maxi - mini
-                    } else {
-                        if(length(R) != n.vars)
-                            stop("'R' must be of length 'ncol(x)'")
-                    }
-
-                    ## call the C code
-                    d <- .C("xy_mixed", x = as.double(x), y = as.double(y),
-                            nr1 = as.integer(nrx), nr2 = as.integer(nry),
-                            nc = as.integer(n.vars), d = as.double(d),
-                            vtype = as.integer(type3),
-                            weights = as.double(weights), R = as.double(R),
-                            NAOK = as.integer(TRUE),
-                            PACKAGE = "analogue")$d
-                } else {
-                    if(is.null(R)) {
-                        XY <- rbind(x, y)
-                        maxi <- apply(XY, 2, max, na.rm = TRUE)
-                        mini <- apply(XY, 2, min, na.rm = TRUE)
-                        R <- maxi - mini
-                    } else {
-                        if(length(R) != n.vars)
-                            stop("'R' must be of length 'ncol(x)'")
-                    }
-                    x <- data.matrix(x)
-                    y <- data.matrix(y)
-
-                    ## pre-process for gower and alt gower
-                    ## but these handled by xy_distance below
-                    x <- sweep(x, 2, R, "/")
-                    y <- sweep(y, 2, R, "/")
-                    d <- .C("xy_distance", x = as.double(x), y = as.double(y),
-                            nr1 = as.integer(nrx), nr2 = as.integer(nry),
-                            nc = as.integer(n.vars), d = as.double(d),
-                            method = as.integer(DCOEF), NAOK = as.integer(FALSE),
-                            PACKAGE = "analogue")$d
-                }
-            }
-            if(method == "kendall") {
-                x <- data.matrix(x)
-                y <- data.matrix(y)
-                XY <- rbind(x, y)
-                maxi <- apply(XY, 2, max)
-                d <- .C("xy_kendall", x = as.double(x), y = as.double(y),
-                        nr1 = as.integer(nrx), nr2 = as.integer(nry),
-                        nc = as.integer(n.vars), d = as.double(d),
-                        maxi = as.double(maxi), NAOK = as.integer(FALSE),
-                        PACKAGE = "analogue")$d
-            }
-        } else {
-            ## must be one of the DC's handled by xy_distance
-            x <- data.matrix(x)
-            y <- data.matrix(y)
-            d <- .C("xy_distance", x = as.double(x), y = as.double(y),
-                    nr1 = as.integer(nrx), nr2 = as.integer(nry),
-                    nc = as.integer(n.vars), d = as.double(d),
-                    method = as.integer(DCOEF), NAOK = as.integer(FALSE),
-                    PACKAGE = "analogue")$d
-        }
-        ## convert d to a matrix
-        d <- matrix(d, ncol = nry, byrow = TRUE)
-        colnames(d) <- y.names
-        rownames(d) <- x.names
-        attr(d, "method") <- method
-        attr(d, "type") <- "asymmetric"
-        class(d) <- c("distance","matrix")
-    }
-    return(d)
-}

Deleted: pkg/R/distance_c.R
===================================================================
--- pkg/R/distance_c.R	2013-10-05 21:10:47 UTC (rev 367)
+++ pkg/R/distance_c.R	2013-10-05 21:11:52 UTC (rev 368)
@@ -1,110 +0,0 @@
-distanceX <- function(x, y, method = "euclidean", weights = NULL, R = NULL,
-                      as.dist = FALSE, ...) {
-    ## Euclid?an could be spelled variously
-    if(!is.na(pmatch(method, "euclidian")))
-	method <- "euclidean"
-    METHODS <- c("euclidean", "SQeuclidean", "chord", "SQchord",
-                 "bray", "chi.square", "SQchi.square",
-                 "information","chi.distance", "manhattan",
-                 "kendall", "gower", "alt.gower", "mixed")
-    DCOEF <- pmatch(method, METHODS)
-    if(missing(y)) { ## only a single matrix
-        ## variables
-        nr <- nrow(x)
-        nc <- ncol(x)
-        ## object names (row names)
-        x.names <- rownames(x)
-        ## some preprocessing steps required for some coefs
-        ## so dealt with separately
-        if(method %in% c("chi.distance", "gower", "alt.gower",
-                         "mixed", "kendall")) {
-          if(method == "chi.distance") {
-            x <- data.matrix(x)
-            csum <- colSums(x)
-            x <- x / rowSums(x)
-            d <- .Call("Cchisqdistxx", x, csum, PACKAGE = "analogue")
-          }
-          if(method == "kendall") {
-            x <- data.matrix(x)
-            maxi <- apply(x, 2, max)
-            d <- .Call("Ckendallxx", x, maxi, PACKAGE = "analogue")
-          }
-          if(method %in% c("gower", "alt.gower")) {
-            if(is.null(R)) {
-              x <- data.matrix(x)
-              maxi <- apply(x, 2, max, na.rm = TRUE)
-              mini <- apply(x, 2, min, na.rm = TRUE)
-              R <- maxi - mini
-            } else {
-              if(length(R) != nc)
-                stop("'R' must be of length 'ncol(x)'")
-            }
-            ## pre-process here for gower and alt.gower
-            ## but note we call the main driver Cdistxx
-            x <- sweep(x, 2, R, "/")
-            d <- .Call("Cdistxx", x, DCOEF, PACKAGE = "analogue")
-          }
-        } else {
-            ## must be one of the DC's handled by xy_distance
-            x <- data.matrix(x)
-            d <- .Call("Cdistxx", x, DCOEF, PACKAGE = "analogue")
-        }
-        attr(d, "Size") <- nr
-        attr(d, "Labels") <- x.names
-        attr(d, "Diag") <- FALSE
-        attr(d, "Upper") <- FALSE
-        attr(d, "method") <- method
-        attr(d, "call") <- match.call()
-        class(d) <- "dist"
-        if(!as.dist) {
-            d <- as.matrix(d)
-            attr(d, "method") <- method
-            attr(d, "type") <- "symmetric"
-            class(d) <- c("distance","matrix")
-        }
-    } else { ## two matrices
-        ## check x and y have same columns
-        if(!isTRUE(all.equal(names(x), names(y))))
-            stop("'x' and 'y' appear to have different variables.")
-        if(!isTRUE(all.equal((n.vars <- ncol(x)), ncol(y))))
-            stop("'x' and 'y' have different numbers of columns.")
-        ## variables
-        nrx <- nrow(x)
-        nry <- nrow(y)
-        ## object names (row names)
-        x.names <- rownames(x)
-        y.names <- rownames(y)
-        ## some preprocessing steps required for some coefs
-        ## so dealt with separately
-        if(method %in% c("chi.distance", "gower", "alt.gower",
-                         "mixed", "kendall")) {
-          if(method == "chi.distance") {
-            x <- data.matrix(x)
-            y <- data.matrix(y)
-            csum <- colSums(rbind(x, y))
-            y <- y / rowSums(y)
-            x <- x / rowSums(x)
-            d <- .C("xy_chisq_dist", x = as.double(x), y = as.double(y),
-                    nr1 = as.integer(nrx), nr2 = as.integer(nry),
-                    nc = as.integer(n.vars), d = as.double(d),
-                    csum = as.double(csum), NAOK = as.integer(FALSE),
-                    PACKAGE = "analogue")$d
-            ##d <- .Call("Cchisqdistxy", x, y, )
-          }
-        } else {
-          ## must be one of the DC's handled by xy_distance
-          x <- data.matrix(x)
-          y <- data.matrix(y)
-          d <- .Call("Cdistxy", x, y, DCOEF, PACKAGE = "analogue")
-        }
-
-        ## convert d to a matrix
-        d <- matrix(d, ncol = nry, byrow = TRUE)
-        colnames(d) <- y.names
-        rownames(d) <- x.names
-        attr(d, "method") <- method
-        attr(d, "type") <- "asymmetric"
-        class(d) <- c("distance","matrix")
-    }
-    d
-}

Added: pkg/R/new-distance.R
===================================================================
--- pkg/R/new-distance.R	                        (rev 0)
+++ pkg/R/new-distance.R	2013-10-05 21:11:52 UTC (rev 368)
@@ -0,0 +1,227 @@
+## New distance() generic and methods
+
+`distance` <- function(x, ...) {
+    UseMethod("distance")
+}
+
+distance.join <- function(x, ...) {
+    if(!inherits(x, "join"))
+        stop("This method should only be used on objects of class 'join'")
+    if(inherits(x, "data.frame")) {
+        distance.default(x, ...)
+    } else {
+        if(length(x) != 2)
+            warning("Object contains more than 2 data sets.\n  Only the first 2 data sets used")
+        distance.default(x[[1]], x[[2]], ...)
+    }
+}
+
+`distance.default` <- function(x, y, method = "euclidean", weights = NULL,
+                               R = NULL, dist = FALSE, ...){
+    ## Euclid?an could be spelled variously
+    if(!is.na(pmatch(method, "euclidian")))
+	method <- "euclidean"
+    METHODS <- c("euclidean", "SQeuclidean", "chord", "SQchord",
+                 "bray", "chi.square", "SQchi.square",
+                 "information","chi.distance", "manhattan",
+                 "kendall", "gower", "alt.gower", "mixed")
+    DCOEF <- pmatch(method, METHODS)
+    if(miss.y <- missing(y)) {
+        dmat <- dxx(x = x, DCOEF = DCOEF, weights = weights,
+                    R = R, dist = dist, ...)
+    } else {
+        dmat <- dxy(x = x, y = y, DCOEF = DCOEF, weights = weights,
+                    R = R, ...)
+    }
+
+    ## add attributes, classes, and return
+    attr(dmat, "method") <- method
+    if(!dist) {
+        class(dmat) <- c("distance", "matrix")
+        attr(dmat, "type") <- if(miss.y) "symmetric" else "asymmetric"
+    }
+    dmat
+}
+
+## Internal, not exported, function for computing distances when
+## only `x` is available
+`dxx` <- function(x, DCOEF, weights, R, dist = FALSE, ...) {
+    ## variables
+    nr <- nrow(x)
+    nc <- ncol(x)
+    ## object names (row names)
+    x.names <- rownames(x)
+
+    ## allocate storage
+    d <- double(nr * (nr - 1)/2)
+
+    ## some preprocessing steps required for some coefs
+    ## so dealt with separately
+    if(DCOEF %in% c(9L, 11L, 12L, 13L, 14L)) {
+        ## "chi.distance", "gower", "alt.gower","mixed", "kendall"
+        if(DCOEF == 9L) { ## "chi.distance"
+            x <- data.matrix(x)
+            csum <- colSums(x)
+            x <- x / rowSums(x)
+            d <- .C("xx_chisq_dist", x = as.double(x), nr = as.integer(nr),
+                    nc = as.integer(nc), d = as.double(d),
+                    diag = as.integer(FALSE),
+                    csum = as.double(csum), NAOK = as.integer(FALSE),
+                    PACKAGE = "analogue")$d
+        }
+        if(DCOEF == 11L) { ## "kendall"
+            x <- data.matrix(x)
+            maxi <- apply(x, 2, max)
+            d <- .C("xx_kendall", x = as.double(x), nr = as.integer(nr),
+                    nc = as.integer(nc), d = as.double(d),
+                    diag = as.integer(FALSE),
+                    maxi = as.double(maxi), NAOK = as.integer(FALSE),
+                    PACKAGE = "analogue")$d
+        }
+        if(DCOEF == 14L) { ## "mixed"
+            ## TODO
+        }
+        if(DCOEF %in% c(12L, 13L)) { ## "gower", "alt.gower"
+            if(is.null(R)) {
+                x <- data.matrix(x)
+                maxi <- apply(x, 2, max, na.rm = TRUE)
+                mini <- apply(x, 2, min, na.rm = TRUE)
+                R <- maxi - mini
+            } else {
+                if(length(R) != nc)
+                    stop("'R' must be of length 'ncol(x)'")
+            }
+            ## pre-process here for gower and alt.gower
+            ## but note we call the main driver Cdistxx
+            x <- sweep(x, 2, R, "/")
+            d <- .C("xx_distance", x = as.double(x),
+                    nr = as.integer(nr), nc = as.integer(nc),
+                    d = as.double(d), diag = as.integer(FALSE),
+                    method = as.integer(DCOEF),
+                    NAOK = as.integer(FALSE),
+                    PACKAGE = "analogue")$d
+        }
+    } else {
+        ## must be one of the DC's handled by xy_distance
+        x <- data.matrix(x)
+        d <- .C("xx_distance", x = as.double(x),
+                nr = as.integer(nr), nc = as.integer(nc),
+                d = as.double(d), diag = as.integer(FALSE),
+                method = as.integer(DCOEF),
+                NAOK = as.integer(FALSE), PACKAGE = "analogue")$d
+    }
+
+    ## convert d to a matrix
+    ZAP <- 1e-15
+    d[d < ZAP] <- 0
+    if (any(is.na(d)))
+        warning("missing values in results")
+    attr(d, "Size") <- nr
+    attr(d, "Labels") <- x.names #dimnames(x)[[1]]
+    attr(d, "Diag") <- FALSE
+    attr(d, "Upper") <- FALSE
+    attr(d, "method") <- DCOEF
+    attr(d, "call") <- match.call()
+    class(d) <- "dist"
+
+    ## convert to matrix? Only if dist == FALSE
+    if(!dist) {
+        d <- as.matrix(d)
+    }
+
+    ## return
+    d
+}
+
+## Internal, not exported, function for computing distances when
+## both `x` and `y` are available
+`dxy` <- function(x, y, DCOEF, weights, R, ...) {
+    ## check x and y have same columns
+    if(!isTRUE(all.equal(colnames(x), colnames(y))))
+        stop("'x' and 'y' appear to have different variables.")
+    if(!isTRUE(all.equal((n.vars <- ncol(x)), ncol(y))))
+        stop("'x' and 'y' have different numbers of columns.")
+    ## variables
+    nrx <- nrow(x)
+    nry <- nrow(y)
+    nc <- ncol(x)
+
+    ## object names (row names)
+    x.names <- rownames(x)
+    y.names <- rownames(y)
+
+    ## allocate storage
+    d <- numeric(length = nrx * nry)
+
+    ## some preprocessing steps required for some coefs
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/analogue -r 368

From noreply at r-forge.r-project.org  Sun Oct  6 22:32:05 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sun,  6 Oct 2013 22:32:05 +0200 (CEST)
Subject: [Analogue-commits] r369 - in pkg: R src
Message-ID: <20131006203205.AE9A418459A@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-06 22:32:05 +0200 (Sun, 06 Oct 2013)
New Revision: 369

Modified:
   pkg/R/new-distance.R
   pkg/src/distx.c
Log:
Gowers mixed coef now implemented for the x-only case

Modified: pkg/R/new-distance.R
===================================================================
--- pkg/R/new-distance.R	2013-10-05 21:11:52 UTC (rev 368)
+++ pkg/R/new-distance.R	2013-10-06 20:32:05 UTC (rev 369)
@@ -79,7 +79,56 @@
                     PACKAGE = "analogue")$d
         }
         if(DCOEF == 14L) { ## "mixed"
-            ## TODO
+            if(is.null(weights))
+                weights <- rep(1, nc)
+            else {
+                if(length(weights) != nc)
+                    stop("'weights' must be of length 'ncol(x)'")
+            }
+            ## process vtypes
+            if(is.data.frame(x)) {
+                xType <- sapply(x, data.class, USE.NAMES = FALSE)
+            } else {
+                xType <- rep("numeric", n.vars)
+                names(xType) <- colnames(x)
+            }
+            ## Record the variable types
+            xType[tI <- xType %in% c("numeric", "integer")] <- "Q"
+            ## save which are ordinal for rank conversion below - TODO
+            xType[(ordinal <- xType == "ordered")] <- "O"
+            xType[xType == "factor"] <- "N"
+            xType[xType == "logical"] <- "A"
+            typeCodes <- c("A", "S", "N", "O", "Q", "I", "T")
+            xType <- match(xType, typeCodes)
+            if (any(ina <- is.na(xType)))
+                stop("invalid type ", xType[ina], " for column numbers ",
+                     paste(pColl(which(ina)), collapse = ", "))
+
+            ## convert to matrix, preserving factor info as numeric
+            x <- data.matrix(x)
+
+            ## Compute range Rj
+            if(is.null(R)) {
+                maxi <- apply(x, 2, max, na.rm = TRUE)
+                mini <- apply(x, 2, min, na.rm = TRUE)
+                R <- maxi - mini
+            } else {
+                if(length(R) != nc)
+                    stop("'R' must be of length 'ncol(x)'")
+            }
+
+            ## call the C code
+            d <- .C("xx_mixed",
+                    x = as.double(x),
+                    nr = as.integer(nr),
+                    nc = as.integer(nc),
+                    d = as.double(d),
+                    diag = as.integer(FALSE),
+                    vtype = as.integer(xType),
+                    weights = as.double(weights),
+                    R = as.double(R),
+                    NAOK = as.integer(TRUE),
+                    PACKAGE = "analogue")$d
         }
         if(DCOEF %in% c(12L, 13L)) { ## "gower", "alt.gower"
             if(is.null(R)) {

Modified: pkg/src/distx.c
===================================================================
--- pkg/src/distx.c	2013-10-05 21:11:52 UTC (rev 368)
+++ pkg/src/distx.c	2013-10-06 20:32:05 UTC (rev 369)
@@ -496,74 +496,76 @@
 		int *vtype, double *weights, double *R, 
 		double wsum)
 {
-    double dist, dev;
-    int count, j;
-    
-    count = 0;
-    dist = 0.0;
-    wsum = 0.0;
-
-    for (j=0; j<nc; j++) {
-	if (R_FINITE(x[i1]) && R_FINITE(x[i2])) {
-	    if(vtype[j] == 1) {
-		dev = (x[i1] == x[i2]) ? 1 : 0;
-		dist += dev * weights[j];
-	    }
-	    if(vtype[j] == 2) { // Asymmetric binary
-		    /*dev = (x[i1] == x[i2]) ? 1 : 0;
-		      dist += dev * weights[j]; */
-		    if((x[i1] != 0) || (x[i2] != 0)) {
-			    // both x1 and x2 not zero for this variables
-			    dev = (x[i1] == x[i2]) ? 1 : 0;
-			    dist += dev * weights[j];
-		    } else {
-			    /* set jth current weight to zero and do not
-			       increment dist as ignoring double zero
-			       We actually subtract the weight as it gets added
-			       later on.
-			    */
-			    wsum -= weights[j];
-		    }
-	    }
-	    if(vtype[j] == 3) { // Nominal
-		dev = (x[i1] == x[i2]) ? 1 : 0;
-		dist += dev * weights[j];
-	    }
-	    if(vtype[j] == 4) { // Ordinal
-		/* ordinal data currently handled as Nominal */
-		dev = (x[i1] == x[i2]) ? 1 : 0;
-		dist += dev * weights[j];
-		break;
-	    }
-	    if(vtype[j] == 5) {
-		dev = 1 - (fabs(x[i1] - x[i2]) / R[j]);
-		dist += dev * weights[j];
-	    }
-	    count++;
-	    // only summing weights for non-NA comparisons
-	    wsum += weights[j];
+  double dist, dev;
+  int count, j;
+  
+  count = 0;
+  dist = 0.0;
+  wsum = 0.0;
+  
+  for (j=0; j<nc; j++) {
+    if (R_FINITE(x[i1]) && R_FINITE(x[i2])) {
+      if(vtype[j] == 1) {
+	dev = (x[i1] == x[i2]) ? 1 : 0;
+	dist += dev * weights[j];
+      }
+      if(vtype[j] == 2) { // Asymmetric binary
+	/*dev = (x[i1] == x[i2]) ? 1 : 0;
+	  dist += dev * weights[j]; */
+	if((x[i1] != 0) || (x[i2] != 0)) {
+	  // both x1 and x2 not zero for this variables
+	  dev = (x[i1] == x[i2]) ? 1 : 0;
+	  dist += dev * weights[j];
+	} else {
+	  /* set jth current weight to zero and do not
+	     increment dist as ignoring double zero
+	     We actually subtract the weight as it gets added
+	     later on.
+	  */
+	  wsum -= weights[j];
 	}
-	i1 += nr;
-	i2 += nr;
+      }
+      if(vtype[j] == 3) { // Nominal
+	dev = (x[i1] == x[i2]) ? 1 : 0;
+	dist += dev * weights[j];
+      }
+      if(vtype[j] == 4) { // Ordinal
+	/* ordinal data currently handled as Nominal */
+	dev = (x[i1] == x[i2]) ? 1 : 0;
+	dist += dev * weights[j];
+	break;
+      }
+      if(vtype[j] == 5) {
+	dev = 1 - (fabs(x[i1] - x[i2]) / R[j]);
+	dist += dev * weights[j];
+      }
+      count++;
+      // only summing weights for non-NA comparisons
+      wsum += weights[j];
     }
-    if (count == 0) return NA_REAL;
-    return 1 - (dist / wsum);
+    i1 += nr;
+    i2 += nr;
+  }
+  if (count == 0) return NA_REAL;
+  return 1 - (dist / wsum);
 }
 
+/*
 double xx_calcTI(double *x, double *y, int nr1, int nr2, int nc, int i1, int i2)
 {
-    int k;
-    double ti;
+int k;
+double ti;
 
-    ti = 0.0;
+ti = 0.0;
 
-    for (k=0; k<nc; k++) {
-	ti += (x[i1] == y[i2]) ? 1.0 : 0.0;
-	i1 += nr1;
-	i2 += nr2;
-    }
-    return ti;
+for (k=0; k<nc; k++) {
+ti += (x[i1] == y[i2]) ? 1.0 : 0.0;
+i1 += nr1;
+i2 += nr2;
 }
+return ti;
+}
+*/
 
 void xx_mixed(double *x, int *nr, int *nc, double *d, 
 	      int *diag, int *vtype, double *weights, double *R)


From noreply at r-forge.r-project.org  Sun Oct  6 22:40:32 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sun,  6 Oct 2013 22:40:32 +0200 (CEST)
Subject: [Analogue-commits] r370 - pkg/src
Message-ID: <20131006204032.84A29184888@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-06 22:40:32 +0200 (Sun, 06 Oct 2013)
New Revision: 370

Modified:
   pkg/src/distx.c
Log:
a little tidying

Modified: pkg/src/distx.c
===================================================================
--- pkg/src/distx.c	2013-10-06 20:32:05 UTC (rev 369)
+++ pkg/src/distx.c	2013-10-06 20:40:32 UTC (rev 370)
@@ -505,13 +505,13 @@
   
   for (j=0; j<nc; j++) {
     if (R_FINITE(x[i1]) && R_FINITE(x[i2])) {
+      // Symmetric binary
       if(vtype[j] == 1) {
 	dev = (x[i1] == x[i2]) ? 1 : 0;
 	dist += dev * weights[j];
       }
-      if(vtype[j] == 2) { // Asymmetric binary
-	/*dev = (x[i1] == x[i2]) ? 1 : 0;
-	  dist += dev * weights[j]; */
+      // Asymmetric binary
+      if(vtype[j] == 2) {
 	if((x[i1] != 0) || (x[i2] != 0)) {
 	  // both x1 and x2 not zero for this variables
 	  dev = (x[i1] == x[i2]) ? 1 : 0;
@@ -525,16 +525,19 @@
 	  wsum -= weights[j];
 	}
       }
-      if(vtype[j] == 3) { // Nominal
+      // Nominal
+      if(vtype[j] == 3) {
 	dev = (x[i1] == x[i2]) ? 1 : 0;
 	dist += dev * weights[j];
       }
-      if(vtype[j] == 4) { // Ordinal
+      // Ordinal
+      if(vtype[j] == 4) {
 	/* ordinal data currently handled as Nominal */
 	dev = (x[i1] == x[i2]) ? 1 : 0;
 	dist += dev * weights[j];
 	break;
       }
+      // Quantitative
       if(vtype[j] == 5) {
 	dev = 1 - (fabs(x[i1] - x[i2]) / R[j]);
 	dist += dev * weights[j];


From noreply at r-forge.r-project.org  Mon Oct  7 00:48:37 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Mon,  7 Oct 2013 00:48:37 +0200 (CEST)
Subject: [Analogue-commits] r371 - in pkg: R man src
Message-ID: <20131006224837.869BA184BDE@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-07 00:48:37 +0200 (Mon, 07 Oct 2013)
New Revision: 371

Modified:
   pkg/R/distance.R
   pkg/R/new-distance.R
   pkg/man/distance.Rd
   pkg/src/distxy.c
Log:
now Gowers mixed coef also works for case of supplied x and y

Modified: pkg/R/distance.R
===================================================================
--- pkg/R/distance.R	2013-10-06 20:40:32 UTC (rev 370)
+++ pkg/R/distance.R	2013-10-06 22:48:37 UTC (rev 371)
@@ -11,7 +11,7 @@
 ##                                                                       ##
 ###########################################################################
 ## x = training data, y = fossil data
-oldDistance <- function(x, ...) UseMethod("distance")
+oldDistance <- function(x, ...) UseMethod("oldDistance")
 
 oldDistance.join <- function(x, ...)
   {

Modified: pkg/R/new-distance.R
===================================================================
--- pkg/R/new-distance.R	2013-10-06 20:40:32 UTC (rev 370)
+++ pkg/R/new-distance.R	2013-10-06 22:48:37 UTC (rev 371)
@@ -89,7 +89,7 @@
             if(is.data.frame(x)) {
                 xType <- sapply(x, data.class, USE.NAMES = FALSE)
             } else {
-                xType <- rep("numeric", n.vars)
+                xType <- rep("numeric", nc)
                 names(xType) <- colnames(x)
             }
             ## Record the variable types
@@ -102,7 +102,7 @@
             xType <- match(xType, typeCodes)
             if (any(ina <- is.na(xType)))
                 stop("invalid type ", xType[ina], " for column numbers ",
-                     paste(pColl(which(ina)), collapse = ", "))
+                     paste(which(ina), collapse = ", "))
 
             ## convert to matrix, preserving factor info as numeric
             x <- data.matrix(x)
@@ -230,7 +230,74 @@
                     PACKAGE = "analogue")$d
         }
         if(DCOEF == 14L) { ## "mixed"
-            ## TODO
+            if(is.null(weights))
+                weights <- rep(1, nc)
+            else {
+                if(length(weights) != nc)
+                    stop("'weights' must be of length 'ncol(x)'")
+            }
+            ## process vtypes
+            if(is.data.frame(x)) {
+                xType <- sapply(x, data.class, USE.NAMES = FALSE)
+                ##x <- data.matrix(x)
+            } else {
+                xType <- rep("numeric", nc)
+                names(xType) <- colnames(x)
+            }
+            if(is.data.frame(y)) {
+                yType <- sapply(y, data.class, USE.NAMES = FALSE)
+                ##y <- data.matrix(y)
+            } else {
+                yType <- rep("numeric", nc)
+                names(yType) <- colnames(y)
+            }
+            ## x and y should have same column types
+            if(!isTRUE(all.equal(xType, yType)))
+                stop("Variable types in 'x' and 'y' differ.
+Did you forget  to 'join' 'x' and 'y' before calling 'distance'?")
+
+            ## Record the variable types
+            xType[tI <- xType %in% c("numeric", "integer")] <- "Q"
+            ## save which are ordinal for rank conversion below - TODO
+            xType[(ordinal <- xType == "ordered")] <- "O"
+            xType[xType == "factor"] <- "N"
+            xType[xType == "logical"] <- "A"
+            typeCodes <- c("A", "S", "N", "O", "Q", "I", "T")
+            xType <- match(xType, typeCodes)
+            if (any(ina <- is.na(xType)))
+                stop("invalid type ", xType[ina], " for column numbers ",
+                     paste(which(ina), collapse = ", "))
+
+            ## Convert to matrices from now on
+            ## also takes care of ordinal == metric as all factors
+            ## are converted to internal numeric codes
+            x <- data.matrix(x)
+            y <- data.matrix(y)
+
+            ## Compute range Rj
+            XY <- rbind(x, y)
+            if(is.null(R)) {
+                maxi <- apply(XY, 2, max, na.rm = TRUE)
+                mini <- apply(XY, 2, min, na.rm = TRUE)
+                R <- maxi - mini
+            } else {
+                if(length(R) != nc)
+                    stop("'R' must be of length 'ncol(x)'")
+            }
+
+            ## call the C code
+            d <- .C("xy_mixed",
+                    x = as.double(x),
+                    y = as.double(y),
+                    nr1 = as.integer(nrx),
+                    nr2 = as.integer(nry),
+                    nc = as.integer(nc),
+                    d = as.double(d),
+                    vtype = as.integer(xType),
+                    weights = as.double(weights),
+                    R = as.double(R),
+                    NAOK = as.integer(TRUE),
+                    PACKAGE = "analogue")$d
         }
         if(DCOEF %in% c(12L, 13L)) { ## "gower", "alt.gower"
             if(is.null(R)) {

Modified: pkg/man/distance.Rd
===================================================================
--- pkg/man/distance.Rd	2013-10-06 20:40:32 UTC (rev 370)
+++ pkg/man/distance.Rd	2013-10-06 22:48:37 UTC (rev 371)
@@ -238,22 +238,22 @@
 
 ## calculate Gower's general coefficient for mixed data
 ## first, make a couple of variables factors
+
 fossil[,4] <- factor(sample(rep(1:4, length = 10), 10))
 train[,4] <- factor(sample(rep(1:4, length = 20), 20))
 ## now fit the mixed coefficient
-#test3 <- distance(train, fossil, "mixed")
+test3 <- distance(train, fossil, "mixed")
 
 ## Example from page 260 of Legendre & Legendre (1998)
 x1 <- t(c(2,2,NA,2,2,4,2,6))
 x2 <- t(c(1,3,3,1,2,2,2,5))
 Rj <- c(1,4,2,4,1,3,2,5) # supplied ranges
 
-#distance(x1, x2, method = "mixed", R = Rj)
+1 - distance(x1, x2, method = "mixed", R = Rj)
 
-## note this gives 1 - 0.66 (not 0.66 as the answer in
-## Legendre & Legendre) as this is expressed as a
-## distance whereas Legendre & Legendre describe the
-## coefficient as similarity coefficient
+## note this gives ~0.66 as Legendre & Legendre describe the
+## coefficient as a similarity coefficient. Hence here we do
+## 1 - Dij here to get the same answer. 
 }
 \keyword{multivariate}% at least one, from doc/KEYWORDS
 \keyword{methods}

Modified: pkg/src/distxy.c
===================================================================
--- pkg/src/distxy.c	2013-10-06 20:40:32 UTC (rev 370)
+++ pkg/src/distxy.c	2013-10-06 22:48:37 UTC (rev 371)
@@ -587,84 +587,89 @@
 		int nc, int i1, int i2, int *vtype,
 		double *weights, double *R, double wsum)
 {
-    double dist, dev;
-    int count, j;
+  double dist, dev;
+  int count, j;
+  
+  count = 0;
+  dist = 0.0;
+  wsum = 0.0;
+  //curweights = weights; /* current weights */
     
-    count = 0;
-    dist = 0.0;
-    wsum = 0.0;
-    //curweights = weights; /* current weights */
-    
-    for (j=0; j<nc; j++) {
-	if (R_FINITE(x[i1]) && R_FINITE(y[i2])) {
-	    if(vtype[j] == 1) { // Symmetric binary
-		dev = (x[i1] == y[i2]) ? 1 : 0;
-		dist += dev * weights[j];
-	    }
-	    if(vtype[j] == 2) { // Asymmetric binary
-		if((x[i1] != 0) || (y[i2] != 0)) {
-		    // both x and y not zero for this variables
-		    dev = (x[i1] == y[i2]) ? 1 : 0;
-		    dist += dev * weights[j];
-		} else {
-		    /* set jth current weight to zero and do not
-		       increment dist as ignoring double zero
-		       We actually subtract the weight as it gets added
-		       later on.
-		    */
-		    wsum -= weights[j];
-		}
-	    }
-	    if(vtype[j] == 3) { // Nominal
-		dev = (x[i1] == y[i2]) ? 1 : 0;
-		dist += dev * weights[j];
-	    }
-	    if(vtype[j] == 4) { // Ordinal
-		dev = (x[i1] == y[i2]) ? 1 : 0;
-		dist += dev * weights[j];
-		break;
-		/* ordinal data current not handled 
-		 * so don't call this yet
-		 */
-		/* switch(ord) {
-		   case 1: { // classic gower as per nominal
-		   dev = (x[i1] == y[i2]) ? 1 : 0;
-		   dist += dev * weights[j];
-		   break;
-		   }
-		   case 2: { // podanis rank version
-		   if(x[i1] == y[i2]) {
-		   dev = 1;
-		   } else {
-		   dev = (fabs(x[i1] - y[i2])) / 
-		   (R[j] - (tmax - 1)/2 - (tmin - 1)/2);
-		   }
-		   break;
-		   }
-		   case 3: { // podanis metric version treat as Quantitative??
-		   dev = 1 - (fabs(x[i1] - y[i2]) / R[j]);
-		   dist += dev * weights[j];
-		   break;
-		   }
-		   default: {
-		   dist += 0;
-		   break;
-		   }
-		   }*/
-	    }
-	    if(vtype[j] == 5) { // Quantitative
-		dev = 1 - (fabs(x[i1] - y[i2]) / R[j]);
-		dist += dev * weights[j];
-	    }
-	    count++;
-	    // only summing weights for non-NA comparisons
-	    wsum += weights[j];
+  for (j=0; j<nc; j++) {
+    if (R_FINITE(x[i1]) && R_FINITE(y[i2])) {
+      // Symmetric binary
+      if(vtype[j] == 1) {
+	dev = (x[i1] == y[i2]) ? 1 : 0;
+	dist += dev * weights[j];
+      }
+      // Asymmetric binary
+      if(vtype[j] == 2) {
+	if((x[i1] != 0) || (y[i2] != 0)) {
+	  // both x and y not zero for this variables
+	  dev = (x[i1] == y[i2]) ? 1 : 0;
+	  dist += dev * weights[j];
+	} else {
+	  /* set jth current weight to zero and do not
+	     increment dist as ignoring double zero
+	     We actually subtract the weight as it gets added
+	     later on.
+	  */
+	  wsum -= weights[j];
 	}
-	i1 += nr1;
-	i2 += nr2;
+      }
+      // Nominal
+      if(vtype[j] == 3) {
+	dev = (x[i1] == y[i2]) ? 1 : 0;
+	dist += dev * weights[j];
+      }
+      // Ordinal
+      if(vtype[j] == 4) {
+	dev = (x[i1] == y[i2]) ? 1 : 0;
+	dist += dev * weights[j];
+	break;
+	/* ordinal data current not handled 
+	 * so don't call this yet
+	 */
+	/* switch(ord) {
+	   case 1: { // classic gower as per nominal
+	   dev = (x[i1] == y[i2]) ? 1 : 0;
+	   dist += dev * weights[j];
+	   break;
+	   }
+	   case 2: { // podanis rank version
+	   if(x[i1] == y[i2]) {
+	   dev = 1;
+	   } else {
+	   dev = (fabs(x[i1] - y[i2])) / 
+	   (R[j] - (tmax - 1)/2 - (tmin - 1)/2);
+	   }
+	   break;
+	   }
+	   case 3: { // podanis metric version treat as Quantitative??
+	   dev = 1 - (fabs(x[i1] - y[i2]) / R[j]);
+	   dist += dev * weights[j];
+	   break;
+	   }
+	   default: {
+	   dist += 0;
+	   break;
+	   }
+	   }*/
+      }
+      // Quantitative
+      if(vtype[j] == 5) {
+	dev = 1 - (fabs(x[i1] - y[i2]) / R[j]);
+	dist += dev * weights[j];
+      }
+      count++;
+      // only summing weights for non-NA comparisons
+      wsum += weights[j];
     }
-    if (count == 0) return NA_REAL;
-    return 1 - (dist / wsum);
+    i1 += nr1;
+    i2 += nr2;
+  }
+  if (count == 0) return NA_REAL;
+  return 1 - (dist / wsum);
 }
 
 double xy_calcTI(double *x, double *y, int nr1, int nr2, int nc, int i1, int i2)


From noreply at r-forge.r-project.org  Mon Oct  7 02:09:15 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Mon,  7 Oct 2013 02:09:15 +0200 (CEST)
Subject: [Analogue-commits] r372 - pkg/R
Message-ID: <20131007000915.437EC184699@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-07 02:09:14 +0200 (Mon, 07 Oct 2013)
New Revision: 372

Modified:
   pkg/R/distance.R
Log:
fixes a bug in oldDistance() with Kendalls coef in the only-x case

Modified: pkg/R/distance.R
===================================================================
--- pkg/R/distance.R	2013-10-06 22:48:37 UTC (rev 371)
+++ pkg/R/distance.R	2013-10-07 00:09:14 UTC (rev 372)
@@ -83,7 +83,14 @@
       }
     kendall <- function(x, y, maxi)
       {
-        sum(maxi - pmin(x, y))
+          ## the sum in the else isn't right if x == y
+          ## then the dissimilarity should be 0
+          out <- if (isTRUE(all.equal(sum(x-y), 0))) {
+              0
+          } else {
+              sum(maxi - pmin(x, y))
+          }
+          out
       }
     gower <- function(x, y, maxi, mini)
       {
@@ -215,7 +222,8 @@
         } else {
             apply(y, 2, max, na.rm = NA.RM)
         }
-        maxi <- apply(rbind(maxX, maxY), 2, max, na.rm = NA.RM)
+        ##maxi <- apply(rbind(maxX, maxY), 2, max, na.rm = NA.RM)
+        maxi <- pmax(maxX, maxY)
         if(method %in% c("gower", "alt.gower", "mixed")) {
             ## need the mins of each variable
             ## need to account for a single site (matrix with 1 row)


From noreply at r-forge.r-project.org  Mon Oct  7 02:16:29 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Mon,  7 Oct 2013 02:16:29 +0200 (CEST)
Subject: [Analogue-commits] r373 - pkg/inst/tests
Message-ID: <20131007001629.7D06F184699@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-07 02:16:29 +0200 (Mon, 07 Oct 2013)
New Revision: 373

Modified:
   pkg/inst/tests/test-new-distance.R
Log:
now checks all dissimilarity methods in x-only and x and y cases

Modified: pkg/inst/tests/test-new-distance.R
===================================================================
--- pkg/inst/tests/test-new-distance.R	2013-10-07 00:09:14 UTC (rev 372)
+++ pkg/inst/tests/test-new-distance.R	2013-10-07 00:16:29 UTC (rev 373)
@@ -4,7 +4,7 @@
 library("testthat")
 library_if_available("analogue")
 
-context("Testing new distance compiled code functions")
+context("Testing distance compiled code")
 
 ## simple example using dummy data
 train <- data.frame(matrix(abs(runif(200)), ncol = 10))
@@ -14,6 +14,12 @@
 colnames(fossil) <- as.character(1:10)
 rownames(fossil) <- letters[1:10]
 
+## Distance methods to check
+METHODS <- c("euclidean", "SQeuclidean","chord", "SQchord",
+             "bray", "chi.square", "SQchi.square", "information",
+             "chi.distance", "manhattan", "kendall", "gower",
+             "alt.gower", "mixed")
+
 ## test methods for x and y
 test_that("distance matches compiled versions for x and y", {
 
@@ -21,9 +27,26 @@
     expect_equal(distance(train, fossil),
                  oldDistance(train, fossil))
 
-    ## euclidean
-    method <- "euclidean"
-    expect_equal(distance(train, fossil, method = method),
-                 oldDistance(train, fossil, method = method))
+    ## check all the methods
+    for (m in METHODS) {
+        ##writeLines(paste("Method:", m))
+        expect_equal(distance(train, fossil, method = m),
+                     oldDistance(train, fossil, method = m))
+    }
 
 })
+
+## test methods for x only
+test_that("distance matches compiled versions for x only", {
+
+    ## default settings
+    expect_equal(distance(train), oldDistance(train))
+
+    ## check all the methods
+    for (m in METHODS) {
+        ##writeLines(paste("Method:", m))
+        expect_equal(distance(train, method = m),
+                     oldDistance(train, method = m))
+    }
+
+})


From noreply at r-forge.r-project.org  Mon Oct  7 02:17:24 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Mon,  7 Oct 2013 02:17:24 +0200 (CEST)
Subject: [Analogue-commits] r374 - pkg/R
Message-ID: <20131007001724.86D63184699@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-07 02:17:24 +0200 (Mon, 07 Oct 2013)
New Revision: 374

Modified:
   pkg/R/new-distance.R
Log:
fix a minor typo in code applied to Kendall Dij in the x and y case

Modified: pkg/R/new-distance.R
===================================================================
--- pkg/R/new-distance.R	2013-10-07 00:16:29 UTC (rev 373)
+++ pkg/R/new-distance.R	2013-10-07 00:17:24 UTC (rev 374)
@@ -220,7 +220,7 @@
         }
         if(DCOEF == 11L) { ## "kendall"
             x <- data.matrix(x)
-            x <- data.matrix(y)
+            y <- data.matrix(y)
             XY <- rbind(x, y)
             maxi <- apply(XY, 2, max)
             d <- .C("xy_kendall", x = as.double(x), y = as.double(y),


From noreply at r-forge.r-project.org  Mon Oct  7 04:32:59 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Mon,  7 Oct 2013 04:32:59 +0200 (CEST)
Subject: [Analogue-commits] r375 - pkg/vignettes
Message-ID: <20131007023259.F30C01800FB@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-07 04:32:59 +0200 (Mon, 07 Oct 2013)
New Revision: 375

Modified:
   pkg/vignettes/analogue_methods.Rnw
   pkg/vignettes/analogue_refs.bib
Log:
some minor edits to update details on C versions of dissimilarities and development dstage

Modified: pkg/vignettes/analogue_methods.Rnw
===================================================================
--- pkg/vignettes/analogue_methods.Rnw	2013-10-07 00:17:24 UTC (rev 374)
+++ pkg/vignettes/analogue_methods.Rnw	2013-10-07 02:32:59 UTC (rev 375)
@@ -432,7 +432,7 @@
 We briefly describe some of the other features of the \pkg{analogue} package.
 
 \subsection{Dissimilarity coefficients}\label{dissims}
-Analogue provides a wide range of dissimilarity coefficients via the \code{distance} function. A list of the coefficients provided is shown in Table \ref{dissim_tab}. All the dissimilarity coefficients are coded in pure \proglang{R} code. As such, \code{distance} will not be as quick as other similar functions available in \proglang{R}, such as \code{dist}, or \code{vegdist} in \pkg{vegan}, where the computations are done in compiled \proglang{C} code. Where there is overlap with coefficients available explicitly or indirectly (via transformation), in functions \code{dist} or \code{vegdist}, these faster functions are used by default, but only if no second argument \code{y} is supplied.
+Analogue provides a wide range of dissimilarity coefficients via the \code{distance} function. A list of the coefficients provided is shown in Table \ref{dissim_tab}. In early versions of \pkg{analogue}, all the dissimilarity coefficients were written in pure \proglang{R} code. As such, \code{distance} was not particulalry efficient compared to other similar functions available in \proglang{R}, such as \code{dist}, or \code{vegdist} in \pkg{vegan}. Starting with version 0.11-6 of \pkg{analogue} all dissimilarity coeficients are now computed using fast \proglang{C} functions modelled after \code{dist}, or \code{vegdist} in \pkg{vegan}. The first publicly-available version of \pkg{analogue} on CRAN employing the faster version of \code{distance} is version 0.12-0. The old behaviour is retained for compatibility under function \code{oldDistance}.
 
 \renewcommand{\thefootnote}{\fnsymbol{footnote}}
 \renewcommand{\arraystretch}{1.25}
@@ -642,12 +642,12 @@
 \section{Final remarks and future development plans}\label{future_plans}
 The functionality of \proglang{R} package \pkg{analogue} has been demonstrated and explained using the SWAP diatom:pH data set and diatom counts from the RLGH sediment core. The SWAP dataset is a relatively large data set compared to those routinely produced in palaeoecological studies, and as such represents a real-world example of the type of data used in the field.
 
-\pkg{analogue} is still in the early stages of planned development. The main functionality for generating MAT transfer functions and reconstructions and for performing AM is already implemented, but several areas of development remain.
+\pkg{analogue} is still under active development. The main functionality for generating MAT transfer functions and reconstructions and for performing AM is already implemented, but several areas of development remain.
 
-As mentioned above, faster \proglang{C} versions of the dissimilarity calculations are planned to speed up the functions for use on large problems. Also, the package code has yet to receive any rigorous optimisation in terms of memory usage or computation time. Once the feature set has stabilised sufficiently, a code review will be performed to identify bottlenecks and to improve the implementation where possible.
-
 It will be noticeable that the functionality is more comprehensive for MAT transfer functions than for analogue matching. This is purely a function of legacy; MAT models have been used in palaeoecology for over 20 years, but analogue matching (in the sense presented in this paper) is a much newer topic and exactly how the results of AM are used in informing conservation policy is an area of ongoing research. As new developments are proposed, they will be added to future versions of \pkg{analogue}.
 
+Since this published version of this paper appeared, \pkg{analogue} has been extended in a number of areas. Notably, MAT has since been joined by weighted averaging and principal components regression transfer function methods. With principal components regression, the ability to apply ecologically-meaningful transformations \emph{sensu} \citet{legendre-gallagher} is a novel approach.
+
 \section*{Acknowledgements}
 Support, in part, for the development of this package was provided by the European Union Sixth Framework Programme integrated project Euro-limpacs (GOCE-CT-2003-505540). The author wishes to thank Viv Jones for permission to use the RLGH core data and to distribute these data with \pkg{analogue}. Two anonymous reviewers and the guest editors provided numerous comments and suggestions that have improved both the manuscript and the package.
 

Modified: pkg/vignettes/analogue_refs.bib
===================================================================
--- pkg/vignettes/analogue_refs.bib	2013-10-07 00:17:24 UTC (rev 374)
+++ pkg/vignettes/analogue_refs.bib	2013-10-07 02:32:59 UTC (rev 375)
@@ -279,3 +279,16 @@
   year           = 2007
 }
 
+
+ at Article{legendre-gallagher,
+  Author         = {P. Legendre and E. D. Gallagher},
+  Title          = {Ecologically meaningful transformations for ordination
+                    of species data},
+  Journal        = {Oecologia},
+  Volume         = {129},
+  Number         = {2},
+  Pages          = {271--280},
+  month          = {},
+  year           = 2001,
+  doi            = {10.1007/s004420100716}
+}


From noreply at r-forge.r-project.org  Mon Oct  7 04:36:01 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Mon,  7 Oct 2013 04:36:01 +0200 (CEST)
Subject: [Analogue-commits] r376 - pkg/inst
Message-ID: <20131007023601.D824E184EED@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-07 04:36:01 +0200 (Mon, 07 Oct 2013)
New Revision: 376

Modified:
   pkg/inst/ChangeLog
Log:
document some recent changes

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2013-10-07 02:32:59 UTC (rev 375)
+++ pkg/inst/ChangeLog	2013-10-07 02:36:01 UTC (rev 376)
@@ -10,6 +10,12 @@
 	This implements the change suggested in 0.11-5. `distance()` is
 	now using the compiled C versions of the dissimilarity code.
 
+	* oldDistance: (was `distance()`) fixed a bug in the x-only case
+	where `method = "kendall"`.
+
+	* Vignette: Updated some details regarding C versions of
+	dissimilarity coefs.
+
 Version 0.11-5
 
 	* newDistance: (yet another) new distance() replacement to


From noreply at r-forge.r-project.org  Mon Oct  7 04:36:50 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Mon,  7 Oct 2013 04:36:50 +0200 (CEST)
Subject: [Analogue-commits] r377 - pkg/tests/Examples
Message-ID: <20131007023650.6A689184699@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-07 04:36:50 +0200 (Mon, 07 Oct 2013)
New Revision: 377

Modified:
   pkg/tests/Examples/analogue-Ex.Rout.save
Log:
Update reference output for Example checks

Modified: pkg/tests/Examples/analogue-Ex.Rout.save
===================================================================
--- pkg/tests/Examples/analogue-Ex.Rout.save	2013-10-07 02:36:01 UTC (rev 376)
+++ pkg/tests/Examples/analogue-Ex.Rout.save	2013-10-07 02:36:50 UTC (rev 377)
@@ -1,5 +1,5 @@
 
-R version 3.0.1 RC (2013-05-11 r62732) -- "Good Sport"
+R version 3.0.2 Patched (2013-09-26 r64005) -- "Frisbee Sailing"
 Copyright (C) 2013 The R Foundation for Statistical Computing
 Platform: x86_64-unknown-linux-gnu (64-bit)
 
@@ -20,14 +20,25 @@
 > pkgname <- "analogue"
 > source(file.path(R.home("share"), "R", "examples-header.R"))
 > options(warn = 1)
+> base::assign(".ExTimings", "analogue-Ex.timings", pos = 'CheckExEnv')
+> base::cat("name\tuser\tsystem\telapsed\n", file=base::get(".ExTimings", pos = 'CheckExEnv'))
+> base::assign(".format_ptime",
++ function(x) {
++   if(!is.na(x[4L])) x[1L] <- x[1L] + x[4L]
++   if(!is.na(x[5L])) x[2L] <- x[2L] + x[5L]
++   options(OutDec = '.')
++   format(x[1L:3L], digits = 7L)
++ },
++ pos = 'CheckExEnv')
+> 
+> ### * </HEADER>
 > library('analogue')
 Loading required package: vegan
 Loading required package: permute
-This is vegan 2.1-29
-Loading required package: princurve
 Loading required package: lattice
+This is vegan 2.0-9
 Loading required package: rgl
-This is analogue 0.11-4
+This is analogue 0.11-6
 > 
 > base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')
 > cleanEx()
@@ -36,6 +47,7 @@
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: ImbrieKipp
 > ### Title: Imbrie and Kipp foraminifera training set
 > ### Aliases: ImbrieKipp SumSST WinSST Salinity V12.122
@@ -106,12 +118,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("ImbrieKipp", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("Pollen")
 > ### * Pollen
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: Pollen
 > ### Title: North American Modern Pollen Database
 > ### Aliases: Pollen Biome Climate Location
@@ -129,12 +144,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("Pollen", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("RMSEP")
 > ### * RMSEP
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: RMSEP
 > ### Title: Root mean square error of prediction
 > ### Aliases: RMSEP RMSEP.default RMSEP.mat RMSEP.bootstrap.mat
@@ -236,12 +254,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("RMSEP", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("Stratiplot")
 > ### * Stratiplot
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: Stratiplot
 > ### Title: Palaeoecological stratigraphic diagrams
 > ### Aliases: Stratiplot Stratiplot.default Stratiplot.formula
@@ -328,12 +349,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("Stratiplot", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("abernethy")
 > ### * abernethy
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: abernethy
 > ### Title: Abernethy Forest Pollen Sequence
 > ### Aliases: abernethy
@@ -400,12 +424,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("abernethy", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("analog")
 > ### * analog
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: analog
 > ### Title: Analogue matching
 > ### Aliases: analog analog.default analog.distance print.analog
@@ -833,12 +860,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("analog", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("bayesF")
 > ### * bayesF
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: bayesF
 > ### Title: Bayes factors
 > ### Aliases: bayesF print.bayesF plot.bayesF
@@ -920,12 +950,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("bayesF", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("bootstrap")
 > ### * bootstrap
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: bootstrap
 > ### Title: Bootstrap estimation and errors
 > ### Aliases: bootstrap bootstrap.default bootstrap.mat print.bootstrap.mat
@@ -1150,12 +1183,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("bootstrap", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("bootstrap.wa")
 > ### * bootstrap.wa
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: bootstrap.wa
 > ### Title: Bootstrap estimation and errors for WA models
 > ### Aliases: bootstrap.wa print.bootstrap.wa
@@ -1213,12 +1249,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("bootstrap.wa", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("caterpillarPlot")
 > ### * caterpillarPlot
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: caterpillarPlot
 > ### Title: Caterpillar plot of species' WA optima and tolerance range.
 > ### Aliases: caterpillarPlot caterpillarPlot.default
@@ -1252,12 +1291,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("caterpillarPlot", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("chooseTaxa")
 > ### * chooseTaxa
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: chooseTaxa
 > ### Title: Select taxa (variables) on basis of maximum abundance attained
 > ###   and number of occurrences.
@@ -1284,12 +1326,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("chooseTaxa", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("cma")
 > ### * cma
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: cma
 > ### Title: Close modern analogues
 > ### Aliases: cma cma.default cma.analog cma.mat cma.predict.mat print.cma
@@ -1751,12 +1796,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("cma", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("crossval")
 > ### * crossval
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: crossval
 > ### Title: Cross-validation of palaeoecological transfer function models
 > ### Aliases: crossval crossval.wa print.crossval predWA predWAT
@@ -1868,12 +1916,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("crossval", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("densityplot.residLen")
 > ### * densityplot.residLen
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: densityplot.residLen
 > ### Title: Lattice density plot for residual lengths
 > ### Aliases: densityplot.residLen
@@ -1906,12 +1957,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("densityplot.residLen", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("dissimilarities")
 > ### * dissimilarities
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: dissimilarities
 > ### Title: Extract dissimilarity coefficients from models
 > ### Aliases: dissimilarities dissimilarities.analog dissimilarities.mat
@@ -2303,15 +2357,19 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("dissimilarities", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("distance")
 > ### * distance
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: distance
 > ### Title: Flexibly calculate dissimilarity or distance measures
-> ### Aliases: distance distance.default distance.join
+> ### Aliases: distance distance.default distance.join oldDistance
+> ###   oldDistance.default oldDistance.join
 > ### Keywords: multivariate methods
 > 
 > ### ** Examples
@@ -2343,11 +2401,12 @@
   ..$ : chr [1:20] "A" "B" "C" "D" ...
   ..$ : chr [1:10] "a" "b" "c" "d" ...
  - attr(*, "method")= chr "euclidean"
+ - attr(*, "class")= chr [1:2] "distance" "matrix"
  - attr(*, "type")= chr "asymmetric"
- - attr(*, "class")= chr [1:2] "distance" "matrix"
 > 
 > ## calculate Gower's general coefficient for mixed data
 > ## first, make a couple of variables factors
+> 
 > fossil[,4] <- factor(sample(rep(1:4, length = 10), 10))
 > train[,4] <- factor(sample(rep(1:4, length = 20), 20))
 > ## now fit the mixed coefficient
@@ -2358,107 +2417,31 @@
 > x2 <- t(c(1,3,3,1,2,2,2,5))
 > Rj <- c(1,4,2,4,1,3,2,5) # supplied ranges
 > 
-> distance(x1, x2, method = "mixed", R = Rj)
-[1] 0.3380952
-attr(,"method")
-[1] "mixed"
-attr(,"type")
-[1] "asymmetric"
-attr(,"class")
-[1] "distance" "matrix"  
-> 
-> ## note this gives 1 - 0.66 (not 0.66 as the answer in
-> ## Legendre & Legendre) as this is expressed as a
-> ## distance whereas Legendre & Legendre describe the
-> ## coefficient as similarity coefficient
-> 
-> 
-> 
-> cleanEx()
-> nameEx("distance3")
-> ### * distance3
-> 
-> flush(stderr()); flush(stdout())
-> 
-> ### Name: distance3
-> ### Title: Flexibly calculate dissimilarity or distance measures
-> ### Aliases: distance3 distanceX distance3.default
-> ### Keywords: multivariate methods
-> 
-> ### ** Examples
-> 
-> ## simple example using dummy data
-> train <- data.frame(matrix(abs(runif(200)), ncol = 10))
-> rownames(train) <- LETTERS[1:20]
-> colnames(train) <- as.character(1:10)
-> fossil <- data.frame(matrix(abs(runif(100)), ncol = 10))
-> colnames(fossil) <- as.character(1:10)
-> rownames(fossil) <- letters[1:10]
-> 
-> ## calculate distances/dissimilarities between train and fossil
-> ## samples
-> test <- distance3(train, fossil)
-> test.o <- distance(train, fossil)
-> stopifnot(isTRUE(all.equal(test.o, test)))
-> 
-> ## using a different coefficient, chi-square distance
-> test <- distance3(train, fossil, method = "chi.distance")
-> test.o <- distance(train, fossil, method = "chi.distance")
-> stopifnot(isTRUE(all.equal(test.o, test)))
-> 
-> ## calculate pairwise distances/dissimilarities for training
-> ## set samples
-> ##test2 <- distance3(train)
-> 
-> ## Using distance on an object of class join
-> #dists <- distance3(join(train, fossil))
-> #str(dists)
-> dists <- distance(join(train, fossil))
-> ##distsX <- distanceX(join(train, fossil))
-> 
-> ## calculate Gower's general coefficient for mixed data
-> ## first, make a couple of variables factors
-> fossil[,4] <- factor(sample(rep(1:4, length = 10), 10))
-> train[,4] <- factor(sample(rep(1:4, length = 20), 20))
-> ## now fit the mixed coefficient
-> test3 <- distance3(train, fossil, "mixed")
-> 
-> ## Example from page 260 of Legendre & Legendre (1998)
-> x1 <- t(c(2,2,NA,2,2,4,2,6))
-> x2 <- t(c(1,3,3,1,2,2,2,5))
-> Rj <- c(1,4,2,4,1,3,2,5) # supplied ranges
-> 
-> distance3(x1, x2, method = "mixed", R = Rj)
+> 1 - distance(x1, x2, method = "mixed", R = Rj)
           [,1]
-[1,] 0.3380952
+[1,] 0.6619048
 attr(,"method")
 [1] "mixed"
-attr(,"type")
-[1] "asymmetric"
 attr(,"class")
 [1] "distance" "matrix"  
-> distance(x1, x2, method = "mixed", R = Rj)
-[1] 0.3380952
-attr(,"method")
-[1] "mixed"
 attr(,"type")
 [1] "asymmetric"
-attr(,"class")
-[1] "distance" "matrix"  
 > 
-> ## note this gives 1 - 0.66 (not 0.66 as the answer in
-> ## Legendre & Legendre) as this is expressed as a
-> ## distance whereas Legendre & Legendre describe the
-> ## coefficient as similarity coefficient
+> ## note this gives ~0.66 as Legendre & Legendre describe the
+> ## coefficient as a similarity coefficient. Hence here we do
+> ## 1 - Dij here to get the same answer. 
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("distance", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("fuse")
 > ### * fuse
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: fuse
 > ### Title: Fused dissimilarities
 > ### Aliases: fuse fuse.matrix fuse.dist
@@ -2509,12 +2492,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("fuse", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("getK")
 > ### * getK
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: getK
 > ### Title: Extract and set the number of analogues
 > ### Aliases: getK getK.default getK.mat getK.bootstrap.mat getK.predict.mat
@@ -2569,12 +2555,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("getK", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("gradientDist")
 > ### * gradientDist
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: gradientDist
 > ### Title: Positions of samples along a unit-length ordination gradient.
 > ### Aliases: gradientDist gradientDist.default gradientDist.cca
@@ -2608,12 +2597,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("gradientDist", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("hist.residLen")
 > ### * hist.residLen
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: hist.residLen
 > ### Title: Histogram plot for residual lengths
 > ### Aliases: hist.residLen
@@ -2646,12 +2638,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("hist.residLen", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("histogram.residLen")
 > ### * histogram.residLen
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: histogram.residLen
 > ### Title: Lattice histogram plot for residual lengths
 > ### Aliases: histogram.residLen
@@ -2684,12 +2679,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("histogram.residLen", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("join")
 > ### * join
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: join
 > ### Title: Merge species data sets on common columns (species)
 > ### Aliases: join head.join tail.join
@@ -3379,12 +3377,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("join", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("logitreg")
 > ### * logitreg
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: logitreg
 > ### Title: Logistic regression models for assessing analogues/non-analogues
 > ### Aliases: logitreg logitreg.default logitreg.analog print.logitreg
@@ -3497,12 +3498,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("logitreg", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("mat")
 > ### * mat
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: mat
 > ### Title: Modern Analogue Technique transfer function models
 > ### Aliases: mat mat.default mat.formula fitted.mat residuals.mat resid.mat
@@ -3988,6 +3992,8 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("mat", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > graphics::par(get("par.postscript", pos = 'CheckExEnv'))
 > cleanEx()
 > nameEx("mcarlo")
@@ -3995,6 +4001,7 @@
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: mcarlo
 > ### Title: Monte Carlo simulation of dissimilarities
 > ### Aliases: mcarlo mcarlo.default mcarlo.mat mcarlo.analog print.mcarlo
@@ -4051,12 +4058,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("mcarlo", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("minDC")
 > ### * minDC
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: minDC
 > ### Title: Extract minimum dissimilarities
 > ### Aliases: minDC minDC.default minDC.predict.mat minDC.analog minDC.wa
@@ -4164,12 +4174,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("minDC", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("optima")
 > ### * optima
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: optima
 > ### Title: Weighted averaging optima and tolerance ranges
 > ### Aliases: optima optima.default print.optima print.tolerance
@@ -4276,12 +4289,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("optima", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("pcr")
 > ### * pcr
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: pcr
 > ### Title: Prinicpal component regression transfer function models
 > ### Aliases: pcr pcr.default pcr.formula print.pcr Hellinger ChiSquare
@@ -4513,12 +4529,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("pcr", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("performance")
 > ### * performance
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: performance
 > ### Title: Transfer function model performance statistics
 > ### Aliases: performance print.performance performance.wa
@@ -4552,16 +4571,19 @@
 > ## the model performance statistics
 > performance(mod)
       RMSE         R2   Avg.Bias   Max.Bias 
- 2.019e+00  9.173e-01  2.228e-14 -3.815e+00 
+ 2.019e+00  9.173e-01  2.854e-15 -3.815e+00 
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("performance", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("plot.dissimilarities")
 > ### * plot.dissimilarities
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: plot.dissimilarities
 > ### Title: Plots the distribution of extracted dissimilarities
 > ### Aliases: plot.dissimilarities
@@ -4951,12 +4973,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("plot.dissimilarities", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("plot.mat")
 > ### * plot.mat
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: plot.mat
 > ### Title: Plot diagnostics for a mat object
 > ### Aliases: plot.mat
@@ -4996,12 +5021,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("plot.mat", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("plot.mcarlo")
 > ### * plot.mcarlo
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: plot.mcarlo
 > ### Title: Plot Monte Carlo simulated dissimilarity distributions
 > ### Aliases: plot.mcarlo
@@ -5058,12 +5086,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("plot.mcarlo", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("plot.minDC")
 > ### * plot.minDC
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: plot.minDC
 > ### Title: Plot of minimum dissimilarity per sample
 > ### Aliases: plot.minDC
@@ -5169,12 +5200,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("plot.minDC", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("plot.prcurve")
 > ### * plot.prcurve
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: plot.prcurve
 > ### Title: Plot a fitted principal curve in PCA space
 > ### Aliases: plot.prcurve lines.prcurve
@@ -5285,22 +5319,25 @@
 
 > 
 > ## Plot the curve
-> plot(aber.pc, abernethy2)
+> plot(aber.pc)
 > 
 > ## The lines() method can be used to add the principal curve to an
 > ## existing plot
 > ord <- rda(abernethy2)
-> plot(ord)
-> lines(aber.pc, data = abernethy2)
+> plot(ord, scaling = 1)
+> lines(aber.pc, scaling = 1)
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("plot.prcurve", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("plot.residLen")
 > ### * plot.residLen
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: plot.residLen
 > ### Title: Plot method for residual lengths
 > ### Aliases: plot.residLen
@@ -5333,12 +5370,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("plot.residLen", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("plot.wa")
 > ### * plot.wa
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: plot.wa
 > ### Title: Plot diagnostics for a weighted averaging model
 > ### Aliases: plot.wa
@@ -5351,12 +5391,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("plot.wa", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("plot3d.prcurve")
 > ### * plot3d.prcurve
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: plot3d.prcurve
 > ### Title: Interactive 3D plof of a principal curve in principal coordinate
 > ###   space
@@ -5470,12 +5513,16 @@
 > 
 > 
 > 
+> 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("plot3d.prcurve", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("prcurve")
 > ### * prcurve
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: prcurve
 > ### Title: Fits a principal curve to m-dimensional data
 > ### Aliases: prcurve initCurve print.prcurve
@@ -5688,12 +5735,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("prcurve", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("predict.mat")
 > ### * predict.mat
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: predict.mat
 > ### Title: Predict method for Modern Analogue Technique models
 > ### Aliases: predict.mat print.predict.mat
@@ -5801,12 +5851,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("predict.mat", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("predict.wa")
 > ### * predict.wa
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: predict.wa
 > ### Title: Predict from a weighted average model
 > ### Aliases: predict.wa print.predict.wa
@@ -5857,12 +5910,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("predict.wa", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("rankDC")
 > ### * rankDC
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: rankDC
 > ### Title: Rank correlation between environmental and species
 > ###   dissimilarities.
@@ -5885,12 +5941,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("rankDC", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("reconPlot")
 > ### * reconPlot
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: reconPlot
 > ### Title: Stratigraphic plots of palaeoenvironmental reconstructions
 > ### Aliases: reconPlot reconPlot.default reconPlot.predict.mat
@@ -5971,12 +6030,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("reconPlot", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("residLen")
 > ### * residLen
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: residLen
 > ### Title: Squared residual length diagnostics
 > ### Aliases: residLen print.residLen fittedY sqrlLinear sqrlUnimodal
@@ -6021,12 +6083,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("residLen", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("residuals.prcurve")
 > ### * residuals.prcurve
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: residuals.prcurve
 > ### Title: Residuals of a principal curve fit.
 > ### Aliases: residuals.prcurve resid.prcurve
@@ -6469,12 +6534,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("residuals.prcurve", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("rlgh")
 > ### * rlgh
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: rlgh
 > ### Title: Round Loch of Glenhead Diatoms
 > ### Aliases: rlgh
@@ -6486,12 +6554,15 @@
 > 
 > 
 > 
+> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
+> base::cat("rlgh", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("roc")
 > ### * roc
 > 
 > flush(stderr()); flush(stdout())
 > 
+> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: roc
 > ### Title: ROC curve analysis
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/analogue -r 377

From noreply at r-forge.r-project.org  Tue Oct  8 00:58:25 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  8 Oct 2013 00:58:25 +0200 (CEST)
Subject: [Analogue-commits] r378 - pkg/tests/Examples
Message-ID: <20131007225825.C6911185FFE@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-08 00:58:25 +0200 (Tue, 08 Oct 2013)
New Revision: 378

Modified:
   pkg/tests/Examples/analogue-Ex.Rout.save
Log:
must not copy the reference outputs when checking --as-cran

Modified: pkg/tests/Examples/analogue-Ex.Rout.save
===================================================================
--- pkg/tests/Examples/analogue-Ex.Rout.save	2013-10-07 02:36:50 UTC (rev 377)
+++ pkg/tests/Examples/analogue-Ex.Rout.save	2013-10-07 22:58:25 UTC (rev 378)
@@ -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)
 
@@ -20,18 +20,6 @@
 > pkgname <- "analogue"
 > source(file.path(R.home("share"), "R", "examples-header.R"))
 > options(warn = 1)
-> base::assign(".ExTimings", "analogue-Ex.timings", pos = 'CheckExEnv')
-> base::cat("name\tuser\tsystem\telapsed\n", file=base::get(".ExTimings", pos = 'CheckExEnv'))
-> base::assign(".format_ptime",
-+ function(x) {
-+   if(!is.na(x[4L])) x[1L] <- x[1L] + x[4L]
-+   if(!is.na(x[5L])) x[2L] <- x[2L] + x[5L]
-+   options(OutDec = '.')
-+   format(x[1L:3L], digits = 7L)
-+ },
-+ pos = 'CheckExEnv')
-> 
-> ### * </HEADER>
 > library('analogue')
 Loading required package: vegan
 Loading required package: permute
@@ -47,7 +35,6 @@
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: ImbrieKipp
 > ### Title: Imbrie and Kipp foraminifera training set
 > ### Aliases: ImbrieKipp SumSST WinSST Salinity V12.122
@@ -118,15 +105,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("ImbrieKipp", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("Pollen")
 > ### * Pollen
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: Pollen
 > ### Title: North American Modern Pollen Database
 > ### Aliases: Pollen Biome Climate Location
@@ -144,15 +128,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("Pollen", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("RMSEP")
 > ### * RMSEP
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: RMSEP
 > ### Title: Root mean square error of prediction
 > ### Aliases: RMSEP RMSEP.default RMSEP.mat RMSEP.bootstrap.mat
@@ -254,15 +235,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("RMSEP", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("Stratiplot")
 > ### * Stratiplot
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: Stratiplot
 > ### Title: Palaeoecological stratigraphic diagrams
 > ### Aliases: Stratiplot Stratiplot.default Stratiplot.formula
@@ -349,15 +327,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("Stratiplot", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("abernethy")
 > ### * abernethy
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: abernethy
 > ### Title: Abernethy Forest Pollen Sequence
 > ### Aliases: abernethy
@@ -424,15 +399,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("abernethy", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("analog")
 > ### * analog
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: analog
 > ### Title: Analogue matching
 > ### Aliases: analog analog.default analog.distance print.analog
@@ -860,15 +832,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("analog", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("bayesF")
 > ### * bayesF
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: bayesF
 > ### Title: Bayes factors
 > ### Aliases: bayesF print.bayesF plot.bayesF
@@ -950,15 +919,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("bayesF", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("bootstrap")
 > ### * bootstrap
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: bootstrap
 > ### Title: Bootstrap estimation and errors
 > ### Aliases: bootstrap bootstrap.default bootstrap.mat print.bootstrap.mat
@@ -1183,15 +1149,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("bootstrap", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("bootstrap.wa")
 > ### * bootstrap.wa
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: bootstrap.wa
 > ### Title: Bootstrap estimation and errors for WA models
 > ### Aliases: bootstrap.wa print.bootstrap.wa
@@ -1249,15 +1212,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("bootstrap.wa", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("caterpillarPlot")
 > ### * caterpillarPlot
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: caterpillarPlot
 > ### Title: Caterpillar plot of species' WA optima and tolerance range.
 > ### Aliases: caterpillarPlot caterpillarPlot.default
@@ -1291,15 +1251,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("caterpillarPlot", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("chooseTaxa")
 > ### * chooseTaxa
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: chooseTaxa
 > ### Title: Select taxa (variables) on basis of maximum abundance attained
 > ###   and number of occurrences.
@@ -1326,15 +1283,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("chooseTaxa", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("cma")
 > ### * cma
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: cma
 > ### Title: Close modern analogues
 > ### Aliases: cma cma.default cma.analog cma.mat cma.predict.mat print.cma
@@ -1796,15 +1750,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("cma", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("crossval")
 > ### * crossval
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: crossval
 > ### Title: Cross-validation of palaeoecological transfer function models
 > ### Aliases: crossval crossval.wa print.crossval predWA predWAT
@@ -1916,15 +1867,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("crossval", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("densityplot.residLen")
 > ### * densityplot.residLen
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: densityplot.residLen
 > ### Title: Lattice density plot for residual lengths
 > ### Aliases: densityplot.residLen
@@ -1957,15 +1905,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("densityplot.residLen", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("dissimilarities")
 > ### * dissimilarities
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: dissimilarities
 > ### Title: Extract dissimilarity coefficients from models
 > ### Aliases: dissimilarities dissimilarities.analog dissimilarities.mat
@@ -2357,15 +2302,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("dissimilarities", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("distance")
 > ### * distance
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: distance
 > ### Title: Flexibly calculate dissimilarity or distance measures
 > ### Aliases: distance distance.default distance.join oldDistance
@@ -2433,15 +2375,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("distance", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("fuse")
 > ### * fuse
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: fuse
 > ### Title: Fused dissimilarities
 > ### Aliases: fuse fuse.matrix fuse.dist
@@ -2492,15 +2431,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("fuse", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("getK")
 > ### * getK
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: getK
 > ### Title: Extract and set the number of analogues
 > ### Aliases: getK getK.default getK.mat getK.bootstrap.mat getK.predict.mat
@@ -2555,15 +2491,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("getK", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("gradientDist")
 > ### * gradientDist
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: gradientDist
 > ### Title: Positions of samples along a unit-length ordination gradient.
 > ### Aliases: gradientDist gradientDist.default gradientDist.cca
@@ -2597,15 +2530,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("gradientDist", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("hist.residLen")
 > ### * hist.residLen
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: hist.residLen
 > ### Title: Histogram plot for residual lengths
 > ### Aliases: hist.residLen
@@ -2638,15 +2568,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("hist.residLen", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("histogram.residLen")
 > ### * histogram.residLen
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: histogram.residLen
 > ### Title: Lattice histogram plot for residual lengths
 > ### Aliases: histogram.residLen
@@ -2679,15 +2606,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("histogram.residLen", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("join")
 > ### * join
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: join
 > ### Title: Merge species data sets on common columns (species)
 > ### Aliases: join head.join tail.join
@@ -3377,15 +3301,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("join", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("logitreg")
 > ### * logitreg
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: logitreg
 > ### Title: Logistic regression models for assessing analogues/non-analogues
 > ### Aliases: logitreg logitreg.default logitreg.analog print.logitreg
@@ -3498,15 +3419,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("logitreg", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("mat")
 > ### * mat
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: mat
 > ### Title: Modern Analogue Technique transfer function models
 > ### Aliases: mat mat.default mat.formula fitted.mat residuals.mat resid.mat
@@ -3992,8 +3910,6 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("mat", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > graphics::par(get("par.postscript", pos = 'CheckExEnv'))
 > cleanEx()
 > nameEx("mcarlo")
@@ -4001,7 +3917,6 @@
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: mcarlo
 > ### Title: Monte Carlo simulation of dissimilarities
 > ### Aliases: mcarlo mcarlo.default mcarlo.mat mcarlo.analog print.mcarlo
@@ -4058,15 +3973,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("mcarlo", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("minDC")
 > ### * minDC
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: minDC
 > ### Title: Extract minimum dissimilarities
 > ### Aliases: minDC minDC.default minDC.predict.mat minDC.analog minDC.wa
@@ -4174,15 +4086,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("minDC", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("optima")
 > ### * optima
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: optima
 > ### Title: Weighted averaging optima and tolerance ranges
 > ### Aliases: optima optima.default print.optima print.tolerance
@@ -4289,15 +4198,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("optima", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("pcr")
 > ### * pcr
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: pcr
 > ### Title: Prinicpal component regression transfer function models
 > ### Aliases: pcr pcr.default pcr.formula print.pcr Hellinger ChiSquare
@@ -4529,15 +4435,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("pcr", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("performance")
 > ### * performance
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: performance
 > ### Title: Transfer function model performance statistics
 > ### Aliases: performance print.performance performance.wa
@@ -4571,19 +4474,16 @@
 > ## the model performance statistics
 > performance(mod)
       RMSE         R2   Avg.Bias   Max.Bias 
- 2.019e+00  9.173e-01  2.854e-15 -3.815e+00 
+ 2.019e+00  9.173e-01  2.228e-14 -3.815e+00 
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("performance", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("plot.dissimilarities")
 > ### * plot.dissimilarities
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: plot.dissimilarities
 > ### Title: Plots the distribution of extracted dissimilarities
 > ### Aliases: plot.dissimilarities
@@ -4973,15 +4873,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("plot.dissimilarities", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("plot.mat")
 > ### * plot.mat
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: plot.mat
 > ### Title: Plot diagnostics for a mat object
 > ### Aliases: plot.mat
@@ -5021,15 +4918,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("plot.mat", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("plot.mcarlo")
 > ### * plot.mcarlo
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: plot.mcarlo
 > ### Title: Plot Monte Carlo simulated dissimilarity distributions
 > ### Aliases: plot.mcarlo
@@ -5086,15 +4980,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("plot.mcarlo", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("plot.minDC")
 > ### * plot.minDC
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: plot.minDC
 > ### Title: Plot of minimum dissimilarity per sample
 > ### Aliases: plot.minDC
@@ -5200,15 +5091,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("plot.minDC", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("plot.prcurve")
 > ### * plot.prcurve
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: plot.prcurve
 > ### Title: Plot a fitted principal curve in PCA space
 > ### Aliases: plot.prcurve lines.prcurve
@@ -5329,15 +5217,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("plot.prcurve", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("plot.residLen")
 > ### * plot.residLen
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: plot.residLen
 > ### Title: Plot method for residual lengths
 > ### Aliases: plot.residLen
@@ -5370,15 +5255,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("plot.residLen", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("plot.wa")
 > ### * plot.wa
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: plot.wa
 > ### Title: Plot diagnostics for a weighted averaging model
 > ### Aliases: plot.wa
@@ -5391,15 +5273,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("plot.wa", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("plot3d.prcurve")
 > ### * plot3d.prcurve
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: plot3d.prcurve
 > ### Title: Interactive 3D plof of a principal curve in principal coordinate
 > ###   space
@@ -5514,15 +5393,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("plot3d.prcurve", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("prcurve")
 > ### * prcurve
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: prcurve
 > ### Title: Fits a principal curve to m-dimensional data
 > ### Aliases: prcurve initCurve print.prcurve
@@ -5735,15 +5611,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("prcurve", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("predict.mat")
 > ### * predict.mat
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: predict.mat
 > ### Title: Predict method for Modern Analogue Technique models
 > ### Aliases: predict.mat print.predict.mat
@@ -5851,15 +5724,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("predict.mat", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("predict.wa")
 > ### * predict.wa
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: predict.wa
 > ### Title: Predict from a weighted average model
 > ### Aliases: predict.wa print.predict.wa
@@ -5910,15 +5780,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("predict.wa", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("rankDC")
 > ### * rankDC
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: rankDC
 > ### Title: Rank correlation between environmental and species
 > ###   dissimilarities.
@@ -5941,15 +5808,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("rankDC", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("reconPlot")
 > ### * reconPlot
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: reconPlot
 > ### Title: Stratigraphic plots of palaeoenvironmental reconstructions
 > ### Aliases: reconPlot reconPlot.default reconPlot.predict.mat
@@ -6030,15 +5894,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("reconPlot", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("residLen")
 > ### * residLen
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: residLen
 > ### Title: Squared residual length diagnostics
 > ### Aliases: residLen print.residLen fittedY sqrlLinear sqrlUnimodal
@@ -6083,15 +5944,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("residLen", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("residuals.prcurve")
 > ### * residuals.prcurve
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: residuals.prcurve
 > ### Title: Residuals of a principal curve fit.
 > ### Aliases: residuals.prcurve resid.prcurve
@@ -6534,15 +6392,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("residuals.prcurve", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("rlgh")
 > ### * rlgh
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: rlgh
 > ### Title: Round Loch of Glenhead Diatoms
 > ### Aliases: rlgh
@@ -6554,15 +6409,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("rlgh", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("roc")
 > ### * roc
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: roc
 > ### Title: ROC curve analysis
 > ### Aliases: roc roc.default roc.mat roc.analog print.roc summary.roc
@@ -6623,15 +6475,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("roc", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("scores.prcurve")
 > ### * scores.prcurve
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: scores.prcurve
 > ### Title: 'scores' method for principal curve objects of class
 > ###   '"prcurve"'.
@@ -6762,15 +6611,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("scores.prcurve", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("screeplot")
 > ### * screeplot
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: screeplot
 > ### Title: Screeplots of model results
 > ### Aliases: screeplot.mat screeplot.bootstrap.mat
@@ -6845,15 +6691,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("screeplot", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("splitSample")
 > ### * splitSample
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: splitSample
 > ### Title: Select samples from along an environmental gradient
 > ### Aliases: splitSample
@@ -6909,15 +6752,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("splitSample", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("sppResponse.prcurve")
 > ### * sppResponse.prcurve
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: sppResponse
 > ### Title: Species responses along gradients.
 > ### Aliases: sppResponse sppResponse.prcurve
@@ -7032,15 +6872,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("sppResponse.prcurve", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("stdError")
 > ### * stdError
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: stdError
 > ### Title: Standard error of MAT fitted and predicted values
 > ### Aliases: stdError stdError.mat stdError.predict.mat
@@ -7179,15 +7016,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("stdError", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("summary.analog")
 > ### * summary.analog
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: summary.analog
 > ### Title: Summarise analogue matching results
 > ### Aliases: summary.analog print.summary.analog
@@ -7207,15 +7041,12 @@
 > 
 > 
 > 
-> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
-> base::cat("summary.analog", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
 > cleanEx()
 > nameEx("summary.bootstrap.mat")
 > ### * summary.bootstrap.mat
 > 
 > flush(stderr()); flush(stdout())
 > 
-> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
 > ### Name: summary.bootstrap.mat
 > ### Title: Summarise bootstrap resampling for MAT models
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/analogue -r 378

From noreply at r-forge.r-project.org  Tue Oct  8 00:58:47 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  8 Oct 2013 00:58:47 +0200 (CEST)
Subject: [Analogue-commits] r379 - pkg/vignettes
Message-ID: <20131007225847.929A4185FFE@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-08 00:58:47 +0200 (Tue, 08 Oct 2013)
New Revision: 379

Modified:
   pkg/vignettes/analogue_methods.Rnw
Log:
update affiliation

Modified: pkg/vignettes/analogue_methods.Rnw
===================================================================
--- pkg/vignettes/analogue_methods.Rnw	2013-10-07 22:58:25 UTC (rev 378)
+++ pkg/vignettes/analogue_methods.Rnw	2013-10-07 22:58:47 UTC (rev 379)
@@ -9,7 +9,7 @@
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 %% almost as usual
-\author{Gavin L. Simpson\\Environmental Change Research Centre --- UCL}
+\author{Gavin L. Simpson\\Institute of Environmental Change and Society --- University of Regina}
 \title{Analogue Methods in Palaeoecology:\\ Using the \pkg{analogue} Package}
 
 %% for pretty printing and a nice hypersummary also set:
@@ -38,15 +38,15 @@
 %% The address of (at least) one author should be given
 %% in the following format:
 %\Address{
-%  Gavin L. Simpson\\
-%  Environmental Change Research Centre\\
-%  UCL Department of Geography\\
-%  Pearson Building\\
-%  Gower Street\\
-%  London, UK, WC1E 6BT\\
-%  E-mail: \email{gavin.simpson at ucl.ac.uk}\\
-%  URL: \url{http://www.homepages.ucl.ac.uk/~ucfagls/}
-%}
+  % Gavin L. Simpson\\
+  % Insitutute of Environmental Change and Society\\
+  % University of Regina\\
+  % 3737 Wascana Parkway\\
+  % Regina\\
+  % SK, S4S 0A2, Canada\\
+  % %%E-mail: \email{ucfagls\@gmail.com}\\
+  % URL: \url{http://www.fromthebottomoftheheap.net/}
+%} 
 %% It is also possible to add a telephone and fax number
 %% before the e-mail in the following format:
 %% Telephone: +43/1/31336-5053


From noreply at r-forge.r-project.org  Tue Oct  8 07:21:32 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  8 Oct 2013 07:21:32 +0200 (CEST)
Subject: [Analogue-commits] r380 - in pkg: R inst tests/Examples
Message-ID: <20131008052132.DC969180941@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-08 07:21:32 +0200 (Tue, 08 Oct 2013)
New Revision: 380

Modified:
   pkg/R/print.performance.R
   pkg/inst/ChangeLog
   pkg/tests/Examples/analogue-Ex.Rout.save
Log:
zap small values in printed output in vector case; update the example reference material

Modified: pkg/R/print.performance.R
===================================================================
--- pkg/R/print.performance.R	2013-10-07 22:58:47 UTC (rev 379)
+++ pkg/R/print.performance.R	2013-10-08 05:21:32 UTC (rev 380)
@@ -4,10 +4,11 @@
     if(inherits(x, "data.frame")) {
         print.data.frame(x, digits = digits, ...)
     } else {
+        x <- zapsmall(x, digits = digits)
         perf.names <- names(x)
         attributes(x) <- NULL
         names(x) <- perf.names
-        print.default(x, digits = digits, ...) # x was round(x, 4)
+        print.default(x, digits = digits, ...)
     }
     invisible(x)
 }

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2013-10-07 22:58:47 UTC (rev 379)
+++ pkg/inst/ChangeLog	2013-10-08 05:21:32 UTC (rev 380)
@@ -16,6 +16,10 @@
 	* Vignette: Updated some details regarding C versions of
 	dissimilarity coefs.
 
+	* performance: a tweak to the print method to zap values that
+	are effectively 0. Only affects vectors of performance statistics
+	not data frames of stats.
+
 Version 0.11-5
 
 	* newDistance: (yet another) new distance() replacement to
@@ -197,8 +201,8 @@
 
 	* Tests: code in wa() generates slightly different results
 	under R 3.0.0 (to be). Differences are in the 8th or 9th
-	decimal place so irrelevant, but I was the reference output
-	for the examples was checking to that level of precision.
+	decimal place so irrelevant, but I was using the reference
+	output for the examples was checking to that level of precision.
 	For tests only, the Example in ?wa uses options(digits = 5).
 
 Version 0.10-0

Modified: pkg/tests/Examples/analogue-Ex.Rout.save
===================================================================
--- pkg/tests/Examples/analogue-Ex.Rout.save	2013-10-07 22:58:47 UTC (rev 379)
+++ pkg/tests/Examples/analogue-Ex.Rout.save	2013-10-08 05:21:32 UTC (rev 380)
@@ -1,5 +1,5 @@
 
-R version 3.0.2 Patched (2013-10-07 r64035) -- "Frisbee Sailing"
+R version 3.0.2 Patched (2013-09-26 r64005) -- "Frisbee Sailing"
 Copyright (C) 2013 The R Foundation for Statistical Computing
 Platform: x86_64-unknown-linux-gnu (64-bit)
 
@@ -1208,7 +1208,7 @@
 > ## performance statistics
 > performance(ik.boot)
    RMSEP       R2 Avg.Bias Max.Bias 
-  2.3846   0.8948  -0.1778  -3.2058 
+   2.385    0.895   -0.178   -3.206 
 > 
 > 
 > 
@@ -4473,8 +4473,8 @@
 > 
 > ## the model performance statistics
 > performance(mod)
-      RMSE         R2   Avg.Bias   Max.Bias 
- 2.019e+00  9.173e-01  2.228e-14 -3.815e+00 
+    RMSE       R2 Avg.Bias Max.Bias 
+   2.019    0.917    0.000   -3.815 
 > 
 > 
 > 
@@ -5775,7 +5775,7 @@
 > ## extract the model performance stats
 > performance(v12.pred)
    RMSEP       R2 Avg.Bias Max.Bias 
-  2.3617   0.8989  -0.1483  -3.2158 
+   2.362    0.899   -0.148   -3.216 
 > 
 > 
 > 
@@ -7726,7 +7726,7 @@
 > ###
 > options(digits = 7L)
 > base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed:  18.977 0.45 19.605 0.001 0.002 
+Time elapsed:  22.917 0.33 23.65 0 0.004 
 > grDevices::dev.off()
 null device 
           1 


From noreply at r-forge.r-project.org  Wed Oct  9 04:42:45 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed,  9 Oct 2013 04:42:45 +0200 (CEST)
Subject: [Analogue-commits] r381 - in pkg: R inst
Message-ID: <20131009024245.8D7391853B3@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-09 04:42:44 +0200 (Wed, 09 Oct 2013)
New Revision: 381

Modified:
   pkg/R/predict.pcr.R
   pkg/inst/ChangeLog
Log:
predict.pcr now applies the transformation

Modified: pkg/R/predict.pcr.R
===================================================================
--- pkg/R/predict.pcr.R	2013-10-08 05:21:32 UTC (rev 380)
+++ pkg/R/predict.pcr.R	2013-10-09 02:42:44 UTC (rev 381)
@@ -16,6 +16,8 @@
         want <- (spp.names <- colnames(object$data$x)) %in% colnames(newdata)
         want <- spp.names[want]
         newdata <- newdata[, want, drop = FALSE]
+        ## apply transformation to newdata
+        newdata <- obj$tranFun(newdata)
         ## do predictions
         ## matrix of predictions
         pred <- matrix(ncol = length(ncomp), nrow = Np)
@@ -23,8 +25,11 @@
             B0 <- object$yMean - object$xMeans %*% B[, j]
             pred[, j] <- newdata %*% B[, j] + rep(B0, Np)
         }
+    } else {
+        stop("Other methods of crossvalidation not yet implemented")
     }
     rownames(pred) <- newSamp
     colnames(pred) <- paste0("PC", ncomp)
     pred
 }
+

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2013-10-08 05:21:32 UTC (rev 380)
+++ pkg/inst/ChangeLog	2013-10-09 02:42:44 UTC (rev 381)
@@ -20,6 +20,9 @@
 	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).
+
 Version 0.11-5
 
 	* newDistance: (yet another) new distance() replacement to


From noreply at r-forge.r-project.org  Wed Oct  9 04:49:42 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed,  9 Oct 2013 04:49:42 +0200 (CEST)
Subject: [Analogue-commits] r382 - pkg/R
Message-ID: <20131009024942.1656F185689@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-09 04:49:41 +0200 (Wed, 09 Oct 2013)
New Revision: 382

Modified:
   pkg/R/predict.pcr.R
Log:
fix typo in object name

Modified: pkg/R/predict.pcr.R
===================================================================
--- pkg/R/predict.pcr.R	2013-10-09 02:42:44 UTC (rev 381)
+++ pkg/R/predict.pcr.R	2013-10-09 02:49:41 UTC (rev 382)
@@ -17,7 +17,7 @@
         want <- spp.names[want]
         newdata <- newdata[, want, drop = FALSE]
         ## apply transformation to newdata
-        newdata <- obj$tranFun(newdata)
+        newdata <- object$tranFun(newdata)
         ## do predictions
         ## matrix of predictions
         pred <- matrix(ncol = length(ncomp), nrow = Np)


From noreply at r-forge.r-project.org  Wed Oct  9 06:29:50 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed,  9 Oct 2013 06:29:50 +0200 (CEST)
Subject: [Analogue-commits] r383 - pkg/R
Message-ID: <20131009042951.1522B185A68@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-09 06:29:50 +0200 (Wed, 09 Oct 2013)
New Revision: 383

Modified:
   pkg/R/predict.pcr.R
Log:
argument n.boot renamed to nboot; needed to subset transformation object to get at transformed data

Modified: pkg/R/predict.pcr.R
===================================================================
--- pkg/R/predict.pcr.R	2013-10-09 02:49:41 UTC (rev 382)
+++ pkg/R/predict.pcr.R	2013-10-09 04:29:50 UTC (rev 383)
@@ -1,6 +1,6 @@
-`predict.pcr` <- function(object, newdata, ncomp = seq_len(object$ncomp),
+`predict.pcr` <- function(object, newdata, ncomp = seq_along(object$ncomp),
                           CV = c("none", "LOO", "bootstrap", "nfold"),
-                          verbose = FALSE, n.boot = 100, nfold = 5,
+                          verbose = FALSE, nboot = 100, nfold = 5,
                           ...) {
     if(missing(newdata))
         return(fitted(object))
@@ -17,13 +17,15 @@
         want <- spp.names[want]
         newdata <- newdata[, want, drop = FALSE]
         ## apply transformation to newdata
-        newdata <- object$tranFun(newdata)
+        tf <- object$tranFun(newdata)
+        newdata <- tf$data
         ## do predictions
         ## matrix of predictions
         pred <- matrix(ncol = length(ncomp), nrow = Np)
-        for(j in ncomp) {
-            B0 <- object$yMean - object$xMeans %*% B[, j]
-            pred[, j] <- newdata %*% B[, j] + rep(B0, 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)
         }
     } else {
         stop("Other methods of crossvalidation not yet implemented")


From noreply at r-forge.r-project.org  Wed Oct  9 06:30:57 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed,  9 Oct 2013 06:30:57 +0200 (CEST)
Subject: [Analogue-commits] r384 - pkg/man
Message-ID: <20131009043057.CF132185689@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-09 06:30:57 +0200 (Wed, 09 Oct 2013)
New Revision: 384

Added:
   pkg/man/predict.pcr.Rd
Log:
document predict.pcr

Added: pkg/man/predict.pcr.Rd
===================================================================
--- pkg/man/predict.pcr.Rd	                        (rev 0)
+++ pkg/man/predict.pcr.Rd	2013-10-09 04:30:57 UTC (rev 384)
@@ -0,0 +1,69 @@
+\name{predict.pcr}
+\alias{predict.pcr}
+
+\title{Predicted values from a principal components regression}
+
+\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).
+}
+
+\usage{
+\method{predict}{pcr}(object, newdata, ncomp = seq_along(object$ncomp),
+        CV = c("none", "LOO", "bootstrap", "nfold"),
+        verbose = FALSE, nboot = 100, nfold = 5, \dots)
+}
+
+\arguments{
+  \item{object}{a fitted model of class \code{"pcr"}, the result of a
+    call to \code{\link{pcr}}.}
+  \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.}
+  \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{\dots}{arguments passed to other methods.}
+}
+
+\details{
+  \code{predict.pcr} arranges for any transformation applied to the
+  training data to be applied to the \code{newdata} prior to
+  prediction.
+}
+
+\value{
+  A matrix of predicted values with rows representing samples in
+  \code{newdata} and columns, the PCR components requested via
+  \code{ncomp}.
+}
+
+\author{Gavin L. Simpson}
+
+\seealso{\code{\link{pcr}}}
+
+\examples{
+## Load the Imbrie & Kipp data and
+## summer sea-surface temperatures
+data(ImbrieKipp)
+data(SumSST)
+
+## choose 10 samples to act as a test set, for illustration
+take <- c(5,58,31,51,42,28,30,57,8,50)
+
+## normal interface and apply Hellinger transformation
+mod <- pcr(ImbrieKipp[-take, ], SumSST[-take], tranFun = Hellinger)
+
+## predictions
+predict(mod, ImbrieKipp[take, ], ncomp = 1:4)
+
+}
+\keyword{methods}
\ No newline at end of file


From noreply at r-forge.r-project.org  Wed Oct  9 06:32:05 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed,  9 Oct 2013 06:32:05 +0200 (CEST)
Subject: [Analogue-commits] r385 - pkg/tests/Examples
Message-ID: <20131009043205.DECF6185689@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-09 06:32:05 +0200 (Wed, 09 Oct 2013)
New Revision: 385

Modified:
   pkg/tests/Examples/analogue-Ex.Rout.save
Log:
new reference material

Modified: pkg/tests/Examples/analogue-Ex.Rout.save
===================================================================
--- pkg/tests/Examples/analogue-Ex.Rout.save	2013-10-09 04:30:57 UTC (rev 384)
+++ pkg/tests/Examples/analogue-Ex.Rout.save	2013-10-09 04:32:05 UTC (rev 385)
@@ -5725,6 +5725,47 @@
 > 
 > 
 > cleanEx()
+> nameEx("predict.pcr")
+> ### * predict.pcr
+> 
+> flush(stderr()); flush(stdout())
+> 
+> ### Name: predict.pcr
+> ### Title: Predicted values from a principal components regression
+> ### Aliases: predict.pcr
+> ### Keywords: methods
+> 
+> ### ** Examples
+> 
+> ## Load the Imbrie & Kipp data and
+> ## summer sea-surface temperatures
+> data(ImbrieKipp)
+> data(SumSST)
+> 
+> ## choose 10 samples to act as a test set, for illustration
+> take <- c(5,58,31,51,42,28,30,57,8,50)
+> 
+> ## normal interface and apply Hellinger transformation
+> mod <- pcr(ImbrieKipp[-take, ], SumSST[-take], tranFun = Hellinger)
+> 
+> ## predictions
+> predict(mod, ImbrieKipp[take, ], ncomp = 1: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
+V12.18  26.20249 26.438019 26.250313 26.405603
+V15.164 28.73089 27.389314 27.464025 27.556603
+V22.204 26.62995 26.287830 26.489270 26.472449
+V19.222 22.51833 23.657659 23.610868 23.537830
+V16.189 26.73964 26.671009 26.551076 26.529436
+V20.230 28.03053 26.819795 27.094141 27.094730
+V23.29  11.45795 11.373413 11.816852 12.136959
+A180.76 28.15434 26.970442 27.221069 27.230316
+> 
+> 
+> 
+> 
+> cleanEx()
 > nameEx("predict.wa")
 > ### * predict.wa
 > 
@@ -7726,7 +7767,7 @@
 > ###
 > options(digits = 7L)
 > base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed:  22.917 0.33 23.65 0 0.004 
+Time elapsed:  23.269 0.335 24.256 0.001 0.003 
 > grDevices::dev.off()
 null device 
           1 


From noreply at r-forge.r-project.org  Wed Oct  9 06:37:21 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed,  9 Oct 2013 06:37:21 +0200 (CEST)
Subject: [Analogue-commits] r386 - in pkg: R inst
Message-ID: <20131009043721.A0DA71863C7@r-forge.r-project.org>

Author: gsimpson
Date: 2013-10-09 06:37:21 +0200 (Wed, 09 Oct 2013)
New Revision: 386

Modified:
   pkg/R/crossval.pcr.R
   pkg/inst/ChangeLog
Log:
LOO CV was incorrectly averaging over PCR components

Modified: pkg/R/crossval.pcr.R
===================================================================
--- pkg/R/crossval.pcr.R	2013-10-09 04:32:05 UTC (rev 385)
+++ pkg/R/crossval.pcr.R	2013-10-09 04:37:21 UTC (rev 386)
@@ -54,7 +54,7 @@
                 pred[i, j] <- Xi %*% FIT$B[, j, drop = FALSE] + B0
             }
         }
-        pred <- rowMeans(pred, na.rm = TRUE)
+        ##pred <- rowMeans(pred, na.rm = TRUE)
     }
     if(identical(method, "kfold")) {
         ## form ncomp, as k-fold we have ceiling(N / nfold) fewer sites

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2013-10-09 04:32:05 UTC (rev 385)
+++ pkg/inst/ChangeLog	2013-10-09 04:37:21 UTC (rev 386)
@@ -23,6 +23,9 @@
 	* predict.pcr: Apply transformation function and stop is any form
 	of crossvalidation is selected (as not yet implemented).
 
+	* crossval.pcr: leave-one-out CV was incorrectly averaging over
+	components.
+
 Version 0.11-5
 
 	* newDistance: (yet another) new distance() replacement to