[adegenet-commits] r658 - pkg/R

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

Author: jombart
Date: 2010-09-08 12:18:10 +0200 (Wed, 08 Sep 2010)
New Revision: 658

Modified:
   pkg/R/Hs.R
Log:
Fixed an issue arising when one pop is fixed at one locus.


Modified: pkg/R/Hs.R
===================================================================
--- pkg/R/Hs.R	2010-07-31 09:30:05 UTC (rev 657)
+++ pkg/R/Hs.R	2010-09-08 10:18:10 UTC (rev 658)
@@ -3,12 +3,22 @@
 ############################
 Hs <- function(x, truenames=TRUE) {
 
-    ## checks
+    ## CHECKS
     if(!is.genpop(x)) stop("x is not a valid genpop object")
     if(x at type=="PA") stop("not implemented for presence/absence markers")
 
-    ## main computations
+
+    ## MAIN COMPUTATIONS
+
+    ## have to handle loci with no polymorphism
     x.byloc <- seploc(x, truenames=truenames)
+
+    toRemove <- which(x at loc.nall==1)
+      if(length(toRemove)>0){
+          x.byloc <- x.byloc[-toRemove]
+
+    }
+
     lX <- lapply(x.byloc, function(e) makefreq(e, quiet=TRUE, truenames=truenames)$tab)
     lres <- lapply(lX, function(X) 1- apply(X^2,1,sum))