another experiment
Evangeline Reynolds
2023-12-08
knitr::opts_chunk$set(echo = TRUE)
options(tidyverse.quiet = TRUE)Intro Thoughts
Sometimes I’ve wanted to add default aes to a stat_* or geom_* function. However, this is messy. You can cleanly pass all the behavior with ellipses only to carry on with behavior within the aes call or outside.
geom_barlab <- function(...){stat_count(aes(label = after_stat(count)), ...)}
geom_barlab <- function(...){stat_count(aes(label = after_stat(count), ...))}What if we modify the ggproto stat itself that feeds stat_count, to have label as a default aes. I can imagine this kind of move being useful for the labeling problem…
Status Quo, without new functions
library(tidyverse)
mtcars %>%
ggplot() +
aes(x = vs, y = am) +
stat_sum(alpha = .2) +
stat_sum(geom = "text",
aes(label = after_stat(n)))
aliasing stat to geom …
geom_sum <- stat_sum
mtcars %>%
ggplot() +
aes(x = vs, y = am) +
geom_sum(alpha = .2)
but we also want labeling geom
StatSum$default_aes## Aesthetic mapping:
## * `size` -> `after_stat(n)`
## * `weight` -> 1# adding label to make it ready for
StatSum$default_aes = aes(size = after_stat(n),
weight = 1,
label = after_stat(n))
geom_sum_text <- function(...){stat_sum(geom = "text", ...)}
mtcars %>%
ggplot() +
aes(x = vs, y = am) +
geom_sum(alpha = .2) +
geom_sum_text()
Second application…
# Status quoto
mtcars %>%
ggplot() +
aes(x = factor(vs), y = factor(am)) +
stat_bin_2d(alpha = .2) +
stat_bin_2d(geom = "text",
aes(label = after_stat(count)))
# alias
geom_heatmap <- stat_bin2d
# add label default
StatBin2d$default_aes## Aesthetic mapping:
## * `weight` -> 1
## * `fill` -> `after_stat(count)`StatBin2d$default_aes <- aes(weight = 1,
fill = after_stat(count),
label = after_stat((100*count/sum(count)) %>%
round(1) %>%
paste0("%")))
geom_heatmap_percent <- function(...){stat_bin_2d(geom = "text", ...)}
mtcars %>%
ggplot() +
aes(x = factor(vs), y = factor(am)) +
geom_heatmap(alpha = .2) +
geom_heatmap_percent()
third example
library(tidyverse)
diamonds %>%
ggplot() +
aes(y = cut) +
geom_bar() +
stat_count(geom = "text",
aes(label = after_stat(count)))
StatCount$default_aes## Aesthetic mapping:
## * `x` -> `after_stat(count)`
## * `y` -> `after_stat(count)`
## * `weight` -> 1StatCount$default_aes <- aes(x = after_stat(count),
y = after_stat(count),
weight = 1,
label = after_stat(count),
percent = after_stat(100*count/sum(count)) %>%
round(1) %>%
paste0("%"))
geom_barlab <- function(...){stat_count(geom = "text", ...)}
diamonds %>%
ggplot() +
aes(y = cut) +
geom_bar() +
geom_barlab()
layer_data() # wow! percent is here. (but we can't seem to access it)## x label percent count prop y flipped_aes PANEL group xmin xmax ymin ymax
## 1 1610 1610 3% 1610 1 1 TRUE 1 1 0 1610 0.55 1.45
## 2 4906 4906 9.1% 4906 1 2 TRUE 1 2 0 4906 1.55 2.45
## 3 12082 12082 22.4% 12082 1 3 TRUE 1 3 0 12082 2.55 3.45
## 4 13791 13791 25.6% 13791 1 4 TRUE 1 4 0 13791 3.55 4.45
## 5 21551 21551 40% 21551 1 5 TRUE 1 5 0 21551 4.55 5.45
## colour fill linewidth linetype alpha
## 1 NA grey35 0.5 1 NA
## 2 NA grey35 0.5 1 NA
## 3 NA grey35 0.5 1 NA
## 4 NA grey35 0.5 1 NA
## 5 NA grey35 0.5 1 NAexample four, re-defaulting when there are required aesthetics…
reference: https://evamaerey.github.io/mytidytuesday/2023-11-08-ggforce-pies/ggforce-pies-reawakens.html
library(tidyverse)
diamonds %>%
count(cut) %>%
ggplot() +
aes(amount = n, r0 = 0, r = 1, fill = cut, x0 = 0, y0 = 0) +
ggforce::stat_pie()## Warning: Using the `size` aesthetic in this geom was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` in the `default_aes` field and elsewhere instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
compute_panel_wedge <- function(data, scales, n = 360, sep = 0){
# defaulting aesthetics, instead of requiring
# data$x0 <- data$x0 %||% 0
if(!("x0" %in% names(data))){data$x0 <- 0}
if(!("y0" %in% names(data))){data$y0 <- 0}
if(!("r0" %in% names(data))){data$r0 <- 0}
if(!("r" %in% names(data))) {data$r <- sqrt(sum(data$amount)/pi)} # area will be equal to amount
# maybe change 'amount' to 'weight'?
# piggybacking from StatPie
ggforce::StatPie$compute_panel(data, scales = scales, n = n, sep = sep)
}
StatWedge <- ggplot2::ggproto(
`_class` = 'StatWedge',
`_inherit` = ggplot2::Stat,
compute_panel = compute_panel_wedge,
required_aes = c('amount'),
default_aes = ggplot2::aes(x0 = NULL, y0 = NULL,
r0 = NULL, r = NULL,
explode = NULL)
)
# Gentle modification from ggforce::GeomArcBar, changing color (was black) and fill (was NA) defaults
GeomArcWedge <- ggplot2::ggproto('GeomArcWedge', ggforce::GeomShape,
default_aes = ggforce:::combine_aes(ggforce::GeomShape$default_aes,
ggplot2::aes(colour = NA, fill = "grey"))
)
geom_wedge <- function(mapping = NULL, data = NULL,
geom = 'arc_wedge', stat = StatWedge,
position = 'identity', n = 360, sep = 0, na.rm = FALSE,
show.legend = NA, inherit.aes = TRUE, ...) {
layer(
stat = stat, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, n = n, sep = sep, ...)
)
}
diamonds %>%
count(cut) %>%
ggplot() +
aes(amount = n, fill = cut) +
geom_wedge() 
Attempt to apply changing required aesthetics to geom bar case… hiding, not working
Closing remarks, Other Relevant Work, Caveats
- There’s a danger of overwriting necessary default aesthetics; restart r session to restore… check out what the existing defaults are and include them.
- though a default aes addition seems innocuous, it seems a bit heavy handed to change a proto…
- it would be nice to have a handful of calculations to choose from for labels. I’m not sure what the way forward is. conditional logic in default aes doesn’t see to work.
Could you, in this case, What if you want a variant, where default aes, e.g. text gives you something a little different, but you want both functions to work. https://stackoverflow.com/questions/70637463/when-i-modify-a-duplicated-copied-geom-object-this-also-modifies-the-underlyi
library(tidyverse)
StatCount2 <- ggproto(NULL, ggplot2::StatCount)
StatCount2$default_aes = aes(x = after_stat(count),
y = after_stat(count),
weight = 1,
label = after_stat(100*count/sum(count)) %>%
round(1) %>%
paste0("%"))
# did copy paste og stat_count and changed geom to "text" and StatCount to StatCount2
geom_bar_percent <- function (mapping = NULL, data = NULL,
geom = "text",
position = "stack",
..., width = NULL, na.rm = FALSE, orientation = NA, show.legend = NA,
inherit.aes = TRUE)
{
params <- rlang::list2(na.rm = na.rm, orientation = orientation,
width = width, ...)
layer(data = data, mapping = mapping, stat = StatCount2, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = params)
}
diamonds %>%
ggplot() +
aes(y = cut) +
geom_bar() +
geom_bar_percent()