[adegenet-commits] r496 - pkg/R

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

Author: jombart
Date: 2009-11-25 14:37:28 +0100 (Wed, 25 Nov 2009)
New Revision: 496

Modified:
   pkg/R/haploPop.R
Log:
optimized correction for reverse mutations


Modified: pkg/R/haploPop.R
===================================================================
--- pkg/R/haploPop.R	2009-11-25 12:44:00 UTC (rev 495)
+++ pkg/R/haploPop.R	2009-11-25 13:37:28 UTC (rev 496)
@@ -65,17 +65,25 @@
         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))
+        ## }
+
         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
+        ## ## clean reverse mutations
         cleanRes <- function(vec){
             temp <- table(vec)
-            return(sort(as.integer(names(temp)[temp %% 2 != 0])))
+            return( as.integer(names(temp)[temp %% 2 != 0]) )
         }
 
-        myPop <- lapply(myPop, cleanRes)
-
-        return(myPop)
+        ## return(myPop)
+        return( lapply(myPop, cleanRes) )
     } # end assignMutations
 
 
@@ -637,12 +645,10 @@
         ## clean reverse mutations
         cleanRes <- function(vec){
             temp <- table(vec)
-            return(sort(as.integer(names(temp)[temp %% 2 != 0])))
+            return( as.integer(names(temp)[temp %% 2 != 0]) )
         }
 
-        myPop <- lapply(myPop, cleanRes)
-
-        return(myPop)
+        return( lapply(myPop, cleanRes) )
     } # end assignMutations