[adegenet-commits] r834 - pkg/R

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

Author: jombart
Date: 2011-03-03 13:27:51 +0100 (Thu, 03 Mar 2011)
New Revision: 834

Modified:
   pkg/R/SNPbin.R
Log:
Added construction of genlight from snp.matrix objects.


Modified: pkg/R/SNPbin.R
===================================================================
--- pkg/R/SNPbin.R	2011-03-03 11:18:33 UTC (rev 833)
+++ pkg/R/SNPbin.R	2011-03-03 12:27:51 UTC (rev 834)
@@ -52,8 +52,8 @@
     x <- .Object
     input <- list(...)
     if(length(input)==1) names(input) <- "snp"
+    if(length(input)>1 && ! "snp" %in% names(input)) names(input)[1] <- "snp"
 
-
     ## handle snp data ##
     if(!is.null(input$snp) && length(input$snp)>0){
         ## a vector of raw is provided
@@ -170,7 +170,7 @@
 
 
         ## input$gen is a matrix or a data.frame
-        if(is.matrix(input$gen) | is.data.frame(input$gen)){
+        if((is.matrix(input$gen) & !inherits(input$gen,"snp.matrix")) | is.data.frame(input$gen)){
             if(is.null(input$ind.names)){
                 input$ind.names <- rownames(input$gen)
             }
@@ -217,6 +217,38 @@
                 x at gen <- lapply(input$gen, function(e) new("SNPbin",e))
             }
         }
+
+
+        ## input$gen is a snp.matrix object ##
+        if(inherits(input$gen,"snp.matrix")){
+            if(!require(snpMatrix)){
+                cat("\nThe package snp.matrix is needed for this conversion.")
+                cat("\nTo install it, type:")
+                cat("\n  source(\"http://bioconductor.org/biocLite.R\")")
+                cat("\n  biocLite(\"snpMatrix\")\n")
+                x at gen <- NULL
+            } else {
+
+                ## function to convert one indiv
+                f1 <- function(x){
+                    res <- as.integer(x)
+                    res[res==0] <- NA
+                    res <- res-1
+                    return(new("SNPbin", as.integer(res), ploidy=2))
+                }
+
+                ## create SNPbin list
+                if(multicore){
+                    x at gen <- mclapply(1:nrow(input$gen), function(i) f1(input$gen[i,]), mc.cores=n.cores, mc.silent=TRUE, mc.cleanup=TRUE, mc.preschedule=FALSE)
+                } else {
+                    x at gen <- lapply(1:nrow(input$gen), function(i) f1(input$gen[i,]))
+                }
+
+                ## handle names
+                if(is.null(input$ind.names)) {input$ind.names <- rownames(input$gen)}
+                if(is.null(input$loc.names)) {input$loc.names <- colnames(input$gen)}
+            }
+        }
     }
 
 
@@ -781,6 +813,13 @@
 })
 
 
+setAs("snp.matrix", "genlight", def=function(from){
+    return(new("genlight", from))
+})
+
+
+
+
 setMethod("as.genlight", "matrix", function(x, ...) as(x, "genlight"))
 setMethod("as.genlight", "data.frame", function(x, ...) as(x, "genlight"))
 setMethod("as.genlight", "list", function(x, ...) as(x, "genlight"))