-## cophyloplot.R (2010-03-18)
+## cophyloplot.R (2012-02-14)
## Plots two phylogenetic trees face to
## face with the links between the tips
if (click < length(res$a[, 1]) + 1) {
if (click > res$N.tip.x)
x <- rotate(x, click)
- }
- else if (click < length(res$c[, 1]) + 1) {
+ } else if (click < length(res$c[, 1]) + 1) {
if (click > length(res$a[, 1]) + res$N.tip.y)
y <- rotate(y, click - length(res$a[, 1]))
}
- plotCophylo2(x, y, assoc = assoc, use.edge.length = use.edge.length,
- space = space, length.line = length.line, gap = gap,
- type = type, return = TRUE, col = col, lwd=lwd, lty=lty, show.tip.label = show.tip.label, font = font)
}
on.exit(print("done"))
}
font = font, ...)
{
res <- list()
-###choice of the minimum space between the trees###
+###choice of the minimum space between the trees
left <- max(nchar(x$tip.label, type = "width")) + length.line
right <- max(nchar(y$tip.label, type = "width")) + length.line
space.min <- left + right + gap * 2
res$a <- a
b <- plotPhyloCoor(y, use.edge.length = use.edge.length,
direction = "leftwards", type = type)
- ###for the two trees to have the extreme leaves at the same ordinate.
- a[, 2] <- a[, 2] - min(a[, 2])
+###for the two trees to have the extreme leaves at the same ordinate.
+ a[, 2] <- a[, 2] - min(a[, 2])
b[, 2] <- b[, 2] - min(b[, 2])
res$b <- b
b2 <- b
}
}
if (show.tip.label) {
- text(a[1:N.tip.x, ], cex = 0, font = font, pos = 4, labels = x$tip.label)
+ text(a[1:N.tip.x, ], cex = 0, font = font, pos = 4,
+ labels = x$tip.label)
text(b2[1:N.tip.y, ], cex = 1, font = font, pos = 2,
- labels = y$tip.label)
+ labels = y$tip.label)
}
###links between associated taxa. Takes into account the size of the character strings of the taxa names.
lsa <- 1:N.tip.x
else if (length(lwd)>=nrow(assoc)) lwidths<-lwd
else lwidths<-c(rep(lwd, as.integer(nrow(assoc)/length(lwd))+1))
- #lty
+ #lty
if (length(lty) == 1) ltype <- c(rep(lty, nrow(assoc)))
else if (length(lty) >= nrow(assoc)) ltype <- lty
else ltype <- c(rep(lty, as.integer(nrow(assoc)/length(lty))+1))
for (i in 1:nrow(assoc)) {
-
- if (show.tip.label) {
- decx[i] <- strwidth(x$tip.label[lsa[x$tip.label ==
- assoc[i, 1]]])
- decy[i] <- strwidth(y$tip.label[lsb[y$tip.label ==
- assoc[i, 2]]])
- }
- else {
+ if (show.tip.label) {
+ decx[i] <- strwidth(x$tip.label[lsa[x$tip.label == assoc[i, 1]]])
+ decy[i] <- strwidth(y$tip.label[lsb[y$tip.label == assoc[i, 2]]])
+ } else {
decx[i] <- decy[i] <- 0
}
- segments(a[lsa[x$tip.label == assoc[i, 1]], 1] + decx[i] + gap, a[lsa[x$tip.label == assoc[i, 1]], 2], a[lsa[x$tip.label == assoc[i, 1]], 1] + gap + left, a[lsa[x$tip.label == assoc[i, 1]], 2], col = colors[i], lwd=lwidths[i], lty=ltype[i])
- segments(b2[lsb[y$tip.label == assoc[i, 2]], 1] - (decy[i] + gap), b2[lsb[y$tip.label == assoc[i, 2]], 2], b2[lsb[y$tip.label == assoc[i, 2]], 1] - (gap + right), b2[lsb[y$tip.label == assoc[i, 2]], 2], col = colors[i], lwd=lwidths[i], lty=ltype[i])
- segments(a[lsa[x$tip.label == assoc[i, 1]], 1] + gap + left, a[lsa[x$tip.label == assoc[i, 1]], 2], b2[lsb[y$tip.label == assoc[i, 2]], 1] - (gap + right), b2[lsb[y$tip.label == assoc[i, 2]], 2], col = colors[i], lwd=lwidths[i], lty=ltype[i])
+ segments(a[lsa[x$tip.label == assoc[i, 1]], 1] + decx[i] + gap,
+ a[lsa[x$tip.label == assoc[i, 1]], 2],
+ a[lsa[x$tip.label == assoc[i, 1]], 1] + gap + left,
+ a[lsa[x$tip.label == assoc[i, 1]], 2],
+ col = colors[i], lwd = lwidths[i], lty = ltype[i])
+
+ segments(b2[lsb[y$tip.label == assoc[i, 2]], 1] - (decy[i] + gap),
+ b2[lsb[y$tip.label == assoc[i, 2]], 2],
+ b2[lsb[y$tip.label == assoc[i, 2]], 1] - (gap + right),
+ b2[lsb[y$tip.label == assoc[i, 2]], 2],
+ col = colors[i], lwd = lwidths[i], lty = ltype[i])
+
+ segments(a[lsa[x$tip.label == assoc[i, 1]], 1] + gap + left,
+ a[lsa[x$tip.label == assoc[i, 1]], 2],
+ b2[lsb[y$tip.label == assoc[i, 2]], 1] - (gap + right),
+ b2[lsb[y$tip.label == assoc[i, 2]], 2],
+ col = colors[i], lwd = lwidths[i], lty = ltype[i])
}
if (return == TRUE) return(res)
}