3e4b5998 |
##' add tree scale
##'
##'
##' @title geom_treescale
##' @param x x position
##' @param y y position
##' @param width width of scale
##' @param offset offset of text to line
##' @param color color
##' @param linesize size of line
##' @param fontsize size of text
|
51f3c877 |
##' @param family sans by default, can be any supported font
|
3e4b5998 |
##' @return ggplot layers
##' @export
##' @author Guangchuang Yu
geom_treescale <- function(x=NULL, y=NULL, width=NULL, offset=NULL, color="black",
|
51f3c877 |
linesize=0.5, fontsize=3.88, family="sans") {
|
3e4b5998 |
data=NULL
position="identity"
show.legend=NA
|
17714487 |
na.rm=TRUE
|
3e4b5998 |
inherit.aes=FALSE
default_aes <- aes_(x=~x, y=~y)
mapping <- default_aes
list(
stat_treeScaleLine(xx=x, yy=y, width=width, color=color, offset=offset, size=linesize,
mapping=mapping, data=data,
position=position, show.legend = show.legend,
inherit.aes = inherit.aes, na.rm=na.rm),
|
51f3c877 |
stat_treeScaleText(xx=x, yy=y, width=width, color=color, offset=offset,
size=fontsize, family = family,
|
3e4b5998 |
mapping=mapping, data=data,
position=position, show.legend = show.legend,
inherit.aes = inherit.aes, na.rm=na.rm)
)
}
stat_treeScaleLine <- function(mapping=NULL, data=NULL,
geom="segment", position="identity",
xx, yy, width, offset, color, ...,
show.legend=NA, inherit.aes=FALSE, na.rm=FALSE){
|
5662ae9e |
default_aes <- aes_(x=~x, y=~y, xend=~x, yend=~y)
|
3e4b5998 |
if (is.null(mapping)) {
mapping <- default_aes
} else {
mapping <- modifyList(mapping, default_aes)
}
layer(
stat=StatTreeScaleLine,
data=data,
mapping=mapping,
geom = geom,
position=position,
show.legend=show.legend,
inherit.aes=inherit.aes,
params=list(xx=xx,
yy=yy,
width=width,
offset=offset,
color=color,
na.rm=na.rm,
...)
)
}
stat_treeScaleText <- function(mapping=NULL, data=NULL,
geom="text", position="identity",
xx, yy, width, offset, color, ...,
show.legend=NA, inherit.aes=TRUE, na.rm=FALSE) {
|
17714487 |
default_aes <- aes_(x=~x, y=~y, label=~x)
|
3e4b5998 |
if (is.null(mapping)) {
mapping <- default_aes
} else {
mapping <- modifyList(mapping, default_aes)
}
layer(
stat=StatTreeScaleText,
data=data,
mapping=mapping,
geom=GeomText,
position=position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(xx=xx,
yy=yy,
width=width,
offset=offset,
color=color,
na.rm=na.rm,
...)
)
}
StatTreeScaleLine <- ggproto("StatTreeScaleLine", Stat,
compute_group = function(self, data, scales, params, xx, yy, width, offset) {
get_treescale_position(data, xx, yy, width, offset)[[1]]
},
required_aes = c("x", "y", "xend", "yend")
)
StatTreeScaleText <- ggproto("StatTreeScaleText", Stat,
compute_group = function(self, data, scales, params, xx, yy, width, offset) {
get_treescale_position(data, xx, yy, width, offset)[[2]]
},
required_aes = c("x", "y", "label")
)
get_treescale_position <- function(data, xx, yy, width, offset=NULL) {
x <- xx
y <- yy
dx <- data$x %>% range %>% diff
if (is.null(x)) {
x <- dx/2
}
if (is.null(y)) {
y <- 0
}
if (is.null(width) || is.na(width)) {
d <- dx/10
n <- 0
while (d < 1) {
d <- d*10
n <- n + 1
}
d <- floor(d)/(10^n)
} else {
d <- width
}
if (is.null(offset)) {
offset <- 0.4
}
list(LinePosition=data.frame(x=x, xend=x+d, y=y, yend=y),
TextPosition=data.frame(x=x+d/2, y=y+offset, label=d))
}
|
17714487 |
## ##' add evolution distance legend
## ##'
## ##'
|
3e4b5998 |
## ##' @title add_legend
## ##' @param p tree view
## ##' @param width width of legend
## ##' @param x x position
## ##' @param y y position
## ##' @param offset offset of text and line
## ##' @param font.size font size
## ##' @param ... additional parameter
## ##' @return tree view
## ##' @importFrom grid linesGrob
## ##' @importFrom grid textGrob
## ##' @importFrom grid gpar
## ##' @importFrom ggplot2 ylim
## ##' @export
## ##' @author Guangchuang Yu
## add_legend <- function(p, width=NULL, x=NULL, y=NULL, offset=NULL, font.size=4, ...) {
## dd <- get_treescale_position(p$data, x, y, width, offset)
## x <- dd[[1]]$x
## y <- dd[[1]]$y
## d <- dd[[1]]$xend -x
## p <- p + annotation_custom(linesGrob(), xmin=x, xmax=x+d, ymin=y, ymax=y) +
## annotation_custom(textGrob(label=d, gp = gpar(fontsize = font.size)),
## xmin=x+d/2, xmax=x+d/2, ymin=y+offset, ymax=y+offset)
## return(p)
## }
|