[adegenet-commits] r859 - pkg/R

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

Author: jombart
Date: 2011-04-02 20:24:31 +0200 (Sat, 02 Apr 2011)
New Revision: 859

Modified:
   pkg/R/glHandle.R
Log:
seploc for genlight seems OK
Need to fix a bug in cbind.


Modified: pkg/R/glHandle.R
===================================================================
--- pkg/R/glHandle.R	2011-04-02 17:36:27 UTC (rev 858)
+++ pkg/R/glHandle.R	2011-04-02 18:24:31 UTC (rev 859)
@@ -236,10 +236,15 @@
 ##########
 ## seploc
 ##########
-setMethod("seploc", signature(x="genlight"), function(x, n.block=NULL, block.size=NULL, random=FALSE){
+setMethod("seploc", signature(x="genlight"), function(x, n.block=NULL, block.size=NULL, random=FALSE,
+                               multicore=FALSE, n.cores=NULL){
     ## CHECKS ##
     if(is.null(n.block) & is.null(block.size)) stop("n.block and block.size are both missing.")
     if(!is.null(n.block) & !is.null(block.size)) stop("n.block and block.size are both provided.")
+    if(multicore && !require(multicore)) stop("multicore package requested but not installed")
+    if(multicore && is.null(n.cores)){
+        n.cores <- multicore:::detectCores()
+    }
 
 
     ## GET BLOCK SIZE VECTOR ##
@@ -254,9 +259,9 @@
 
     }
 
-     ## n.block is given
+    ## block.size is given
     if(!is.null(block.size)){
-        vec.blocksize <- rep(block.size, P %/% n.block)
+        vec.blocksize <- rep(block.size, P %/% block.size)
         if(P %% block.size >0){
              vec.blocksize <- c( vec.blocksize, P %% block.size)
         }
@@ -269,12 +274,24 @@
         fac.block <- sample(fac.block)
     }
 
+    if(multicore){
+        res <- mclapply(levels(fac.block), function(lev) x[,fac.block==lev],
+                        mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE, mc.preschedule=FALSE)
+    }
+
     res <- lapply(levels(fac.block), function(lev) x[,fac.block==lev])
 
+    ## return result ##
+    names(res) <- paste("block", 1:length(res),sep=".")
+
     return(res)
-})
+}) # end seploc
 
 
+
+
+
+
 ###################
 ### TESTING
 ###################