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

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

Author: pdc
Date: 2008-08-06 10:43:39 +0200 (Wed, 06 Aug 2008)
New Revision: 256

Modified:
   branches/pdcgsoc/misc/temp.R
Log:
add node labelling

Modified: branches/pdcgsoc/misc/temp.R
===================================================================
--- branches/pdcgsoc/misc/temp.R	2008-08-06 08:32:06 UTC (rev 255)
+++ branches/pdcgsoc/misc/temp.R	2008-08-06 08:43:39 UTC (rev 256)
@@ -3,7 +3,8 @@
 require(lattice)
 treePlot <- function(phy, 
                      type = c('phylogram', 'cladogram'), 
-                     show.tip.label = TRUE, 
+                     show.tip.label = TRUE,
+                     show.node.label = FALSE, 
                      tip.order = NULL,
                      plot.data = is(phy, 'phylo4d'),
                      rot = 0,
@@ -44,7 +45,7 @@
                             layout = phyplotlayout, 
                             name = 'phyplotlayout', angle = -rot))
         pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1))
-            tree.plot(xxyy, show.tip.label, 
+            tree.plot(xxyy, show.tip.label, show.node.label, 
                 edge.color, node.color, tip.color, 
                 edge.width, rot)
         upViewport()
@@ -68,7 +69,7 @@
                                     layout = datalayout, 
                                     name = 'datalayout', angle = -rot))
                 pushViewport(viewport(layout.pos.col = 1:Ntips))
-                    tree.plot(xxyy, show.tip.label, 
+                    tree.plot(xxyy, show.tip.label, show.node.label, 
                         edge.color, node.color, tip.color, 
                         edge.width, rot)
                 upViewport()
@@ -77,7 +78,7 @@
                     yscale = c(-0.5/Ntips, 1 + 0.5/Ntips), 
                     layout.pos.col = Ntips + 1, 
                     name = 'data_plots'))
-                    grid.rect(gp = gpar(col = 2))
+                    # grid.rect(gp = gpar(col = 2))
                 ## TODO should plots float at tips, or only along edge?
                 for(i in xxyy$yy[which(phy at edge[, 2] <= Ntips)]) {
                     pushViewport(viewport(
@@ -111,7 +112,7 @@
                     phylobubbles(xxyy, ...)
                 upViewport()
                 pushViewport(viewport(layout.pos.col = 1, layout.pos.row = 1))
-                    tree.plot(xxyy, show.tip.label, 
+                    tree.plot(xxyy, show.tip.label, show.node.label, 
                         edge.color, node.color, tip.color, 
                         edge.width, rot)
                 upViewport()
@@ -120,7 +121,7 @@
     }
 }
 
-tree.plot <- function(xxyy, show.tip.label, edge.color, 
+tree.plot <- function(xxyy, show.tip.label, show.node.label, edge.color, 
                         node.color, tip.color, edge.width, rot) 
 {
     # TODO switch to phylobase abstractions
@@ -189,6 +190,21 @@
         )
         upViewport()
     }
+    # TODO probably want to be able to adjust the location of these guys
+    if(show.node.label) {
+        pushViewport(viewport(
+            layout = treelayout, layout.pos.col = 1, 
+            ))
+        labtext <- grid.text(
+            phy at node.label[nindex], 
+            x = xxyy$xx[phy at edge[, 2] > Ntips], 
+            ## TODO yuck!!
+            y = xxyy$yy[phy at edge[, 2] > Ntips], 
+            default.units = 'npc', 
+            rot = rot, just = 'left', gp = gpar(col = node.color[nindex])
+        )
+        upViewport()
+    }
     upViewport()
     # grobTree(vseg, hseg, labtext)
 }
@@ -392,6 +408,7 @@
 p1 <- treePlot(
     geospiza, 
     # show.tip.label = FALSE, 
+    show.node.label = TRUE, 
     # edge.color = rainbow(nrow(geospiza at edge)),  
     # plot.data = FALSE, 
     tip.plot.fun = function() {grid.lines(1:10/10, runif(10))},