[adegenet-commits] r858 - pkg/R

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

Author: jombart
Date: 2011-04-02 19:36:27 +0200 (Sat, 02 Apr 2011)
New Revision: 858

Modified:
   pkg/R/glHandle.R
Log:
Function to split SNPs per blocks.
Need to test.
Need to add multicore option.


Modified: pkg/R/glHandle.R
===================================================================
--- pkg/R/glHandle.R	2011-03-29 23:08:57 UTC (rev 857)
+++ pkg/R/glHandle.R	2011-04-02 17:36:27 UTC (rev 858)
@@ -226,7 +226,7 @@
     names(kObj) <- levels(pop(x))
 
     return(kObj)
-})
+}) # end seppop
 
 
 
@@ -236,12 +236,42 @@
 ##########
 ## seploc
 ##########
-setMethod("seploc", signature(x="genlight"), function(x, n.block, blockSize=NULL, random=FALSE){
-    ## HANDLE ARGUMENTS ##
-    ## blocksize
-    if(is.null(blockSize)){
-        
+setMethod("seploc", signature(x="genlight"), function(x, n.block=NULL, block.size=NULL, random=FALSE){
+    ## 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.")
+
+
+    ## GET BLOCK SIZE VECTOR ##
+    P <- nLoc(x)
+
+    ## n.block is given
+    if(!is.null(n.block)){
+        vec.blocksize <- rep(P %/% n.block, n.block)
+        if(P %% n.block >0){
+            vec.blocksize[1:(P %% n.block)] <- vec.blocksize[1:(P %% n.block)] + 1
+        }
+
     }
+
+     ## n.block is given
+    if(!is.null(block.size)){
+        vec.blocksize <- rep(block.size, P %/% n.block)
+        if(P %% block.size >0){
+             vec.blocksize <- c( vec.blocksize, P %% block.size)
+        }
+    }
+
+
+    ## split data by blocks ##
+    fac.block <- factor(rep(1:length(vec.blocksize), vec.blocksize))
+    if(random){
+        fac.block <- sample(fac.block)
+    }
+
+    res <- lapply(levels(fac.block), function(lev) x[,fac.block==lev])
+
+    return(res)
 })