[adegenet-commits] r473 - pkg/R

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

Author: jombart
Date: 2009-11-12 01:08:18 +0100 (Thu, 12 Nov 2009)
New Revision: 473

Modified:
   pkg/R/haploPop.R
Log:
this is the end... the ennnnnd !


Modified: pkg/R/haploPop.R
===================================================================
--- pkg/R/haploPop.R	2009-11-11 22:11:13 UTC (rev 472)
+++ pkg/R/haploPop.R	2009-11-12 00:08:18 UTC (rev 473)
@@ -117,7 +117,8 @@
     while(i<(n.steps+1)){ # evolve all generations
         i <- i + 1L # update iterator
         if(!quiet){
-            cat(ifelse((i%%10)==0, i, "."))
+            catStep <- max(round(n.steps/200), 10)
+            cat(ifelse((i %% catStep)==0, paste(" ...", i), ""))
         }
 
 
@@ -149,13 +150,13 @@
         }
 
         ## FOR DEBUGGING
-        cat("\n=== ",i," ===")
-        cat("\nlistPop")
-        print(listPop)
-        cat("\nvecS")
-        print(vecS)
-        cat("\nlistAges")
-        print(listAges)
+        ## cat("\n=== ",i," ===")
+        ## cat("\nlistPop")
+        ## print(listPop)
+        ## cat("\nvecS")
+        ## print(vecS)
+        ## cat("\nlistAges")
+        ## print(listAges)
         ## END DEBUGGING
     } # end while
 
@@ -241,10 +242,19 @@
 ##################
 ## sample.haploPop
 ##################
-sample.haploPop <- function(x, n){
-    x <- unlist(x, recursive=FALSE)
-    res <- list()
-    res[[1]] <- sample(x, n)
+sample.haploPop <- function(x, n, n.pop=NULL){
+    x$call <- NULL
+    if(is.null(n.pop)){
+        x <- unlist(x, recursive=FALSE)
+        res <- list()
+        res[[1]] <- sample(x, n)
+    } else {
+        toKeep <- sapply(x,length)>n
+        x <- x[toKeep]
+        x <- sample(x, n.pop, replace=FALSE)
+        popId <- sample(1:n.pop, n, replace=TRUE)
+        res <- sapply(popId, function(i) sample(x[[i]],1))
+    }
     class(res) <- "haploPop"
     return(res)
 } # end sample.haploPop