[adegenet-commits] r470 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Nov 11 16:08:48 CET 2009
Author: jombart
Date: 2009-11-11 16:08:47 +0100 (Wed, 11 Nov 2009)
New Revision: 470
Modified:
pkg/R/haploPop.R
Log:
Still working on SIR. Also fixed aging of populations.
Modified: pkg/R/haploPop.R
===================================================================
--- pkg/R/haploPop.R 2009-11-11 14:40:09 UTC (rev 469)
+++ pkg/R/haploPop.R 2009-11-11 15:08:47 UTC (rev 470)
@@ -8,11 +8,10 @@
## - mu: substitution rate / nucleotide / year
## - n.steps: number of generations to simulate
##
-haploPop <- function(n.steps=20, haplo.length=1e6, mu=1e-4, gen.time=1, n.snp.ini=10,
- r.func=function(Nt){max(0, Nt * rnorm(1, mean=1.2, sd=.2))},
- pop.ini.size=function(){1e1}, pop.max.size=function(){1e4},
- p.new.pop=function(){1e-4}, max.nb.pop=100, kill.func=function(age){age>1},
- quiet=FALSE) {
+haploPop <- function(n.steps=20, haplo.length=1e6, mu=1e-4, n.snp.ini=10,
+ r.func=function(Nt){max(0, Nt * rnorm(1, mean=1.2, sd=.2))}, gen.time=1,
+ pop.ini.size=function(){1e1}, pop.max.size=function(){1e4}, max.nb.pop=100,
+ p.new.pop=function(){1e-4}, kill.func=function(age){age>1}, quiet=FALSE) {
## SOME CHECKS
@@ -102,7 +101,8 @@
if(!quiet){
cat("\nSimulating populations of haplotypes through time: \n")
}
- while((sum(vecS)>0) & (i<(n.steps+1))){ # evolve all generations
+ ##while((sum(vecS)>0) & (i<(n.steps+1))){ # evolve all generations
+ while(i<(n.steps+1)){ # evolve all generations
i <- i + 1L # update iterator
if(!quiet){
cat(ifelse((i%%10)==0, i, "."))
@@ -124,8 +124,8 @@
return(invisible(NULL))
}
- ## evolve populations of one generation
- temp <- which(vecS>0)
+ ## make populations evolve of one generation
+ temp <- 1:length(listPop) # make sure that new pop won't evolve this time
for(j in temp){
temp<- evolveOnePop(listPop[[j]], vecS[j], listAges[[j]])
listPop[[j]] <- temp$pop
More information about the adegenet-commits
mailing list