-
Notifications
You must be signed in to change notification settings - Fork 308
/
shadow-wake.R
148 lines (145 loc) · 6.17 KB
/
shadow-wake.R
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
#' Show preceding frames with gradual falloff
#'
#' This shadow is meant to draw a small wake after data by showing the latest
#' frames up to the current. You can choose to gradually diminish the size
#' and/or opacity of the shadow. The length of the wake is not given in absolute
#' frames as that would make the animation susceptible to changes in the
#' framerate. Instead it is given as a proportion of the total length of the
#' animation.
#'
#' @param wake_length A number between 0 and 1 giving the length of the wake,
#' in relation to the total number of frames.
#' @param size Numeric indicating the size the wake should end on. If `NULL`
#' then size is not modified. Can also be a boolean with `TRUE` beeing equal `0`
#' and `FALSE` beeing equal to `NULL`
#' @param alpha as `size` but for alpha modification of the wake
#' @param colour,fill colour or fill the wake should end on. If `NULL` they are
#' not modified.
#' @param falloff An easing function that control how size and/or alpha should
#' change.
#' @param wrap Should the shadow wrap around, so that the first frame will get
#' shadows from the end of the animation.
#' @param exclude_layer Indexes of layers that should be excluded.
#' @param exclude_phase Element phases that should not get a shadow. Possible
#' values are `'enter'`, `'exit'`, `'static'`, `'transition'`, and `'raw'`. If
#' `NULL` all phases will be included. Defaults to `'enter'` and `'exit'`
#'
#' @family shadows
#'
#' @importFrom ggplot2 ggproto
#' @export
#'
#' @examples
#' anim <- ggplot(iris, aes(Petal.Length, Sepal.Length)) +
#' geom_point() +
#' labs(title = "{closest_state}") +
#' transition_states(Species, transition_length = 4, state_length = 1)
#'
#' # `shadow_wake` can be combined with e.g. `transition_states` to show
#' # motion of geoms as they are in transition with respect to the selected state.
#' anim1 <- anim +
#' shadow_wake(wake_length = 0.05)
#'
#' # Different qualities can be manipulated by setting a value for it that it
#' # should taper off to
#' anim2 <- anim +
#' shadow_wake(0.1, size = 10, alpha = FALSE, colour = 'grey92')
#'
#' # Use `detail` in the `animate()` call to increase the number of calculated
#' # frames and thus make the wake smoother
#' \dontrun{
#' animate(anim2, detail = 5)
#' }
#'
shadow_wake <- function(wake_length, size = TRUE, alpha = TRUE, colour = NULL, fill = NULL, falloff = 'cubic-in', wrap = TRUE, exclude_layer = NULL, exclude_phase = c('enter', 'exit')) {
if (is_logical(size)) size <- if (size) 0 else NULL
if (is_logical(alpha)) alpha <- if (alpha) 0 else NULL
ggproto(NULL, ShadowWake,
exclude_layer = exclude_layer,
params = list(
wake_length = wake_length,
colour = colour,
fill = fill,
size = size,
alpha = alpha,
falloff = falloff,
wrap = wrap,
exclude_phase = exclude_phase
)
)
}
#' @rdname gganimate-ggproto
#' @format NULL
#' @usage NULL
#' @export
#' @importFrom ggplot2 ggproto
#' @importFrom tweenr tween_at
ShadowWake <- ggproto('ShadowWake', Shadow,
setup_params = function(self, data, params) {
params$wake_length <- round(params$nframes * params$wake_length)
params$at <- seq(0, 1, length = params$wake_length + 1)[seq_len(params$wake_length)]
params
},
get_frames = function(self, params, i) {
frames <- rev(i - seq_len(params$wake_length))
if (params$wrap) {
frames <- frames %% params$nframes
frames[frames == 0] <- params$nframes
} else {
frames <- frames[frames > 0 & frames <= params$nframes]
}
frames
},
prepare_shadow = function(self, shadow, params) {
lapply(shadow, function(d) {
if (length(d) == 0) return(NULL)
i <- rep(params$at[seq_along(d)], vapply(d, nrow, integer(1)))
d <- vec_rbind0(!!!d)
if (!is.null(params$colour)) {
if (!is.null(d$colour)) d$colour <- tween_at(params$colour, d$colour, i, params$falloff)
if (!is.null(d$edge_colour)) d$edge_colour <- tween_at(params$colour, d$edge_colour, i, params$falloff)
}
if (!is.null(params$fill)) {
if (!is.null(d$fill)) d$colour <- tween_at(params$fill, d$fill, i, params$falloff)
if (!is.null(d$edge_fill)) d$edge_fill <- tween_at(params$fill, d$edge_fill, i, params$falloff)
}
if (!is.null(params$alpha)) {
if (!is.null(d$edge_alpha)) {
no_alpha <- is.na(d$edge_alpha)
d$edge_alpha[!no_alpha] <- tween_at(params$alpha, d$edge_alpha[!no_alpha], i, params$falloff)
} else if (!is.null(d$alpha)) {
no_alpha <- is.na(d$alpha)
d$alpha[!no_alpha] <- tween_at(params$alpha, d$alpha[!no_alpha], i, params$falloff)
} else {
no_alpha <- TRUE
}
if (!is.null(d$colour)) d$colour[no_alpha] <- mod_alpha(d$colour[no_alpha], i, params$alpha, params$falloff)
if (!is.null(d$fill)) d$fill[no_alpha] <- mod_alpha(d$fill[no_alpha], i, params$alpha, params$falloff)
if (!is.null(d$edge_colour)) d$edge_colour[no_alpha] <- mod_alpha(d$edge_colour[no_alpha], i, params$alpha, params$falloff)
if (!is.null(d$edge_fill)) d$edge_fill[no_alpha] <- mod_alpha(d$edge_fill[no_alpha], i, params$alpha, params$falloff)
}
if (!is.null(params$size)) {
if (!is.null(d$size)) d$size <- tween_at(params$size, d$size, i, params$falloff)
if (!is.null(d$edge_size)) d$edge_size <- tween_at(params$size, d$edge_size, i, params$falloff)
if (!is.null(d$edge_width)) d$edge_width <- tween_at(params$size, d$edge_width, i, params$falloff)
if (!is.null(d$stroke)) d$stroke <- tween_at(params$size, d$stroke, i, params$falloff)
}
d
})
},
prepare_frame_data = function(self, data, shadow, params, frame_ind, shadow_ind) {
Map(function(d, s, e) {
if (e) return(d[[1]])
ids <- d[[1]]$.id[!d[[1]]$.phase %in% params$exclude_phase]
s <- s[s$.id %in% ids, , drop = FALSE]
d <- vec_rbind0(s, d[[1]])
d[order(match(d$.id, unique0(d$.id))), , drop = FALSE]
}, d = data, s = shadow, e = seq_along(data) %in% params$excluded_layers)
}
)
#' @importFrom scales alpha
#' @importFrom grDevices col2rgb
mod_alpha <- function(col, i, end, ease) {
alpha <- col2rgb(col, TRUE)[4,] / 255
alpha(col, tween_at(end, alpha, i, ease))
}