[adegenet-commits] r495 - pkg/R

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

Author: jombart
Date: 2009-11-25 13:44:00 +0100 (Wed, 25 Nov 2009)
New Revision: 495

Modified:
   pkg/R/haploPop.R
Log:
Now handle correctly reverse mutations on the fly, when assigning mutations.
No longer optional posterior treatment of reverse mutations. 


Modified: pkg/R/haploPop.R
===================================================================
--- pkg/R/haploPop.R	2009-11-25 01:46:03 UTC (rev 494)
+++ pkg/R/haploPop.R	2009-11-25 12:44:00 UTC (rev 495)
@@ -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, allow.reverse=FALSE) {
+                     quiet=FALSE, allow.reverse=TRUE) {
 
 
     ## SOME CHECKS
@@ -66,9 +66,19 @@
         id <- sample(1:length(myPop), size=length(mutations), replace=TRUE)
         mutations <- split(mutations, id)
         myPop[as.integer(names(mutations))] <- mapply(c, myPop[as.integer(names(mutations))], mutations, SIMPLIFY=FALSE)
+
+        ## clean reverse mutations
+        cleanRes <- function(vec){
+            temp <- table(vec)
+            return(sort(as.integer(names(temp)[temp %% 2 != 0])))
+        }
+
+        myPop <- lapply(myPop, cleanRes)
+
         return(myPop)
-    }
+    } # end assignMutations
 
+
     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
@@ -253,24 +263,24 @@
 
     ## CLEAN RESULTS ##
     ## handle reverse mutations
-    if(clean.haplo){
-        if(!quiet){
-            cat("\n... Cleaning haplotypes (handling reverse mutations)\n")
-        }
+    ## if(clean.haplo){
+    ##     if(!quiet){
+    ##         cat("\n... Cleaning haplotypes (handling reverse mutations)\n")
+    ##     }
 
-        cleanRes <- function(vec){
-            temp <- table(vec)
-            return(sort(as.integer(names(temp)[temp %% 2 != 0])))
-        }
+    ##     cleanRes <- function(vec){
+    ##         temp <- table(vec)
+    ##         return(sort(as.integer(names(temp)[temp %% 2 != 0])))
+    ##     }
 
-        for(i in 1:length(listPop)){
-            listPop[[i]] <- lapply(listPop[[i]], cleanRes)
-        }
+    ##     for(i in 1:length(listPop)){
+    ##         listPop[[i]] <- lapply(listPop[[i]], cleanRes)
+    ##     }
 
-        if(!quiet){
-            cat("\n... done! \n")
-        }
-    }
+    ##     if(!quiet){
+    ##         cat("\n... done! \n")
+    ##     }
+    ## }
 
     ## RETURN RESULTS ##
     res <- list(pop=listPop, ages=listAges, S=vecS)
@@ -566,7 +576,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, allow.reverse=FALSE,
+                        quiet=FALSE, allow.reverse=TRUE,
                         track=c("div", "distRoot", "freq"), root.haplo=NULL, samp.size=50) {
 
 
@@ -623,9 +633,19 @@
         id <- sample(1:length(myPop), size=length(mutations), replace=TRUE)
         mutations <- split(mutations, id)
         myPop[as.integer(names(mutations))] <- mapply(c, myPop[as.integer(names(mutations))], mutations, SIMPLIFY=FALSE)
+
+        ## clean reverse mutations
+        cleanRes <- function(vec){
+            temp <- table(vec)
+            return(sort(as.integer(names(temp)[temp %% 2 != 0])))
+        }
+
+        myPop <- lapply(myPop, cleanRes)
+
         return(myPop)
-    }
+    } # end assignMutations
 
+
     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