R/clade-functions.R
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)
 }