Status Quo
library(tidyverse)
compute_panel_wedge <- function(data, scales, vertices = 5){
data |>
mutate(prop = area/sum(area)) |>
mutate(cumprop = cumsum(prop)) |>
mutate(lagcumprop = lag(cumprop, default = 0)) ->
props_vertices; props_vertices
data.frame(around = 0:vertices/vertices) %>%
crossing(props_vertices) %>%
group_by(id) %>%
filter(lagcumprop <= around &
cumprop >= around) ->
arcs; arcs
props_vertices %>%
mutate(around = cumprop) %>%
bind_rows(arcs) %>%
bind_rows(props_vertices %>%
mutate(around = lagcumprop)) |>
arrange(id, around) %>%
mutate(x = cos(2*pi*around)) %>%
mutate(y = sin(2*pi*around)) ->
circle_points; circle_points
data |>
distinct(id, area) |>
mutate(x = 0) |>
mutate(y = 0) %>%
mutate(around = -1) %>%
mutate(prop = -1,
cumprop = -1,
lagcumprop = -1) ->
middle; middle
data |>
distinct(id, area) |>
mutate(x = 0) |>
mutate(y = 0) %>%
mutate(around = 2) %>%
mutate(prop = 2,
cumprop = 2,
lagcumprop = 2) ->
middle2; middle2
bind_rows(middle,
circle_points) %>%
bind_rows(middle2) %>%
arrange(around) %>%
ungroup()
}
diamonds %>%
count(cut) %>%
select(id = cut, area = n) ->
data
data %>%
compute_panel_wedge() %>%
data.frame()
## id area x y around prop cumprop
## 1 Fair 1610 0.0000000 0.000000e+00 -1.00000000 -1.00000000 -1.00000000
## 2 Good 4906 0.0000000 0.000000e+00 -1.00000000 -1.00000000 -1.00000000
## 3 Very Good 12082 0.0000000 0.000000e+00 -1.00000000 -1.00000000 -1.00000000
## 4 Premium 13791 0.0000000 0.000000e+00 -1.00000000 -1.00000000 -1.00000000
## 5 Ideal 21551 0.0000000 0.000000e+00 -1.00000000 -1.00000000 -1.00000000
## 6 Fair 1610 1.0000000 0.000000e+00 0.00000000 0.02984798 0.02984798
## 7 Fair 1610 1.0000000 0.000000e+00 0.00000000 0.02984798 0.02984798
## 8 Fair 1610 0.9824658 1.864430e-01 0.02984798 0.02984798 0.02984798
## 9 Good 4906 0.9824658 1.864430e-01 0.02984798 0.09095291 0.12080089
## 10 Good 4906 0.7255147 6.882067e-01 0.12080089 0.09095291 0.12080089
## 11 Very Good 12082 0.7255147 6.882067e-01 0.12080089 0.22398962 0.34479051
## 12 Very Good 12082 0.3090170 9.510565e-01 0.20000000 0.22398962 0.34479051
## 13 Very Good 12082 -0.5609942 8.278197e-01 0.34479051 0.22398962 0.34479051
## 14 Premium 13791 -0.5609942 8.278197e-01 0.34479051 0.25567297 0.60046348
## 15 Premium 13791 -0.8090170 5.877853e-01 0.40000000 0.25567297 0.60046348
## 16 Premium 13791 -0.8090170 -5.877853e-01 0.60000000 0.25567297 0.60046348
## 17 Premium 13791 -0.8073019 -5.901387e-01 0.60046348 0.25567297 0.60046348
## 18 Ideal 21551 -0.8073019 -5.901387e-01 0.60046348 0.39953652 1.00000000
## 19 Ideal 21551 0.3090170 -9.510565e-01 0.80000000 0.39953652 1.00000000
## 20 Ideal 21551 1.0000000 -2.449294e-16 1.00000000 0.39953652 1.00000000
## 21 Ideal 21551 1.0000000 -2.449294e-16 1.00000000 0.39953652 1.00000000
## 22 Fair 1610 0.0000000 0.000000e+00 2.00000000 2.00000000 2.00000000
## 23 Good 4906 0.0000000 0.000000e+00 2.00000000 2.00000000 2.00000000
## 24 Very Good 12082 0.0000000 0.000000e+00 2.00000000 2.00000000 2.00000000
## 25 Premium 13791 0.0000000 0.000000e+00 2.00000000 2.00000000 2.00000000
## 26 Ideal 21551 0.0000000 0.000000e+00 2.00000000 2.00000000 2.00000000
## lagcumprop
## 1 -1.00000000
## 2 -1.00000000
## 3 -1.00000000
## 4 -1.00000000
## 5 -1.00000000
## 6 0.00000000
## 7 0.00000000
## 8 0.00000000
## 9 0.02984798
## 10 0.02984798
## 11 0.12080089
## 12 0.12080089
## 13 0.12080089
## 14 0.34479051
## 15 0.34479051
## 16 0.34479051
## 17 0.34479051
## 18 0.60046348
## 19 0.60046348
## 20 0.60046348
## 21 0.60046348
## 22 2.00000000
## 23 2.00000000
## 24 2.00000000
## 25 2.00000000
## 26 2.00000000
diamonds %>%
count(cut) %>%
select(id = cut, area = n) %>%
compute_panel_wedge() %>%
ggplot() +
aes(x = x, y = y, color = id) +
geom_point() +
geom_path() +
coord_equal()
StatWedge <- ggproto("StatWedge",
Stat,
compute_panel =
compute_panel_wedge)
diamonds |>
count(cut) |>
ggplot() +
aes(id = cut, area = n) +
geom_point(stat = StatWedge) +
aes(color = after_stat(id)) +
aes(fill = after_stat(id)) +
geom_polygon(stat = StatWedge) +
coord_equal()
## Error in `scale_apply()`:
## ! `scale_id` must not contain any "NA".
compute_panel_wedge <- function(data, scales, vertices = 5){
data |>
mutate(prop = area/sum(area)) |>
mutate(cumprop = cumsum(prop)) |>
mutate(lagcumprop = lag(cumprop, default = 0)) ->
props_vertices; props_vertices
data.frame(around = 0:vertices/vertices) %>%
crossing(props_vertices) %>%
group_by(id) %>%
filter(lagcumprop <= around &
cumprop >= around) ->
arcs; arcs
props_vertices %>%
mutate(around = cumprop) %>%
bind_rows(arcs) %>%
bind_rows(props_vertices %>%
mutate(around = lagcumprop)) |>
arrange(id, around) %>%
mutate(x = cos(2*pi*around)) %>%
mutate(y = sin(2*pi*around)) ->
circle_points; circle_points
data |>
distinct() |>
mutate(x = 0) |>
mutate(y = 0) %>%
mutate(around = -1) %>%
mutate(prop = -1,
cumprop = -1,
lagcumprop = -1) ->
middle; middle
data |>
distinct() |>
mutate(x = 0) |>
mutate(y = 0) %>%
mutate(around = 2) %>%
mutate(prop = 2,
cumprop = 2,
lagcumprop = 2) ->
middle2; middle2
bind_rows(middle,
circle_points) %>%
bind_rows(middle2) %>%
arrange(around) %>%
ungroup()
}
StatWedge$compute_panel <- compute_panel_wedge
diamonds |>
count(cut) |>
ggplot() +
aes(id = cut, area = n) +
geom_point(stat = StatWedge) +
aes(color = after_stat(id)) +
aes(fill = after_stat(id)) +
geom_polygon(stat = StatWedge, vertices = 10) +
coord_equal()
layer_data(i = 2)
## fill colour id area PANEL group x y
## 1 #440154FF #440154FF Fair 1610 1 1 0.0000000 0.000000e+00
## 2 #3B528BFF #3B528BFF Good 4906 1 2 0.0000000 0.000000e+00
## 3 #21908CFF #21908CFF Very Good 12082 1 3 0.0000000 0.000000e+00
## 4 #5DC863FF #5DC863FF Premium 13791 1 4 0.0000000 0.000000e+00
## 5 #FDE725FF #FDE725FF Ideal 21551 1 5 0.0000000 0.000000e+00
## 6 #440154FF #440154FF Fair 1610 1 1 1.0000000 0.000000e+00
## 7 #440154FF #440154FF Fair 1610 1 1 1.0000000 0.000000e+00
## 8 #440154FF #440154FF Fair 1610 1 1 0.9824658 1.864430e-01
## 9 #3B528BFF #3B528BFF Good 4906 1 2 0.9824658 1.864430e-01
## 10 #3B528BFF #3B528BFF Good 4906 1 2 0.8090170 5.877853e-01
## 11 #3B528BFF #3B528BFF Good 4906 1 2 0.7255147 6.882067e-01
## 12 #21908CFF #21908CFF Very Good 12082 1 3 0.7255147 6.882067e-01
## 13 #21908CFF #21908CFF Very Good 12082 1 3 0.3090170 9.510565e-01
## 14 #21908CFF #21908CFF Very Good 12082 1 3 -0.3090170 9.510565e-01
## 15 #21908CFF #21908CFF Very Good 12082 1 3 -0.5609942 8.278197e-01
## 16 #5DC863FF #5DC863FF Premium 13791 1 4 -0.5609942 8.278197e-01
## 17 #5DC863FF #5DC863FF Premium 13791 1 4 -0.8090170 5.877853e-01
## 18 #5DC863FF #5DC863FF Premium 13791 1 4 -1.0000000 1.224647e-16
## 19 #5DC863FF #5DC863FF Premium 13791 1 4 -0.8090170 -5.877853e-01
## 20 #5DC863FF #5DC863FF Premium 13791 1 4 -0.8073019 -5.901387e-01
## 21 #FDE725FF #FDE725FF Ideal 21551 1 5 -0.8073019 -5.901387e-01
## 22 #FDE725FF #FDE725FF Ideal 21551 1 5 -0.3090170 -9.510565e-01
## 23 #FDE725FF #FDE725FF Ideal 21551 1 5 0.3090170 -9.510565e-01
## 24 #FDE725FF #FDE725FF Ideal 21551 1 5 0.8090170 -5.877853e-01
## 25 #FDE725FF #FDE725FF Ideal 21551 1 5 1.0000000 -2.449294e-16
## 26 #FDE725FF #FDE725FF Ideal 21551 1 5 1.0000000 -2.449294e-16
## 27 #440154FF #440154FF Fair 1610 1 1 0.0000000 0.000000e+00
## 28 #3B528BFF #3B528BFF Good 4906 1 2 0.0000000 0.000000e+00
## 29 #21908CFF #21908CFF Very Good 12082 1 3 0.0000000 0.000000e+00
## 30 #5DC863FF #5DC863FF Premium 13791 1 4 0.0000000 0.000000e+00
## 31 #FDE725FF #FDE725FF Ideal 21551 1 5 0.0000000 0.000000e+00
## around prop cumprop lagcumprop linewidth linetype alpha
## 1 -1.00000000 -1.00000000 -1.00000000 -1.00000000 0.5 1 NA
## 2 -1.00000000 -1.00000000 -1.00000000 -1.00000000 0.5 1 NA
## 3 -1.00000000 -1.00000000 -1.00000000 -1.00000000 0.5 1 NA
## 4 -1.00000000 -1.00000000 -1.00000000 -1.00000000 0.5 1 NA
## 5 -1.00000000 -1.00000000 -1.00000000 -1.00000000 0.5 1 NA
## 6 0.00000000 0.02984798 0.02984798 0.00000000 0.5 1 NA
## 7 0.00000000 0.02984798 0.02984798 0.00000000 0.5 1 NA
## 8 0.02984798 0.02984798 0.02984798 0.00000000 0.5 1 NA
## 9 0.02984798 0.09095291 0.12080089 0.02984798 0.5 1 NA
## 10 0.10000000 0.09095291 0.12080089 0.02984798 0.5 1 NA
## 11 0.12080089 0.09095291 0.12080089 0.02984798 0.5 1 NA
## 12 0.12080089 0.22398962 0.34479051 0.12080089 0.5 1 NA
## 13 0.20000000 0.22398962 0.34479051 0.12080089 0.5 1 NA
## 14 0.30000000 0.22398962 0.34479051 0.12080089 0.5 1 NA
## 15 0.34479051 0.22398962 0.34479051 0.12080089 0.5 1 NA
## 16 0.34479051 0.25567297 0.60046348 0.34479051 0.5 1 NA
## 17 0.40000000 0.25567297 0.60046348 0.34479051 0.5 1 NA
## 18 0.50000000 0.25567297 0.60046348 0.34479051 0.5 1 NA
## 19 0.60000000 0.25567297 0.60046348 0.34479051 0.5 1 NA
## 20 0.60046348 0.25567297 0.60046348 0.34479051 0.5 1 NA
## 21 0.60046348 0.39953652 1.00000000 0.60046348 0.5 1 NA
## 22 0.70000000 0.39953652 1.00000000 0.60046348 0.5 1 NA
## 23 0.80000000 0.39953652 1.00000000 0.60046348 0.5 1 NA
## 24 0.90000000 0.39953652 1.00000000 0.60046348 0.5 1 NA
## 25 1.00000000 0.39953652 1.00000000 0.60046348 0.5 1 NA
## 26 1.00000000 0.39953652 1.00000000 0.60046348 0.5 1 NA
## 27 2.00000000 2.00000000 2.00000000 2.00000000 0.5 1 NA
## 28 2.00000000 2.00000000 2.00000000 2.00000000 0.5 1 NA
## 29 2.00000000 2.00000000 2.00000000 2.00000000 0.5 1 NA
## 30 2.00000000 2.00000000 2.00000000 2.00000000 0.5 1 NA
## 31 2.00000000 2.00000000 2.00000000 2.00000000 0.5 1 NA