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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Aug 2 07:33:15 CEST 2008


Author: pdc
Date: 2008-08-02 07:33:15 +0200 (Sat, 02 Aug 2008)
New Revision: 221

Modified:
   branches/pdcgsoc/misc/temp.R
Log:
neatify code

Modified: branches/pdcgsoc/misc/temp.R
===================================================================
--- branches/pdcgsoc/misc/temp.R	2008-08-02 03:04:32 UTC (rev 220)
+++ branches/pdcgsoc/misc/temp.R	2008-08-02 05:33:15 UTC (rev 221)
@@ -16,7 +16,9 @@
             )
     {
     phy.orig <- phy
-    Å
+    Nedges   <- nrow(phy at edges)
+    Ntips    <- length(phy at tip.label)
+    
     if (type == 'phylogram') {
         xxyy <- phyloXXYY(phy, tip.order)
         ## because we may reoder the tip, we need to update the phy objec
@@ -27,13 +29,13 @@
     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))
+    if(length(edge.color) != Nedges) {
+        edge.color <- rep(edge.color, length.out = Nedges)
     }
     edge.color <- edge.color[eindex]
     
     ## TODO check that colors are valid?
-    nindex <- sort(eindex[phy at edge[, 2] > length(phy at tip.label)], index.return = TRUE)$ix
+    nindex <- sort(eindex[phy at edge[, 2] > Ntips], index.return = TRUE)$ix
     if(length(node.color) != length(nindex)) {
         node.color <- rep(node.color, length.out = length(nindex))
     }
@@ -63,9 +65,9 @@
     
     ## 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))
+        tindex <- phy at edge[phy at edge[, 2] <= Ntips, 2]
+        if(length(tip.color) != Ntips) {
+            tip.color <- rep(tip.color, length.out = Ntips)
         }
         
         pushViewport(viewport(
@@ -74,7 +76,7 @@
             name = 'tip_labels'))
         grid.text(
             phy at tip.label[tindex], 
-            x = rep(0, length(phy at tip.label)), 
+            x = rep(0, Ntips), 
             ## TODO yuck!!
             y = xxyy$xxyy$yy[phy at edge[, 2] %in% tindex], 
             rot = rot, just = 'left', gp = gpar(col = tip.color[tindex])
@@ -83,7 +85,7 @@
     }
     if (plot.data) {
         ## datalayout <- grid.layout(
-        ##                 nrow = length(phy at tip.label), 
+        ##                 nrow = Ntips, 
         ##                 ncol = 1,
         ##                 respect = TRUE)
         pushViewport(viewport(
@@ -91,7 +93,7 @@
             layout.pos.col = 3, 
             name = 'data_plots'))
         ## TODO should plots float at tips, or only along edge?
-        for(i in xxyy$xxyy$yy[which(phy at edge[, 2] <= length(phy at tip.label))]) {
+        for(i in xxyy$xxyy$yy[which(phy at edge[, 2] <= Ntips)]) {
             pushViewport(viewport(
                 y = i, 
                 height = unit(1, 'snpc'), 
@@ -122,8 +124,8 @@
 phyloXXYY <- function(phy, tip.order = NULL) {
     ## initalize the output
     xxyy = list(
-        yy = rep(NA, nrow(phy at edge)), 
-        xx = numeric(nrow(phy at edge)), 
+        yy = rep(NA, Nedges), 
+        xx = numeric(Nedges), 
         ## record the order that nodes are visited in
         traverse = NULL) 
     
@@ -132,12 +134,12 @@
         ## TODO do we need to acount for line weight when plotting close to edges?
     #     yy[which(phy at edge[, 2] == tip.order)] <- seq(
         ## TODO perhaps we want to use match here?
-        ## 0, 1, length.out = length(phy at tip.label)) 
+        ## 0, 1, length.out = Ntips) 
     # } else {
         ## reoder the phylo and assign even y spacing to the tips
         phy <- reorder(phy)
-        xxyy$yy[phy at edge[, 2] <= length(phy at tip.label)] <- seq(
-            0, 1, length.out = length(phy at tip.label)
+        xxyy$yy[phy at edge[, 2] <= Ntips] <- seq(
+            0, 1, length.out = Ntips
         )
     # }
     
@@ -178,17 +180,17 @@
         xxyy
     }
     ## call function for the first time
-    xxyy <- calc.node.xy(length(phy at tip.label) + 1, phy, xxyy)
+    xxyy <- calc.node.xy(Ntips + 1, phy, xxyy)
     ## scale the x values
     xxyy$xx <- xxyy$xx / max(xxyy$xx)
     list(xxyy = xxyy, phy = phy)
 }
 
 segs <- function(phy, XXYY) {
-    treelen <- rep(NA, nrow(phy at edge) + 1)
+    treelen <- rep(NA, Nedges + 1)
     segs <- list(v0x = treelen, v0y = treelen, v1x = treelen, v1y = treelen,
                  h0x = treelen, h0y = treelen, h1x = treelen, h1y = treelen)
-    troot <- length(phy at tip.label) + 1
+    troot <- Ntips + 1
 
     get.coor <- function(node, segs) {
         if(any(phy at edge[, 2] == node) == FALSE) {



More information about the Phylobase-commits mailing list