Browse Source
Easy labels with geom_bars when position="fill" or position="stack"revert-15-stat_labels
3 changed files with 146 additions and 0 deletions
@ -0,0 +1,78 @@ |
|||
#' Labels position for fill position. |
|||
#' |
|||
#' Computes position of labels when using \code{position = "fill"} |
|||
#' |
|||
#' @inheritParams ggplot2::stat_count |
|||
#' @param geom Use to override the default connection between |
|||
#' \code{geom_text} and \code{stat_stack_labels}. |
|||
#' @section Computed variables: |
|||
#' \describe{ |
|||
#' \item{count}{the number of observations} |
|||
#' \item{prop}{proportion on \code{x}} |
|||
#' \item{cumprop}{the cumulative proportion on \code{x}} |
|||
#' \item{ylabel}{the y position of labels, i.e. \eqn{cumprop - prop / 2}} |
|||
#' } |
|||
#' @seealso \code{\link{stat_stack_labels}} for \code{position = "stack"}. |
|||
#' @examples |
|||
#' ggplot(as.data.frame(Titanic)) + |
|||
#' aes(x = Class, fill = Survived, weight = Freq) + |
|||
#' geom_bar(position = "fill") + stat_fill_labels() |
|||
#' ggplot(as.data.frame(Titanic)) + |
|||
#' aes(x = Class, fill = Survived, weight = Freq) + |
|||
#' geom_bar(position = "fill") + geom_label(stat = "fill_labels") |
|||
#' ggplot(as.data.frame(Titanic)) + |
|||
#' aes(x = Class, fill = Survived, weight = Freq) + |
|||
#' geom_bar(position = "fill") + geom_text(stat = "fill_labels") + facet_grid(~Sex) |
|||
#' ggplot(as.data.frame(Titanic)) + |
|||
#' aes(x = as.integer(Class), fill = Survived, weight = Freq) + |
|||
#' geom_area(position = "fill", stat = "count") + geom_text(stat = "fill_labels") |
|||
#' |
|||
#' # Cumulative percentages with dodge position |
|||
#' ggplot(as.data.frame(Titanic)) + |
|||
#' aes(x = Class, fill = Survived, weight = Freq) + |
|||
#' geom_bar(aes(y = ..prop..), stat="fill_labels", position="dodge", width = .8) + |
|||
#' geom_text( |
|||
#' aes(label = scales::percent(..prop..), y = ..prop../2), |
|||
#' stat = "fill_labels", position = position_dodge(width = .8) |
|||
#' ) |
|||
#' @export |
|||
stat_fill_labels <- function(mapping = NULL, data = NULL, geom = "text", |
|||
position = "identity", width = NULL, na.rm = FALSE, show.legend = NA, |
|||
inherit.aes = TRUE, ...) { |
|||
layer( |
|||
stat = StatFillLabels, data = data, mapping = mapping, geom = geom, |
|||
position = position, show.legend = show.legend, inherit.aes = inherit.aes, |
|||
params = list(na.rm = na.rm, ...) |
|||
) |
|||
} |
|||
|
|||
|
|||
#' @export |
|||
StatFillLabels <- ggproto( |
|||
"StatFillLabels", |
|||
StatCount, |
|||
compute_panel = function (self, data, scales, ...) { |
|||
if (ggplot2:::empty(data)) |
|||
return(data.frame()) |
|||
groups <- split(data, data$group) |
|||
stats <- lapply(groups, function(group) { |
|||
self$compute_group(data = group, scales = scales, ...) |
|||
}) |
|||
stats <- mapply(function(new, old) { |
|||
if (ggplot2:::empty(new)) |
|||
return(data.frame()) |
|||
unique <- ggplot2:::uniquecols(old) |
|||
missing <- !(names(unique) %in% names(new)) |
|||
cbind(new, unique[rep(1, nrow(new)), missing, drop = FALSE]) |
|||
}, stats, groups, SIMPLIFY = FALSE) |
|||
data <- do.call(plyr::rbind.fill, stats) |
|||
plyr::ddply( |
|||
data, "x", plyr::mutate, |
|||
prop = count/sum(count), |
|||
cumprop = cumsum(count)/sum(count), |
|||
ylabel = (cumsum(count) - count / 2)/sum(count), |
|||
na.rm = TRUE |
|||
) |
|||
}, |
|||
default_aes = aes(y = ..ylabel.., label = paste0(round(100 * ..prop.., digits =1), "%")) |
|||
) |
@ -0,0 +1,66 @@ |
|||
#' Labels position for stack position. |
|||
#' |
|||
#' Computes position of labels when using \code{position = "stack"} |
|||
#' |
|||
#' @inheritParams ggplot2::stat_count |
|||
#' @param geom Use to override the default connection between |
|||
#' \code{geom_text} and \code{stat_stack_labels}. |
|||
#' @section Computed variables: |
|||
#' \describe{ |
|||
#' \item{count}{the number of observations} |
|||
#' \item{cumcount}{the cumulative number of observations} |
|||
#' \item{ylabel}{the y position of labels, i.e. \eqn{cumcount - count / 2}} |
|||
#' } |
|||
#' @seealso \code{\link{stat_fill_labels}} for \code{position = "fill"}. |
|||
#' @examples |
|||
#' ggplot(as.data.frame(Titanic)) + |
|||
#' aes(x = Class, fill = Survived, weight = Freq) + |
|||
#' geom_bar() + stat_stack_labels() |
|||
#' ggplot(as.data.frame(Titanic)) + |
|||
#' aes(x = Class, fill = Survived, weight = Freq) + |
|||
#' geom_bar() + geom_label(stat = "stack_labels") |
|||
#' ggplot(as.data.frame(Titanic)) + |
|||
#' aes(x = Class, fill = Survived, weight = Freq) + |
|||
#' geom_bar() + stat_stack_labels() + facet_grid(~Sex) |
|||
#' ggplot(as.data.frame(Titanic)) + |
|||
#' aes(x = as.integer(Class), fill = Survived, weight = Freq) + |
|||
#' geom_area(stat = "count") + stat_stack_labels() |
|||
#' @export |
|||
stat_stack_labels <- function(mapping = NULL, data = NULL, geom = "text", |
|||
position = "identity", width = NULL, na.rm = FALSE, show.legend = NA, |
|||
inherit.aes = TRUE, ...) { |
|||
layer( |
|||
stat = StatStackLabels, data = data, mapping = mapping, geom = geom, |
|||
position = position, show.legend = show.legend, inherit.aes = inherit.aes, |
|||
params = list(na.rm = na.rm, ...) |
|||
) |
|||
} |
|||
|
|||
#' @export |
|||
StatStackLabels <- ggproto( |
|||
"StatStackLabels", |
|||
StatCount, |
|||
compute_panel = function (self, data, scales, ...) { |
|||
if (ggplot2:::empty(data)) |
|||
return(data.frame()) |
|||
groups <- split(data, data$group) |
|||
stats <- lapply(groups, function(group) { |
|||
self$compute_group(data = group, scales = scales, ...) |
|||
}) |
|||
stats <- mapply(function(new, old) { |
|||
if (ggplot2:::empty(new)) |
|||
return(data.frame()) |
|||
unique <- ggplot2:::uniquecols(old) |
|||
missing <- !(names(unique) %in% names(new)) |
|||
cbind(new, unique[rep(1, nrow(new)), missing, drop = FALSE]) |
|||
}, stats, groups, SIMPLIFY = FALSE) |
|||
data <- do.call(plyr::rbind.fill, stats) |
|||
plyr::ddply( |
|||
data, "x", plyr::mutate, |
|||
cumcount = cumsum(count), |
|||
ylabel = cumsum(count) - count / 2, |
|||
na.rm = TRUE |
|||
) |
|||
}, |
|||
default_aes = aes(y = ..ylabel.., label = ..count..) |
|||
) |
Loading…
Reference in new issue