[adegenet-commits] r410 - pkg/R

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

Author: jombart
Date: 2009-06-19 01:05:14 +0200 (Fri, 19 Jun 2009)
New Revision: 410

Modified:
   pkg/R/seqTrack.R
Log:
implementing free distribution for dates in optimize


Modified: pkg/R/seqTrack.R
===================================================================
--- pkg/R/seqTrack.R	2009-06-18 22:06:35 UTC (rev 409)
+++ pkg/R/seqTrack.R	2009-06-18 23:05:14 UTC (rev 410)
@@ -434,7 +434,7 @@
 ##
 optimize.seqTrack.default <- function(x, x.names, x.dates, typed.chr, mu0, chr.length,
                                       thres=0.2, optim=c("min","max"), prox.mat=NULL, nstep=10, step.size=1e3,
-                                      rDate=.rTimeSeq, rMissDate=.rUnifTimeSeq, ...){
+                                      rDate=.rTimeSeq, arg.rDate=NULL, rMissDate=.rUnifTimeSeq, ...){
 
 
     ## CHECKS ##
@@ -458,7 +458,20 @@
 
     isMissDate <- is.na(x.dates)
 
+    if(!identical(rDate, .rTimeSeq)){
+        if(is.null(arg.rDate)){
+            warning("Specific time distribution specified without arguments.")
+            arg.rDate <- list(n=step.size)
+        } else {
+            if(!is.list(arg.rDate)) stop("If provided, arg.rDate must be a list.")
+            if(!is.null(arg.rDate$n)) {
+                warning("arg.rDate$n is provided, but will be replaced by step.size.")
+            }
+            arg.rDate <- list(n=step.size)
+        }
+    }
 
+
     N <- length(x.names)
     id <- 1:N
     ## if(length(mu0) < N) { # recycle mu0
@@ -544,8 +557,15 @@
     ## DEFAULT CASE: NO MISSING DATES
     if(!any(isMissDate)){
         ## dates initialisation, taken from initial prior
-        newDates <- sapply(1:N, function(i)
-                           rDate(n=step.size, mu0=list.mu0[[i]], L=list.chr.length[[i]], maxNbDays=RANGE.DATES))
+        ## If dates distrib is .rTimeSeq
+        if(identical(rDate, .rTimeSeq)){
+            newDates <- sapply(1:N, function(i)
+                               rDate(n=step.size, mu0=list.mu0[[i]], L=list.chr.length[[i]],
+                                     maxNbDays=RANGE.DATES))
+        } else { ## Else, any other distrib with free arguements
+            newDates <- sapply(1:N, function(i) do.call(rDate, arg.rDate))
+        }
+
         newDates <- t(newDates)*24*3600 + x.dates
 
         ## >> one step of 'step.size' simulations, all with same prior << ##