[Analogue-commits] r254 - in pkg: R inst

[noreply at r-forge.r-project.org]

Author: gsimpson
Date: 2012-02-20 13:45:42 +0100 (Mon, 20 Feb 2012)
New Revision: 254

Modified:
   pkg/R/cma.R
   pkg/inst/ChangeLog
Log:
always generate a list of close analogues; original code could simplify to an array in some circumstances

Modified: pkg/R/cma.R
===================================================================
--- pkg/R/cma.R	2012-02-09 12:57:17 UTC (rev 253)
+++ pkg/R/cma.R	2012-02-20 12:45:42 UTC (rev 254)
@@ -38,9 +38,14 @@
     #             cutoff, "\":\n\tChoose a more suitable value", sep = ""))
     n.samp <- ncol(object$analogs)
     nams <- colnames(object$analogs)
-    close <- apply(object$analogs, 2, function(x) {
-      x <- sort(x)
-      x <- x[x <= cutoff]})
+    ## don't want apply() as that may simplify if all samples have
+    ## same number of analogues - must return a list
+    nc <- ncol(object$analogs)
+    close <- vector("list", nc)
+    for(i in seq_len(nc)) {
+        close[[i]] <- sortByCutoff(object$analogs[, i], cutoff)
+    }
+    names(close) <- colnames(object$analogs)
     if(length(close) == 0)
       close <- vector(mode = "list", length = length(nams))
     each.analogs <- sapply(close, length, USE.NAMES = FALSE)
@@ -73,10 +78,6 @@
         K <- TRUE
     }
     if(K) {
-        sortByK <- function(x, ks) {
-            x <- sort(x)
-            x[ks]
-        }
         close <- vector(mode = "list", length = n.samp)
         ks <- seq_len(k)
         for(i in seq_along(close)) {
@@ -85,11 +86,14 @@
         each.analogs <- sapply(close, length, USE.NAMES = FALSE)
         names(each.analogs) <- names(close) <- nams
     } else {
-        sortByCutoff <- function(x, cutoff) {
-            x <- sort(x)
-            x <- x[x <= cutoff]
+        ## don't want apply as that may simplify if all samples have
+        ## same number of analogues - must return a list
+        nc <- ncol(object$Dij)
+        close <- vector("list", nc)
+        for(i in seq_len(nc)) {
+            close[[i]] <-  sortByCutoff(object$Dij[,i], cutoff)
         }
-        close <- apply(object$Dij, 2, sortByCutoff, cutoff = cutoff)
+        names(close) <- colnames(object$Dij)
         each.analogs <- sapply(close, length, USE.NAMES = FALSE)
         k <- NULL
         names(each.analogs) <- names(close) <- nams
@@ -127,10 +131,6 @@
         K <- TRUE
     }
     if(K) {
-        sortByK <- function(x, ks) {
-            x <- sort(x)
-            x[ks]
-        }
         close <- vector(mode = "list", length = n.samp)
         ks <- seq_len(k)
         for(i in seq_along(close)) {
@@ -139,11 +139,14 @@
         each.analogs <- sapply(close, length, USE.NAMES = FALSE)
         names(each.analogs) <- names(close) <- nams
     } else {
-        sortByCutoff <- function(x, cutoff) {
-            x <- sort(x)
-            x <- x[x <= cutoff]
+        ## don't want apply as that may simplify if all samples have
+        ## same number of analogues - must return a list
+        nc <- ncol(object$Dij)
+        close <- vector("list", nc)
+        for(i in seq_len(nc)) {
+            close[[i]] <-  sortByCutoff(object$Dij[,i], cutoff)
         }
-        close <- apply(object$Dij, 2, sortByCutoff, cutoff = cutoff)
+        names(close) <- colnames(object$Dij)
         each.analogs <- sapply(close, length, USE.NAMES = FALSE)
         k <- NULL
         names(each.analogs) <- names(close) <- nams
@@ -188,3 +191,16 @@
     cat("\n")
     invisible(x)
 }
+
+## two simple functions that now get used more often in the methods above
+## so made full functions (rather than in-line) but not exported so
+## don't need to be documented
+sortByCutoff <- function(x, cutoff) {
+    x <- sort(x)
+    x <- x[x <= cutoff]
+}
+
+sortByK <- function(x, ks) {
+    x <- sort(x)
+    x[ks]
+}

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2012-02-09 12:57:17 UTC (rev 253)
+++ pkg/inst/ChangeLog	2012-02-20 12:45:42 UTC (rev 254)
@@ -2,6 +2,10 @@
 
 Version 0.8-1
 
+	* cma: if cutoff meant that all analogues returned for all
+	sites, code would return an array instead of the usual list.
+	This is now fixed in all methods.
+
 	* Replaced instances of `.Internal(sample(....))` with
 	`sample.int(....)` at request of Brian Ripley.