[adegenet-commits] r350 - pkg/R

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

Author: jombart
Date: 2009-06-03 18:00:47 +0200 (Wed, 03 Jun 2009)
New Revision: 350

Modified:
   pkg/R/seqTrack.R
Log:
Getting closer. Have to try it.



Modified: pkg/R/seqTrack.R
===================================================================
--- pkg/R/seqTrack.R	2009-06-03 15:53:08 UTC (rev 349)
+++ pkg/R/seqTrack.R	2009-06-03 16:00:47 UTC (rev 350)
@@ -500,16 +500,16 @@
 
             ## retain thres% of the dates ##
             toKeep <- valRes < quantile(valRes, thres) ## NOT WORKING FOR optim==max !!!
-            date <- date[toKeep]
+            date <- date[,toKeep] # retained posterior
             newDates <- apply(date, 1, function(vec)
-                              sample(vec, size=step.size, replace=TRUE))
+                              sample(vec, size=step.size, replace=TRUE)) # new prior
             newDates <- t(newDates)
 
             ## re-initialize posterior distributions
             if(i<nstep){
-                ances <- integer(0)
+                ## ances <- integer(0) # not needed now
                 date <- character(0)
-                ances.date <- character(0)
+                ## ances.date <- character(0) # not needed now
                 valRes <- numeric(0)
             } # end if
         } # end for i
@@ -526,8 +526,10 @@
         ##                     w <- w/sum(w)
         ##                 }
 
+        ## newDates <- apply(date, 1, function(vec) #  used a weighted sampling
+        ##                                  sample(vec, size=step.size, replace=TRUE, prob=w))
 
-        ## new dates
+
         ## DEBUGING ##
         ## temp <- apply(date,1,function(vec) length(unique(vec)))
         ##                 cat("\n i =", i, "j =", j, "Number of dates per sequence:\n")
@@ -538,10 +540,6 @@
         ## print(w)
         ## END DEBUGING ##
 
-        ## newDates <- apply(date, 1, function(vec) #  used a weighted sampling
-        ##                                  sample(vec, size=step.size, replace=TRUE, prob=w))
-
-
     } # end if(!any(isMissDate))
 
 
@@ -584,6 +582,14 @@
 
 
     ## RESULT ##
+
+    ## reconstruct the result with new dates
+    res <- lapply(1:ncol(date), function(i)
+                   seqTrack(seq.names=seq.names, seq.dates=date[,i], W=W,
+                                    optim=optim, prox.mat=prox.mat, ...))
+    ances <- data.frame(lapply(res, function(e) e$ances))
+    ances.date <- data.frame(lapply(res, function(e) e$ances.date))
+
     res <- list(ances=ances, date=date, ances.date=ances.date, valsim=valRes)
     return(res)