geom circle
Evangeline Reynolds
8/6/2022
R Markdown
knitr::include_graphics("step0geomcircle.png")library(ggplot2)
radius <- 10
x0 <- 4
y0 <- 2
angles <- seq(0, 2*pi, length.out = 200)
circle <- data.frame(
x = cos(angles) * radius + x0,
y = sin(angles) * radius + y0
)
ggplot(circle) +
geom_polygon(aes(x, y),
fill = 'forestgreen',
colour = 'black') +
coord_fixed()
knitr::include_graphics("step1computation.png")
create_circle <- function(data, n){
angles <- seq(from = 0, to = 2*pi,length.out = n+1)
data.frame()
}knitr::include_graphics("step2ggproto.png")
library(ggplot2)
library(tidyverse)## ── Attaching core tidyverse packages ─────────────────── tidyverse 2.0.0.9000 ──
## ✔ dplyr 1.1.0 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ lubridate 1.9.2 ✔ tibble 3.2.1
## ✔ purrr 1.0.1 ✔ tidyr 1.3.0
## ── 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 errorsmy_setup <- function(data, params){
if(data$group[1] == -1){
nrows <- nrow(data)
data$group <- seq_len(nrows)
}
data
}
cars %>%
mutate(group = -1L) %>% # specifies
my_setup()## speed dist group
## 1 4 2 1
## 2 4 10 2
## 3 7 4 3
## 4 7 22 4
## 5 8 16 5
## 6 9 10 6
## 7 10 18 7
## 8 10 26 8
## 9 10 34 9
## 10 11 17 10
## 11 11 28 11
## 12 12 14 12
## 13 12 20 13
## 14 12 24 14
## 15 12 28 15
## 16 13 26 16
## 17 13 34 17
## 18 13 34 18
## 19 13 46 19
## 20 14 26 20
## 21 14 36 21
## 22 14 60 22
## 23 14 80 23
## 24 15 20 24
## 25 15 26 25
## 26 15 54 26
## 27 16 32 27
## 28 16 40 28
## 29 17 32 29
## 30 17 40 30
## 31 17 50 31
## 32 18 42 32
## 33 18 56 33
## 34 18 76 34
## 35 18 84 35
## 36 19 36 36
## 37 19 46 37
## 38 19 68 38
## 39 20 32 39
## 40 20 48 40
## 41 20 52 41
## 42 20 56 42
## 43 20 64 43
## 44 22 66 44
## 45 23 54 45
## 46 24 70 46
## 47 24 92 47
## 48 24 93 48
## 49 24 120 49
## 50 25 85 50my_setup <- function(data, params) {
if (anyDuplicated(data$group)) {
data$group <- paste(data$group, seq_len(nrow(data)), sep = "-")
}
data
}
cars %>%
mutate(group = -1L) %>%
my_setup()## speed dist group
## 1 4 2 -1-1
## 2 4 10 -1-2
## 3 7 4 -1-3
## 4 7 22 -1-4
## 5 8 16 -1-5
## 6 9 10 -1-6
## 7 10 18 -1-7
## 8 10 26 -1-8
## 9 10 34 -1-9
## 10 11 17 -1-10
## 11 11 28 -1-11
## 12 12 14 -1-12
## 13 12 20 -1-13
## 14 12 24 -1-14
## 15 12 28 -1-15
## 16 13 26 -1-16
## 17 13 34 -1-17
## 18 13 34 -1-18
## 19 13 46 -1-19
## 20 14 26 -1-20
## 21 14 36 -1-21
## 22 14 60 -1-22
## 23 14 80 -1-23
## 24 15 20 -1-24
## 25 15 26 -1-25
## 26 15 54 -1-26
## 27 16 32 -1-27
## 28 16 40 -1-28
## 29 17 32 -1-29
## 30 17 40 -1-30
## 31 17 50 -1-31
## 32 18 42 -1-32
## 33 18 56 -1-33
## 34 18 76 -1-34
## 35 18 84 -1-35
## 36 19 36 -1-36
## 37 19 46 -1-37
## 38 19 68 -1-38
## 39 20 32 -1-39
## 40 20 48 -1-40
## 41 20 52 -1-41
## 42 20 56 -1-42
## 43 20 64 -1-43
## 44 22 66 -1-44
## 45 23 54 -1-45
## 46 24 70 -1-46
## 47 24 92 -1-47
## 48 24 93 -1-48
## 49 24 120 -1-49
## 50 25 85 -1-50my_compute_panel <- function(data, scales, n = 5, r = 1){
angles <- seq(
from = 0,
to = 2*pi,
length.out = n + 1
)
nrows = nrow(data)
df <- data.frame()
for(i in 1:nrows){
bind_rows(df,
data.frame(
x = cos(angles) * data$r[i] + data$x0[i],
y = cos(angles) * data$r[i] + data$y0[i],
group = i
)
) ->
df
}
}
cars %>%
rename(x0 = dist) %>%
rename(y0 = speed) %>%
mutate(r = y0/12) %>%
my_compute_panel
StatCircle <- ggproto(`_class` = 'StatCircle',
`_inherit` = Stat,
setup_data = my_setup,
compute_panel = my_compute_panel,
required_aes = c('x0', 'y0', 'r'))
geom_circle <- function(mapping = NULL, data = NULL, stat = "circle",
position = "identity", ..., r = 1,
n = 50, arrow = NULL, 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(
r = r,
n = n,
arrow = arrow,
lineend = lineend,
linejoin = linejoin,
na.rm = na.rm,
...
)
)
}
ggplot(cars) +
aes(x = speed) +
aes(y = dist) +
geom_point() +
aes(r = dist, x0 = speed, y0 = dist) +
geom_circle()## Warning in geom_circle(): Ignoring unknown parameters: `arrow`
https://evamaerey.github.io/flipbooks/extending_ggplot2.html#86
library(ggplot2)
library(tidyverse)
create_circle <- function(x0, y0, r = 1, n = 100){
angels <- seq(
from = 0,
to = 2*pi,
length.out = n + 1
)
data.frame(
x = cos(angels) * r + x0,
y = sin(angels) * r + y0
)
}
the_compute_panel <- function(data, scales, r = 1, n = 50) {
cols_to_keep <- setdiff(names(data), c("x0", "y0"))
circles <- lapply(seq_len(nrow(data)), function(i) {
circles_path <- create_circle(data$x0[i], data$y0[i], data$r[i], n)
cbind(circles_path, unclass(data[i, cols_to_keep]))
})
do.call(rbind, circles)
}
cars %>%
.[1:2,] %>%
rename(x0 = speed) %>%
rename(y0 = dist) %>%
mutate(r = y0) %>%
mutate(group = row_number()) %>%
the_compute_panel(n = 5)## x y r group
## 1 6.000000 2.00000000 2 1
## 2 4.618034 3.90211303 2 1
## 3 2.381966 3.17557050 2 1
## 4 2.381966 0.82442950 2 1
## 5 4.618034 0.09788697 2 1
## 6 6.000000 2.00000000 2 1
## 7 14.000000 10.00000000 10 2
## 8 7.090170 19.51056516 10 2
## 9 -4.090170 15.87785252 10 2
## 10 -4.090170 4.12214748 10 2
## 11 7.090170 0.48943484 10 2
## 12 14.000000 10.00000000 10 2the_setup_data <- function(data, params) {
if (anyDuplicated(data$group)) {
data$group <- paste(data$group, seq_len(nrow(data)), sep = "-")
}
data
}
cars %>%
.[1:2,] %>%
mutate(group = row_number()) %>%
the_setup_data()## speed dist group
## 1 4 2 1
## 2 4 10 2StatCircle <- ggproto("StatCircle", Stat,
# setup_params = function(data, params) {
# if (is.null(params$r)) {
# params$r <- 1
# } else if (params$r == 0) {
# rlang::abort("Circles cannot be defined with a radius of 0")
# }
# if (is.null(params$n)) {
# params$n <- 50
# } else if (params$n <= 0) {
# rlang::abort("Circles must be defined with `n` greater than 0")
# }
# params
# },
setup_data = the_setup_data,
compute_panel = the_compute_panel,
required_aes = c("x0", "y0", "r")
)
geom_circle <- function(mapping = NULL, data = NULL, stat = "circle",
position = "identity", ..., r = 1,
n = 50, arrow = NULL, 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(
r = r,
n = n,
arrow = arrow,
lineend = lineend,
linejoin = linejoin,
na.rm = na.rm,
...
)
)
}
set.seed(1244)
cars %>%
.[1:5,] %>%
ggplot() +
aes(x = speed, y = dist) +
geom_point() +
aes(x0 = speed, y0 = dist, r = dist^.5) +
geom_circle(n = 3, alpha = .2) +
geom_circle(n = 13, alpha = .2) +
geom_circle(r = 2, alpha = .2) +
geom_circle(alpha = .2)## Warning in geom_circle(n = 3, alpha = 0.2): Ignoring unknown parameters:
## `arrow`## Warning in geom_circle(n = 13, alpha = 0.2): Ignoring unknown parameters:
## `arrow`## Warning in geom_circle(r = 2, alpha = 0.2): Ignoring unknown parameters:
## `arrow`## Warning in geom_circle(alpha = 0.2): Ignoring unknown parameters: `arrow`## Warning: Duplicated aesthetics after name standardisation: x and y
## Duplicated aesthetics after name standardisation: x and y
## Duplicated aesthetics after name standardisation: x and y
## Duplicated aesthetics after name standardisation: x and y## Warning in validDetails.polygon(x): NAs introduced by coercion
## Warning in validDetails.polygon(x): NAs introduced by coercion
## Warning in validDetails.polygon(x): NAs introduced by coercion
## Warning in validDetails.polygon(x): NAs introduced by coercion
layer_data(last_plot(), 2)## Warning: Duplicated aesthetics after name standardisation: x and y## Warning: Duplicated aesthetics after name standardisation: x and y
## Duplicated aesthetics after name standardisation: x and y
## Duplicated aesthetics after name standardisation: x and y## x y r x.1 y.1 PANEL group colour fill linewidth
## 1 5.414214 2.0000000 1.414214 4 2 1 -1-1 NA grey20 0.5
## 2 3.292893 3.2247449 1.414214 4 2 1 -1-1 NA grey20 0.5
## 3 3.292893 0.7752551 1.414214 4 2 1 -1-1 NA grey20 0.5
## 4 5.414214 2.0000000 1.414214 4 2 1 -1-1 NA grey20 0.5
## 5 7.162278 10.0000000 3.162278 4 10 1 -1-2 NA grey20 0.5
## 6 2.418861 12.7386128 3.162278 4 10 1 -1-2 NA grey20 0.5
## 7 2.418861 7.2613872 3.162278 4 10 1 -1-2 NA grey20 0.5
## 8 7.162278 10.0000000 3.162278 4 10 1 -1-2 NA grey20 0.5
## 9 9.000000 4.0000000 2.000000 7 4 1 -1-3 NA grey20 0.5
## 10 6.000000 5.7320508 2.000000 7 4 1 -1-3 NA grey20 0.5
## 11 6.000000 2.2679492 2.000000 7 4 1 -1-3 NA grey20 0.5
## 12 9.000000 4.0000000 2.000000 7 4 1 -1-3 NA grey20 0.5
## 13 11.690416 22.0000000 4.690416 7 22 1 -1-4 NA grey20 0.5
## 14 4.654792 26.0620192 4.690416 7 22 1 -1-4 NA grey20 0.5
## 15 4.654792 17.9379808 4.690416 7 22 1 -1-4 NA grey20 0.5
## 16 11.690416 22.0000000 4.690416 7 22 1 -1-4 NA grey20 0.5
## 17 12.000000 16.0000000 4.000000 8 16 1 -1-5 NA grey20 0.5
## 18 6.000000 19.4641016 4.000000 8 16 1 -1-5 NA grey20 0.5
## 19 6.000000 12.5358984 4.000000 8 16 1 -1-5 NA grey20 0.5
## 20 12.000000 16.0000000 4.000000 8 16 1 -1-5 NA grey20 0.5
## linetype alpha
## 1 1 0.2
## 2 1 0.2
## 3 1 0.2
## 4 1 0.2
## 5 1 0.2
## 6 1 0.2
## 7 1 0.2
## 8 1 0.2
## 9 1 0.2
## 10 1 0.2
## 11 1 0.2
## 12 1 0.2
## 13 1 0.2
## 14 1 0.2
## 15 1 0.2
## 16 1 0.2
## 17 1 0.2
## 18 1 0.2
## 19 1 0.2
## 20 1 0.2