[adegenet-commits] r753 - pkg/R

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

Author: jombart
Date: 2011-01-05 16:03:44 +0100 (Wed, 05 Jan 2011)
New Revision: 753

Modified:
   pkg/R/SNPbin.R
Log:
subsetting and conversion to list, matrix and data.frame from genlight works.


Modified: pkg/R/SNPbin.R
===================================================================
--- pkg/R/SNPbin.R	2011-01-05 14:08:26 UTC (rev 752)
+++ pkg/R/SNPbin.R	2011-01-05 15:03:44 UTC (rev 753)
@@ -53,7 +53,7 @@
 
 
     ## handle snp data ##
-    if(!is.null(input$snp) && length(input$snp)>1){
+    if(!is.null(input$snp) && length(input$snp)>0){
         ## a vector of raw is provided
         if(is.raw(input$snp)){
             x at snp <-list(input$snp)
@@ -73,6 +73,7 @@
             ## determine ploidy
             if(is.null(input$ploidy)){
                 input$ploidy <- max(input$snp, na.rm=TRUE)
+                if(input$ploidy==0) input$ploidy <- 1
             }
             input$ploidy <- as.integer(input$ploidy)
             if(input$ploidy<1) stop("Ploidy is less than 1")
@@ -426,8 +427,35 @@
 
 
 
+## lightgen
+setMethod("[", signature(x="genlight", i="ANY", j="ANY", drop="ANY"), function(x, i, j, ...) {
+    if (missing(i)) i <- TRUE
+    if (missing(j)) j <- TRUE
 
+    ## subset individuals
+    x at gen <- x at gen[i]
+    x at ind.names <- x at ind.names[i]
+    if(!is.null(x at ploidy)) {
+        ori.ploidy <- ploidy(x)[i]
+    } else {
+        ori.ploidy <- NULL
+    }
 
+    ## subset loci
+    x <- as.matrix(x)[, j, drop=FALSE]
+    x <- x[!apply(x, 1, function(e) all(is.na(e))), , drop=FALSE] # remove indiv that are all NAs
+    x <- x[, !apply(x, 2, function(e) all(is.na(e))), drop=FALSE] # remove loci that are all NAs
+
+    x <- new("genlight", gen=x, ploidy=ori.ploidy)
+
+    return(x)
+}) # end [] for SNPbin
+
+
+
+
+
+
 ###################
 ##
 ##   CONVERSIONS
@@ -620,7 +648,7 @@
 
 ## SIMPLE TEST
 ## library(adegenet)
-## dat <- list(toto=c(1,1,0), titi=c(NA,1,1,0), tata=c(NA,0,3, NA))
+## dat <- list(toto=c(1,1,0,0), titi=c(NA,1,1,0), tata=c(NA,0,3, NA))
 ## x <- new("genlight", dat)
 ## x
 ## as.list(x)
@@ -630,13 +658,24 @@
 ## identical(x, new("genlight", as.matrix(x))) # round trip - matrix - MUST BE TRUE
 ## identical(x, new("genlight", as.data.frame(x))) # round trip - data.frame - MUST BE TRUE
 
+## ## test subsetting
+## identical(as.list(x[c(1,3)]), as.list(x)[c(1,3)]) # MUST BE TRUE
+## identical(x, x[]) # MUST BE TRUE
+## all.equal(t(as.matrix(as.data.frame(dat)))[,1:3], as.matrix(x[,1:3])) # MUST BE TRUE
 
 
-## ## BIG SCALE TEST - HAPLOID DATA WITH NA
-## dat <- lapply(1:100, function(i) sample(c(0,1,NA), 1e6, prob=c(.5, .49, .01), replace=TRUE))
+
+
+## ## ## BIG SCALE TEST - HAPLOID DATA WITH NA
+## library(adegenet)
+## dat <- lapply(1:50, function(i) sample(c(0,1,NA), 1e6, prob=c(.5, .49, .01), replace=TRUE))
 ## names(dat) <- paste("indiv", 1:length(dat))
 ## print(object.size(dat), unit="aut")
 
 ## system.time(x <- new("genlight", dat)) # conversion + time taken
 ## print(object.size(x), unit="au")
 ## object.size(dat)/object.size(x) # conversion efficiency
+
+
+## ## time taken by subsetting (quite long, +- 35sec)
+## system.time(y <- x[1:10, 1:5e5])