Intro Thoughts

Status Quo: ggforce lets you build pie chart in cartesian coordinate sytsem; there are a lot of required aesthetics - so can feel like a mouthfull

library(ggforce)
## Loading required package: ggplot2
# If you know the angle spans to plot it is easy
arcs <- data.frame(
  start = seq(0, 2 * pi, length.out = 11)[-11],
  end = seq(0, 2 * pi, length.out = 11)[-1],
  r = rep(1:2, 5)
)

# Behold the arcs
ggplot(arcs) +
  geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = r - 1, r = r, start = start,
                   end = end, fill = r))
## 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.

# geom_arc_bar uses geom_shape to draw the arcs, so you have all the
# possibilities of that as well, e.g. rounding of corners
ggplot(arcs) +
  geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = r - 1, r = r, start = start,
                   end = end, fill = r), radius = unit(4, 'mm'))

# If you got values for a pie chart, use stat_pie
states <- c(
  'eaten', "eaten but said you didn\'t", 'cat took it', 'for tonight',
  'will decompose slowly'
)
pie <- data.frame(
  state = factor(rep(states, 2), levels = states),
  type = rep(c('Pie', 'Donut'), each = 5),
  r0 = rep(c(0, 0.8), each = 5),
  focus = rep(c(0.2, 0, 0, 0, 0), 2),
  amount = c(4, 3, 1, 1.5, 6, 6, 1, 2, 3, 2)
)

# Look at the cakes
ggplot() + geom_arc_bar(aes(
  x0 = 0, y0 = 0, r0 = r0, r = 1, amount = amount,
  fill = state, explode = focus
),
data = pie, stat = 'pie'
) +
  facet_wrap(~type, ncol = 1) +
  coord_fixed() +
#  theme_no_axes() +
  scale_fill_brewer('', type = 'qual')

# proposed interface reduces number of required aesthetics… aliasing give users familiar geom_pie()

# proposed?
ggplot(pie) +
  aes(fill = state, amount = amount) +
  geom_pie() + 
  facet_wrap(~type)

Experiment rewrite: x0, y0, r0, and r all have defaults; geom_pie is created as stat_pie alias.

The trick it to insert this code a bunch of times. (I kind of saw this with the explode argument and borrowed)

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 <- 1}

Then you can move x0, etc from required_aes to default_aes

...
required_aes = c('start', 'end'),
default_aes = aes(x0 = NULL, y0 = NULL, r0 = NULL, r = NULL)
...

rewrite

#' @include shape.R
NULL
## NULL
unique0 <- ggplot2:::unique0
polygonGrob <- grid:::polygonGrob
gpar <- grid:::gpar
`%||%` <- ggplot2:::`%||%`


