another experiment

Intro Thoughts

Step 0. With base ggplot2

library(tidyverse)
p <- diamonds %>%
ggplot() + 
  aes(y = 0, fill = cut) + 
  geom_bar() + # or geom_bar
  coord_polar() + 
  theme_void() 

p

Step 1. compute

geom_bar <- function(mapping = NULL, data = NULL,
                     stat = "count", position = "stack",
                     ...,
                     just = 0.5,
                     width = NULL,
                     na.rm = FALSE,
                     orientation = NA,
                     show.legend = NA,
                     inherit.aes = TRUE) {
  layer(
    data = data,
    mapping = mapping,
    stat = stat,
    geom = GeomBar,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = rlang::list2(
      just = just,
      width = width,
      na.rm = na.rm,
      orientation = orientation,
      ...
    )
  )
}

setup_data_bar <- function(data, params) {
    data$flipped_aes <- params$flipped_aes
    data <- flip_data(data, params$flipped_aes)
    data$width <- data$width %||%
      params$width %||% (min(vapply(
        split(data$x, data$PANEL, drop = TRUE),
        resolution, numeric(1), zero = FALSE
      )) * 0.9)
    data$just <- params$just %||% 0.5
    data <- transform(data,
      ymin = pmin(y, 0), ymax = pmax(y, 0),
      xmin = x - width * just, xmax = x + width * (1 - just),
      width = NULL, just = NULL
    )
    flip_data(data, params$flipped_aes)
}


draw_panel_bar <- function(self, data, panel_params, coord, lineend = "butt",
                        linejoin = "mitre", width = NULL, flipped_aes = FALSE) {
    # Hack to ensure that width is detected as a parameter
    ggproto_parent(GeomRect, self)$draw_panel(
      data,
      panel_params,
      coord,
      lineend = lineend,
      linejoin = linejoin
    )
  }

GeomBar <- ggproto("GeomBar", GeomRect,
  required_aes = c("x", "y"),
  # These aes columns are created by setup_data(). They need to be listed here so
  # that GeomRect$handle_na() properly removes any bars that fall outside the defined
  # limits, not just those for which x and y are outside the limits
  non_missing_aes = c("xmin", "xmax", "ymin", "ymax"),
  setup_params = function(data, params) {
    params$flipped_aes <- has_flipped_aes(data, params)
    params
  },
  extra_params = c("just", "na.rm", "orientation"),
  setup_data = setup_data_bar,
  draw_panel = draw_panel_bar,
  rename_size = TRUE
)

setup_params_count <- function(self, data, params) {
    params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE)

    has_x <- !(is.null(data$x) && is.null(params$x))
    has_y <- !(is.null(data$y) && is.null(params$y))
    if (!has_x && !has_y) {
      cli::cli_abort("{.fn {snake_class(self)}} requires an {.field x} or {.field y} aesthetic.")
    }
    if (has_x && has_y) {
      cli::cli_abort("{.fn {snake_class(self)}} must only have an {.field x} {.emph or} {.field y} aesthetic.")
    }

    if (is.null(params$width)) {
      x <- if (params$flipped_aes) "y" else "x"
      params$width <- resolution(data[[x]]) * 0.9
    }

    params
    
  }

compute_group_count <- function(self, data, scales, 
                                width = NULL, flipped_aes = FALSE) {
    data <- flip_data(data, flipped_aes)
    x <- data$x
    weight <- data$weight %||% rep(1, length(x))

    count <- as.vector(rowsum(weight, x, na.rm = TRUE))

    bars <- ggplot2:::data_frame0(
      count = count,
      prop = count / sum(abs(count)),
      x = sort(ggplot2:::unique0(x)),
      width = width,
      flipped_aes = flipped_aes,
      .size = length(count)
    )
    flip_data(bars, flipped_aes)
  }

StatCount <- ggproto("StatCount", Stat,
  required_aes = "x|y",
  default_aes = aes(x = after_stat(count), y = after_stat(count), weight = 1),
  setup_params = setup_params_count,
  extra_params = c("na.rm", "orientation"),
  compute_group = compute_group_count,
  dropped_aes = "weight"
)

diamonds %>%
ggplot() + 
  aes(y = 0, fill = cut) + 
  geom_bar() + # or geom_bar
  coord_polar() + 
  theme_void()