[Phylobase-commits] r276 - branches/pdcgsoc/R

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

Author: pdc
Date: 2008-08-09 02:32:12 +0200 (Sat, 09 Aug 2008)
New Revision: 276

Modified:
   branches/pdcgsoc/R/treePlot.R
Log:
name some viewports and a couple of bug fixes


Modified: branches/pdcgsoc/R/treePlot.R
===================================================================
--- branches/pdcgsoc/R/treePlot.R	2008-08-08 08:53:20 UTC (rev 275)
+++ branches/pdcgsoc/R/treePlot.R	2008-08-09 00:32:12 UTC (rev 276)
@@ -10,6 +10,7 @@
                      node.color = 'black', # TODO what do with node.color parameter
                      tip.color  = 'black', 
                      edge.width = 1,
+                     newpage = TRUE,
                      ...
             )
 {
@@ -21,16 +22,18 @@
     # TODO remove the false cladogram option?
     if(is.null(edgeLength(phy)) || type == 'cladogram') {
         phy at edge.length <- rep(1, Nedges)
-        if(type == 'cladogram') {
-            xxyy$xx[phy at edge[, 2] <= Ntips] <- 1
-        }
     }
     xxyy <- phyloXXYY(phy, tip.order)
     phy <- xxyy$phy
     tindex <- phy at edge[phy at edge[, 2] <= Ntips, 2]
+    if(type == 'cladogram') {
+        xxyy$xx[phy at edge[, 2] <= Ntips] <- 1
+    }
     
     pushTree <- function(row, col) {
-            pushViewport(viewport(layout.pos.row = row, layout.pos.col = col))
+            pushViewport(viewport(layout.pos.row = row, 
+                                  layout.pos.col = col,
+                                  name = 'treevp'))
                 tree.plot(xxyy = xxyy, type = type, 
                     show.tip.label = show.tip.label, 
                     show.node.label = show.node.label, 
@@ -48,7 +51,7 @@
     # if no plot is present TODO perhpas there's a better solution than calling plot.new
     
     ## because we may reoder the tip, we need to update the phy objec
-    grid.newpage()
+    if(newpage) grid.newpage()
     if(!plot.data) {
         phyplotlayout <- grid.layout(nrow = 1, ncol = 1)
         pushViewport(viewport(width = width, height = height, 
@@ -70,9 +73,11 @@
                 pushViewport(viewport(width = width, height = height, 
                                     layout = phyplotlayout, 
                                     name = 'phyplotlayout'))
-                    pushViewport(viewport(layout.pos.row = 1:2, layout.pos.col = 2,
-                                        height = unit(1, 'npc', NULL) + 
-                                                    convertUnit(dlabwdth, 'npc'), 
+                    pushViewport(viewport(layout.pos.row = 1:2, 
+                                            layout.pos.col = 2,
+                                            height = unit(1, 'npc', NULL) + 
+                                                convertUnit(dlabwdth, 'npc'),
+                                            name = 'bubbleplots', 
                                         default.units = 'native'))
                         phylobubbles(xxyy, ...)
                     upViewport()
@@ -214,7 +219,8 @@
     upViewport()
     if(show.tip.label) {
         pushViewport(viewport(layout = treelayout, layout.pos.col = 1:2,
-            xscale = c(0, 1 + convertUnit(adjlabw, 'native', valueOnly = TRUE))))
+            xscale = c(0, 1 + convertUnit(adjlabw, 'native', valueOnly = TRUE)),
+            name = 'tiplabelvp'))
         labtext <- grid.text(
             phy at tip.label[tindex], 
             x = xxyy$xx[phy at edge[, 2] %in% tindex] + laboff[tindex], rot = lrot,
@@ -227,7 +233,7 @@
     # 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))
-            rty <- mean(xxyy$yy[phy at edge[, 1] == Ntips + 1])
+            rty <- mean(xxyy$yy[phy at edge[, 1] == Ntips + 1], name = 'nodelabelvp')
         labtext <- grid.text(
             phy at node.label, 
             x = c(0, xxyy$xx[phy at edge[, 2] > Ntips][nindex]), 
@@ -354,6 +360,8 @@
 }
 
 phylobubbles <- function(XXYY, square = FALSE) {
+    ## TODO remove data transformation from phylobubbles
+    ## TODO add legend command
     phy <- XXYY$phy
     
     tys <- XXYY$yy[phy at edge[, 2] <= nTips(phy)]
@@ -410,7 +418,7 @@
     } else {
         grid.circle(xrep, tys, r = unlist(traits), gp = gpar(fill = ccol))
     }
-    popViewport()
+    upViewport()
     pushViewport(viewport( 
         name = 'bubble_tip_labels', 
         layout = bublayout, 
@@ -418,7 +426,7 @@
         layout.pos.row = 1
     ))
     grid.text(phy at tip.label, 0.2, tys, just = 'left')
-    popViewport()
+    upViewport()
     pushViewport(viewport( 
         name = 'bubble_data_labels', 
         layout = bublayout, 
@@ -426,7 +434,7 @@
         layout.pos.row = 2
     ))
     grid.text(colnames(traits), xpos, .8, rot = 90, just = 'right')
-    popViewport()
+    upViewport()
 
-    popViewport()
+    upViewport()
 }