#' Arcs and wedges as polygons
#'
#' This set of stats and geoms makes it possible to draw arcs and wedges as
#' known from pie and donut charts as well as more specialized plottypes such as
#' sunburst plots.
#'
#' @details An arc bar is the thick version of an arc; that is, a circle segment
#' drawn as a polygon in the same way as a rectangle is a thick version of a
#' line. A wedge is a special case of an arc where the inner radius is 0. As
#' opposed to applying coord_polar to a stacked bar chart, these layers are
#' drawn in cartesian space, which allows for transformations not possible with
#' the native ggplot2 approach. Most notable of these are the option to explode
#' arcs and wedgets away from their center point, thus detaching it from the
#' main pie/donut.
#'
#' @section Aesthetics:
#' geom_arc_bar understand the following aesthetics (required aesthetics are in
#' bold):
#'
#' - **start** - when using stat_arc_bar
#' - **end** - when using stat_arc_bar
#' - **amount** - when using stat_pie
#' - explode
#' - color
#' - fill
#' - linewidth
#' - linetype
#' - alpha
#'
#'
#' @section Computed variables:
#' \describe{
#'  \item{x, y}{x and y coordinates for the polygon}
#' }
#'
#' \describe{
#'  \item{x, y}{The start coordinates for the segment}
#' }
#'
#' @inheritParams ggplot2::geom_polygon
#' @inheritParams ggplot2::stat_identity
#'
#' @param n The number of points used to draw a full circle. The number of
#' points on each arc will then be calculated as n / span-of-arc
#'
#' @param sep The separation between arcs in pie/donut charts
#'
#' @name geom_arc_bar
#' @rdname geom_arc_bar
#' @seealso [geom_arc()] for drawing arcs as lines
#'
#' @examples
#' # If you know the angle spans to plot it is easy
#' arcs <- data.frame(
#'   start = seq(0, 2 * pi, length.out = 11)[-11],
#'   end = seq(0, 2 * pi, length.out = 11)[-1],
#'   r = rep(1:2, 5)
#' )
#'
#' # Behold the arcs
#' ggplot(arcs) +
#'   geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = r - 1, r = r, start = start,
#'                    end = end, fill = r))
#'
#' # geom_arc_bar uses geom_shape to draw the arcs, so you have all the
#' # possibilities of that as well, e.g. rounding of corners
#' ggplot(arcs) +
#'   geom_arc_bar(aes(x0 = 0, y0 = 0, r0 = r - 1, r = r, start = start,
#'                    end = end, fill = r), radius = unit(4, 'mm'))
#'
#' # If you got values for a pie chart, use stat_pie
#' states <- c(
#'   'eaten', "eaten but said you didn\'t", 'cat took it', 'for tonight',
#'   'will decompose slowly'
#' )
#' pie <- data.frame(
#'   state = factor(rep(states, 2), levels = states),
#'   type = rep(c('Pie', 'Donut'), each = 5),
#'   r0 = rep(c(0, 0.8), each = 5),
#'   focus = rep(c(0.2, 0, 0, 0, 0), 2),
#'   amount = c(4, 3, 1, 1.5, 6, 6, 1, 2, 3, 2)
#' )
#'
#' # Look at the cakes
#' ggplot() + geom_arc_bar(aes(
#'   x0 = 0, y0 = 0, r0 = r0, r = 1, amount = amount,
#'   fill = state, explode = focus
#' ),
#' data = pie, stat = 'pie'
#' ) +
#'   facet_wrap(~type, ncol = 1) +
#'   coord_fixed() +
#' #  theme_no_axes() +
#'   scale_fill_brewer('', type = 'qual')
#'
NULL
## NULL
#' @rdname ggforce-extensions
#' @format NULL
#' @usage NULL
#' @export
StatArcBar <- ggproto('StatArcBar', Stat,
  compute_panel = function(data, scales, n = 360) {
    arcPaths(data, n)
  },
  
  # required_aes = c('x0', 'y0', 'r0', 'r', 'start', 'end'),
  required_aes = c('start', 'end'),
  default_aes = aes(x0 = NULL, y0 = NULL, r0 = NULL, r = NULL)
)
#' @rdname geom_arc_bar
#' @export
stat_arc_bar <- function(mapping = NULL, data = NULL, geom = 'arc_bar',
                         position = 'identity', n = 360, na.rm = FALSE,
                         show.legend = NA, inherit.aes = TRUE, ...) {
  layer(
    stat = StatArcBar, data = data, mapping = mapping, geom = geom,
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, n = n, ...)
  )
}
#' @rdname ggforce-extensions
#' @format NULL
#' @usage NULL
#' @export
StatPie <- ggproto('StatPie', Stat,
  compute_panel = function(data, scales, n = 360, sep = 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 <- 1}
    
    data <- ggforce:::dapply(data, c('x0', 'y0'), function(df) {
      angles <- cumsum(df$amount)
      seps <- cumsum(sep * seq_along(angles))
      if (max(seps) >= 2 * pi) {
        cli::cli_abort(c(
          'Total separation exceeds circle circumference',
          i = 'Try lowering {.arg sep}.'
        ))
      }
      angles <- angles / max(angles) * (2 * pi - max(seps))
      ggplot2:::data_frame0(
        df,
        start = c(0, angles[-length(angles)]) + c(0, seps[-length(seps)]) + sep / 2,
        end = angles + seps - sep / 2
      )
    })
    arcPaths(as.data.frame(data), n)
  },

  # required_aes = c('x0', 'y0', 'r0', 'r', 'amount'),
  required_aes = c('amount'),
  # default_aes = aes(explode = NULL)
  default_aes = aes(x0 = NULL, y0 = NULL, r0 = NULL, r = NULL, explode = NULL)
)
#' @rdname geom_arc_bar
#' @export
stat_pie <- function(mapping = NULL, data = NULL, geom = 'arc_bar',
                     position = 'identity', n = 360, sep = 0, na.rm = FALSE,
                     show.legend = NA, inherit.aes = TRUE, ...) {
  layer(
    stat = StatPie, 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, ...)
  )
}
#' @rdname ggforce-extensions
#' @format NULL
#' @usage NULL
#' @export
GeomArcBar <- ggproto('GeomArcBar', GeomShape,
  default_aes = ggforce:::combine_aes(GeomShape$default_aes, aes(colour = 'black', fill = NA))
)
#' @rdname geom_arc_bar
#' @inheritParams geom_shape
#' @export
geom_arc_bar <- function(mapping = NULL, data = NULL, stat = 'arc_bar',
                         position = 'identity', n = 360, expand = 0, radius = 0,
                         na.rm = FALSE, show.legend = NA, inherit.aes = TRUE,
                         ...) {
  layer(
    data = data, mapping = mapping, stat = stat, geom = GeomArcBar,
    position = position, show.legend = show.legend, inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, n = n, expand = expand, radius = radius, ...)
  )
}

