1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
#' Some different geometries to play with
#'
#' These functions are provided to allow you to play with somee simple shapes as
#' you explore `transformr` and are also used in the examples for the different
#' tween functions. All geometries can be returned as either a standard
#' `data.frame` with `x`, `y`, and `id` column, or as an sf geometry of the
#' appropriate type.
#'
#' @param st Logical. Should the geometry be returned as an `sf` feature?
#' @param detail The number of points defining the shape
#' @param n For `poly_circles` the number of circles, for `poly_star` and
#' `poly_star_hole` the number of 'arms', and for `point_random` the number of
#' points
#' @param r,r1 The radius of the geometry. `r` gives the radius of the circles
#' in `poly_circles` and `r1` gives the inner radius for
#' `poly_star`/`poly_star_hole`, thus determining how pointy it is
#' @param windings The number of revolutions in the spiral
#' @param w1,w2 The frequency for the two sine waves
#' @param dim the number of rows and columns in the grid
#'
#' @return Either a data.frame or an sf feature depending on the value of `st`
#'
#' @name simple_shapes
#' @rdname simple_shapes
#'
#' @examples
#' # Create a 7-pointed star
#' poly_star(n = 7)
#'
NULL
#' @rdname simple_shapes
#' @export
poly_circle <- function(st = FALSE, detail = 360) {
i <- seq(0, 2*pi, length.out = detail+1)[-detail-1]
x <- sin(i)
y = cos(i)
if (st) {
st_polygon(list(cbind(x, y)[c(seq_len(detail), 1), , drop = FALSE]))
} else {
data_frame(x = x, y = y, id = 1L)
}
}
#' @rdname simple_shapes
#' @importFrom sf st_multipolygon
#' @export
poly_circles <- function(st = FALSE, n = 3, r = 0.25, detail = 360) {
i <- seq(0, 2*pi, length.out = n+1)[-n-1]
x <- sin(i)
y = cos(i)
d <- poly_circle(detail = detail)
d_small <- d
d_small$x <- d_small$x * r
d_small$y <- d_small$y * r
d1 <- d_small
d2 <- d_small
d3 <- d_small
d1$x <- d1$x + x[1]
d1$y <- d1$y + y[1]
d2$x <- d2$x + x[2]
d2$y <- d2$y + y[2]
d2$id <- 2L
d3$x <- d3$x + x[3]
d3$y <- d3$y + y[3]
d3$id <- 3L
if (st) {
st_multipolygon(list(
list(cbind(d1$x, d1$y)[c(seq_len(360), 1), , drop = FALSE]),
list(cbind(d2$x, d2$y)[c(seq_len(360), 1), , drop = FALSE]),
list(cbind(d3$x, d3$y)[c(seq_len(360), 1), , drop = FALSE])
))
} else {
vec_rbind(d1,d2,d3)
}
}
#' @rdname simple_shapes
#' @export
poly_star <- function(st = FALSE, n = 5, r1 = 0.5) {
d <- poly_circle(detail = n*2)
d$x[c(FALSE, TRUE)] <- d$x[c(FALSE, TRUE)] * r1
d$y[c(FALSE, TRUE)] <- d$y[c(FALSE, TRUE)] * r1
if (st) {
d <- st_polygon(list(cbind(d$x, d$y)[c(seq_len(n*2), 1), , drop = FALSE]))
}
d
}
#' @rdname simple_shapes
#' @export
poly_star_hole <- function(st = FALSE, n = 5, r1 = 0.5) {
d <- poly_star(n = n, r1 = r1)
d1 <- d
d1$x <- d1$x * 0.5
d1$y <- d1$y * 0.5
if (st) {
st_polygon(list(
cbind(d$x, d$y)[c(seq_len(n*2), 1), , drop = FALSE],
cbind(d1$x, d1$y)[c(seq_len(n*2), 1), , drop = FALSE]
))
} else {
vec_rbind(
d,
data_frame(x = NA, y = NA, id = 1L),
d1
)
}
}
#' @rdname simple_shapes
#' @export
path_spiral <- function(st = FALSE, windings = 5) {
n = 50 * windings
r = seq(0, 1, length.out = n)
i <- seq(0, 2*pi*windings, length.out = n+1)[-n-1]
x <- sin(i) * r
y <- cos(i) * r
if (st) {
st_linestring(cbind(x, y))
} else {
data_frame(x = x, y = y, id = 1L)
}
}
#' @rdname simple_shapes
#' @export
path_waves <- function(st = FALSE, w1 = 7, w2 = 11) {
x <- seq(-1, 1, length.out = 150)
y1 = 0.2*sin(w1*x) + 0.5
y2 = 0.2*sin(w2*x) - 0.5
if (st) {
st_multilinestring(list(
cbind(x, y1),
cbind(x, y2)
))
} else {
data_frame(x = rep(x, 2), y = c(y1, y2), id = rep(c(1L, 2L), each = length(x)))
}
}
#' @rdname simple_shapes
#' @export
#' @importFrom sf st_multipoint
#' @importFrom stats runif
point_random <- function(st = FALSE, n = 10) {
x <- runif(10, min = -1, max = 1)
y <- runif(10, min = -1, max = 1)
if (st) {
st_multipoint(cbind(x, y))
} else {
data_frame(x = x, y = y, i = seq_len(n))
}
}
#' @rdname simple_shapes
#' @export
#' @importFrom sf st_multipoint
point_grid <- function(st = FALSE, dim = 5) {
x <- rep(seq(-1, 1, length.out = dim), each = dim)
y <- rep(seq(-1, 1, length.out = dim), dim)
if (st) {
st_multipoint(cbind(x, y))
} else {
data_frame(x = x, y = y, i = seq_len(dim^2))
}
}
|
