[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