[adegenet-commits] r494 - pkg/R

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

Author: jombart
Date: 2009-11-25 02:46:03 +0100 (Wed, 25 Nov 2009)
New Revision: 494

Modified:
   pkg/R/haploPop.R
Log:
Added an option to allow (or not) reverse mutations.


Modified: pkg/R/haploPop.R
===================================================================
--- pkg/R/haploPop.R	2009-11-25 00:46:12 UTC (rev 493)
+++ pkg/R/haploPop.R	2009-11-25 01:46:03 UTC (rev 494)
@@ -12,7 +12,7 @@
                      birth.func=function(){ sample(0:3, 1, prob=c(.05, .45, .35, .15))},
                      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) {
+                     quiet=FALSE, clean.haplo=FALSE, allow.reverse=FALSE) {
 
 
     ## SOME CHECKS
@@ -47,9 +47,18 @@
     vecS <- 1 # will be redefined later, but needed for evolveOnePop definition
 
     ## AUXILIARY FUNCTIONS ##
-    createMutations <- function(N){ # L:genome length; N: pop size
-        nb.mutations <- sum(rbinom(N, size=haplo.length, prob=mu))
-        return( sample(SNP.POOL, size=nb.mutations, replace=TRUE) )
+    if(allow.reverse){
+        createMutations <- function(N){ # L:genome length; N: pop size
+            nb.mutations <- sum(rbinom(N, size=haplo.length, prob=mu))
+            return( sample(SNP.POOL, size=nb.mutations, replace=TRUE) )
+        }
+    } else {
+        createMutations <- function(N){ # L:genome length; N: pop size
+            nb.mutations <- sum(rbinom(N, size=haplo.length, prob=mu))
+            res <- sample(SNP.POOL, size=nb.mutations, replace=TRUE)
+            SNP.POOL <<- setdiff(SNP.POOL, res)# update pool of SNPs
+            return(res)
+        }
     }
 
     assignMutations <- function(myPop, mutations){ # mypop: list of `haplotypes'; mutations: vector of SNPs
@@ -557,7 +566,7 @@
                         birth.func=function(){ sample(0:3, 1, prob=c(.05, .45, .35, .15))},
                         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,
+                        quiet=FALSE, clean.haplo=FALSE, allow.reverse=FALSE,
                         track=c("div", "distRoot", "freq"), root.haplo=NULL, samp.size=50) {
 
 
@@ -595,9 +604,18 @@
     vecS <- 1 # will be redefined later, but needed for evolveOnePop definition
 
     ## AUXILIARY FUNCTIONS ##
-    createMutations <- function(N){ # L:genome length; N: pop size
-        nb.mutations <- sum(rbinom(N, size=haplo.length, prob=mu))
-        return( sample(SNP.POOL, size=nb.mutations, replace=TRUE) )
+    if(allow.reverse){
+        createMutations <- function(N){ # L:genome length; N: pop size
+            nb.mutations <- sum(rbinom(N, size=haplo.length, prob=mu))
+            return( sample(SNP.POOL, size=nb.mutations, replace=TRUE) )
+        }
+    } else {
+        createMutations <- function(N){ # L:genome length; N: pop size
+            nb.mutations <- sum(rbinom(N, size=haplo.length, prob=mu))
+            res <- sample(SNP.POOL, size=nb.mutations, replace=TRUE)
+            SNP.POOL <<- setdiff(SNP.POOL, res)# update pool of SNPs
+            return(res)
+        }
     }
 
     assignMutations <- function(myPop, mutations){ # mypop: list of `haplotypes'; mutations: vector of SNPs