# This function is like base::make.unique, but it
# maintains the ordering of the original names if the values
# are sorted.
make_unique <- function(x, sep = '.') {
  if (!anyDuplicated(x)) return(x)
  groups <- match(x, unique(x))
  suffix <- unsplit(lapply(split(x, groups), seq_along), groups)
  max_chars <- nchar(max(suffix))
  suffix_format <- paste0('%0', max_chars, 'd')
  paste0(x, sep, sprintf(suffix_format, suffix))
}

arcPaths <- function(data, n) {
  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 <- 1}
  trans <- ggforce:::radial_trans(c(0, 1), c(0, 2 * pi), pad = 0)
  data <- data[data$start != data$end, ]
  data$nControl <- ceiling(n / (2 * pi) * abs(data$end - data$start))
  data$nControl[data$nControl < 3] <- 3
  extraData <- !names(data) %in% c('r0', 'r', 'start', 'end', 'group')
  data$group <- make_unique(as.character(data$group))
  paths <- lapply(seq_len(nrow(data)), function(i) {
    path <- ggplot2:::data_frame0(
      a = seq(data$start[i], data$end[i], length.out = data$nControl[i]),
      r = data$r[i]
    )
    if ('r0' %in% names(data)) {
      if (data$r0[i] != 0) {
        path <- vctrs:::vec_rbind(
          path,
          ggplot2:::data_frame0(a = rev(path$a), r = data$r0[i])
        )
      } else {
        path <- vctrs:::vec_rbind(
          path,
          ggplot2:::data_frame0(a = data$start[i], r = 0)
        )
      }
    }
    path$group <- data$group[i]
    path$index <- seq(0, 1, length.out = nrow(path))
    path <- cbind(path, data[rep(i, nrow(path)), extraData, drop = FALSE])
  })
  paths <- vctrs:::vec_rbind(!!!paths)
  paths <- cbind(
    paths[, !names(paths) %in% c('r', 'a')],
    trans$transform(paths$r, paths$a)
  )
  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 <- 1}

  paths$x <- paths$x + paths$x0
  paths$y <- paths$y + paths$y0
  if ('explode' %in% names(data)) {
    exploded <- data$explode != 0
    if (any(exploded)) {
      exploder <- trans$transform(
        data$explode[exploded],
        data$start[exploded] + (data$end[exploded] - data$start[exploded]) / 2
      )
      explodedPaths <- paths$group %in% which(exploded)
      exploderInd <- as.integer(factor(paths$group[explodedPaths]))
      paths$x[explodedPaths] <-
        paths$x[explodedPaths] + exploder$x[exploderInd]
      paths$y[explodedPaths] <-
        paths$y[explodedPaths] + exploder$y[exploderInd]
    }
  }
  paths[, !names(paths) %in% c('x0', 'y0', 'exploded')]
}

