[adegenet-commits] r809 - pkg/R

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

Author: jombart
Date: 2011-02-17 16:21:33 +0100 (Thu, 17 Feb 2011)
New Revision: 809

Modified:
   pkg/R/SNPbin.R
Log:
started cbind commands. OK for SNPbin; need fixes for genlight.


Modified: pkg/R/SNPbin.R
===================================================================
--- pkg/R/SNPbin.R	2011-02-15 09:57:25 UTC (rev 808)
+++ pkg/R/SNPbin.R	2011-02-17 15:21:33 UTC (rev 809)
@@ -601,7 +601,7 @@
     if(length(j)==1 && is.logical(j) && j){ # no need to subset SNPs
         return(x)
     } else { # need to subset SNPs
-        x <- as.matrix(x)[, j, drop=FALSE]
+        x <- as.matrix(x)[, j, drop=FALSE] # maybe need to process one row at a time
         x <- new("genlight", gen=x, ploidy=ori.ploidy)
     }
     return(x)
@@ -612,6 +612,59 @@
 
 
 
+
+######################
+##
+## c, cbind, rbind...
+##
+######################
+
+################
+## cbind SNPbin
+################
+##setMethod("cbind", signature("SNPbin"), function(..., deparse.level = 1) {
+cbind.SNPbin <- function(..., deparse.level = 1){
+    myList <- list(...)
+    if(!all(sapply(myList, class)=="SNPbin")) stop("some objects are not SNPbin objects")
+    if(length(unique(sapply(myList, ploidy))) !=1 ) stop("objects have different ploidy levels")
+    x <- new("SNPbin", unlist(lapply(myList, as.integer)))
+    return(x)
+}
+##})
+
+
+
+##################
+## cbind genlight
+##################
+##setMethod("cbind", signature(x="genlight"), function(..., deparse.level = 1) {
+cbind.genlight <- function(..., deparse.level = 1){
+    myList <- list(...)
+    if(!all(sapply(myList, class)=="genlight")) stop("some objects are not genlight objects")
+    if(length(unique(sapply(myList, nInd))) !=1 ) stop("objects have different numbers of individuals")
+    n.obj <- length(myList)
+    n.ind <- nInd(myList[[1]])
+
+    ## merge one individual at a time ##
+    res <- list()
+    for(i in 1:n.ind){
+        res[[i]] <- Reduce(cbind, lapply(myList, function(e) e at gen[[i]]))
+    }
+
+    res <- new("genlight",temp)
+
+    ## handle loc.names, alleles, etc. ##
+    locNames(res) <- unlist(lapply(myList, locNames))
+    alleles(res) <- unlist(lapply(myList, alleles))
+
+    ## return object ##
+    return(res)
+}
+##})
+
+
+
+
 ###################
 ##
 ##   CONVERSIONS
@@ -754,16 +807,10 @@
 
 
 
-######################
-## c, cbind, rbind...
-######################
 
 
 
 
-
-
-
 ################################
 ## testing SNPbin
 ##