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

`%||%` <- ggplot2:::`%||%`
setup_data_bar <- function(data, params) {
  
    data$y %||% 0
    data$y <- 0
  
    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, 
      xmin = r0, 
      # xmax = x + width * (1 - just),
      xmax = r,
      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
    )
  }

GeomPie <- ggproto("GeomPie", GeomRect,
  required_aes = "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$flipped_aes <- TRUE #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
)

GeomPie$required_aes <- character()
GeomPie$required_aes
## character(0)
setup_params_count <- function(self, data, params) {
    params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE)

    data$y %||% 0
    data$y <- 0

    
    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$width <- resolution(data[[x]])

    }

    params
    
  }

compute_group_count <- function(self, data, scales, 
                                width = NULL, 
                                r = 1, r0 = 0,
                                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,
      r = r,
      r0 = r0,
      flipped_aes = flipped_aes,
      .size = length(count)
    )
    flip_data(bars, flipped_aes)
  }

StatPie <- ggproto("StatPie", Stat,
  # required_aes = "y",
  default_aes = aes(x = after_stat(count), 
                    # y = after_stat(count), 
                    y = NULL,
                    weight = 1),
  setup_params = setup_params_count,
  extra_params = c("na.rm", "orientation"),
  compute_group = compute_group_count
  # dropped_aes = "weight"
)
geom_pie <- function(mapping = NULL, data = NULL,
                     stat = "pie", 
                     position = "fill", # from 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 = GeomPie,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = rlang::list2(
      just = just,
      width = width,
      na.rm = na.rm,
      orientation = orientation,
      ...
    )
  )
}
diamonds %>%
ggplot() + 
  aes(y = 20000, 
      fill = cut) + 
  geom_pie()  

last_plot() +  
  coord_polar() + 
  theme_void() 

last_plot() + 
  facet_wrap(facets = vars(color))

last_plot() + 
  aes(fill = price > 2000,
      alpha = cut)

diamonds %>%
ggplot() + 
  aes(y = -100, 
      fill = cut) + 
  geom_pie(r = 3)  

required aes…

GeomPie$required_aes <- character()

geom_pie <- function(mapping = NULL, data = NULL,
                     stat = "pie", 
                     position = "fill", # from 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 = GeomPie,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = rlang::list2(
      just = just,
      width = width,
      na.rm = na.rm,
      orientation = orientation,
      ...
    )
  )
}


diamonds %>%
ggplot() + 
  aes(y = -100, 
      fill = cut) + 
  geom_pie()  

diamonds %>%
ggplot() + 
  aes(
      fill = cut) + 
  geom_pie()  
## Warning in min(x, na.rm = na.rm): no non-missing arguments to min; returning
## Inf
## Warning in max(x, na.rm = na.rm): no non-missing arguments to max; returning
## -Inf
## Warning in min(d[d > tolerance]): no non-missing arguments to min; returning
## Inf
## Warning: Computation failed in `stat_pie()`.
## Caused by error in `rowsum.default()`:
## ! unimplemented type 'NULL' in 'HashTableSetup'