Quantitative link strength for APE cophyloplot
[This article was first published on [R] tricks, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.
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) if (type == "cladogram") { 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) }
To leave a comment for the author, please follow the link and comment on their blog: [R] tricks.
R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.