[adegenet-commits] r685 - pkg/R

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

Author: jombart
Date: 2010-10-07 19:42:24 +0200 (Thu, 07 Oct 2010)
New Revision: 685

Modified:
   pkg/R/dapc.R
Log:
Fixed a score for Pf=1


Modified: pkg/R/dapc.R
===================================================================
--- pkg/R/dapc.R	2010-10-07 17:10:32 UTC (rev 684)
+++ pkg/R/dapc.R	2010-10-07 17:42:24 UTC (rev 685)
@@ -342,8 +342,15 @@
     sumry <- summary(x)
 
     ## get the a-scores
-    lscores <- lapply(lsim, function(e) (sumry$assign.per.pop-e)/(1-e))
+    f1 <- function(Pt, Pf){
+        tol <- 1e-7
+        res <- (Pt-Pf) / (1-Pf)
+        res[Pf > (1-tol)] <- 0
+        return(res)
+    }
 
+    lscores <- lapply(lsim, function(e) f1(sumry$assign.per.pop, e))
+
     ## make a table of a-scores
     tab <- data.frame(lscores)
     colnames(tab) <- paste("sim", 1:n.sim, sep=".")