245479db |
##' plots simultaneously a whole phylogenetic tree and a portion of it.
##'
##'
##' @title gzoom
##' @param phy phylo object
##' @param focus selected tips
##' @param subtree logical
##' @param widths widths
##' @return a list of ggplot object
##' @importFrom ggplot2 xlim
##' @importFrom ggplot2 scale_color_manual
##' @importFrom ape drop.tip
##' @author ygc
##' @examples
##' require(ape)
##' data(chiroptera)
##' gzoom(chiroptera, grep("Plecotus", chiroptera$tip.label))
gzoom.phylo <- function(phy, focus, subtree=FALSE, widths=c(.3, .7)) {
if (is.character(focus)) {
focus <- which(phy$tip.label %in% focus)
}
group_name <- "focus"
phy <- gfocus(phy, focus, group_name)
foc <- attr(phy, group_name)
## foc should +1 since the group index start from 0
cols <- c("black", "red")[foc+1]
p1 <- ggtree(phy, color=cols)
subtr <- drop.tip(phy, phy$tip.label[-focus],
subtree=subtree, rooted=TRUE)
p2 <- ggtree(subtr, color="red") + geom_tiplab(hjust=-0.05)
p2 <- p2 + xlim(0, max(p2$data$x)*1.2)
|
90df068e |
multiplot(p1, p2, ncol=2, widths=widths)
|
245479db |
invisible(list(p1=p1, p2=p2))
}
gzoom.ggplot <- function(tree_view, focus, widths=c(.3, .7), xmax_adjust=0) {
node <- MRCA(tree_view, focus)
cpos <- get_clade_position(tree_view, node)
p2 <- with(cpos, tree_view+
xlim(xmin, xmax+xmax_adjust)+
ylim(ymin, ymax))
|
90df068e |
multiplot(tree_view, p2, ncol=2, widths=widths)
|
245479db |
invisible(list(p1=tree_view, p2=p2))
}
##' @rdname gzoom-methods
##' @exportMethod gzoom
##' @param xmax_adjust adjust xmax (xlim[2])
setMethod("gzoom", signature(object="gg"),
function(object, focus, widths=c(.3, .7), xmax_adjust=0) {
gzoom.ggplot(object, focus, widths, xmax_adjust)
})
##' @rdname gzoom-methods
##' @exportMethod gzoom
setMethod("gzoom", signature(object="apeBootstrap"),
function(object, focus, subtree=FALSE, widths=c(.3, .7)) {
gzoom.phylo(get.tree(object), focus, subtree, widths)
})
|
3e4b5998 |
##' zoom selected subtree
##'
##'
##' @rdname gzoom-methods
##' @exportMethod gzoom
setMethod("gzoom", signature(object="beast"),
function(object, focus, subtree=FALSE, widths=c(.3, .7)) {
gzoom.phylo(get.tree(object), focus, subtree, widths)
})
|
245479db |
##' @rdname gzoom-methods
##' @exportMethod gzoom
setMethod("gzoom", signature(object="codeml"),
function(object, focus, subtree=FALSE, widths=c(.3, .7)) {
gzoom.phylo(get.tree(object), focus, subtree, widths)
})
|
3e4b5998 |
##' @rdname gzoom-methods
##' @exportMethod gzoom
setMethod("gzoom", signature(object="nhx"),
function(object, focus, subtree=FALSE, widths=c(.3, .7)) {
gzoom.phylo(get.tree(object), focus, subtree, widths)
})
##' @rdname gzoom-methods
##' @exportMethod gzoom
setMethod("gzoom", signature(object="paml_rst"),
function(object, focus, subtree=FALSE, widths=c(.3, .7)) {
gzoom.phylo(get.tree(object), focus, subtree, widths)
})
##' @rdname gzoom-methods
##' @exportMethod gzoom
setMethod("gzoom", signature(object="phylo"),
function(object, focus, subtree=FALSE, widths=c(.3, .7)) {
gzoom.phylo(object, focus, subtree, widths)
})
|