| cc06d22b |
##' layer of hilight clade with rectangle
##'
|
| 0d9e240e |
##'
|
| cc06d22b |
##' @title geom_hilight
##' @param node selected node to hilight
##' @param fill color fill
##' @param alpha alpha (transparency)
|
| 1949a7f4 |
##' @param extend extend xmax of the rectangle
##' @param extendto extend xmax to extendto
|
| cc06d22b |
##' @return ggplot2
##' @export
##' @importFrom ggplot2 aes_
##' @importFrom ggplot2 GeomRect
##' @author Guangchuang Yu
|
| 1949a7f4 |
geom_hilight <- function(node, fill="steelblue", alpha=.5, extend=0, extendto=NULL) {
|
| 0d9e240e |
|
| af18d052 |
data = NULL
stat = "hilight"
position = "identity"
show.legend = NA
|
| 0bd36b2a |
na.rm = TRUE
|
| af18d052 |
inherit.aes = FALSE
|
| 0d9e240e |
|
| cc06d22b |
default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, branch.length=~branch.length)
mapping <- default_aes
|
| 0d9e240e |
|
| cc06d22b |
layer(
stat=StatHilight,
data = data,
mapping = mapping,
geom = GeomRect,
position = position,
show.legend=show.legend,
inherit.aes = inherit.aes,
params = list(node=node,
|
| 1949a7f4 |
fill=fill,
alpha=alpha,
extend=extend,
extendto=extendto,
|
| bedefde1 |
na.rm = na.rm),
|
| 0d9e240e |
check.aes = FALSE
|
| cc06d22b |
)
}
##' stat_hilight
|
| af18d052 |
##'
##'
##' @title stat_hilight
##' @param mapping aes mapping
##' @param data data
|
| cc06d22b |
##' @param geom geometric object
|
| af18d052 |
##' @param position position
##' @param node node number
##' @param show.legend show legend
##' @param inherit.aes logical
##' @param fill fill color
##' @param alpha transparency
|
| 1949a7f4 |
##' @param extend extend xmax of the rectangle
##' @param extendto extend xmax to extendto
|
| af18d052 |
##' @param ... additional parameter
##' @return layer
|
| cc06d22b |
##' @importFrom ggplot2 layer
##' @export
stat_hilight <- function(mapping=NULL, data=NULL, geom="rect",
|
| 0d9e240e |
position="identity", node,
|
| cc06d22b |
show.legend=NA, inherit.aes=FALSE,
|
| 3e0a61f1 |
fill, alpha, extend=0, extendto=NULL,
|
| cc06d22b |
...) {
default_aes <- aes_(x=~x, y=~y, node=~node, parent=~parent, branch.length=~branch.length)
if (is.null(mapping)) {
mapping <- default_aes
} else {
mapping <- modifyList(mapping, default_aes)
}
|
| 0d9e240e |
|
| cc06d22b |
layer(
stat=StatHilight,
data = data,
mapping = mapping,
geom = geom,
position = position,
show.legend=show.legend,
inherit.aes = inherit.aes,
params = list(node=node,
|
| 3e0a61f1 |
fill=fill,
alpha=alpha,
extend=extend,
extendto=extendto,
|
| 1949a7f4 |
...)
|
| cc06d22b |
)
}
##' StatHilight
##' @rdname ggtree-ggproto
##' @format NULL
##' @usage NULL
##' @importFrom ggplot2 Stat
##' @export
StatHilight <- ggproto("StatHilight", Stat,
|
| 1949a7f4 |
compute_group = function(self, data, scales, params, node, extend, extendto) {
df <- get_clade_position_(data, node)
df$xmax <- df$xmax + extend
if (!is.null(extendto) && !is.na(extendto)) {
if (extendto < df$xmax) {
warning("extendto is too small, keep the original xmax value...")
} else {
df$xmax <- extendto
}
}
return(df)
|
| cc06d22b |
},
required_aes = c("x", "y", "branch.length")
)
##' get position of clade (xmin, xmax, ymin, ymax)
##'
|
| 0d9e240e |
##'
|
| cc06d22b |
##' @title get_clade_position
##' @param treeview tree view
##' @param node selected node
##' @return data.frame
##' @export
##' @author Guangchuang Yu
get_clade_position <- function(treeview, node) {
get_clade_position_(treeview$data, node)
}
get_clade_position_ <- function(data, node) {
|
| 1949a7f4 |
sp <- tryCatch(get.offspring.df(data, node), error=function(e) NULL)
i <- match(node, data$node)
if (is.null(sp)) {
## tip
sp.df <- data[i,]
} else {
sp <- c(sp, node)
sp.df <- data[match(sp, data$node),]
}
|
| cc06d22b |
x <- sp.df$x
y <- sp.df$y
|
| 0d9e240e |
|
| d5c2a530 |
if ("branch.length" %in% colnames(data)) {
|
| 1949a7f4 |
xmin <- min(x)-data[i, "branch.length"]/2
|
| d5c2a530 |
} else {
xmin <- min(sp.df$branch)
}
data.frame(xmin=xmin,
|
| cc06d22b |
xmax=max(x),
ymin=min(y)-0.5,
ymax=max(y)+0.5)
}
|
