[adegenet-commits] r387 - pkg/R

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

Author: jombart
Date: 2009-06-09 20:13:54 +0200 (Tue, 09 Jun 2009)
New Revision: 387

Modified:
   pkg/R/haploSim.R
   pkg/R/seqTrack.R
Log:
Added a sample.haploSim
--This line, and tsample.haploSimhose below, will be ignored--

M    pkg/R/haploSim.R
M    pkg/R/seqTrack.R


Modified: pkg/R/haploSim.R
===================================================================
--- pkg/R/haploSim.R	2009-06-09 12:12:44 UTC (rev 386)
+++ pkg/R/haploSim.R	2009-06-09 18:13:54 UTC (rev 387)
@@ -468,3 +468,44 @@
     return(invisible(res))
 
 } # end plotHaploSim
+
+
+
+
+
+
+
+
+
+
+###################
+## sample.haploSim
+###################
+sample.haploSim <- function(x, n){
+    ## EXTRACT THE SAMPLE ##
+    res <- x[sample(1:nrow(x$seq), n, replace=FALSE)]
+
+
+    ## RETRIEVE SOME PARAMETERS FROM HAPLOSIM CALL
+    prevCall <- as.list(x$call)
+    if(!is.null(prevCall$mu)){
+        mu0 <- eval(prevCall$mu)
+    } else {
+        mu0 <- 1e-04
+    }
+
+    if(!is.null(prevCall$seq.length)){
+        L <- eval(prevCall$seq.length)
+    } else {
+        L <- 1000
+    }
+
+    truedates <- res$dates
+    daterange <- range(res$dates,na.rm=TRUE)
+
+    sampdates <- .rTimeSeq(mu0=mu0, L=L, n=length(truedates), maxNbDays=daterange/2)
+
+    res$dates <- sampdates
+
+    return(res)
+} # end sample.haploSim

Modified: pkg/R/seqTrack.R
===================================================================
--- pkg/R/seqTrack.R	2009-06-09 12:12:44 UTC (rev 386)
+++ pkg/R/seqTrack.R	2009-06-09 18:13:54 UTC (rev 387)
@@ -634,6 +634,7 @@
         ori.dim <- dim(e)
         e <- as.character(e)
         dim(e) <- ori.dim
+        return(e)
     }
 
 
@@ -665,6 +666,12 @@
         attr(res$ances, "levels") <- newlev
     }
 
+    ## method for haploSim
+    if(class(x)=="haploSim"){
+        res <- x
+        ances.id <- match(x$ances, labels(x))
+    }
+
     return(res)
 
 } # end get.result.by
@@ -700,7 +707,9 @@
     }
 
     ## form the output
+    olev <- levels(orires$ances)
     res$ances <- newances
+    levels(res$ances) <- olev
     res$support <- ances.support
 
     return(res)
@@ -711,6 +720,7 @@
 
 
 
+
 ###############
 ## seqTrack.ml
 ###############