[Phylobase-commits] r695 - in pkg: R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Oct 26 02:13:26 CET 2009


Author: pdc
Date: 2009-10-26 02:13:19 +0100 (Mon, 26 Oct 2009)
New Revision: 695

Modified:
   pkg/R/treePlot.R
   pkg/man/phyloXXYY.Rd
   pkg/man/phylobubbles.Rd
   pkg/man/tip.data.plot.Rd
   pkg/man/treePlot-methods.Rd
Log:
Fixed two bugs w/ data and edge order when tip.order was supplied, Fixed Bug #673
Cleaned up code, deleted debugging and example code.
Updated help files to match changes in this commit as well as pervious undocumented changes

Modified: pkg/R/treePlot.R
===================================================================
--- pkg/R/treePlot.R	2009-10-14 22:19:59 UTC (rev 694)
+++ pkg/R/treePlot.R	2009-10-26 01:13:19 UTC (rev 695)
@@ -35,28 +35,24 @@
     type   <- match.arg(type)
     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, tipLabels(phy))
+                tip.order <- as.numeric(names(tipLabels(phy))[match(tip.order, tipLabels(phy))])
             }
         }
     }
-    
+    tip.order <- rev(tip.order)
     ## TODO remove the false cladogram option?
     if(!hasEdgeLength(phy) || type == 'cladogram') {
         edgeLength(phy) <- rep(1, Nedges)
     }
     xxyy   <- phyloXXYY(phy, tip.order)
-    phy    <- xxyy$phy
-    pedges <- edges(phy)
-    tindex <- pedges[pedges[, 2] <= Ntips, 2][tip.order]
     if(type == 'cladogram') {
-        xxyy$xx[pedges[, 2] <= Ntips] <- 1
+        xxyy$xx[edges(xxyy$phy)[, 2] <= Ntips] <- 1
     }
     
     ## plotViewport is a convience function that provides margins in lines
@@ -71,7 +67,6 @@
                 phylobubbles(
                     type = type, 
                     show.node.label = show.node.label, 
-                    tip.order = tip.order, 
                     rot = 0, 
                     edge.color = edge.color, 
                     node.color = node.color, # TODO what do with node.color parameter
@@ -91,7 +86,6 @@
                     type = type, 
                     show.tip.label = show.tip.label, 
                     show.node.label = show.node.label, 
-                    tip.order = tip.order, 
                     rot = 0, 
                     tip.plot.fun = tip.plot.fun, 
                     edge.color = edge.color, 
@@ -118,7 +112,7 @@
     Ntips  <- nTips(phy)
     pedges <- edges(phy)
     tindex <- pedges[pedges[, 2] <= Ntips, 2]
-    eindex <- match(pedges[,2], edges(xxyy$phy.orig)[,2])
+    eindex <- xxyy$eorder
     segs   <- xxyy$segs
 
     ## TODO check that colors are valid?
@@ -214,18 +208,16 @@
     # grobTree(vseg, hseg, labtext)
 }
 
