[adegenet-commits] r395 - pkg/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Jun 11 19:56:02 CEST 2009


Author: jombart
Date: 2009-06-11 19:56:02 +0200 (Thu, 11 Jun 2009)
New Revision: 395

Modified:
   pkg/R/seqTrack.R
Log:
Small changes to the consensus calculation.


Modified: pkg/R/seqTrack.R
===================================================================
--- pkg/R/seqTrack.R	2009-06-11 14:20:45 UTC (rev 394)
+++ pkg/R/seqTrack.R	2009-06-11 17:56:02 UTC (rev 395)
@@ -495,7 +495,7 @@
                            .rTimeSeq(n=step.size, mu0=mu0[i], L=seq.length[i], maxNbDays=RANGE.DATES))
         newDates <- t(newDates)*24*3600 + seq.dates
 
-        ## >> one step of 'step.size simulations', all with same prior << ##
+        ## >> one step of 'step.size' simulations, all with same prior << ##
         for(i in 1:nstep){
             ## >> each step contains 'step.size' iterations << ##
             for(j in 1:step.size){
@@ -686,6 +686,7 @@
 #################
 get.consensus <- function(orires, listres){
     res <- orires
+    nbDraws <- 0
 
     ## tables of occurences of ancestors
     temp <- apply(listres$ances, 1, table)
@@ -697,8 +698,12 @@
     } else {
         f1 <- function(tab){
             res <- names(tab)[tab==max(tab)]
-            if(length(res)==1) return(res)
-            return(NA)
+            ## if(length(res)==1) return(res)
+            ##             return(NA)
+            if(length(res)>1) {
+                nbDraws <- nbDraws+1
+            }
+            return(res[1])
         }
 
         newances <- sapply(temp, f1)
@@ -712,6 +717,8 @@
     levels(res$ances) <- olev
     res$support <- ances.support
 
+    cat("\nThere were\n",nbDraws, "draws.\n")
+
     return(res)
 }
 



More information about the adegenet-commits mailing list