885fa776 |
##' get taxa name of a selected node (or tree if node=NULL) sorted by their position in plotting
|
0b5c08bd |
##'
|
d8a0e350 |
##'
|
0b5c08bd |
##' @title get_taxa_name
##' @param tree_view tree view
##' @param node node
##' @return taxa name vector
##' @export
##' @author Guangchuang Yu
|
885fa776 |
get_taxa_name <- function(tree_view=NULL, node=NULL) {
|
0b5c08bd |
tree_view %<>% get_tree_view
|
d8a0e350 |
|
0b5c08bd |
df <- tree_view$data
|
885fa776 |
if (!is.null(node)) {
sp <- get.offspring.df(df, node)
df <- df[sp, ]
}
|
0b5c08bd |
|
885fa776 |
with(df, {
i = order(y, decreasing=T)
label[i][isTip[i]]
})
}
|
0b5c08bd |
##' view a clade of tree
##'
|
d8a0e350 |
##'
|
0b5c08bd |
##' @title viewClade
|
d8a0e350 |
##' @param tree_view full tree view
|
0b5c08bd |
##' @param node internal node number
##' @param xmax_adjust adjust xmax
##' @return clade plot
|
d8a0e350 |
##' @importFrom ggplot2 ggplot_build
##' @importFrom ggplot2 coord_cartesian
|
0b5c08bd |
##' @export
##' @author Guangchuang Yu
viewClade <- function(tree_view=NULL, node, xmax_adjust=0) {
tree_view %<>% get_tree_view
|
905d1116 |
## xd <- tree_view$data$branch.length[node]/2
|
d8a0e350 |
|
0b5c08bd |
cpos <- get_clade_position(tree_view, node=node)
|
d8a0e350 |
xmax <- ggplot_build(tree_view)$layout$panel_ranges[[1]]$x.range[2]
## tree_view+xlim(cpos$xmin, xmax + xmax_adjust) + ylim(cpos$ymin, cpos$ymax)
|
905d1116 |
tree_view + coord_cartesian(xlim=c(cpos$xmin, xmax), ylim=c(cpos$ymin, cpos$ymax), expand=FALSE)
|
0b5c08bd |
}
|
d8a0e350 |
|
0b5c08bd |
##' collapse a clade
##'
|
d8a0e350 |
##'
|
0b5c08bd |
##' @title collapse
|
d8a0e350 |
##' @param tree_view tree view
|
0b5c08bd |
##' @param node clade node
##' @return tree view
##' @export
##' @seealso expand
##' @author Guangchuang Yu
|
d8a0e350 |
collapse <- function(tree_view=NULL, node) {
|
0b5c08bd |
tree_view %<>% get_tree_view
|
d8a0e350 |
|
0b5c08bd |
df <- tree_view$data
|
69b0d0e9 |
if (is.na(df$x[df$node == node])) {
warning("specific node was already collapsed...")
return(tree_view)
}
|
d8a0e350 |
|
0b5c08bd |
sp <- get.offspring.df(df, node)
sp.df <- df[sp,]
|
a91c9f44 |
## df[node, "isTip"] <- TRUE
|
b1e524c4 |
sp_y <- range(sp.df$y, na.rm=TRUE)
|
0b5c08bd |
ii <- which(df$y > max(sp_y))
if (length(ii)) {
df$y[ii] <- df$y[ii] - diff(sp_y)
}
df$y[node] <- min(sp_y)
df[sp, "x"] <- NA
df[sp, "y"] <- NA
|
d8a0e350 |
|
e69e5f4f |
df <- reassign_y_from_node_to_root(df, node)
|
d8a0e350 |
|
0b5c08bd |
## re-calculate branch mid position
df <- calculate_branch_mid(df)
|
bedefde1 |
ii <- which(!is.na(df$x))
df$angle[ii] <- calculate_angle(df[ii,])$angle
|
d8a0e350 |
|
0b5c08bd |
tree_view$data <- df
clade <- paste0("clade_", node)
attr(tree_view, clade) <- sp.df
tree_view
}
##' expand collased clade
##'
|
d8a0e350 |
##'
|
0b5c08bd |
##' @title expand
##' @param tree_view tree view
##' @param node clade node
##' @return tree view
##' @export
##' @seealso collapse
##' @author Guangchuang Yu
expand <- function(tree_view=NULL, node) {
tree_view %<>% get_tree_view
|
d8a0e350 |
|
0b5c08bd |
clade <- paste0("clade_", node)
sp.df <- attr(tree_view, clade)
if (is.null(sp.df)) {
return(tree_view)
}
df <- tree_view$data
|
a91c9f44 |
## df[node, "isTip"] <- FALSE
|
0b5c08bd |
sp_y <- range(sp.df$y)
ii <- which(df$y > df$y[node])
df[ii, "y"] <- df[ii, "y"] + diff(sp_y)
|
d8a0e350 |
|
0b5c08bd |
sp.df$y <- sp.df$y - min(sp.df$y) + df$y[node]
df[sp.df$node,] <- sp.df
root <- which(df$node == df$parent)
pp <- node
while(any(pp != root)) {
df[pp, "y"] <- mean(df[getChild.df(df, pp), "y"])
pp <- df[pp, "parent"]
}
j <- getChild.df(df, pp)
j <- j[j!=pp]
df[pp, "y"] <- mean(df[j, "y"])
## re-calculate branch mid position
df <- calculate_branch_mid(df)
|
d8a0e350 |
|
bedefde1 |
tree_view$data <- calculate_angle(df)
|
0b5c08bd |
attr(tree_view, clade) <- NULL
tree_view
}
##' rotate 180 degree of a selected branch
##'
|
d8a0e350 |
##'
|
0b5c08bd |
##' @title rotate
|
d8a0e350 |
##' @param tree_view tree view
|
0b5c08bd |
##' @param node selected node
##' @return ggplot2 object
##' @export
##' @author Guangchuang Yu
rotate <- function(tree_view=NULL, node) {
tree_view %<>% get_tree_view
|
d8a0e350 |
|
0b5c08bd |
df <- tree_view$data
sp <- get.offspring.df(df, node)
sp_idx <- with(df, match(sp, node))
tip <- sp[df$isTip[sp_idx]]
sp.df <- df[sp_idx,]
ii <- with(sp.df, match(tip, node))
jj <- ii[order(sp.df[ii, "y"])]
sp.df[jj,"y"] <- rev(sp.df[jj, "y"])
sp.df[-jj, "y"] <- NA
sp.df <- re_assign_ycoord_df(sp.df, tip)
df[sp_idx, "y"] <- sp.df$y
|
b21ec73a |
## df$node == node is TRUE when node was root
df[df$node == node, "y"] <- mean(df[df$parent == node & df$node != node, "y"])
|
0b5c08bd |
pnode <- df$parent[df$node == node]
if (pnode != node && !is.na(pnode)) {
df[df$node == pnode, "y"] <- mean(df[df$parent == pnode, "y"])
}
|
bedefde1 |
tree_view$data <- calculate_angle(df)
|
0b5c08bd |
tree_view
}
##' flip position of two selected branches
##'
|
d8a0e350 |
##'
|
0b5c08bd |
##' @title flip
|
d8a0e350 |
##' @param tree_view tree view
|
0b5c08bd |
##' @param node1 node number of branch 1
##' @param node2 node number of branch 2
##' @return ggplot2 object
##' @export
##' @author Guangchuang Yu
flip <- function(tree_view=NULL, node1, node2) {
tree_view %<>% get_tree_view
|
d8a0e350 |
|
0b5c08bd |
df <- tree_view$data
p1 <- with(df, parent[node == node1])
p2 <- with(df, parent[node == node2])
if (p1 != p2) {
stop("node1 and node2 should share a same parent node...")
}
sp1 <- c(node1, get.offspring.df(df, node1))
sp2 <- c(node2, get.offspring.df(df, node2))
sp1.df <- df[sp1,]
sp2.df <- df[sp2,]
min_y1 <- min(sp1.df$y)
min_y2 <- min(sp2.df$y)
if (min_y1 < min_y2) {
tmp <- sp1.df
sp1.df <- sp2.df
sp2.df <- tmp
tmp <- sp1
sp1 <- sp2
sp2 <- tmp
}
min_y1 <- min(sp1.df$y)
min_y2 <- min(sp2.df$y)
space <- min(sp1.df$y) - max(sp2.df$y)
sp1.df$y <- sp1.df$y - abs(min_y1 - min_y2)
sp2.df$y <- sp2.df$y + max(sp1.df$y) + space - min(sp2.df$y)
df[sp1, "y"] <- sp1.df$y
df[sp2, "y"] <- sp2.df$y
anc <- getAncestor.df(df, node1)
ii <- match(anc, df$node)
df[ii, "y"] <- NA
currentNode <- unlist(as.vector(sapply(anc, getChild.df, df=df)))
currentNode <- currentNode[!currentNode %in% anc]
|
d8a0e350 |
|
0b5c08bd |
tree_view$data <- re_assign_ycoord_df(df, currentNode)
|
bedefde1 |
tree_view$data <- calculate_angle(tree_view$data)
|
0b5c08bd |
tree_view
}
##' scale clade
##'
|
d8a0e350 |
##'
|
0b5c08bd |
##' @title scaleClade
##' @param tree_view tree view
##' @param node clade node
##' @param scale scale
##' @param vertical_only logical. If TRUE, only vertical will be scaled.
##' If FALSE, the clade will be scaled vertical and horizontally.
##' TRUE by default.
##' @return tree view
##' @export
##' @author Guangchuang Yu
scaleClade <- function(tree_view=NULL, node, scale=1, vertical_only=TRUE) {
tree_view %<>% get_tree_view
|
d8a0e350 |
|
0b5c08bd |
if (scale == 1) {
return(tree_view)
}
|
d8a0e350 |
|
0b5c08bd |
df <- tree_view$data
sp <- get.offspring.df(df, node)
sp.df <- df[sp,]
|
d8a0e350 |
|
0b5c08bd |
## sp_nr <- nrow(sp.df)
## span <- diff(range(sp.df$y))/sp_nr
|
d8a0e350 |
|
0b5c08bd |
## new_span <- span * scale
old.sp.df <- sp.df
sp.df$y <- df[node, "y"] + (sp.df$y - df[node, "y"]) * scale
|
e69e5f4f |
if (! vertical_only) {
|
0b5c08bd |
sp.df$x <- df[node, "x"] + (sp.df$x - df[node, "x"]) * scale
}
|
d8a0e350 |
|
0b5c08bd |
scale_diff.up <- max(sp.df$y) - max(old.sp.df$y)
scale_diff.lw <- min(sp.df$y) - min(old.sp.df$y)
|
d8a0e350 |
|
0b5c08bd |
ii <- df$y > max(old.sp.df$y)
if (sum(ii) > 0) {
df[ii, "y"] <- df[ii, "y"] + scale_diff.up
}
|
d8a0e350 |
|
0b5c08bd |
jj <- df$y < min(old.sp.df$y)
if (sum(jj) > 0) {
df[jj, "y"] <- df[jj, "y"] + scale_diff.lw
}
|
d8a0e350 |
|
0b5c08bd |
df[sp,] <- sp.df
|
d8a0e350 |
|
0b5c08bd |
if (! "scale" %in% colnames(df)) {
df$scale <- 1
}
df[sp, "scale"] <- df[sp, "scale"] * scale
|
e69e5f4f |
df <- reassign_y_from_node_to_root(df, node)
|
d8a0e350 |
|
0b5c08bd |
## re-calculate branch mid position
df <- calculate_branch_mid(df)
|
d8a0e350 |
|
bedefde1 |
tree_view$data <- calculate_angle(df)
|
0b5c08bd |
tree_view
}
|
e69e5f4f |
reassign_y_from_node_to_root <- function(df, node) {
root <- which(df$node == df$parent)
pp <- df[node, "parent"]
while(any(pp != root)) {
df[pp, "y"] <- mean(df[getChild.df(df, pp), "y"])
pp <- df[pp, "parent"]
}
j <- getChild.df(df, pp)
j <- j[j!=pp]
df[pp, "y"] <- mean(df[j, "y"])
return(df)
}
|