[Phylobase-commits] r608 - pkg/R

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

Author: pdc
Date: 2009-08-31 03:18:05 +0200 (Mon, 31 Aug 2009)
New Revision: 608

Modified:
   pkg/R/treePlot.R
Log:
Fixes bug #616, Top level "margins" viewport wasn't being exited, leaving baggage for future plots.  Also fixes an issue with only the tip labels being rotated when rot is given.  And, finally reverts/fixes some sloppiness in the previous commit.


Modified: pkg/R/treePlot.R
===================================================================
--- pkg/R/treePlot.R	2009-08-29 03:15:36 UTC (rev 607)
+++ pkg/R/treePlot.R	2009-08-31 01:18:05 UTC (rev 608)
@@ -2,7 +2,7 @@
                      type = c('phylogram', 'cladogram', 'fan'), 
                      show.tip.label = TRUE,
                      show.node.label = FALSE, 
-                     ## tip.order = 1:nTips(phy),
+                     tip.order = NULL,
                      plot.data = is(phy, 'phylo4d'),
                      rot = 0,
                      tip.plot.fun = 'bubbles',
@@ -32,17 +32,17 @@
     Nedges <- nEdges(phy)
     Ntips  <- nTips(phy)
     
+    if(!is.null(tip.order)) {
+        if(length(tip.order) != Ntips) {stop('tip.order must be the same length as nTips(phy)')}
+        if(is.numeric(tip.order)) {
+            tip.order <- tip.order
+        } else {
+            if(is.character(tip.order)) {
+                tip.order <- match(tip.order, phy at tip.labeli)
+            }
+        }
+    }
     
-    ## if(length(tip.order) != Ntips) {stop('tip.order must be the same length as nTips(phy)')}
-    ## if(is.numeric(tip.order)) {
-    ##     tip.order <- tip.order
-    ## } else {
-    ##     if(is.character(tip.order)) {
-    ##         tip.order <- match(tip.order, phy at tip.labeli)
-    ##     }
-    ## }
-    tip.order <- NULL
-    
     ## TODO remove the false cladogram option?
     if(is.null(edgeLength(phy)) || type == 'cladogram') {
         phy at edge.length <- rep(1, Nedges)
@@ -100,6 +100,7 @@
             } ## if (plot.at.tip)
         } ## else
     } ## else
+    upViewport() # margins
 }
 
 plotOneTree <- function(xxyy, type, show.tip.label, show.node.label, edge.color, 
@@ -157,7 +158,7 @@
     pushViewport(viewport(
         x = 0.5, y = 0.5, 
         width = 1, height = 1, 
-        layout = treelayout, name = 'treelayout'))
+        layout = treelayout, angle = rot, name = 'treelayout'))
     pushViewport(viewport(
         layout.pos.col = 1, 
         name = 'tree'))
@@ -176,7 +177,7 @@
             x1 = segs$h1x, y1 = segs$h1y, 
             name = "horz", gp = gpar(col = edge.color, lwd = edge.width))
     }
-    upViewport()
+    upViewport() # tree
     if(show.tip.label) {
         pushViewport(viewport(layout.pos.col = 1,
             name = 'tiplabelvp'))
@@ -187,7 +188,7 @@
             default.units = 'native', name = 'tiplabels',
             just = 'center', gp = gpar(col = tip.color[tindex])
         )
-        upViewport()
+        upViewport() #tiplabelvp
     }
     # TODO probably want to be able to adjust the location of these guys
     if(show.node.label) {
@@ -200,9 +201,9 @@
             default.units = 'npc', name = 'nodelabels', rot = -rot,
             just = 'center', gp = gpar(col = node.color[nindex])
         )
-        upViewport()
+        upViewport() #nodelabelvp
     }
-    upViewport()
+    upViewport() # treelayout
     # grobTree(vseg, hseg, labtext)
 }
 
@@ -423,7 +424,7 @@
             layout.pos.col = 2, 
             layout.pos.row = 1
         ))
-        tt <- phy at tip.label # tipLabels(phy)
+        tt <- tipLabels(phy) # phy at tip.label 
         grid.text(tt, 0.1, tys, just = 'left')
         upViewport()
     }
@@ -506,11 +507,11 @@
             tvals <- tdata(phy, type = 'tip')[nodeId(phy,'tip'), , drop=FALSE]
             vals = t(tvals[i, ])
             if (!all(is.na(vals))) tip.plot.fun(vals, ...)
-        upViewport()
+        upViewport() # loop viewports
     }
     plotOneTree(xxyy, type, show.tip.label, show.node.label, edge.color, 
                             node.color, tip.color, edge.width, rot)    
-    upViewport(2)
+    upViewport(2) ## data_plot & datalayout
 }
 
 # phyloStripchart <- function()