arcPaths2 <- function(data, n) {
  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 <- 1}
  
  trans <- radial_trans(c(0, 1), c(0, 2 * pi), pad = 0)
  fullCirc <- n / (2 * pi)
  extraData <- setdiff(names(data), c('r', 'x0', 'y0', 'end', 'group', 'PANEL'))
  hasExtra <- length(extraData) != 0
  extraTemplate <- data[1, extraData, drop = FALSE]
  paths <- lapply(split(seq_len(nrow(data)), data$group), function(i) {
    if (length(i) != 2) {
      cli::cli_abort(c(
        'Arcs must be defined by two end points',
        i = 'Make sure each group consists of two rows'
      ))
    }
    if (data$r[i[1]] != data$r[i[2]] ||
      data$x0[i[1]] != data$x0[i[2]] ||
      data$y0[i[1]] != data$y0[i[2]]) {
      cli::cli_abort(
        'Both end points in each arc must be at same radius ({.arg r}) and with same center ({.arg {c("x0", "y0")}})'
      )
    }
    if (data$end[i[1]] == data$end[i[2]]) return()
    nControl <- ceiling(fullCirc * abs(diff(data$end[i])))
    if (nControl < 3) nControl <- 3
    path <- ggplot2:::data_frame0(
      a = seq(data$end[i[1]], data$end[i[2]], length.out = nControl),
      r = data$r[i[1]],
      x0 = data$x0[i[1]],
      y0 = data$y0[i[1]],
      group = data$group[i[1]],
      index = seq(0, 1, length.out = nControl),
      .interp = c(FALSE, rep(TRUE, nControl - 2), FALSE),
      PANEL = data$PANEL[i[1]]
    )
    if (hasExtra) {
      path <- cbind(path, extraTemplate[rep(1, nControl), , drop = FALSE])
      path[1, extraData] <- data[i[1], extraData, drop = FALSE]
      path[nControl, extraData] <- data[i[2], extraData, drop = FALSE]
    }
    path
  })
  paths <- vctrs:::vec_rbind(!!!paths)
  paths <- cbind(
    paths[, !names(paths) %in% c('r', 'a')],
    trans$transform(paths$r, paths$a)
  )
  paths$x <- paths$x + paths$x0
  paths$y <- paths$y + paths$y0
  paths[, !names(paths) %in% c('x0', 'y0')]
}

try out proposed

# If you know the angle spans to plot it is easy
arcs <- data.frame(
  start = seq(0, 2 * pi, length.out = 11)[-11],
  end = seq(0, 2 * pi, length.out = 11)[-1],
  r = rep(1:2, 5)
)

# Behold the arcs
ggplot(arcs) +
  geom_arc_bar(aes(r0 = r - 1, r = r, start = start,
                   end = end, fill = r))

# geom_arc_bar uses geom_shape to draw the arcs, so you have all the
# possibilities of that as well, e.g. rounding of corners
ggplot(arcs) +
  geom_arc_bar(aes(r0 = r - 1, r = r, start = start,
                   end = end, fill = r), radius = unit(4, 'mm'))

