[adegenet-commits] r777 - pkg/R

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

Author: jombart
Date: 2011-01-25 12:22:25 +0100 (Tue, 25 Jan 2011)
New Revision: 777

Modified:
   pkg/R/SNPbin.R
Log:
A few minor fixes to accessors, show, etc.


Modified: pkg/R/SNPbin.R
===================================================================
--- pkg/R/SNPbin.R	2011-01-24 18:24:37 UTC (rev 776)
+++ pkg/R/SNPbin.R	2011-01-25 11:22:25 UTC (rev 777)
@@ -14,7 +14,7 @@
                                   NA.posi = "integer",
                                   label = "charOrNULL",
                                   ploidy = "integer"),
-         prototype(snp = list(), n.loc = integer(0), label = NULL, ploidy = 1L))
+         prototype(snp = list(), n.loc = 0L, label = NULL, ploidy = 1L))
 
 
 
@@ -30,7 +30,7 @@
                                     ploidy = "intOrNULL",
                                     pop = "factorOrNULL",
                                     other = "list"),
-         prototype(gen = list(), n.loc = integer(0), ind.names = NULL, loc.names = NULL, loc.all = NULL, ploidy=NULL, pop=NULL, other=list()))
+         prototype(gen = list(), n.loc = 0L, ind.names = NULL, loc.names = NULL, loc.all = NULL, ploidy=NULL, pop=NULL, other=list()))
 
 
 
@@ -298,7 +298,7 @@
             }
         }
 
-        
+
         ## HANDLE INPUT$POP ##
         if(!is.null(input$pop)){
             ## check length consistency
@@ -357,14 +357,19 @@
     cat(" === S4 class genlight ===")
     cat("\n", nInd(object), "genotypes with", nLoc(object),  "binary SNPs")
     temp <- unique(ploidy(object))
-    if(length(temp)==1){
-        cat("\n Ploidy:", temp)
-    } else {
-        temp <- summary(ploidy(object))
-        cat("\n Ploidy statistics (min/median/max):", temp[1], "/", temp[3], "/", temp[6])
+    if(!is.null(temp)){
+        if(length(temp)==1){
+            cat("\n Ploidy:", temp)
+        } else {
+            temp <- summary(ploidy(object))
+            cat("\n Ploidy statistics (min/median/max):", temp[1], "/", temp[3], "/", temp[6])
+        }
     }
     temp <- sapply(object at gen, function(e) length(e at NA.posi))
-    cat("\n ", sum(temp), " (", round(sum(temp)/(nInd(object)*nLoc(object)),2)," %) missing data\n", sep="")
+    if(length(temp>1)){
+        cat("\n ", sum(temp), " (", round(sum(temp)/(nInd(object)*nLoc(object)),2)," %) missing data", sep="")
+    }
+    cat("\n")
 }) # end show method
 
 
@@ -427,13 +432,17 @@
 })
 
 setMethod("ploidy","genlight", function(x,...){
-    if(!is.null(x at ploidy)){
-        res <- x at ploidy
+    if(nInd(x)>0){
+        if(!is.null(x at ploidy)){
+            res <- x at ploidy
+        } else {
+            res <- sapply(x at gen, function(e) e at ploidy)
+        }
+        names(res) <- x at ind.names
+        return(res)
     } else {
-        res <- sapply(x at gen, function(e) e at ploidy)
+        return(NULL)
     }
-    names(res) <- x at ind.names
-    return(res)
 })
 
 
@@ -504,8 +513,22 @@
 })
 
 
+## pop
+setMethod("pop","genlight", function(x){
+    return(x at pop)
+})
 
 
+setMethod("pop<-","genlight",function(x,value) {
+    if(length(value) != nInd(x)) stop("Vector length does no match number of individuals")
+    slot(x,"pop", check=TRUE) <- factor(value)
+    return(x)
+})
+
+
+
+
+
 ###############
 ## '[' operators
 ###############