[Phylobase-commits] r220 - branches/pdcgsoc/misc

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

Author: pdc
Date: 2008-08-02 05:04:32 +0200 (Sat, 02 Aug 2008)
New Revision: 220

Modified:
   branches/pdcgsoc/misc/temp.R
Log:
edge, node, and tip coloring

Modified: branches/pdcgsoc/misc/temp.R
===================================================================
--- branches/pdcgsoc/misc/temp.R	2008-08-01 21:57:56 UTC (rev 219)
+++ branches/pdcgsoc/misc/temp.R	2008-08-02 03:04:32 UTC (rev 220)
@@ -10,12 +10,13 @@
                      tip.plot.fun = function() {grid.lines(1:10/10, rnorm(10, sd = .2, mean = .5))},
                      edge.color = 'black', ## TODO colors for branhes and nodes seperately?
                      node.color = 'black',
-                     lwd = 1 ## TODO currently only one width is allowed allow many?
+                     tip.color  = 'black', 
+                     edge.width = 1 ## TODO currently only one width is allowed allow many?
                      ## tip.plot.fun = function() {}
             )
     {
-    
-    
+    phy.orig <- phy
+    Å
     if (type == 'phylogram') {
         xxyy <- phyloXXYY(phy, tip.order)
         ## because we may reoder the tip, we need to update the phy objec
@@ -23,13 +24,21 @@
         segs <- segs(phy, XXYY = xxyy$xxyy)
     }
     
-    ## TODO do these parameters even require a whole fun?
-    ## edges <- edgechar(phy, params) 
+    eindex <- match(phy at edge[,2], phy.orig at edge[,2])
+    ## TODO check that colors are valid?
+    ## TODO edge colors are required to be in the order of edge matrix
+    if(length(edge.color) != nrow(phy at edge)) {
+        edge.color <- rep(edge.color, length.out = nrow(phy at edge))
+    }
+    edge.color <- edge.color[eindex]
     
-    ## tipplots <- tipPlot(...)
+    ## TODO check that colors are valid?
+    nindex <- sort(eindex[phy at edge[, 2] > length(phy at tip.label)], index.return = TRUE)$ix
+    if(length(node.color) != length(nindex)) {
+        node.color <- rep(node.color, length.out = length(nindex))
+    }
+    node.color <- node.color[nindex]
     
-    ## nodeplot <- nodPlot(...)
-    
     ## initialize canvas
     # call appropriate plot type
     ## grid calls Peter GSOC
@@ -54,16 +63,21 @@
     
     ## TODO handle better show label | data
     if (show.tip.label | plot.data) {
+        tindex <- phy at edge[phy at edge[, 2] <= length(phy at tip.label), 2]
+        if(length(tip.color) != length(phy at tip.label)) {
+            tip.color <- rep(tip.color, length.out = length(phy at tip.label))
+        }
+        
         pushViewport(viewport(
             layout = treelayout, 
             layout.pos.col = 2, 
             name = 'tip_labels'))
         grid.text(
-            phy at tip.label, 
+            phy at tip.label[tindex], 
             x = rep(0, length(phy at tip.label)), 
             ## TODO yuck!!
-            y = xxyy$xxyy$yy[which(phy at edge[, 2] <= length(phy at tip.label))], 
-            rot = rot, just = 'left'
+            y = xxyy$xxyy$yy[phy at edge[, 2] %in% tindex], 
+            rot = rot, just = 'left', gp = gpar(col = tip.color[tindex])
             )
         popViewport()
     }
@@ -96,11 +110,11 @@
     grid.segments( # draws vertical lines
         x0 = segs$v0x, y0 = segs$v0y, 
         x1 = segs$v1x, y1 = segs$v1y, 
-        name = "vert", gp = gpar(col = node.color, lwd = lwd)) 
+        name = "vert", gp = gpar(col = node.color, lwd = 1)) 
     grid.segments(  # draws horizontal lines
         x0 = segs$h0x, y0 = segs$h0y, 
         x1 = segs$h1x, y1 = segs$h1y, 
-        name = "horz", gp = gpar(col = edge.color, lwd = lwd))
+        name = "horz", gp = gpar(col = edge.color, lwd = 1))
     popViewport()
 }
 
@@ -218,4 +232,9 @@
 ##     nrow(geospiza at tip.data))/ncol(geospiza at tip.data) - .2, 
 ##     y = scale(geospiza at tip.data))
 
-treePlot(geospiza, plot.data = TRUE, edge.color = c('red', 'blue'))
+treePlot(
+    geospiza, 
+    plot.data = TRUE, 
+    # edge.color = rainbow(nrow(geospiza at edge)),  
+    tip.color = c('red',  'black', 'blue')
+)