# If you got values for a pie chart, use stat_pie
states <- c(
  'eaten', 'eaten but said you didn\'t', 'cat took it', 'for tonight',
  'will decompose slowly'
)

pie <- data.frame(
  state = factor(rep(states, 2), levels = states),
  type = rep(c('Pie', 'Donut'), each = 5),
  r0 = rep(c(0, 0.8), each = 5),
  focus = rep(c(0.2, 0, 0, 0, 0), 2),
  amount = c(4, 3, 1, 1.5, 6, 6, 1, 2, 3, 2)
)

# Look at the cakes; original fancy
ggplot(data = pie) + 
  geom_arc_bar(stat = 'pie') +
    aes(r0 = r0, 
        amount = amount,
        fill = state, 
        explode = focus) +
  facet_wrap(~type, ncol = 1) +
  coord_fixed() +
#  theme_no_axes() +
  scale_fill_brewer('', type = 'qual')

# simple two pies
ggplot(data = pie) + 
  aes(amount = amount,
      fill = state) +
  geom_arc_bar(stat = 'pie') +
  facet_wrap(~type) +
  coord_fixed()

# simple donuts
ggplot(data = pie) + 
  aes(amount = amount,
      fill = state,
      r0 = .2) +
  geom_arc_bar(stat = 'pie') +
  facet_wrap(~type) +
  coord_fixed()

# quick alias
geom_pie <- function(...){geom_arc_bar(stat = 'pie', ...)}


# simple one pie

pie |>
  dplyr::filter(type == "Pie") |>
  ggplot() + 
  aes(amount = amount,
      fill = state) +
  geom_pie() 

pie |> 
  dplyr::filter(type == "Donut") |> 
  ggplot() + 
  aes(amount = amount,
      fill = state,
      r0 = .5) +
  geom_pie()

hesitation, not exploring much

# uh-oh, I'd like to *set* r0 in geom_pie as follows; but fails.
pie |> 
  dplyr::filter(type == "Donut") |> 
  ggplot() + 
  aes(amount = amount,
      fill = state) +
  geom_pie(r0 = .5) 
## Warning in geom_arc_bar(stat = "pie", ...): Ignoring unknown parameters: `r0`

# yet, this is also true of the original ggforce stat_pie...
# Ignoring unknown parameters: `r0`
pie |> 
  dplyr::filter(type == "Donut") |> 
  ggplot() + 
  aes(amount = amount, x0 = 0, y0 = 0, r0 = 0, r = 1, 
      fill = state) +
  ggforce::stat_pie(r0 = .5) 
## Warning in ggforce::stat_pie(r0 = 0.5): Ignoring unknown parameters: `r0`

But … short-term, in-script helpers?

remove(list = ls())
library(tidyverse)
library(ggforce)

# overwriting ggplot feels a little weird for sure
# alternative is ggwedge, ggdonut individually
# just trying some new things
ggplot <- function(data, defaults = NULL){
  
  if(is.null(defaults)){start <- ggplot2::ggplot(data = data)}

  if(defaults == "wedge_plot"){
  start <- ggplot2::ggplot(data = data) +
    # I don't thinkg aes really belong in here, it's a hack
   aes(x0 = 0, y0 = 0, r0 = 0, r = 1) +
   coord_fixed() 
  }

  if(defaults == "wedge_donut_plot"){
  start <- ggplot2::ggplot(data = data) +
  aes(x0 = 0, y0 = 0, r0 = .75, r = 1) +
  coord_fixed()
  }
  
  start
  
}

geom_wedge <- function(...){stat_pie(...)}

ggplot2::diamonds %>% 
  count(cut) %>% 
  ggplot(defaults = "wedge_plot") + 
  aes(amount = n, fill = cut) +
  geom_wedge()

ggplot2::diamonds %>% 
  count(cut) %>% 
  ggplot(defaults = "wedge_donut_plot") + 
  aes(amount = n, fill = cut) +
  geom_wedge()