[adegenet-commits] r417 - pkg/R

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

Author: jombart
Date: 2009-06-21 17:58:11 +0200 (Sun, 21 Jun 2009)
New Revision: 417

Modified:
   pkg/R/seqTrack.R
Log:
Some reforms of the plotting function plotSeqtrack; 
now, only support and threshold should be provided. 


Modified: pkg/R/seqTrack.R
===================================================================
--- pkg/R/seqTrack.R	2009-06-19 21:02:12 UTC (rev 416)
+++ pkg/R/seqTrack.R	2009-06-21 15:58:11 UTC (rev 417)
@@ -137,9 +137,9 @@
 ################
 ## plotSeqTrack
 ################
-plotSeqTrack <- function(x, xy, useArrows=TRUE, annot=TRUE, dateRange=NULL,
+plotSeqTrack <- function(x, xy, useArrows=TRUE, annot=TRUE, labels=NULL, dateRange=NULL,
                          col=NULL, bg="grey", add=FALSE, quiet=FALSE,
-                         showAmbiguous=FALSE, mu0=NULL, chr.length=NULL, prob=0.75,
+                         support=NULL, thres=0.5,
                          plot=TRUE,...){
 
     ## CHECKS ##
@@ -147,8 +147,11 @@
     ##if(ncol(x) != 5) stop("x does not have five columns")
     if(ncol(xy) != 2) stop("xy does not have two columns")
     if(nrow(xy) != nrow(x)) stop("x and xy have inconsistent dimensions")
-    if(showAmbiguous & (is.null(mu0) | is.null(chr.length)) ){
-        stop("showAmbiguous is TRUE, but mu0 and chr.length are not all provided.")
+    ## if(showAmbiguous & (is.null(mu0) | is.null(chr.length)) ){
+    ##         stop("showAmbiguous is TRUE, but mu0 and chr.length are not all provided.")
+    ##     }
+    if(!is.null(support)){
+        if(length(support)!=nrow(xy)) stop("Inconsistent length for support.")
     }
 
     isAmbig <- NULL
@@ -164,18 +167,30 @@
     x <- x[!isNA,,drop=FALSE]
     xy.all <- xy ## used to retrieve all coordinates
     xy <- xy[!isNA,,drop=FALSE]
-    if(!is.null(col)){
+    if(!is.null(labels)){ # subset labels
+        labels <- labels[!isNA]
+    }
+    if(!is.null(col)){ # subset colors
         col <- col[!isNA]
     }
+    if(!is.null(support)){
+        support <- support[!isNA] # subset support
+    }
 
 
-    ## FIND AMBIGUOUS TEMPORAL ORDERING ##
-    if(showAmbiguous){
-        temp <- .pAbeforeB(x$ances.date, x$date, mu0, chr.length)
-        isAmbig <- temp < prob
+    ## FIND AMBIGUOUS ANCESTRIES ##
+    if(!is.null(support)){
+        isAmbig <- support < thres
     }
 
 
+    ## ## FIND AMBIGUOUS TEMPORAL ORDERING ##
+    ##     if(showAmbiguous){
+    ##         temp <- .pAbeforeB(x$ances.date, x$date, mu0, chr.length)
+    ##         isAmbig <- temp < prob
+    ##     }
+
+
     ## FIND SEGMENTS COORDS ##
     from <- unlist(x[,2])
     to <- unlist(x[,1])
@@ -197,6 +212,7 @@
         col[w < 1] <- "red"
     }
 
+
     ## THIS WAS USED WHEN COLOR REPRESENTED THE NUMBER OF MUTATIONS ##
     ##  if(is.null(col)){
     ##         w <- as.numeric(x[,3])
@@ -237,11 +253,17 @@
         col <- col[toKeep]
         xy <- xy[toKeep,,drop=FALSE]
         x <- x[toKeep,,drop=FALSE]
-        if(!is.null(isAmbig)) {
+        if(!is.null(isAmbig)) { # subset isAmbig
             isAmbig <- isAmbig[toKeep]
         }
+        if(!is.null(labels)){ # subset labels
+            labels <- labels[toKeep]
+        }
     }
 
+
+
+
     ## DO THE PLOTTING ##
     if(plot){
         obg <- par("bg")
@@ -257,9 +279,10 @@
         ## handle segments/arrows with length 0 ##
         nullLength <- (abs(x.from-x.to)<1e-10) & (abs(y.from-y.to)<1e-10)
 
-        if(showAmbiguous & any(isAmbig)){ # plot arrows & segments
-            suppressWarnings(arrows(x.from[!isAmbig], y.from[!isAmbig],
-                                    x.to[!isAmbig], y.to[!isAmbig], col=col[!isAmbig], angle=15, ...))
+        if(any(isAmbig)){ # plot arrows & segments
+            suppressWarnings(arrows(x.from[!isAmbig & !nullLength], y.from[!isAmbig & !nullLength],
+                                    x.to[!isAmbig & !nullLength], y.to[!isAmbig & !nullLength],
+                                    col=col[!isAmbig & !nullLength], angle=15, ...))
             segments(x.from[isAmbig], y.from[isAmbig],
                      x.to[isAmbig], y.to[isAmbig], col=col,...)
         } else{ # plot all arrows
@@ -272,12 +295,17 @@
     }
 
 
-    if(annot & plot) text(xy,lab=rownames(x), font=2)
+    if(annot & plot) {
+        if(is.null(labels)){
+            labels <- rownames(x)
+        }
+        text(xy,lab=labels, font=2)
+    }
 
     if(any(nullLength) & plot) {
-        points(x.from[nullLength], y.from[nullLength], col=col[nullLength], cex=2, pch=20, ...)
         sunflowerplot(x.from[nullLength], y.from[nullLength], seg.lwd=2, size=1/6,
                       col=col[nullLength], seg.col=col[nullLength], add=TRUE, ...)
+        points(x.from[nullLength], y.from[nullLength], col=col[nullLength], cex=2, pch=20, ...)
     }