# Quantitative link strength for APE cophyloplot

November 17, 2009
By

(This article was first published on [R] tricks, and kindly contributed to R-bloggers)

Just add a third column with link strength to the association matrix

```plotCophylo2 <- function (x, y, assoc = assoc, use.edge.length = use.edge.length,
space = space, length.line = length.line, gap = gap, type = type,
return = return, col = col, show.tip.label = show.tip.label,
font = font)
{
if(ncol(assoc)==2)
{
assoc <- cbind(assoc,rep(1,nrow(assoc)))
}
res <- list()
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
if ((space <= 0) || (space < space.min))
space <- space.min
N.tip.x <- Ntip(x)
N.tip.y <- Ntip(y)
res\$N.tip.x <- N.tip.x
res\$N.tip.y <- N.tip.y
a <- plotPhyloCoor(x, use.edge.length = use.edge.length,
type = type)
res\$a <- a
b <- plotPhyloCoor(y, use.edge.length = use.edge.length,
direction = "leftwards", type = type)
a[, 2] <- a[, 2] - min(a[, 2])
b[, 2] <- b[, 2] - min(b[, 2])
res\$b <- b
b2 <- b
b2[, 1] <- b[1:nrow(b), 1] * (max(a[, 1])/max(b[, 1])) +
space + max(a[, 1])
b2[, 2] <- b[1:nrow(b), 2] * (max(a[, 2])/max(b[, 2]))
res\$b2 <- b2
c <- matrix(ncol = 2, nrow = nrow(a) + nrow(b))
c[1:nrow(a), ] <- a[1:nrow(a), ]
c[nrow(a) + 1:nrow(b), 1] <- b2[, 1]
c[nrow(a) + 1:nrow(b), 2] <- b2[, 2]
res\$c <- c
plot(c, type = "n", xlim = NULL, ylim = NULL, log = "", main = NULL,
sub = NULL, xlab = NULL, ylab = NULL, ann = FALSE, axes = FALSE,
frame.plot = FALSE)
for (i in 1:(nrow(a) - 1)) segments(a[x\$edge[i, 1], 1],
a[x\$edge[i, 1], 2], a[x\$edge[i, 2], 1], a[x\$edge[i,
2], 2])
for (i in 1:(nrow(b) - 1)) segments(b2[y\$edge[i, 1],
1], b2[y\$edge[i, 1], 2], b2[y\$edge[i, 2], 1], b2[y\$edge[i,
2], 2])
}
if (type == "phylogram") {
for (i in (N.tip.x + 1):nrow(a)) {
l <- length(x\$edge[x\$edge[, 1] == i, ][, 1])
for (j in 1:l) {
segments(
a[x\$edge[x\$edge[, 1] == i, ][1, 1], 1],
a[x\$edge[x\$edge[, 1] == i, 2], 2][1],
a[x\$edge[x\$edge[, 1] == i, ][1, 1], 1],
a[x\$edge[x\$edge[, 1] == i, 2], 2][j]
)
segments(
a[x\$edge[x\$edge[, 1] == i, ][1, 1], 1],
a[x\$edge[x\$edge[, 1] == i, 2], 2][j],
a[x\$edge[x\$edge[, 1] == i, 2], 1][j],
a[x\$edge[x\$edge[, 1] == i, 2], 2][j]
)
}
}
for (i in (N.tip.y + 1):nrow(b)) {
l <- length(y\$edge[y\$edge[, 1] == i, ][, 1])
for (j in 1:l) {
segments(b2[y\$edge[y\$edge[, 1] == i, ][1, 1],
1], b2[y\$edge[y\$edge[, 1] == i, 2], 2][1],
b2[y\$edge[y\$edge[, 1] == i, ][1, 1], 1], b2[y\$edge[y\$edge[,
1] == i, 2], 2][j])
segments(b2[y\$edge[y\$edge[, 1] == i, ][1, 1],
1], b2[y\$edge[y\$edge[, 1] == i, 2], 2][j],
b2[y\$edge[y\$edge[, 1] == i, 2], 1][j], b2[y\$edge[y\$edge[,
1] == i, 2], 2][j])
}
}
}
if (show.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)
}
lsa <- 1:N.tip.x
lsb <- 1:N.tip.y
decx <- array(nrow(assoc))
decy <- array(nrow(assoc))
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 {
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 = col , lwd = as.numeric(assoc[i,3]))
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 = col , lwd = as.numeric(assoc[i,3]))
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 = col , lwd = as.numeric(assoc[i,3]))
}
if (return == TRUE)
return(res)
}
```

R-bloggers.com offers daily e-mail updates about R news and tutorials on topics such as: Data science, Big Data, R jobs, visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series, trading) and more...