#' ggplot2 geom that adds a label to facet panes
#'
#' @export
GeomIndicator <- ggplot2::ggproto(
"GeomIndicator", ggplot2::Geom,
required_aes = c("indicator"),
default_aes = ggplot2::aes(
colour = "black",
xpos="right",
ypos="top",
xjust=NULL,
yjust=NULL,
size = 5,
group=1,
angle = 0,
alpha = NA,
family = "",
fontface = 1,
lineheight = 1.2),
draw_group = function(
data, scales, coordinates,
parse = FALSE, na.rm = FALSE, check_overlap = FALSE){
indicator <- data$indicator[1]
if(is.na(indicator) || is.null(indicator)){
return(grid::nullGrob())
}
if("xpos" %in% names(data)){
if(data$xpos[1] == "left"){
xpos <- .07
} else if( data$xpos[1] == "center"){
xpos <- .5
} else if( data$xpos[1] == "right"){
xpos <- .97
} else if( is.numeric(data$xpos[1]) && 0 <= data$xpos[1] && data$xpos[1] <= 1){
xpos <- data$xpos[1]
} else {
stop(paste("In geom_indicator(), unrecognized value xpos=\"", data$xpos[1],"\". Please use 'left', 'right' or 'center', or a value from 0 to 1.", sep=""))
}
} else {
xpos <- .97
}
if("ypos" %in% names(data)){
if(data$ypos[1] == "top"){
ypos <- .97
} else if( data$ypos[1] == "center"){
ypos <- .5
} else if( data$ypos[1] == "bottom"){
ypos <- .03
} else if( is.numeric(data$ypos[1]) && 0L <= data$ypos[1] && data$ypos[1] <= 1L){
ypos <- data$ypos[1]
} else {
stop(paste("In geom_indicator(), unrecognized value ypos=\"", data$ypos[1],"\". Please use 'top', 'bottom' or 'center', or a value from 0 to 1.", sep=""))
}
} else {
ypos <- .97
}
if(!is.null(data$xjust[1])){
if(data$xjust[1] %in% c("left", "center", "right")){
xjust <- data$xjust[1]
} else {
stop(paste("In geom_indicator(), unrecognized value xjust=\"", data$xjust[1],"\". Please use 'left', 'right' or 'center'.", sep=""))
}
} else {
if(xpos < 1/3){
xjust <- "left"
} else if(xpos >= 1/3 && xpos < 2/3){
xjust <- "center"
} else {
xjust <- "right"
}
}
if(!is.null(data$yjust[1])){
if(data$yjust[1] %in% c("top", "center", "bottom")){
yjust <- data$yjust[1]
} else {
stop(paste("In geom_indicator(), unrecognized value yjust=\"", data$yjust[1],"\". Please use 'top', 'bottom' or 'center'.", sep=""))
}
} else {
if(ypos < 1/3){
yjust <- "bottom"
} else if(ypos >= 1/3 && ypos < 2/3){
yjust <- "center"
} else {
yjust <- "top"
}
}
if (parse) {
# this is what the new geom_text does
indicator_display_value <- parse(text = as.character(data$indicator[1]))
} else {
if(is.character(indicator)){
indicator_display_value <- indicator
} else {
indicator_display_value <- prettyNum(data$indicator[1], big.mark=",")
}
}
size <- data$size[1]
level <- data$group[1] - 1
grid::textGrob(
indicator_display_value,
grid::unit(xpos, "npc"),
grid::unit(ypos, "npc") - grid::unit(level, "line"),
just=c(xjust, yjust),
gp=grid::gpar(
col=scales::alpha(data$colour[1], data$alpha[1]),
fontsize=size*12/5,
fontfamily=data$family[1],
fontface=data$fontface[1],
lineheight=data$lineheight[1]),
check.overlap = check_overlap)})
#' @export
geom_indicator <- function (
mapping = NULL,
data = NULL,
stat = "identity",
position = "identity",
parse = FALSE,
...,
nudge_x = 0,
nudge_y = 0,
check_overlap = FALSE,
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE
) {
if (!missing(nudge_x) || !missing(nudge_y)) {
if (!missing(position)) {
stop("Specify either `position` or `nudge_x`/`nudge_y`", call. = FALSE)
}
position <- position_nudge(nudge_x, nudge_y)
}
ggplot2::layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomIndicator,
position = position,
inherit.aes = inherit.aes,
show.legend=F,
params=list(
parse = parse,
check_overlap = check_overlap,
na.rm = na.rm,
...
)
)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.