[adegenet-commits] r659 - pkg/R

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

Author: jombart
Date: 2010-09-08 12:54:34 +0200 (Wed, 08 Sep 2010)
New Revision: 659

Modified:
   pkg/R/Hs.R
   pkg/R/makefreq.R
Log:
Now the bug with fixed loci (in all pop of a genpop) is fixed.


Modified: pkg/R/Hs.R
===================================================================
--- pkg/R/Hs.R	2010-09-08 10:18:10 UTC (rev 658)
+++ pkg/R/Hs.R	2010-09-08 10:54:34 UTC (rev 659)
@@ -9,20 +9,11 @@
 
 
     ## 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))
-
     res <- apply(as.matrix(data.frame(lres)),1,mean)
-
+ 
     return(res)
 } # end Hs

Modified: pkg/R/makefreq.R
===================================================================
--- pkg/R/makefreq.R	2010-09-08 10:18:10 UTC (rev 658)
+++ pkg/R/makefreq.R	2010-09-08 10:54:34 UTC (rev 659)
@@ -25,6 +25,7 @@
 
   # tabfreq is a pop x loci table of allelic frequencies
   tabfreq <- t(apply(tabcount,1,function(r) unlist(tapply(r,x at loc.fac,f1))))
+  if(x at loc.nall == 1) tabfreq <- t(tabfreq) # matrix is transposed by apply if there's a single allele
   colnames(tabfreq) <- colnames(x at tab)
 
   # NA treatment