-phyloXXYY <- function(phy, tip.order = NULL) 
+phyloXXYY <- function(phy, tip.order=NULL) 
 {
     phy.orig <- phy
     ## initalize the output
     phy    <- reorder(phy, 'preorder')
     pedges <- edges(phy)
+    eindex <- match(pedges[,2], edges(phy.orig)[,2])
     Nedges <- nrow(pedges) ## TODO switch to the accessor once stablized
     Ntips  <- nTips(phy)
     tips <- pedges[, 2] <= Ntips
-    if(!is.null(tip.order)) {
-        tip.order <- match(tip.order, pedges[, 2][tips])
-    }
     xx <- numeric(Nedges)
     yy <- numeric(Nedges)
 
@@ -245,31 +237,19 @@
     segsv0x <- as.numeric(rep.int(0, Nedges))
     xPos <- .C("phyloxx", edge1, edge2,
             edgeLen, nedges, xx, segsv0x)
-    ## browser()
     xx <- xPos[[5]]
     segs$v0x <- xPos[[6]]
-    ## test1 <- function() {
-    ##     for (i in edge[, 2]) {
-    ##         dex <- edge[, 1] == i
-    ##         cur <- edge[, 2] == i
-    ##         xx[dex] <- phy at edge.length[dex] + xx[cur]
-    ##         segs$v0x[dex] <- xx[cur]
-    ##     }
-    ##     return(list(segs=segs, xx=xx))
-    ## }
-    ## test1out <- test1()
-    ## segs <- test1out$segs
-    ## xx   <- test1out$xx
 
     ## Set y positions for terminal nodes and calculate remaining y positions
     if(!is.null(tip.order)) {
-        yy[tips][tip.order] <- seq(0, 1, length = Ntips)
+        yy[tips][match(tip.order, edge2[tips])] <- seq(0, 1, length = Ntips)
     } else {
         yy[tips] <- seq(0, 1, length = Ntips)
+        tip.order <- edge2[edge2 <= Ntips]
     }
     segs$h0y[tips] <- segs$h1y[tips] <- yy[tips]
     segs$v1y[tips] <- segs$v0y[tips] <- yy[tips]
-    placeHolder <- function() {
+    phyloyy <- function() {
         for(i in rev((Ntips + 1):nEdges(phy))) {
             dex <- pedges[, 1] == i
             cur <- pedges[, 2] == i
@@ -277,16 +257,8 @@
         }
         return(list(segs=segs, yy=yy))
     }
-    placeHolder2 <- function() {
-        for(i in rev((Ntips + 1):nEdges(phy))) {
-            cur <- pedges[, 2] == i
-            dex <- pedges[, 1] == i
-            yy[cur] <- segs$v0y[dex] <- mean(yy[dex])
-        }
-        return(list(segs=segs, yy=yy))
-    }
 
-    yPos <- placeHolder()
+    yPos <- phyloyy()
     segs <- yPos$segs
     yy   <- yPos$yy
 
@@ -295,7 +267,7 @@
     ## ntips   <- as.integer(nTips(phy))
     ## yy      <- as.numeric(yy)
     ## segsv0y <- as.numeric(yy)
-    ## browser()
+
     ## yPos <- .C("phyloyy", edge1, edge2,
     ##         ntips, nedges, yy, segsv0y)
 
@@ -310,7 +282,7 @@
     segs$v1x <- segs$h0x <- segs$v0x 
     
     # TODO return an index vector instead of a second phy object
-    list(xx = xx, yy = yy, phy = phy, phy.orig = phy.orig, segs = segs)
+    list(xx = xx, yy = yy, phy = phy, segs = segs, torder=tip.order, eorder=eindex)
 }
 
 
@@ -356,7 +328,6 @@
 phylobubbles <- function(type = type,
                         place.tip.label = "right", 
                         show.node.label = show.node.label, 
-                        tip.order = NULL,
                         rot = 0,
                         edge.color = edge.color, 
                         node.color = node.color, # TODO what do with node.color parameter
@@ -367,21 +338,22 @@
                         XXYY, square = FALSE, grid = TRUE)
 {
     ## TODO add legend command
-    ## tys   -- tip y coordinates
-    ## nVars -- number of traits/characters
-    ## maxr  -- maximum circle radius, based on nVars or nTips
+    ## tys    -- tip y coordinates
+    ## nVars  -- number of traits/characters
+    ## maxr   -- maximum circle radius, based on nVars or nTips
+    ## torder -- the order of tips in the reordered edge matrix
     if(rot != 0) {stop("Rotation of bubble plots not yet implemented")}
     lab.right <- ifelse(place.tip.label %in% c("right", "both"), TRUE, FALSE)
     lab.left  <- ifelse(place.tip.label %in% c("left", "both"), TRUE, FALSE)
 
+    phy       <- XXYY$phy
+    tmin      <- min(tdata(phy, type = 'tip'), na.rm = TRUE)
+    tmax      <- max(tdata(phy, type = 'tip'), na.rm = TRUE)
+    pedges    <- edges(phy)
+    tip.order <- XXYY$torder
+    tipdata   <- tdata(phy, type = "tip")[tip.order,,drop=FALSE]
+    nVars     <- ncol(tipdata) # number of bubble columns
 
-    phy     <- XXYY$phy
-    tmin    <- min(tdata(phy, type = 'tip'), na.rm = TRUE)
-    tmax    <- max(tdata(phy, type = 'tip'), na.rm = TRUE)
-    tipdata <- tdata(phy, type = "tip")[nodeId(phy,"tip"),,drop=FALSE]
-    nVars   <- ncol(tipdata) # number of bubble columns
-    pedges  <- edges(phy)
-
     dlabwdth <- max(stringWidth(colnames(tipdata))) * 1.2
     if(convertWidth(dlabwdth, 'cm', valueOnly=TRUE) < 2) {dlabwdth <- unit(2, 'cm')}
     phyplotlayout <- grid.layout(nrow = 2, ncol = 2, 
@@ -395,7 +367,8 @@
 
     # tip y coordinates
     tys <- XXYY$yy[pedges[, 2] <= nTips(phy)]
-    
+    tys <- tys[match(names(tipLabels(phy))[tip.order], XXYY$torder)]
+
     maxr <- ifelse(ncol(tipdata) > nTips(phy), 1 / ncol(tipdata), 1 / nTips(phy))
     tipdataS <- apply(tipdata, 2, 
                     function(x) (maxr * x) / max(abs(x), na.rm = TRUE))
@@ -409,6 +382,7 @@
     xrep <- rep(xpos, each = length(tys))
     yrep <- rep(tys, nVars)
     ## color bubbles 
+
     ccol <- ifelse(tipdata < 0, 'black', 'white')
     
     ## generate matrices of every x and y by filling the repd value columnwise
@@ -475,7 +449,7 @@
             layout.pos.col = 2, 
             layout.pos.row = 1
         ))
-        tt <- tipLabels(phy) # phy at tip.label 
+        tt <- tipLabels(phy)[tip.order] # phy at tip.label 
         grid.text(tt, 0.1, tys, just = 'left')
         upViewport()
     }
