[Analogue-commits] r264 - in pkg: R inst man

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

Author: gsimpson
Date: 2012-04-18 22:30:39 +0200 (Wed, 18 Apr 2012)
New Revision: 264

Modified:
   pkg/R/splitSample.R
   pkg/inst/ChangeLog
   pkg/man/splitSample.Rd
Log:
Silly bug in splitSample, constrain the while loop too

Modified: pkg/R/splitSample.R
===================================================================
--- pkg/R/splitSample.R	2012-04-16 21:32:09 UTC (rev 263)
+++ pkg/R/splitSample.R	2012-04-18 20:30:39 UTC (rev 264)
@@ -12,7 +12,8 @@
 ##                                                                    ##
 ##--------------------------------------------------------------------##
 splitSample <- function(env, chunk = 10, take, nchunk,
-                        fill = c("head","tail","random")) {
+                        fill = c("head","tail","random"),
+                        maxit = 1000) {
     sampFun <- function(ind, x, nchunk) {
         sample(x[[ind]], min(length(x[[ind]]), nchunk[[ind]]))
     }
@@ -33,8 +34,8 @@
         ## fill in the remainder samples according to fill type
         tooSmall <- lens < nchunk
         nchunk[tooSmall] <- lens[tooSmall]
-        if(any(tooSmall)) {
-            i <- 1
+        if(sum(nchunk) < take) {
+            i <- iter <- 1
             ## vector of chunks that *aren't* too small expanded to length 100
             vec <- if(isTRUE(all.equal(fill, "head"))) {
                 rep(sort(which(!tooSmall)), 100)
@@ -46,10 +47,15 @@
             ## fill in chunks
             while(sum(nchunk) < take) {
                 want <- vec[i]
+                i <- i + 1
+                iter <- iter + 1
+                if(iter == maxit) {
+                    warning("Failed to allocate all 'take' samples in 'maxit' iterations.")
+                    break
+                }
                 if(lens[want] <= nchunk[want])
                     next
                 nchunk[want] <- nchunk[want] + 1
-                i <- i + 1
                 if(i > 100) ## if used all vec, start again
                     i <- 1
             }
@@ -66,7 +72,7 @@
     samp <- lapply(ind, FUN = sampFun, x = splt, nchunk = nchunk)
     ## grab the number of samples in each chunk
     lengths <- sapply(samp, length)
-    ## turn sample list intoa vector
+    ## turn sample list into a vector
     samp <- unlist(samp, use.names = FALSE)
     ## assign lengths as attribute
     attr(samp, "lengths") <- lengths

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2012-04-16 21:32:09 UTC (rev 263)
+++ pkg/inst/ChangeLog	2012-04-18 20:30:39 UTC (rev 264)
@@ -5,6 +5,8 @@
 	* wa: small tolerances can now be replaced by the mean
 	tolerance of the set of tolerances that are not small.
 
+	* splitSample: several bug fixes and sanity checks.
+
 Version 0.9-1
 
 	* splitSample: new function to sample a test set from across

Modified: pkg/man/splitSample.Rd
===================================================================
--- pkg/man/splitSample.Rd	2012-04-16 21:32:09 UTC (rev 263)
+++ pkg/man/splitSample.Rd	2012-04-18 20:30:39 UTC (rev 264)
@@ -12,7 +12,8 @@
 }
 \usage{
 splitSample(env, chunk = 10, take, nchunk,
-            fill = c("head", "tail", "random"))
+            fill = c("head", "tail", "random"),
+            maxit = 1000)
 }
 %- maybe also 'usage' for other objects documented here.
 \arguments{
@@ -27,6 +28,9 @@
     chunk. See Details.}
   \item{fill}{character; the type of filling of chunks to perform. See
     Details.}
+  \item{maxit}{numeric; maximum number of iterations in which to try to
+    sample \code{take} observations. Basically here to stop the loop
+    going on forever.}
 }
 \details{
   The gradient is split into \code{chunk} sections and samples are