R/inset.R

In YuLab-SMU/ggtree: an R package for visualization of tree and annotation data

##' gemo_inset can add subplots to tree by accepting a list of ggplot objects that are ancestral 
##' stats or data associated with selected nodes in the tree. These ggplot objects can be any 
##' kind of charts or hybrid of of these charts.
##' 
##' Users can also use 
##' 
##' 
##' @title geom_inset
##' @rdname inset
##' @param insets a list of ggplot objects, named by node number
##' @param width width of the inset, relative to the range of x-axis, defaults to .1
##' @param height height of the inset, relative to the range of y-axis, defaults to .1
##' @param hjust adjust the horizontal position of the charts, charts will go left if hjust > 0
##' @param vjust adjust the vertical position of the charts, charts will go down if vjust > 0
##' @param x the position where users want to place the charts, one of 'node' (default) and 'branch'
##' @param reverse_x whether to reverse x axis of the charts by 'ggplot2::scale_x_reverse', defaults to 'FALSE'
##' @param reverse_y whether to reverse y axis of the charts by 'ggplot2::scale_y_reverse', defaults to 'FALSE'
##' @return inset layer
##' @export
##' @author Guangchuang Yu
##' @references
##' For demonstration of this function, please refer to chapter 8.3 of 
##' *Data Integration, Manipulation and Visualization of Phylogenetic Trees*
##' <http://yulab-smu.top/treedata-book/index.html> by Guangchuang Yu.
geom_inset <- function(insets, width = .1, height = .1, hjust = 0, vjust = 0,
                       x = "node", reverse_x = FALSE, reverse_y = FALSE) {
    structure(list(insets = insets, width = width, height = height,
                   hjust = hjust, vjust = vjust, x = x,
                   reverse_x = reverse_x, reverse_y = reverse_y), class = "tree_inset")
}

##' add subplots as insets in a tree
##'
##'
##' @title inset
##' @rdname inset
##' @param tree_view tree view 
##' @return tree view with insets
##' @importFrom yulab.utils get_fun_from_pkg
##' @export
##' @author Guangchuang Yu
inset <- function(tree_view, insets, width, height, hjust=0, vjust=0,
                  x="node", reverse_x=FALSE, reverse_y=FALSE) {

    if(width < 0 || width > 1)
        stop("width should be in range of (0,1)")

    if(height < 0 || height > 1)
        stop("height should be in range of (0,1)")

    df <- tree_view$data[as.numeric(names(insets)),]
    x <- match.arg(x, c("node", "branch", "edge"))

    if (x == 'node') {
        xx <- df$x
    } else {
        xx <- df$branch
    }
    yy <- df$y

    xx <- xx - hjust
    yy <- yy - vjust
    if (reverse_x)
        xx <- -xx
    if (reverse_y)
        yy <- -yy

    width <- width * diff(range(tree_view$data$x, na.rm = TRUE))
    height <- height * diff(range(tree_view$data$y, na.rm = TRUE))

    geom_subview <- get_fun_from_pkg("ggimage", "geom_subview")

    tree_view + geom_subview(subview = insets,
                            width = width,
                            height = height,
                            x = xx,
                            y = yy)
}

##' generate a list of bar charts for results of ancestral state reconstruction
##'
##'
##' @title nodebar
##' @param position position of bars, if 'stack' (default) make bars stacked atop one another, 'dodge' make them dodged side-to-side
##' @inheritParams nodepie
##' @return list of ggplot objects
##' @export
##' @importFrom ggplot2 geom_bar
##' @importFrom tidyr gather
##' @author Guangchuang Yu
nodebar <- function(data, cols, color, alpha=1, position="stack") {
    if (! "node" %in% colnames(data)) {
        stop("data should have a column 'node'...")
    }
    type <- value <- NULL

    ldf <- gather(data, type, value, !! cols) %>% split(., .$node)
    bars <- lapply(ldf, function(df) ggplot(df, aes_(x=1, y=~value, fill=~type)) +
                                     geom_bar(stat='identity', alpha=alpha, position=position) +
                                     theme_inset()
                   )

    if (missingArg(color) || is.null(color) || any(is.na(color))) {
        ## do nothing
    } else {
        bars <- lapply(bars, function(p) p+scale_fill_manual(values=color))
    }
    return(bars)
}

##' generate a list of pie charts for results of ancestral stat reconstruction
##'
##'
##' @title nodepie
##' @param data a data.frame of stats with an additional column of node number named "node"
##' @param cols columns of the data.frame that store the stats
##' @param color set color of bars
##' @param alpha set transparency of the charts
##' @param outline.color color of outline
##' @param outline.size size of outline
##' @return list of ggplot objects
##' @export
##' @author Guangchuang Yu
nodepie <- function(data, cols, color, alpha=1, outline.color="transparent", outline.size=0) {
    if (! "node" %in% colnames(data)) {
        stop("data should have a column 'node'...")
    }
    type <- value <- NULL
    if (missingArg(color)) {
        color <- NA
    }
    ldf <- gather(data, type, value, !! cols) %>% split(., .$node)
    lapply(ldf, function(df) ggpie(df, y=~value, fill=~type, color, alpha, outline.color, outline.size))
}


##' @importFrom methods missingArg
ggpie <- function(data, y, fill, color, alpha=1, outline.color="transparent", outline.size=0) {
    p <- ggplot(data, aes_(x=1, y=y, fill=fill)) +
        geom_bar(stat='identity', alpha=alpha, color=outline.color, size=outline.size, show.legend = F) +
        coord_polar(theta='y') + theme_inset()

    if (missingArg(color) || is.null(color) || any(is.na(color))) {
        ## do nothing
    } else {
        p <- p+scale_fill_manual(values=color)
    }
    return(p)
}