Experiment
compute_panel_prop <- function(data, scales, success_cat = T, width = .2){
data %>%
mutate(outcome = as.numeric(cat == success_cat)) %>%
group_by(outcome) %>%
summarise(count = sum(weight)) %>%
mutate(ymin = 0) %>%
mutate(width = width)
}
Titanic |>
data.frame() |>
select(cat = Survived, weight = Freq) |>
compute_panel_prop(success_cat = "Yes")
## # A tibble: 2 × 4
## outcome count ymin width
## <dbl> <dbl> <dbl> <dbl>
## 1 0 1490 0 0.2
## 2 1 711 0 0.2
compute_panel_prop_balance <- function(data, scales, success_cat = T){
data %>%
mutate(outcome = as.numeric(cat == success_cat)) %>%
uncount(weight) %>%
summarise(x = mean(outcome)) %>%
mutate(y = 0)
}
Titanic |>
data.frame() |>
select(cat = Survived, weight = Freq) |>
compute_panel_prop_balance(success_cat = "Yes")
## x y
## 1 0.323035 0
StatProp <- ggplot2::ggproto(`_class` = "StatProp",
`_inherit` = ggplot2::Stat,
required_aes = c("cat", "weight"),
compute_panel = compute_panel_prop,
default_aes = aes(ymax = after_stat(count),
xmin = after_stat(outcome + width/2),
x = after_stat(outcome),
y = after_stat(count),
xmax = after_stat(outcome - width/2),
weight = NULL,
))
geom_prop <- function(mapping = NULL, data = NULL,
position = "identity", na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE, ...) {
ggplot2::layer(
stat = StatProp, # proto object from step 2
geom = ggplot2::GeomRect, # inherit other behavior
data = data,
mapping = mapping,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
StatPropbalance <- ggplot2::ggproto(`_class` = "StatPropbalance",
`_inherit` = ggplot2::Stat,
required_aes = c("cat", "weight"),
compute_panel = compute_panel_prop_balance)
geom_balance <- function(mapping = NULL, data = NULL,
position = "identity", na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE, ...) {
ggplot2::layer(
stat = StatPropbalance, # proto object from step 2
geom = ggplot2::GeomPoint, # inherit other behavior
data = data,
mapping = mapping,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
Titanic |>
data.frame() |>
ggplot() +
aes(cat = Survived, weight = Freq) +
geom_prop(success_cat = "Yes", width = .2) +
ma206distributions::scale_x_counting() +
geom_balance(success_cat = "Yes")
