[adegenet-commits] r377 - pkg/R

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

Author: jombart
Date: 2009-06-05 23:14:27 +0200 (Fri, 05 Jun 2009)
New Revision: 377

Modified:
   pkg/R/haploSim.R
Log:
Almost all fixed, need the check the dateRange for ploHaploSim (issues an error currently)


Modified: pkg/R/haploSim.R
===================================================================
--- pkg/R/haploSim.R	2009-06-05 19:42:27 UTC (rev 376)
+++ pkg/R/haploSim.R	2009-06-05 21:14:27 UTC (rev 377)
@@ -394,23 +394,13 @@
 
 
 
-
-
-################
-## plotHaploSim
-################
-plotHaploSim <- function(x, annot=FALSE, dateRange=NULL, col=NULL, bg="grey", add=FALSE, ...){
-
-    ## SOME CHECKS ##
-    if(class(x)!="haploSim") stop("x is not a haploSim object")
-    if(is.null(x$xy)) stop("x does not contain xy coordinates; try to simulate date")
-
-
-    ## CONVERSION TO A SEQTRACK-LIKE OBJECT ##
+########################
+## as.seqTrack.haploSim
+########################
+as.seqTrack.haploSim <- function(x){
     x.ori <- x
     x <- na.omit(x)
     toSetToNA <- x$dates==min(x$dates)
-    xy <- x$xy
     res <- list()
     res$id <- labels(x)
     res <- as.data.frame(res)
@@ -425,11 +415,44 @@
     res$ances <- match(res$ances, res$id)
     res$id <- 1:length(res$id)
 
+    return(res)
+}
 
+
+
+
+################
+## plotHaploSim
+################
+plotHaploSim <- function(x, annot=FALSE, dateRange=NULL, col=NULL, bg="grey", add=FALSE, ...){
+
+    ## SOME CHECKS ##
+    if(class(x)!="haploSim") stop("x is not a haploSim object")
+    if(is.null(x$xy)) stop("x does not contain xy coordinates; try to simulate date")
+
+
+    ## ## CONVERSION TO A SEQTRACK-LIKE OBJECT ##
+    xy <- na.omit(x)$xy
+    res <- as.seqTrack.haploSim(x)
+
+    ##     res <- list()
+    ##     res$id <- labels(x)
+    ##     res <- as.data.frame(res)
+    ##     res$ances <- x$ances
+    ##     res$ances[toSetToNA] <- NA
+    ##     res$weight <- 1 # ??? have to recompute that...
+    ##     res$weight[toSetToNA] <- NA
+    ##     res$date <- as.POSIXct(x.ori)[labels(x)]
+    ##     res$ances.date <- as.POSIXct(x.ori)[x$ances]
+    ##     ## set results as indices rather than labels
+    ##     res$ances <- match(res$ances, res$id)
+    ##     res$id <- 1:length(res$id)
+
+
     ## CALL TO PLOTSEQTRACK ##
-    out <- plotSeqTrack(res, xy=xy, annot=annot, dateRange=dateRange,
+    plotSeqTrack(res, xy=xy, annot=annot, dateRange=dateRange,
                         col=col, bg=bg, add=add, showAmbiguous=FALSE, ...)
 
-    return(invisible(out))
+    return(invisible(res))
 
 } # end plotHaploSim