geom_pie and geom_wedge via StatPie and StatWedge
Evangeline Reynolds
2023-11-28
intro…
I tried borrowing from geom_bar in https://github.com/EvaMaeRey/ggpie, but it’s not the best, I think new stats might be the best way forward.
Part 1. geom_pie… An implementation in polar coordinates with geom rect, where total count changes the size of the pie.
Step 0. Get job done with base ggplot2
library(tidyverse)
ggplot2::diamonds %>%
mutate(weight = 1) %>%
count(cut, wt = weight) %>%
mutate(cum_n = cumsum(n)) %>%
mutate(cum_prop = cum_n/sum(n)) %>%
mutate(ymin = lag(cum_prop)) %>%
mutate(ymin = replace_na(ymin, 0)) %>%
mutate(r = sqrt(sum(n)/pi)) %>%
mutate(r0 = 0) %>%
ggplot() +
aes(x = 0, y = 0,
xmin = 0, ymin = ymin,
xmax = r,
ymax = cum_prop) +
geom_rect() +
aes(fill = cut) +
coord_polar(theta = "y")
layer_data()## fill x y xmin ymin xmax ymax PANEL group colour linewidth
## 1 #440154FF 0 0 0 0.00000000 131.033 0.02984798 1 1 NA 0.5
## 2 #3B528BFF 0 0 0 0.02984798 131.033 0.12080089 1 2 NA 0.5
## 3 #21908CFF 0 0 0 0.12080089 131.033 0.34479051 1 3 NA 0.5
## 4 #5DC863FF 0 0 0 0.34479051 131.033 0.60046348 1 4 NA 0.5
## 5 #FDE725FF 0 0 0 0.60046348 131.033 1.00000000 1 5 NA 0.5
## linetype alpha
## 1 1 NA
## 2 1 NA
## 3 1 NA
## 4 1 NA
## 5 1 NAStep 12&3. compute, ggproto, geom_*,
compute_panel_pie <- function(data, scales, digits = 1, r_nudge = 0, r_prop = 1){
if(!("weight" %in% names(data))){data$weight <- 1}
# order matters...
if("fill" %in% names(data)){data <- group_by(data, fill, .add = T)}
if("alpha" %in% names(data)){data <- group_by(data, alpha, .add = T)}
if("colour" %in% names(data)){data <- group_by(data, colour, .add = T)}
if("group" %in% names(data)){data <- group_by(data, group, .add = T)}
if("linetype" %in% names(data)){data <- group_by(data, linetype, .add = T)}
if("linewidth" %in% names(data)){data <- group_by(data, linewidth, .add = T)}
out <- data %>%
summarize(wt = sum(weight)) %>%
ungroup() %>%
mutate(group = 1:n()) %>%
mutate(cum_n = cumsum(wt)) %>%
mutate(xmax = cum_n/sum(wt)) %>%
mutate(xmin = lag(xmax)) %>%
mutate(xmin = replace_na(xmin, 0)) %>%
mutate(r = sqrt(sum(wt)/pi)) %>%
mutate(r0 = 0) %>%
mutate(x = (xmin + xmax)/2, y = r,
ymin = 0, ymax = r
) %>%
mutate(prop = wt/sum(wt)) %>%
mutate(percent = paste0(round(100*prop, digits), "%")) %>%
mutate(r_prop = r_prop) %>%
mutate(r_nudge = r_nudge)
if("r" %in% names(data)){out$ymax <- data$r[1]}
if("r0" %in% names(data)){out$ymin <- data$r0[1]}
out
}
compute_panel_pietext <- function(data, scales, r_prop = 1, r_nudge = 0, digits){
compute_panel_pie(data, scales, r_prop = r_prop, r_nudge = r_nudge) %>%
mutate(y = .data$r * .data$r_prop + .data$r_nudge) # overwriting y
}
ggplot2::diamonds %>%
mutate(fill = cut) %>%
mutate(r = 1) %>%
mutate(r0 = .5) %>%
compute_panel_pie()## # A tibble: 5 × 16
## fill wt group cum_n xmax xmin r r0 x y ymin ymax
## <ord> <dbl> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Fair 1610 1 1610 0.0298 0 131. 0 0.0149 131. 0.5 1
## 2 Good 4906 2 6516 0.121 0.0298 131. 0 0.0753 131. 0.5 1
## 3 Very Good 12082 3 18598 0.345 0.121 131. 0 0.233 131. 0.5 1
## 4 Premium 13791 4 32389 0.600 0.345 131. 0 0.473 131. 0.5 1
## 5 Ideal 21551 5 53940 1 0.600 131. 0 0.800 131. 0.5 1
## # ℹ 4 more variables: prop <dbl>, percent <chr>, r_prop <dbl>, r_nudge <dbl>ggplot2::diamonds %>%
count(cut) %>%
mutate(fill = cut, weight = n) %>%
mutate(r = 1) %>%
mutate(r0 = .5) %>%
compute_panel_pie(r_prop = .5)## # A tibble: 5 × 16
## fill wt group cum_n xmax xmin r r0 x y ymin ymax
## <ord> <int> <int> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Fair 1610 1 1610 0.0298 0 131. 0 0.0149 131. 0.5 1
## 2 Good 4906 2 6516 0.121 0.0298 131. 0 0.0753 131. 0.5 1
## 3 Very Good 12082 3 18598 0.345 0.121 131. 0 0.233 131. 0.5 1
## 4 Premium 13791 4 32389 0.600 0.345 131. 0 0.473 131. 0.5 1
## 5 Ideal 21551 5 53940 1 0.600 131. 0 0.800 131. 0.5 1
## # ℹ 4 more variables: prop <dbl>, percent <chr>, r_prop <dbl>, r_nudge <dbl>ggplot2::diamonds %>%
count(cut) %>%
mutate(fill = cut, weight = n) %>%
mutate(r = 1) %>%
mutate(r0 = .5) %>%
compute_panel_pietext(r_prop = .5, r_nudge = 10 )## # A tibble: 5 × 16
## fill wt group cum_n xmax xmin r r0 x y ymin ymax
## <ord> <int> <int> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Fair 1610 1 1610 0.0298 0 131. 0 0.0149 75.5 0.5 1
## 2 Good 4906 2 6516 0.121 0.0298 131. 0 0.0753 75.5 0.5 1
## 3 Very Good 12082 3 18598 0.345 0.121 131. 0 0.233 75.5 0.5 1
## 4 Premium 13791 4 32389 0.600 0.345 131. 0 0.473 75.5 0.5 1
## 5 Ideal 21551 5 53940 1 0.600 131. 0 0.800 75.5 0.5 1
## # ℹ 4 more variables: prop <dbl>, percent <chr>, r_prop <dbl>, r_nudge <dbl>ggplot2::diamonds %>%
count(cut) %>%
mutate(fill = cut, weight = n) %>%
mutate(r = 1) %>%
mutate(r0 = .5) %>%
compute_panel_pietext(r_nudge = 50)## # A tibble: 5 × 16
## fill wt group cum_n xmax xmin r r0 x y ymin ymax
## <ord> <int> <int> <int> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Fair 1610 1 1610 0.0298 0 131. 0 0.0149 181. 0.5 1
## 2 Good 4906 2 6516 0.121 0.0298 131. 0 0.0753 181. 0.5 1
## 3 Very Good 12082 3 18598 0.345 0.121 131. 0 0.233 181. 0.5 1
## 4 Premium 13791 4 32389 0.600 0.345 131. 0 0.473 181. 0.5 1
## 5 Ideal 21551 5 53940 1 0.600 131. 0 0.800 181. 0.5 1
## # ℹ 4 more variables: prop <dbl>, percent <chr>, r_prop <dbl>, r_nudge <dbl>StatPie <- ggproto(`_class` = "StatPie",
`_inherit` = ggplot2::Stat,
# required_aes = "fill",
compute_panel = compute_panel_pie,
default_aes = aes(group = after_stat(group))
)
StatPietext <- ggproto(`_class` = "StatPietext",
`_inherit` = ggplot2::Stat,
# required_aes = "fill",
compute_panel = compute_panel_pietext,
default_aes = aes(group = after_stat(group), label = after_stat(percent))
)
geom_pie <- function(
mapping = NULL,
data = NULL,
position = "identity",
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE, ...) {
ggplot2::layer(
stat = StatPie, # proto object from step 2
geom = ggplot2::GeomRect, # inherit other behavior
data = data,
mapping = mapping,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(na.rm = na.rm, ...)
)
}
geom_pie_label <- function(
mapping = NULL,
data = NULL,
position = "identity",
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE, ...) {
ggplot2::layer(
stat = StatPietext, # proto object from step 2
geom = ggplot2::GeomText, # 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. Test it out
ggplot2::diamonds %>%
ggplot() +
aes(fill = color) +
geom_pie() +
coord_polar()## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
ggplot2::diamonds %>%
ggplot() +
aes(fill = color) +
geom_pie() +
geom_pie_label(r_nudge = -50) +
coord_polar() +
NULL## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
ggplot2::diamonds %>%
ggplot() +
aes(fill = color) +
geom_pie() +
geom_pie_label(r_prop = 1.5) +
coord_polar() +
NULL## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
layer_data()## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.## fill group PANEL wt cum_n xmax xmin r r0 x
## 1 #440154FF 1 1 6775 6775 0.1256025 0.0000000 131.033 0 0.06280126
## 2 #443A83FF 2 1 9797 16572 0.3072303 0.1256025 131.033 0 0.21641639
## 3 #31688EFF 3 1 9542 26114 0.4841305 0.3072303 131.033 0 0.39568039
## 4 #21908CFF 4 1 11292 37406 0.6934742 0.4841305 131.033 0 0.58880237
## 5 #35B779FF 5 1 8304 45710 0.8474231 0.6934742 131.033 0 0.77044865
## 6 #8FD744FF 6 1 5422 51132 0.9479422 0.8474231 131.033 0 0.89768261
## 7 #FDE725FF 7 1 2808 53940 1.0000000 0.9479422 131.033 0 0.97397108
## y ymin ymax prop percent r_prop r_nudge colour linewidth
## 1 131.033 0 131.033 0.12560252 12.6% 1 0 NA 0.5
## 2 131.033 0 131.033 0.18162773 18.2% 1 0 NA 0.5
## 3 131.033 0 131.033 0.17690026 17.7% 1 0 NA 0.5
## 4 131.033 0 131.033 0.20934372 20.9% 1 0 NA 0.5
## 5 131.033 0 131.033 0.15394883 15.4% 1 0 NA 0.5
## 6 131.033 0 131.033 0.10051910 10.1% 1 0 NA 0.5
## 7 131.033 0 131.033 0.05205784 5.2% 1 0 NA 0.5
## linetype alpha
## 1 1 NA
## 2 1 NA
## 3 1 NA
## 4 1 NA
## 5 1 NA
## 6 1 NA
## 7 1 NAlast_plot() +
coord_polar()## Coordinate system already present. Adding new coordinate system, which will
## replace the existing one.
## `summarise()` has grouped output by 'fill'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the `.groups` argument.
layer_data()## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.## fill group PANEL wt cum_n xmax xmin r r0 x
## 1 #440154FF 1 1 6775 6775 0.1256025 0.0000000 131.033 0 0.06280126
## 2 #443A83FF 2 1 9797 16572 0.3072303 0.1256025 131.033 0 0.21641639
## 3 #31688EFF 3 1 9542 26114 0.4841305 0.3072303 131.033 0 0.39568039
## 4 #21908CFF 4 1 11292 37406 0.6934742 0.4841305 131.033 0 0.58880237
## 5 #35B779FF 5 1 8304 45710 0.8474231 0.6934742 131.033 0 0.77044865
## 6 #8FD744FF 6 1 5422 51132 0.9479422 0.8474231 131.033 0 0.89768261
## 7 #FDE725FF 7 1 2808 53940 1.0000000 0.9479422 131.033 0 0.97397108
## y ymin ymax prop percent r_prop r_nudge colour linewidth
## 1 131.033 0 131.033 0.12560252 12.6% 1 0 NA 0.5
## 2 131.033 0 131.033 0.18162773 18.2% 1 0 NA 0.5
## 3 131.033 0 131.033 0.17690026 17.7% 1 0 NA 0.5
## 4 131.033 0 131.033 0.20934372 20.9% 1 0 NA 0.5
## 5 131.033 0 131.033 0.15394883 15.4% 1 0 NA 0.5
## 6 131.033 0 131.033 0.10051910 10.1% 1 0 NA 0.5
## 7 131.033 0 131.033 0.05205784 5.2% 1 0 NA 0.5
## linetype alpha
## 1 1 NA
## 2 1 NA
## 3 1 NA
## 4 1 NA
## 5 1 NA
## 6 1 NA
## 7 1 NAlast_plot() +
aes(alpha = cut)## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
last_plot() +
facet_wrap(~color)## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
last_plot() +
facet_wrap(~color) +
coord_cartesian()## Coordinate system already present. Adding new coordinate system, which will
## replace the existing one.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
last_plot() +
coord_polar()## Coordinate system already present. Adding new coordinate system, which will
## replace the existing one.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the `.groups` argument.
last_plot() +
aes(r = 1, r0 = .5)## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill', 'alpha'. You can override using the
## `.groups` argument.
ggplot2::diamonds %>%
count(cut) %>%
ggplot() +
aes(fill = cut, weight = n) +
geom_pie() +
coord_polar()## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
last_plot() +
geom_pie_label(aes(label = after_stat(wt), angle = after_stat(c(85,0,0,0,0))),
r_nudge = -40,
color = "oldlace")## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
Step 4. Test With Titanic Data
Titanic %>%
data.frame() %>%
uncount(Freq) %>%
ggplot() +
coord_polar() +
aes(fill = Sex) +
geom_pie() ## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
last_plot() +
facet_wrap(~ Sex) +
aes(fill = Class) ## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
last_plot() +
facet_grid(Sex ~ Class) +
aes(fill = Survived) +
geom_pie_label(r_nudge = 7) +
theme_void() ## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
last_plot() +
facet_wrap(~Sex) +
aes(r = 1, r0 = .5)## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
Example example with weight
Titanic %>%
data.frame() %>%
ggplot() +
coord_polar() +
aes(fill = Survived, weight = Freq) +
facet_wrap(~Sex) +
geom_pie()## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
Part 2. geom_wedge And now in cartesian coordinates…
Step 0. W/ base ggplot2
num_in_arc <- 5
library(tidyverse)
ggplot2::diamonds %>%
count(cut) %>%
mutate(cum_n = cumsum(n)) %>%
mutate(cum_prop = cum_n/sum(n)) %>%
mutate(ymin = lag(cum_prop)) %>%
mutate(ymin = replace_na(ymin, 0)) %>%
mutate(r = sqrt(sum(n)/pi)) %>%
mutate(r0 = 0) %>%
crossing(id_arc_point = c(-1:(num_in_arc + 1))) %>%
mutate(pos_in_radians = 2*pi*(ymin + (cum_prop - ymin)/num_in_arc*id_arc_point )) %>%
mutate(x = r*cos(pos_in_radians)) %>%
mutate(y = r*sin(pos_in_radians)) %>%
mutate(x = ifelse(id_arc_point == -1 |
id_arc_point == num_in_arc + 1, 0, x)) %>%
mutate(y = ifelse(id_arc_point == -1 |
id_arc_point == num_in_arc + 1, 0, y)) %>%
ggplot() +
aes(x = x, y = y ) +
geom_polygon() +
aes(fill = cut) +
aes(color = cut) +
geom_point() +
coord_equal()
Step 123 (compute, ggproto, geom_*)
compute_panel_wedge <- function(data, scales){
data %>%
count(fill) %>%
mutate(cum_n = cumsum(n)) %>%
mutate(cum_prop = cum_n/sum(n)) %>%
mutate(ymin = lag(cum_prop)) %>%
mutate(ymin = replace_na(ymin, 0)) %>%
mutate(r = sqrt(sum(n)/pi)) %>%
mutate(r0 = 0) %>%
crossing(id_arc_point = c(-1:(num_in_arc + 1))) %>%
mutate(pos_in_radians = 2*pi*(ymin + (cum_prop - ymin)/num_in_arc*id_arc_point )) %>%
mutate(x = cos(pos_in_radians)) %>%
mutate(y = sin(pos_in_radians)) %>%
mutate(x = ifelse(id_arc_point == -1 | id_arc_point == num_in_arc + 1, 0, x)) %>%
mutate(y = ifelse(id_arc_point == -1 | id_arc_point == num_in_arc + 1, 0, y))
}
StatWedge <- ggproto(`_class` = "StatWedge",
`_inherit` = ggplot2::Stat,
required_aes = "fill",
compute_panel = compute_panel_wedge,
default_aes = aes(group = after_stat(fill)))
geom_wedge <- function(
mapping = NULL,
data = NULL,
position = "identity",
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE, ...) {
ggplot2::layer(
stat = StatPie, # 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. Test it out (failing)
diamonds %>%
ggplot() +
aes(fill = cut) +
geom_wedge()## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.
layer_data()## `summarise()` has grouped output by 'fill'. You can override using the
## `.groups` argument.## fill group PANEL wt cum_n xmax xmin r r0 x
## 1 #440154FF 1 1 1610 1610 0.02984798 0.00000000 131.033 0 0.01492399
## 2 #3B528BFF 2 1 4906 6516 0.12080089 0.02984798 131.033 0 0.07532443
## 3 #21908CFF 3 1 12082 18598 0.34479051 0.12080089 131.033 0 0.23279570
## 4 #5DC863FF 4 1 13791 32389 0.60046348 0.34479051 131.033 0 0.47262699
## 5 #FDE725FF 5 1 21551 53940 1.00000000 0.60046348 131.033 0 0.80023174
## y ymin ymax prop percent r_prop r_nudge colour linewidth
## 1 131.033 0 131.033 0.02984798 3% 1 0 NA 0.5
## 2 131.033 0 131.033 0.09095291 9.1% 1 0 NA 0.5
## 3 131.033 0 131.033 0.22398962 22.4% 1 0 NA 0.5
## 4 131.033 0 131.033 0.25567297 25.6% 1 0 NA 0.5
## 5 131.033 0 131.033 0.39953652 40% 1 0 NA 0.5
## linetype alpha
## 1 1 NA
## 2 1 NA
## 3 1 NA
## 4 1 NA
## 5 1 NAClosing remarks, Other Relevant Work, Caveats
Need to work on labeling strategy!