Companion Guide: “Extending your Ability to Extend” by Thomas Lin Pederson
Evangeline Reynolds
3/7/2023
- Step 00: Press play on ‘Extending your Ability to Extend’ https://www.youtube.com/watch?v=uj7A3i2fi54
- Step 0: get it done with base ggplot2/tidyverse
- step 1a: write
setup_datafunction - step 1b: test
setup_datadata function - step 2a: write a
compute_groupfunction - step 2b: test
compute_grouprow processing function - Step 3: write ggproto to create StatCircle;
setup_dataandcompute_groupfunctions will be inputs - Step 4: write
geom_circle, inheriting fromGeomPolygon - Step 5: Enjoy! Test out
geom_circle - Keep testing; second guess everything; dispare
- Look at
geom_circlefrom ggforce; hope renewed - Step 6: Post Mordem using
layer_datato look at the data frame
Step 00: Press play on ‘Extending your Ability to Extend’ https://www.youtube.com/watch?v=uj7A3i2fi54
Step 0: Do it with ggplot2.
Step 0: get it done with base ggplot2/tidyverse
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.0 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.1 ✔ tibble 3.1.8
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorscreate_circle <- function(x0, y0, r = 1, n = 7){
angles <- seq(from = 0,
to = 2 * pi,
length.out = n)
data.frame(
x = c(x0 + r * cos(angles)),
y = c(y0 + r * sin(angles))
)
}
cars %>%
.[1:5,] ->
five_cars
five_cars %>%
mutate(diamond =
purrr::map2(.x = speed,
.y = dist,
create_circle)) %>%
mutate(group = row_number()) %>%
unnest() ->
five_cars_circles## Warning: `cols` is now required when using `unnest()`.
## ℹ Please use `cols = c(diamond)`.five_cars %>%
ggplot() +
aes(x = speed, dist) +
geom_point() +
geom_polygon(data = five_cars_circles,
aes(x = x, y = y, group = group),
alpha = .5) +
coord_equal()
step 1a: write setup_data function
setup_data_circle <- function(data, params) {
if (data$group[1] == -1) {
nrows <- nrow(data)
data$group <- seq_len(nrows)
}
data # return data with a group variable
}step 1b: test setup_data data function
cars %>%
slice(1:5) %>%
mutate(group = -1) %>% # no grouping neg one is default in ggplot2
setup_data_circle() # setup makes each row defines a group## speed dist group
## 1 4 2 1
## 2 4 10 2
## 3 7 4 3
## 4 7 22 4
## 5 8 16 5cars %>%
slice(5:20) %>%
mutate(group = 2) %>% # if a group is already defined
setup_data_circle() # setup data does not do anything## speed dist group
## 1 8 16 2
## 2 9 10 2
## 3 10 18 2
## 4 10 26 2
## 5 10 34 2
## 6 11 17 2
## 7 11 28 2
## 8 12 14 2
## 9 12 20 2
## 10 12 24 2
## 11 12 28 2
## 12 13 26 2
## 13 13 34 2
## 14 13 34 2
## 15 13 46 2
## 16 14 26 2step 2a: write a compute_group function
We write a routine that will act on each group in the data (in this case each row)
compute_group_circle <- function(data, scales, n = 5){
angles <- seq(from = 0,
to = 2 * pi,
length.out = n)
data.frame(
x = c(data$x0 + data$r * cos(angles)),
y = c(data$y0 + data$r * sin(angles)),
data
)
}step 2b: test compute_group row processing function
cars %>%
rename(x0 = dist, y0 = speed) %>%
mutate(r = x0) %>%
.[1,] %>%
compute_group_circle(n = 6)## Warning in data.frame(x = c(data$x0 + data$r * cos(angles)), y = c(data$y0 + :
## row names were found from a short variable and have been discarded## x y y0 x0 r
## 1 4.000000 4.000000 4 2 2
## 2 2.618034 5.902113 4 2 2
## 3 0.381966 5.175571 4 2 2
## 4 0.381966 2.824429 4 2 2
## 5 2.618034 2.097887 4 2 2
## 6 4.000000 4.000000 4 2 2cars %>%
rename(x0 = dist, y0 = speed) %>%
mutate(r = x0) %>%
.[5,] %>%
compute_group_circle(n = 6) %>%
ggplot() +
aes(x = x, y = y) +
geom_polygon(alpha = .5) +
coord_equal()## Warning in data.frame(x = c(data$x0 + data$r * cos(angles)), y = c(data$y0 + :
## row names were found from a short variable and have been discarded
Step 3: write ggproto to create StatCircle; setup_data and compute_group functions will be inputs
StatCircle <- ggproto(`_class` = "StatCircle",
`_inherit` = Stat,
setup_data = setup_data_circle,
compute_group = compute_group_circle,
required_aes = c("x0", "y0", "r")
)Step 4: write geom_circle, inheriting from GeomPolygon
geom_circle <- function(mapping = NULL,
data = NULL,
stat = "circle",
position = "identity",
...,
n = 8,
lineend = "butt",
linejoin = "round",
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE) {
layer(
data = data,
mapping = mapping,
stat = stat,
geom = GeomPolygon,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
n = n,
lineend = lineend,
linejoin = linejoin,
na.rm = na.rm,
...
)
)
}Step 5: Enjoy! Test out geom_circle
test_df <- data.frame(
x0 = c(-5, 5),
y0 = c(5, -5),
r = c(5, 4),
class = c("a", "b")
)
cars %>%
slice(1:5) %>%
ggplot() +
aes(x = speed, y = dist) +
geom_point() +
aes(x0 = speed,
y0 = dist,
r = speed/6) +
coord_equal() ->
baseplot
baseplot +
geom_circle(n = 7, alpha = .2)## Warning in data.frame(x = c(data$x0 + data$r * cos(angles)), y = c(data$y0 + :
## row names were found from a short variable and have been discarded
## Warning in data.frame(x = c(data$x0 + data$r * cos(angles)), y = c(data$y0 + :
## row names were found from a short variable and have been discarded
## Warning in data.frame(x = c(data$x0 + data$r * cos(angles)), y = c(data$y0 + :
## row names were found from a short variable and have been discarded
## Warning in data.frame(x = c(data$x0 + data$r * cos(angles)), y = c(data$y0 + :
## row names were found from a short variable and have been discarded
## Warning in data.frame(x = c(data$x0 + data$r * cos(angles)), y = c(data$y0 + :
## row names were found from a short variable and have been discarded
Keep testing; second guess everything; dispare
baseplot +
aes(fill = speed == 6) +
geom_circle(n = 7, alpha = .2)## Warning in data$r * cos(angles): longer object length is not a multiple of
## shorter object length## Warning in data$x0 + data$r * cos(angles): longer object length is not a
## multiple of shorter object length## Warning in data$r * sin(angles): longer object length is not a multiple of
## shorter object length## Warning in data$y0 + data$r * sin(angles): longer object length is not a
## multiple of shorter object length## Warning: Computation failed in `stat_circle()`
## Caused by error in `data.frame()`:
## ! arguments imply differing number of rows: 7, 5
baseplot +
aes(fill = speed > 6) +
geom_circle(n = 7, alpha = .2)## Warning in data$r * cos(angles): longer object length is not a multiple of
## shorter object length## Warning in data$x0 + data$r * cos(angles): longer object length is not a
## multiple of shorter object length## Warning in data$r * sin(angles): longer object length is not a multiple of
## shorter object length## Warning in data$y0 + data$r * sin(angles): longer object length is not a
## multiple of shorter object length## Warning: Computation failed in `stat_circle()`
## Caused by error in `data.frame()`:
## ! arguments imply differing number of rows: 7, 2
Look at geom_circle from ggforce; hope renewed
baseplot +
aes(fill = speed > 6) +
ggforce::geom_circle(n = 5)## 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.
Step 6: Post Mordem using layer_data to look at the data frame
baseplot +
geom_circle(n = 7, alpha = .2) ->
p1
layer_data(p1, 2)## Warning in data.frame(x = c(data$x0 + data$r * cos(angles)), y = c(data$y0 + :
## row names were found from a short variable and have been discarded
## Warning in data.frame(x = c(data$x0 + data$r * cos(angles)), y = c(data$y0 + :
## row names were found from a short variable and have been discarded
## Warning in data.frame(x = c(data$x0 + data$r * cos(angles)), y = c(data$y0 + :
## row names were found from a short variable and have been discarded
## Warning in data.frame(x = c(data$x0 + data$r * cos(angles)), y = c(data$y0 + :
## row names were found from a short variable and have been discarded
## Warning in data.frame(x = c(data$x0 + data$r * cos(angles)), y = c(data$y0 + :
## row names were found from a short variable and have been discarded## x y x0 y0 r x.1 y.1 PANEL group colour fill
## 1 4.666667 2.000000 4 2 0.6666667 4 2 1 1 NA grey20
## 2 4.333333 2.577350 4 2 0.6666667 4 2 1 1 NA grey20
## 3 3.666667 2.577350 4 2 0.6666667 4 2 1 1 NA grey20
## 4 3.333333 2.000000 4 2 0.6666667 4 2 1 1 NA grey20
## 5 3.666667 1.422650 4 2 0.6666667 4 2 1 1 NA grey20
## 6 4.333333 1.422650 4 2 0.6666667 4 2 1 1 NA grey20
## 7 4.666667 2.000000 4 2 0.6666667 4 2 1 1 NA grey20
## 8 4.666667 10.000000 4 10 0.6666667 4 10 1 2 NA grey20
## 9 4.333333 10.577350 4 10 0.6666667 4 10 1 2 NA grey20
## 10 3.666667 10.577350 4 10 0.6666667 4 10 1 2 NA grey20
## 11 3.333333 10.000000 4 10 0.6666667 4 10 1 2 NA grey20
## 12 3.666667 9.422650 4 10 0.6666667 4 10 1 2 NA grey20
## 13 4.333333 9.422650 4 10 0.6666667 4 10 1 2 NA grey20
## 14 4.666667 10.000000 4 10 0.6666667 4 10 1 2 NA grey20
## 15 8.166667 4.000000 7 4 1.1666667 7 4 1 3 NA grey20
## 16 7.583333 5.010363 7 4 1.1666667 7 4 1 3 NA grey20
## 17 6.416667 5.010363 7 4 1.1666667 7 4 1 3 NA grey20
## 18 5.833333 4.000000 7 4 1.1666667 7 4 1 3 NA grey20
## 19 6.416667 2.989637 7 4 1.1666667 7 4 1 3 NA grey20
## 20 7.583333 2.989637 7 4 1.1666667 7 4 1 3 NA grey20
## 21 8.166667 4.000000 7 4 1.1666667 7 4 1 3 NA grey20
## 22 8.166667 22.000000 7 22 1.1666667 7 22 1 4 NA grey20
## 23 7.583333 23.010363 7 22 1.1666667 7 22 1 4 NA grey20
## 24 6.416667 23.010363 7 22 1.1666667 7 22 1 4 NA grey20
## 25 5.833333 22.000000 7 22 1.1666667 7 22 1 4 NA grey20
## 26 6.416667 20.989637 7 22 1.1666667 7 22 1 4 NA grey20
## 27 7.583333 20.989637 7 22 1.1666667 7 22 1 4 NA grey20
## 28 8.166667 22.000000 7 22 1.1666667 7 22 1 4 NA grey20
## 29 9.333333 16.000000 8 16 1.3333333 8 16 1 5 NA grey20
## 30 8.666667 17.154701 8 16 1.3333333 8 16 1 5 NA grey20
## 31 7.333333 17.154701 8 16 1.3333333 8 16 1 5 NA grey20
## 32 6.666667 16.000000 8 16 1.3333333 8 16 1 5 NA grey20
## 33 7.333333 14.845299 8 16 1.3333333 8 16 1 5 NA grey20
## 34 8.666667 14.845299 8 16 1.3333333 8 16 1 5 NA grey20
## 35 9.333333 16.000000 8 16 1.3333333 8 16 1 5 NA grey20
## linewidth linetype alpha
## 1 0.5 1 0.2
## 2 0.5 1 0.2
## 3 0.5 1 0.2
## 4 0.5 1 0.2
## 5 0.5 1 0.2
## 6 0.5 1 0.2
## 7 0.5 1 0.2
## 8 0.5 1 0.2
## 9 0.5 1 0.2
## 10 0.5 1 0.2
## 11 0.5 1 0.2
## 12 0.5 1 0.2
## 13 0.5 1 0.2
## 14 0.5 1 0.2
## 15 0.5 1 0.2
## 16 0.5 1 0.2
## 17 0.5 1 0.2
## 18 0.5 1 0.2
## 19 0.5 1 0.2
## 20 0.5 1 0.2
## 21 0.5 1 0.2
## 22 0.5 1 0.2
## 23 0.5 1 0.2
## 24 0.5 1 0.2
## 25 0.5 1 0.2
## 26 0.5 1 0.2
## 27 0.5 1 0.2
## 28 0.5 1 0.2
## 29 0.5 1 0.2
## 30 0.5 1 0.2
## 31 0.5 1 0.2
## 32 0.5 1 0.2
## 33 0.5 1 0.2
## 34 0.5 1 0.2
## 35 0.5 1 0.2baseplot +
aes(fill = speed > 6) +
geom_circle(n = 7, alpha = .2) ->
p2
layer_data(p2, 2)## Warning in data$r * cos(angles): longer object length is not a multiple of
## shorter object length## Warning in data$x0 + data$r * cos(angles): longer object length is not a
## multiple of shorter object length## Warning in data$r * sin(angles): longer object length is not a multiple of
## shorter object length## Warning in data$y0 + data$r * sin(angles): longer object length is not a
## multiple of shorter object length## Warning: Computation failed in `stat_circle()`
## Caused by error in `data.frame()`:
## ! arguments imply differing number of rows: 7, 2## data frame with 0 columns and 0 rows