@@ -521,7 +495,6 @@
                      type = c('phylogram', 'cladogram', 'fan'), 
                      show.tip.label = TRUE,
                      show.node.label = FALSE, 
-                     tip.order = NULL,
                      rot = 0, 
                      tip.plot.fun = grid.points, 
                      edge.color = 'black', 
@@ -531,6 +504,7 @@
                      ...)    
 {
     phy    <- xxyy$phy
+    tip.order <- xxyy$torder
     pedges <- edges(phy)
     Ntips  <- nTips(phy)
     datalayout <- grid.layout(ncol = 2, width = unit(c(1, 1/Ntips), c('null', 'null')))

Modified: pkg/man/phyloXXYY.Rd
===================================================================
--- pkg/man/phyloXXYY.Rd	2009-10-14 22:19:59 UTC (rev 694)
+++ pkg/man/phyloXXYY.Rd	2009-10-26 01:13:19 UTC (rev 695)
@@ -8,7 +8,7 @@
 }
 \arguments{
   \item{phy}{ A \code{phylo4} or \code{phylo4d} object. }
-  \item{tip.order}{ Unused. A character vector indicating the ordering of tip nodes}
+  \item{tip.order}{A character vector of tip labels, indicating their order along the y axis (from top to bottom). Or, a numeric vector of tip node IDs indicating the order.}
 }
 \details{
 The y coordinates of the tips are evenly spaced from 0 to 1 in pruningwise order.  Ancestor y nodes are given the mean value of immediate descendants.  The root is given the x coordinate 0 and descendant nodes are placed according to the cumulative branch length from the root, with a maximum x value of 1.
@@ -16,9 +16,11 @@
 \value{
   \item{yy}{Internal node and tip y coordinates}
   \item{xx}{Internal node and tip x coordinates}
-  \item{traverse}{The tree traversal order}
   \item{phy}{A \code{phylo4} or \code{phylo4d} object}
-  \item{phy.orig}{The original \code{phylo4} or \code{phylo4d} object}
+  \item{segs}{A list of \code{h0x, h1x, v0x, v1x} and \code{h0y, h1y, v0y, v1y} describing the start and end points for the plot line segments}
+  \item{torder}{The tip order provided as \code{tip.order} or if NULL the preoder tip order}
+  \item{eorder}{The an index of the reordered edges compared to the result of \code{edges(phy)}}
+
 }
 
 \author{Peter Cowan \email{pdc at berkeley.edu}}

Modified: pkg/man/phylobubbles.Rd
===================================================================
--- pkg/man/phylobubbles.Rd	2009-10-14 22:19:59 UTC (rev 694)
+++ pkg/man/phylobubbles.Rd	2009-10-26 01:13:19 UTC (rev 695)
@@ -5,7 +5,7 @@
 \description{
 Plots either circles or squares corresponding to the magnitude of each cell of a \code{phylo4d} object.}
 \usage{
-phylobubbles(type, place.tip.label, show.node.label, tip.order, rot, edge.color, node.color, tip.color, edge.width, newpage, ..., XXYY, square = FALSE, grid = TRUE)
+phylobubbles(type, place.tip.label, show.node.label, rot, edge.color, node.color, tip.color, edge.width, newpage, ..., XXYY, square = FALSE, grid = TRUE)
 }
 
 %- maybe also 'usage' for other objects documented here.
@@ -13,7 +13,6 @@
   \item{type}{the type of plot }
   \item{place.tip.label}{A string indicating whether labels should be plotted to the right or to the left of the bubble plot}
   \item{show.node.label}{A logical indicating whether internal node labels should be plotted }
-  \item{tip.order}{The order of that the tip labels should be plotted in}
   \item{rot}{The number of degrees that the plot should be rotated }
   \item{edge.color}{A vector of colors for the tree edge segments}
   \item{node.color}{A vector of colors for the coloring the nodes}

Modified: pkg/man/tip.data.plot.Rd
===================================================================
--- pkg/man/tip.data.plot.Rd	2009-10-14 22:19:59 UTC (rev 694)
+++ pkg/man/tip.data.plot.Rd	2009-10-26 01:13:19 UTC (rev 695)
@@ -4,14 +4,13 @@
 \title{Plotting trees and associated data}
 \description{Plotting phylogenetic trees and associated data}
 \usage{
-tip.data.plot(xxyy, type = c("phylogram", "cladogram", "fan"), show.tip.label = TRUE, show.node.label = FALSE, tip.order = NULL, rot = 0, tip.plot.fun = grid.points, edge.color = "black", node.color = "black", tip.color = "black", edge.width = 1, ...)
+tip.data.plot(xxyy, type = c("phylogram", "cladogram", "fan"), show.tip.label = TRUE, show.node.label = FALSE, rot = 0, tip.plot.fun = grid.points, edge.color = "black", node.color = "black", tip.color = "black", edge.width = 1, ...)
 }
 \arguments{
   \item{xxyy}{A list created by the  \code{\link{phyloXXYY}} function}
   \item{type}{ A character string indicating the shape of plotted tree }
-    \item{show.tip.label}{ Logical, indicating whether tip labels should be shown }
+  \item{show.tip.label}{ Logical, indicating whether tip labels should be shown }
   \item{show.node.label}{ Logical, indicating whether node labels should be shown }
-  \item{tip.order}{The order of that the tip labels should be plotted in}
   \item{rot}{ Numeric indicating the rotation of the plot in degrees }
   \item{tip.plot.fun}{A function used to plot the data elements of a \code{phylo4d} object}
   \item{edge.color}{ A vector of colors in the order of \code{edges(phy)} }

Modified: pkg/man/treePlot-methods.Rd
===================================================================
--- pkg/man/treePlot-methods.Rd	2009-10-14 22:19:59 UTC (rev 694)
+++ pkg/man/treePlot-methods.Rd	2009-10-26 01:13:19 UTC (rev 695)
@@ -20,7 +20,7 @@
 \usage{
   \S4method{treePlot}{phylo4,phylo4d}(phy, type = c("phylogram", "cladogram", "fan"), show.tip.label = TRUE, 
   show.node.label = FALSE, tip.order = NULL, plot.data = is(phy, "phylo4d"), 
-  rot = 0, tip.plot.fun = "bubbles", plot_by_tip = TRUE, edge.color = "black", 
+  rot = 0, tip.plot.fun = "bubbles", edge.color = "black", 
   node.color = "black", tip.color = "black", edge.width = 1, newpage = TRUE, \dots)
 }
 %- maybe also 'usage' for other objects documented here.
@@ -29,11 +29,10 @@
   \item{type}{ A character string indicating the shape of plotted tree }
   \item{show.tip.label}{ Logical, indicating whether tip labels should be shown }
   \item{show.node.label}{ Logical, indicating whether node labels should be shown }
-  \item{tip.order}{ Unused, a character vector of tip labels, indicating they're order along the y axis }
+  \item{tip.order}{A character vector of tip labels, indicating their order along the y axis (from top to bottom). Or, a numeric vector of tip node IDs indicating the order.}
   \item{plot.data}{ Logical indicating whether \code{phylo4d} data should be plotted }
   \item{rot}{ Numeric indicating the rotation of the plot in degrees }
   \item{tip.plot.fun}{ A function used to generate plot at the each tip of the phylogenetic trees }
-  \item{plot_by_tip}{TODO} % TODO what does the plot_by_tip argument do
   \item{edge.color}{ A vector of colors in the order of \code{edges(phy)} }
   \item{node.color}{ A vector of colors indicating the colors of the node labels }
   \item{tip.color}{ A vector of colors indicating the colors of the tip labels }



More information about the Phylobase-commits mailing list