From noreply at r-forge.r-project.org  Mon Apr  8 06:48:18 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Mon,  8 Apr 2013 06:48:18 +0200 (CEST)
Subject: [Analogue-commits] r319 - in pkg: . R inst man
Message-ID: <20130408044818.AA1631848AF@r-forge.r-project.org>

Author: gsimpson
Date: 2013-04-08 06:48:18 +0200 (Mon, 08 Apr 2013)
New Revision: 319

Modified:
   pkg/NAMESPACE
   pkg/R/analog.R
   pkg/R/distance.R
   pkg/R/distance2.R
   pkg/R/distance_c.R
   pkg/inst/ChangeLog
   pkg/man/analog.Rd
   pkg/man/distance.Rd
Log:
add analog.distance; distance() gains extra attribute as result.

Modified: pkg/NAMESPACE
===================================================================
--- pkg/NAMESPACE	2013-03-22 16:23:14 UTC (rev 318)
+++ pkg/NAMESPACE	2013-04-08 04:48:18 UTC (rev 319)
@@ -82,6 +82,7 @@
 ##
 ## main user-visible functions
 S3method(analog, default)
+S3method(analog, distance)
 S3method(bootstrap, default)
 S3method(bootstrap, mat)
 S3method(bootstrap, wa)

Modified: pkg/R/analog.R
===================================================================
--- pkg/R/analog.R	2013-03-22 16:23:14 UTC (rev 318)
+++ pkg/R/analog.R	2013-04-08 04:48:18 UTC (rev 319)
@@ -33,9 +33,29 @@
     retval <- list(analogs = dissim, train = train,
                    call = .call, method = method)
     class(retval) <- "analog"
-    return(retval)
+    retval
 }
 
+analog.distance <- function(x, train = NULL, keep.train = TRUE, ...) {
+    stopifnot(inherits(x, "distance"))
+    if(!is.null(train)) {
+        if(inherits(train, "dist") || inherits(train, "vegdist")) {
+            train <- as.matrix(train)
+        } else if(!(inherits(train, "distance") &&
+                    isTRUE(all.equal(attr(train, "type"), "symmetric"))))
+            stop("`train` is not of class \"dist\", \"vegdist\", \nor symmetric \"distance\"")
+    }
+    .call <- match.call()
+    .call[[1]] <- as.name("analog")
+    method <- attr(x, "method")
+    tmethod <- attr(train, "method")
+    if(!isTRUE(all.equal(method, tmethod)))
+        warning("\"x\" and \"train\" use different dissimilarity coefficients.\nResults are likely meaningless.")
+    retval <- list(analogs = x, train = train, call = .call, method = method)
+    class(retval) <- "analog"
+    retval
+}
+
 print.analog <- function(x, probs = c(0.01, 0.02, 0.05, 0.1, 0.2),
                          digits = min(3, getOption("digits") - 4), ...)
 {

Modified: pkg/R/distance.R
===================================================================
--- pkg/R/distance.R	2013-03-22 16:23:14 UTC (rev 318)
+++ pkg/R/distance.R	2013-04-08 04:48:18 UTC (rev 319)
@@ -286,6 +286,7 @@
       rownames(res) <- x.names
     }
     attr(res, "method") <- method
+    attr(res, "type") <- if(y.miss) "symmetric" else "asymmetric"
     class(res) <- c("distance","matrix")
     return(res)
   }

Modified: pkg/R/distance2.R
===================================================================
--- pkg/R/distance2.R	2013-03-22 16:23:14 UTC (rev 318)
+++ pkg/R/distance2.R	2013-04-08 04:48:18 UTC (rev 319)
@@ -411,6 +411,7 @@
         colnames(d) <- y.names
         rownames(d) <- x.names
         attr(d, "method") <- method
+        attr(d, "type") <- "asymmetric"
         class(d) <- c("distance","matrix")
     }
     return(d)

