[adegenet-commits] r843 - pkg/R

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

Author: jombart
Date: 2011-03-05 00:53:07 +0100 (Sat, 05 Mar 2011)
New Revision: 843

Modified:
   pkg/R/SNPbin.R
   pkg/R/glHandle.R
   pkg/R/import.R
Log:
Corrected bug reported by Isma. Was due to buidling SNPbin with only NA data.
Corrected also the [] procedure for genlight.


Modified: pkg/R/SNPbin.R
===================================================================
--- pkg/R/SNPbin.R	2011-03-04 20:23:41 UTC (rev 842)
+++ pkg/R/SNPbin.R	2011-03-04 23:53:07 UTC (rev 843)
@@ -55,7 +55,7 @@
     if(length(input)>1 && ! "snp" %in% names(input)) names(input)[1] <- "snp"
 
     ## handle snp data ##
-    if(!is.null(input$snp) && length(input$snp)>0){
+    if(!is.null(input$snp) && length(input$snp)>0 && !all(is.na(input$snp))){
         ## a vector of raw is provided
         if(is.raw(input$snp)){
             x at snp <-list(input$snp)
@@ -108,7 +108,21 @@
         }
     }
 
+    ## handle full-NA data
+    if(all(is.na(input$snp))){
+        x at snp <- list()
+        x at n.loc <- length(input$snp)
+        x at snp[[1]] <- .bin2raw(rep(0L, length(input$snp)))$snp
+        x at NA.posi <- 1:length(input$snp)
+        if(!is.null(input$ploidy)){
+            x at ploidy <- input$ploidy
+        } else {
+            x at ploidy <- as.integer(NA)
+        }
+        return(x)
+    }
 
+
     ## handle n.loc ##
     if(!is.null(input$n.loc)){
         x at n.loc <- as.integer(input$n.loc)
@@ -411,11 +425,11 @@
     }
 
     if(!is.null(pop(object))){
-        cat("\n @pop: individual membership for", length(levels(pop(object))), "populations\n")
+        cat("\n @pop: individual membership for", length(levels(pop(object))), "populations")
     }
 
     if(!is.null(other(object))){
-        cat(" @other: ")
+        cat("\n @other: ")
         cat("a list containing: ")
         cat(ifelse(is.null(names(other(object))), paste(length(other(object)),"unnamed elements"),
                    paste(names(other(object)), collapse= "  ")), "\n")
@@ -521,6 +535,7 @@
     value <- as.integer(value)
     if(any(value)<1) stop("Negative or null values provided")
     if(any(is.na(value))) stop("NA values provided")
+    if(length(value) == 1) value <- rep(value, length=nInd(x))
     if(length(value) != nInd(x)) stop("Length of the provided vector does not match nInd(x)")
     slot(x,"ploidy",check=TRUE) <- value
     return(x)

Modified: pkg/R/glHandle.R
===================================================================
--- pkg/R/glHandle.R	2011-03-04 20:23:41 UTC (rev 842)
+++ pkg/R/glHandle.R	2011-03-04 23:53:07 UTC (rev 843)
@@ -22,14 +22,27 @@
 
 
     ## SUBSET INDIVIDUALS ##
+    ## genotypes
     x at gen <- x at gen[i]
+
+    ## ind names
     x at ind.names <- x at ind.names[i]
+
+    ## ploidy
     if(!is.null(x at ploidy)) {
-        ori.ploidy <- ploidy(x)[i]
+        ori.ploidy <- ploidy(x) <- ploidy(x)[i]
     } else {
         ori.ploidy <- NULL
     }
 
+    ## pop
+    if(!is.null(pop(x))) {
+        ori.pop <- pop(x) <- factor(pop(x)[i])
+    } else {
+        ori.pop <- NULL
+    }
+    
+
     ## HANDLE 'OTHER' SLOT ##
     nOther <- length(other(x))
     namesOther <- names(other(x))
@@ -58,7 +71,7 @@
     } else { # need to subset SNPs
         old.other <- other(x)
         x <- as.matrix(x)[, j, drop=FALSE] # maybe need to process one row at a time
-        x <- new("genlight", gen=x, ploidy=ori.ploidy, other=old.other)
+        x <- new("genlight", gen=x, pop=ori.pop, ploidy=ori.ploidy, other=old.other)
     }
 
     return(x)

Modified: pkg/R/import.R
===================================================================
--- pkg/R/import.R	2011-03-04 20:23:41 UTC (rev 842)
+++ pkg/R/import.R	2011-03-04 23:53:07 UTC (rev 843)
@@ -998,7 +998,7 @@
     ## BUILD FINAL OBJECT ##
     if(!quiet) cat("\n Building final object... \n")
 
-    res <- new("genlight",res, ploidy=ploidy)
+    res <- new("genlight",res, ploidy=2)
     indNames(res) <- misc.info$IID
     pop(res) <- misc.info$FID
     locNames(res) <- loc.names