[adegenet-commits] r497 - pkg/R

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

Author: jombart
Date: 2009-11-25 14:56:39 +0100 (Wed, 25 Nov 2009)
New Revision: 497

Modified:
   pkg/R/haploPop.R
Log:
Finished optimizing reverse mutation handling


Modified: pkg/R/haploPop.R
===================================================================
--- pkg/R/haploPop.R	2009-11-25 13:37:28 UTC (rev 496)
+++ pkg/R/haploPop.R	2009-11-25 13:56:39 UTC (rev 497)
@@ -61,29 +61,30 @@
         }
     }
 
+    ## clean reverse mutations
+    cleanRes <- function(vec){
+        temp <- table(vec)
+        return( as.integer(names(temp)[temp %% 2 != 0]) )
+    }
+
+
+    ## assign mutation to haplotypes
     assignMutations <- function(myPop, mutations){ # mypop: list of `haplotypes'; mutations: vector of SNPs
         if(length(mutations)==0 | length(myPop)==0) return(myPop)
         id <- sample(1:length(myPop), size=length(mutations), replace=TRUE)
         mutations <- split(mutations, id)
 
         ## function to merge new mutations - handle reverse case
-        ## f1 <- function(a,b){
-        ##     revMut <- intersect(a,b)
-        ##     if(length(revMut)==0) return(c(a,b))
-        ##     return(setdiff(c(a ,b), revMut))
-        ## }
+        f1 <- function(a,b){
+            revMut <- intersect(a,b)
+            if(length(revMut)==0) return(c(a,b))
+            return(setdiff(c(a ,b), revMut))
+        }
 
-        myPop[as.integer(names(mutations))] <- mapply(c, myPop[as.integer(names(mutations))], mutations, SIMPLIFY=FALSE)
-        ## myPop[as.integer(names(mutations))] <- mapply(f1, myPop[as.integer(names(mutations))], mutations, SIMPLIFY=FALSE)
+        ##myPop[as.integer(names(mutations))] <- mapply(c, myPop[as.integer(names(mutations))], mutations, SIMPLIFY=FALSE)
+         myPop[as.integer(names(mutations))] <- mapply(f1, myPop[as.integer(names(mutations))], mutations, SIMPLIFY=FALSE)
 
-        ## ## clean reverse mutations
-        cleanRes <- function(vec){
-            temp <- table(vec)
-            return( as.integer(names(temp)[temp %% 2 != 0]) )
-        }
-
-        ## return(myPop)
-        return( lapply(myPop, cleanRes) )
+        return(myPop)
     } # end assignMutations
 
 
@@ -636,19 +637,24 @@
         }
     }
 
+
+    ## assign mutation to haplotypes
     assignMutations <- function(myPop, mutations){ # mypop: list of `haplotypes'; mutations: vector of SNPs
         if(length(mutations)==0 | length(myPop)==0) return(myPop)
         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( as.integer(names(temp)[temp %% 2 != 0]) )
+        ## function to merge new mutations - handle reverse case
+        f1 <- function(a,b){
+            revMut <- intersect(a,b)
+            if(length(revMut)==0) return(c(a,b))
+            return(setdiff(c(a ,b), revMut))
         }
 
-        return( lapply(myPop, cleanRes) )
+        ##myPop[as.integer(names(mutations))] <- mapply(c, myPop[as.integer(names(mutations))], mutations, SIMPLIFY=FALSE)
+         myPop[as.integer(names(mutations))] <- mapply(f1, myPop[as.integer(names(mutations))], mutations, SIMPLIFY=FALSE)
+
+        return(myPop)
     } # end assignMutations