[adegenet-commits] r490 - pkg/R

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

Author: jombart
Date: 2009-11-20 12:30:56 +0100 (Fri, 20 Nov 2009)
New Revision: 490

Modified:
   pkg/R/haploPop.R
Log:
getting to it...


Modified: pkg/R/haploPop.R
===================================================================
--- pkg/R/haploPop.R	2009-11-19 11:38:17 UTC (rev 489)
+++ pkg/R/haploPop.R	2009-11-20 11:30:56 UTC (rev 490)
@@ -684,12 +684,18 @@
         listAges <- ini.obj$ages
     }
 
-    res <- list(tab=list(), popSize=integer())
-    res$tab[[1]] <- table(unlist(listPop))
-    res$popSize[1] <- sum(sapply(listPop, length))
+    ## function getting pairwise distances
+    fRes <- function(list.pop){
+        N <- min(50, sum(sapply(list.pop, length)))
+        dist.haploPop(sample.haploPop(list.pop, N, keep.pop=FALSE), FALSE) # do not include the root in distances.
+    }
 
+    res <- list(dist=list(), popSize=integer())
+    res$dist[[1]] <- fRes(listPop)
+    ##res$popSize[1] <- sum(sapply(listPop, length))
 
 
+
     ## MAKE SIMULATIONS ##
 
     ## evolve all populations
@@ -736,8 +742,8 @@
               return(res)
         }
 
-        res$tab[[i]] <- table(unlist(listPop))
-        res$popSize[i] <- sum(sapply(listPop, length))
+        res$dist[[i]] <- fRes(listPop)
+        ##res$popSize[i] <- sum(sapply(listPop, length))
 
         ## FOR DEBUGGING
         ## cat("\n=== ",i," ===")