[adegenet-commits] r286 - pkg/R

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

Author: jombart
Date: 2009-04-01 19:11:25 +0200 (Wed, 01 Apr 2009)
New Revision: 286

Modified:
   pkg/R/propTyped.R
Log:
propTyped fixed for PA


Modified: pkg/R/propTyped.R
===================================================================
--- pkg/R/propTyped.R	2009-04-01 17:04:02 UTC (rev 285)
+++ pkg/R/propTyped.R	2009-04-01 17:11:25 UTC (rev 286)
@@ -22,7 +22,7 @@
         }
 
         if(by=="loc"){
-            res <- apply(temp,2,function(r) mean(is.na(r)))
+            res <- apply(temp,2,function(c) mean(is.na(c)))
             return(1-res)
         }
 
@@ -71,9 +71,34 @@
 
 setMethod("propTyped","genpop", function(x, by=c("pop","loc","both")){
 
-    checkType(x)
+    ## checkType(x)
     by <- match.arg(by)
 
+
+    ## PA case ##
+    if(x at type=="PA"){
+        temp <- as.matrix(x)
+
+        if(by=="pop"){
+            res <- apply(temp,1,function(r) mean(is.na(r)))
+            return(1-res)
+        }
+
+        if(by=="loc"){
+            res <- apply(temp,2,function(c) mean(is.na(c)))
+            return(1-res)
+        }
+
+        if(by=="both"){
+            res <- !is.na(temp)
+            return(res*1)
+        }
+    } # end PA case
+
+
+    ## codom case ##
+
+
     ## auxil function f1
     f1 <- function(vec){
         if(any(is.na(vec))) return(0)