Step 0. build w/out extending (ggplot2 + ggforce)

library(ggplot2)
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.

Step 1. computation

Here we’re mostly piggybacking on ggforce::StatPie, but we’d like to have more default rather than required aesthetics, an the external circle area to be meaningful; so data$amount

compute_panel_wedge <- function(data, scales, n = 360, sep = 0){
  
  # defaulting aesthetics, instead of requiring
  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)
  
}

Step 2. create ggproto objects

We define a StatWedge, which is closely related to ggforce::StatPie, but has fewer required aesthetics.

#     For reference... showing the abreviated ggforce::StatPie 
#     StatPie <- ggproto('StatPie', Stat,
#       compute_panel = function(data, scales, n = 360, sep = 0) {.......},
#       required_aes = c('x0', 'y0', 'r0', 'r', 'amount'),
#       default_aes = aes(explode = NULL)
#     )

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"))
)

Step 3. pass to user facing geom_* or stat_*

Almost same as stat_pie, but using the GeomArcWedge defined above and StatWedge defined above

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()

Step 4. Try it out…

library(tidyverse)
diamonds %>% 
  count(cut) %>% 
  ggplot() + 
  aes(amount = n) + 
  geom_wedge()

last_plot() + 
  aes(fill = cut)

last_plot() + 
  aes(alpha = n)

last_plot() + 
  aes(r0 = .5, r = 1)

last_plot() + 
  aes(x0 = 5)

last_plot() + 
  aes(r = n)

diamonds |>
  count(cut, clarity) |> 
  ggplot() + 
  facet_wrap(~clarity) +
  geom_wedge(color = "blue", alpha = .2) + 
  aes(amount = n, fill = cut)

last_plot() + 
  aes(r = 1) # back to unit circle...

Titanic %>% 
  data.frame() %>% 
  uncount(Freq) ->
tidyTitanic

tidyTitanic %>% 
  count(Sex, Survived) %>% 
  ggplot() + 
  aes(amount = n, fill = Sex) + 
  geom_wedge()

last_plot() + 
  facet_wrap(~Sex)

## Bayesian thinking
# Given Female, prob survived
last_plot() + 
  aes(fill = Survived)

# Given Survived, prob female
last_plot() + 
  facet_wrap(~Survived) + 
  aes(fill = Sex)

last_plot() + 
  aes(explode = c(0,0, 5, 0))

2201 little wedges

In fact you get a pie back even without aggregating (something you may notice above; if you look close, the “Survive” Wedges are visible when only Sex is a mapped var…). In the plots here, looking closely, you’ll see the exciting wave patterns that the 2201 wedges create.

Ultimately, we’d want to move to some counting in the background. Amount will be like ‘weight’ in geom_bar()/stat_count()

tidyTitanic %>% 
  ggplot() + 
  aes(fill = Sex, amount = 1) + 
  geom_wedge()

last_plot() +
  aes(fill = sort(Sex))

rladies_chapters <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2023/2023-11-21/rladies_chapters.csv')
## Rows: 4268 Columns: 6
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr  (3): chapter, title, location
## dbl  (2): id, year
## date (1): date
## 
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
library(tidyverse)
rladies_chapters  %>% 
  filter(year >= 2016) %>% 
  count(location, year, month = month(date)) %>% 
  ggplot() + 
  aes(fill = location, amount = n) + 
  geom_wedge() + 
  facet_wrap(~year) + 
  coord_equal() 

last_plot() + 
  facet_grid(year~month)

library(ggtext)

rladies_chapters  %>% 
  filter(year == 2020) %>% 
  count(location, month = month(date, label = T, abbr = T)) %>% 
  ggplot() + 
  aes(fill = location, amount = n) + 
  geom_wedge(color = "snow", linewidth = .25) + 
  facet_wrap(~month, nrow = 2) + 
  coord_equal() +
  labs(fill = NULL) + 
  ggstamp::theme_void_fill(fill = "snow") +
  theme(legend.position = "none",
        legend.justification = 0) +
  aes(r = 1) + aes(r = NULL) + 
  scale_fill_manual(values = c("Plum3", "Magenta")) +
  labs(title = "RLadies moved from in person to mostly online in 2020") +
  theme(plot.title.position = "plot") + 
  labs(title = "R-Ladies meetings in 2020 moved<br>from mostly <span style = 'color:Plum3;'>in person</span> to mostly <span style = 'color:Magenta;'>online</span>.") +
  labs(subtitle = "There was also a drop in the number of April/May meetings.\n") +
  theme(
    plot.title = element_textbox_simple(
      size = 14, lineheight = 1, padding = margin(0, 0, 5, 0)
    )
  ) + 
  theme(text = element_text(color = "grey55"))

last_plot() + 
  geom_wedge(aes(label= n), n = 1, geom = "text")