Modified: pkg/R/distance_c.R
===================================================================
--- pkg/R/distance_c.R	2013-03-22 16:23:14 UTC (rev 318)
+++ pkg/R/distance_c.R	2013-04-08 04:48:18 UTC (rev 319)
@@ -59,6 +59,7 @@
         if(!as.dist) {
             d <- as.matrix(d)
             attr(d, "method") <- method
+            attr(d, "type") <- "symmetric"
             class(d) <- c("distance","matrix")
         }
     } else { ## two matrices
@@ -102,6 +103,7 @@
         colnames(d) <- y.names
         rownames(d) <- x.names
         attr(d, "method") <- method
+        attr(d, "type") <- "asymmetric"
         class(d) <- c("distance","matrix")
     }
     d

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2013-03-22 16:23:14 UTC (rev 318)
+++ pkg/inst/ChangeLog	2013-04-08 04:48:18 UTC (rev 319)
@@ -20,6 +20,13 @@
 
 	* scores: new method for objects of class "timetrack".
 
+	* analog: gains a method for objects of class "distance".
+
+	* distance: gains a new attribute ('type') which contains an
+	indicator of whether the distance matrix is symmetric (computed
+	on a single matrix) or asymmetric (dissimilarities between samples
+	of two matrices).
+
 	* distanceX: experimental replacement for distance() which uses
 	fast C code for computing dissimilarities via a .Call interface
 	based on base::dist().

Modified: pkg/man/analog.Rd
===================================================================
--- pkg/man/analog.Rd	2013-03-22 16:23:14 UTC (rev 318)
+++ pkg/man/analog.Rd	2013-04-08 04:48:18 UTC (rev 319)
@@ -1,6 +1,7 @@
 \name{analog}
 \alias{analog}
 \alias{analog.default}
+\alias{analog.distance}
 \alias{print.analog}
 %- Also NEED an '\alias' for EACH other topic documented here.
 \title{Analogue matching}
@@ -19,6 +20,8 @@
                   "information", "chi.distance", "manhattan",
                   "kendall", "gower", "alt.gower", "mixed"),
        keep.train = TRUE, \dots)
+
+\method{analog}{distance}(x, train = NULL, keep.train = TRUE, \dots)
 }
 %- maybe also 'usage' for other objects documented here.
 \arguments{
@@ -28,6 +31,9 @@
     used. See Details below.}
   \item{keep.train}{logical; should the dissimilarity matrix for the
     training set be stored?}
+  \item{train}{a pre-computed dissimilarity matrix for the training set
+    samples. Objects of classes \code{"dist"}, \code{"vegdist"}, and
+    \code{"distance"} are currently accepted.}
   \item{\dots}{arguments passed to or from other methods.}
 }
 \details{
@@ -106,5 +112,11 @@
 ik.analog
 summary(ik.analog)
 
+## Can take pre-computed dissimilarity objects
+d1 <- distance(ImbrieKipp, V12.122)
+d2 <- distance(ImbrieKipp)
+ik <- analog(d1, d2, keep.train = TRUE)
+ik
+
 }
 \keyword{multivariate}% at least one, from doc/KEYWORDS

Modified: pkg/man/distance.Rd
===================================================================
--- pkg/man/distance.Rd	2013-03-22 16:23:14 UTC (rev 318)
+++ pkg/man/distance.Rd	2013-04-08 04:48:18 UTC (rev 319)
@@ -131,7 +131,10 @@
   dissimilarities for the training set \code{x} is returned.
 
   The dissimilarity coefficient used (\code{method}) is returned as
-  attribute \code{"method"}.
+  attribute \code{"method"}. Attribute \code{"type"} indicates whether
+  the object was computed on a single data matrix (\code{"symmetric"})
+  or across two matrices (i.e. the dissimilarties between the rows of
+  two matrices; \code{"asymmetric"}.
 }
 \note{
   The dissimilarities are calculated in native R code. As such, other