another experiment

Step 0. Do it with base ggplot2

library(tidyverse)

data.frame(x0 = 0:1, y0 = 0:1, r = 1:2/3) |> 
  mutate(group = row_number()) |> 
  crossing(tibble(z = 0:15)) |> 
  # mutate(join_var = 1) |> 
  # left_join(tibble(z = 0:15, join_var = 1),
  #           multiple = "all") |> 
  mutate(around = 2*pi*z/max(z)) |> 
  mutate(x = x0 + cos(around)*r,
         y = y0 + sin(around)*r) |> 
  ggplot() + 
  aes(x, y, label = z) +
  geom_text() +
  geom_path(aes(group = group))

Step 1. Compute

compute_panel_equilateral <- function(data, scales, n = 15){
  
  data |> 
    mutate(group = row_number()) |> 
    crossing(tibble(z = 0:n)) |>
    # mutate(join_var = 1) |> 
    # left_join(tibble(z = 0:(n), join_var = 1),
    #         multiple = "all") |> 
    mutate(around = 2*pi*z/max(z)) |> 
    mutate(x = x0 + cos(around)*r,
           y = y0 + sin(around)*r) 
  
}

tibble(x0 = 1:2, y0 = 1:2, r = 1 ) |> 
  compute_panel_equilateral()

## # A tibble: 32 × 8
##       x0    y0     r group     z around      x     y
##    <int> <int> <dbl> <int> <int>  <dbl>  <dbl> <dbl>
##  1     1     1     1     1     0  0     2      1    
##  2     1     1     1     1     1  0.419 1.91   1.41 
##  3     1     1     1     1     2  0.838 1.67   1.74 
##  4     1     1     1     1     3  1.26  1.31   1.95 
##  5     1     1     1     1     4  1.68  0.895  1.99 
##  6     1     1     1     1     5  2.09  0.5    1.87 
##  7     1     1     1     1     6  2.51  0.191  1.59 
##  8     1     1     1     1     7  2.93  0.0219 1.21 
##  9     1     1     1     1     8  3.35  0.0219 0.792
## 10     1     1     1     1     9  3.77  0.191  0.412
## # ℹ 22 more rows

Step 2. Pass to ggproto

StatCircle <- ggproto(
  `_class` = "StatCircle", 
  `_inherit` = ggplot2::Stat,
  compute_panel = compute_panel_equilateral,
                      required_aes = c("x0", "y0", "r")
                      )

Step 3. Write geom_* or stat_*

geom_circle <- function(
  mapping = NULL,
  data = NULL,
  position = "identity",
  na.rm = FALSE,
  show.legend = NA,
  inherit.aes = TRUE, ...) {
  ggplot2::layer(
    stat = StatCircle,  # proto object from Step 2
    geom = ggplot2::GeomPolygon,  # inherit other behavior
    data = data,
    mapping = mapping,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )
}

Step 4: Enjoy (test)

data.frame(x0 = 0:1, y0 = 0:1, r = 1:2/3) |> 
  ggplot() + 
  aes(x0 = x0, y0 = y0, r = r) + 
  geom_circle() + 
  aes(fill = r)

diamonds |> 
  slice_sample(n = 80) |> 
  ggplot() + 
  aes(x0 = as.numeric(cut), y0 = carat  , r = as.numeric(clarity)/20) + 
  geom_circle(alpha = .2) + 
  aes(fill = after_stat(r)) +
  coord_equal()

cars |> 
  sample_n(12) |>  
  ggplot() + 
  aes(x0 = speed, y0 = dist, r = dist/speed) + 
  geom_circle(color = "black") +
  coord_equal()

last_plot() + 
  aes(alpha = speed > 15) +
  aes(linetype = dist > 20) +
  aes(fill = speed > 18) +
  facet_wrap(~ dist > 40)

## Warning: Using alpha for a discrete variable is not advised.

Discussion: Why not compute_group?

StatCircle2 <- ggproto(
  `_class` = "StatCircle2",
  `_inherit` = ggplot2::Stat,
  compute_group = compute_panel_equilateral,
  required_aes = c("x0", "y0", "r"))

geom_circle_CG <- function(
  mapping = NULL,
  data = NULL,
  position = "identity",
  na.rm = FALSE,
  show.legend = NA,
  inherit.aes = TRUE, ...) {
  ggplot2::layer(
    stat = StatCircle2,  # proto object from Step 2
    geom = ggplot2::GeomPolygon,  # inherit other behavior
    data = data,
    mapping = mapping,
    position = position,
    show.legend = show.legend,
    inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )
}

cars |> 
  sample_n(12) |>  
  ggplot() + 
  aes(x0 = speed, y0 = dist, r = dist/speed) + 
  geom_circle_CG(color = "black") +
  coord_equal() + 
  aes(alpha = speed > 15) +
  aes(linetype = dist > 20) +
  aes(fill = speed > 18) +
  facet_wrap(~ dist > 40)

## Warning: Using alpha for a discrete variable is not advised.

Exercise: Write the function, geom_heart() that will take the compute below and do it within the geom_* function

data.frame(x0 = 0:1, y0 = 0:1, r = 1:2/3, rotation = 0) %>% 
  mutate(group = row_number()) %>% 
  tidyr::crossing(around = 0:15/15) %>%
    dplyr::mutate(
      y = y0 + r * (
        .85 * cos(2*pi*around)
        - .35 * cos(2 * 2*pi*around)
        - .25 * cos(3 * 2*pi*around)
        - .05 * cos(4 * 2*pi*around)
      ) - rotation * pi,
      x = x0 + r * (sin(2*pi*around)^3) - rotation * pi) %>% 
  ggplot() +
   aes(x = x, y = y, group = group) + 
  geom_polygon(alpha = .5, fill = "darkred") + 
  coord_equal()