[adegenet-commits] r493 - pkg/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Nov 25 01:46:12 CET 2009
Author: jombart
Date: 2009-11-25 01:46:12 +0100 (Wed, 25 Nov 2009)
New Revision: 493
Modified:
pkg/R/haploPop.R
Log:
Major change in simulation: death occurs AFTER reproduction.
This means that coexistence of parents and descendents is no longer required for the pop to grow.
Modified: pkg/R/haploPop.R
===================================================================
--- pkg/R/haploPop.R 2009-11-23 21:55:08 UTC (rev 492)
+++ pkg/R/haploPop.R 2009-11-25 00:46:12 UTC (rev 493)
@@ -63,21 +63,30 @@
if(!regen){
## VERSION FOR NO REGENERATION OF SUSCEPTIBLES
evolveOnePop <- function(myPop, myS, myAge){ # myPop: pop to evolve; myS: nb of susceptible in the pop; myAge: vector of ages
- ## death 'em bastards (= old strains)
+ ## strains get older
myAge <- myAge + 1
- toKill <- death.func(myAge)
- myPop[toKill] <- NULL
- myAge <- myAge[!toKill]
+ ## toKill <- death.func(myAge)
+ ## myPop[toKill] <- NULL
+ ## myAge <- myAge[!toKill]
## generate new strains for new generation
sampSize <- round(min( length(myPop)*birth.func(), myS)) # number of strains for next step
if(sampSize<1){ # if no sample
+ ## old strains die
+ toKill <- death.func(myAge)
+ myPop[toKill] <- NULL
+ myAge <- myAge[!toKill]
return(list(pop=myPop, S=myS, age=myAge))
}
newGen <- myPop[sample(1:length(myPop), sampSize, replace=TRUE)] # sample strains for new generations
newGen <- assignMutations(newGen, createMutations(sampSize)) # mutate strains
newAge <- rep(0, sampSize) # new ages for newborns
+ ## old strains die
+ toKill <- death.func(myAge)
+ myPop[toKill] <- NULL
+ myAge <- myAge[!toKill]
+
## merge old and new generation
myPop <- c(myPop,newGen)
myAge <- c(myAge, newAge)
@@ -99,22 +108,31 @@
} # end no regen version
} else { ## REGEN VERSION
evolveOnePop <- function(myPop, myS, myAge){ # myPop: pop to evolve; myS: nb of susceptible in the pop; myAge: vector of ages
- ## death 'em bastards (= old strains)
+ ## strains get older
myAge <- myAge + 1
- toKill <- death.func(myAge)
- myPop[toKill] <- NULL
- myAge <- myAge[!toKill]
+ ## toKill <- death.func(myAge)
+ ## myPop[toKill] <- NULL
+ ## myAge <- myAge[!toKill]
myS <- max.pop.size() ## DIFFERENCE between the two versions of the function
## generate new strains for new generation
sampSize <- round(min( length(myPop)*birth.func(), myS)) # number of strains for next step
if(sampSize<1){ # if no sample
+ ## old strains die
+ toKill <- death.func(myAge)
+ myPop[toKill] <- NULL
+ myAge <- myAge[!toKill]
return(list(pop=myPop, S=myS, age=myAge))
}
newGen <- myPop[sample(1:length(myPop), sampSize, replace=TRUE)] # sample strains for new generations
newGen <- assignMutations(newGen, createMutations(sampSize)) # mutate strains
newAge <- rep(0, sampSize) # new ages for newborns
+ ## old strains die
+ toKill <- death.func(myAge)
+ myPop[toKill] <- NULL
+ myAge <- myAge[!toKill]
+
## merge old and new generation
myPop <- c(myPop,newGen)
myAge <- c(myAge, newAge)
@@ -540,7 +558,7 @@
max.pop.size=function(){1e4}, max.nb.pop=30, ini.pop.size=10, regen=FALSE,
p.new.pop=function(){1e-4}, death.func=function(age){age>1},
quiet=FALSE, clean.haplo=FALSE,
- track=c("div", "distRoot"), root.haplo=NULL, samp.size=50) {
+ track=c("div", "distRoot", "freq"), root.haplo=NULL, samp.size=50) {
## SOME CHECKS
@@ -593,21 +611,30 @@
if(!regen){
## VERSION FOR NO REGENERATION OF SUSCEPTIBLES
evolveOnePop <- function(myPop, myS, myAge){ # myPop: pop to evolve; myS: nb of susceptible in the pop; myAge: vector of ages
- ## death 'em bastards (= old strains)
+ ## strains get older
myAge <- myAge + 1
- toKill <- death.func(myAge)
- myPop[toKill] <- NULL
- myAge <- myAge[!toKill]
+ ## toKill <- death.func(myAge)
+ ## myPop[toKill] <- NULL
+ ## myAge <- myAge[!toKill]
## generate new strains for new generation
sampSize <- round(min( length(myPop)*birth.func(), myS)) # number of strains for next step
if(sampSize<1){ # if no sample
+ ## old strains die
+ toKill <- death.func(myAge)
+ myPop[toKill] <- NULL
+ myAge <- myAge[!toKill]
return(list(pop=myPop, S=myS, age=myAge))
}
newGen <- myPop[sample(1:length(myPop), sampSize, replace=TRUE)] # sample strains for new generations
newGen <- assignMutations(newGen, createMutations(sampSize)) # mutate strains
newAge <- rep(0, sampSize) # new ages for newborns
+ ## old strains die
+ toKill <- death.func(myAge)
+ myPop[toKill] <- NULL
+ myAge <- myAge[!toKill]
+
## merge old and new generation
myPop <- c(myPop,newGen)
myAge <- c(myAge, newAge)
@@ -629,22 +656,31 @@
} # end no regen version
} else { ## REGEN VERSION
evolveOnePop <- function(myPop, myS, myAge){ # myPop: pop to evolve; myS: nb of susceptible in the pop; myAge: vector of ages
- ## death 'em bastards (= old strains)
+ ## strains get older
myAge <- myAge + 1
- toKill <- death.func(myAge)
- myPop[toKill] <- NULL
- myAge <- myAge[!toKill]
+ ## toKill <- death.func(myAge)
+ ## myPop[toKill] <- NULL
+ ## myAge <- myAge[!toKill]
myS <- max.pop.size() ## DIFFERENCE between the two versions of the function
## generate new strains for new generation
sampSize <- round(min( length(myPop)*birth.func(), myS)) # number of strains for next step
if(sampSize<1){ # if no sample
+ ## old strains die
+ toKill <- death.func(myAge)
+ myPop[toKill] <- NULL
+ myAge <- myAge[!toKill]
return(list(pop=myPop, S=myS, age=myAge))
}
newGen <- myPop[sample(1:length(myPop), sampSize, replace=TRUE)] # sample strains for new generations
newGen <- assignMutations(newGen, createMutations(sampSize)) # mutate strains
newAge <- rep(0, sampSize) # new ages for newborns
+ ## old strains die
+ toKill <- death.func(myAge)
+ myPop[toKill] <- NULL
+ myAge <- myAge[!toKill]
+
## merge old and new generation
myPop <- c(myPop,newGen)
myAge <- c(myAge, newAge)
@@ -667,7 +703,6 @@
} ## end evolveOnePop (both versions)
-
## INITIATE SIMULATIONS ##
## INITIALIZE FROM SCRATCH
if(is.null(ini.obj)){
@@ -725,7 +760,16 @@
} # end fRes
}
+ ## function getting allele absolute frequencies
+ if(track=="freq"){
+ fRes <- function(list.pop){
+ res <- table(unlist(list.pop))
+ return(res)
+ } # end fRes
+ }
+
+
res <- list(div=list(), popSize=integer())
res$div[[1]] <- fRes(listPop)
res$popSize[1] <- sum(sapply(listPop, length))
More information about the adegenet-commits
mailing list