Codebase list r-cran-tweenr / 7216479
New upstream version 1.0.1 Joost van Baal-Ilić 4 years ago
59 changed file(s) with 5391 addition(s) and 0 deletion(s). Raw diff Collapse all Expand all
+29
-0
DESCRIPTION less more
0 Package: tweenr
1 Type: Package
2 Title: Interpolate Data for Smooth Animations
3 Version: 1.0.1
4 Date: 2018-12-14
5 Authors@R: c(
6 person('Thomas Lin', 'Pedersen', , 'thomasp85@gmail.com', c('aut', 'cre'))
7 )
8 Maintainer: Thomas Lin Pedersen <thomasp85@gmail.com>
9 Description: In order to create smooth animation between states of data,
10 tweening is necessary. This package provides a range of functions for
11 creating tweened data that can be used as basis for animation. Furthermore
12 it adds a number of vectorized interpolaters for common R data
13 types such as numeric, date and colour.
14 URL: https://github.com/thomasp85/tweenr
15 BugReports: https://github.com/thomasp85/tweenr/issues
16 License: MIT + file LICENSE
17 Encoding: UTF-8
18 LazyData: TRUE
19 Depends: R (>= 3.2.0)
20 Imports: Rcpp (>= 0.12.3), grDevices, farver, magrittr, rlang
21 LinkingTo: Rcpp
22 RoxygenNote: 6.1.1
23 Suggests: testthat, covr
24 NeedsCompilation: yes
25 Packaged: 2018-12-14 13:16:06 UTC; thomas
26 Author: Thomas Lin Pedersen [aut, cre]
27 Repository: CRAN
28 Date/Publication: 2018-12-14 13:40:03 UTC
+2
-0
LICENSE less more
0 YEAR: 2018
1 COPYRIGHT HOLDER: Thomas Lin Pedersen
+58
-0
MD5 less more
0 6e6fd070981b4da1e4ff6d549960fd66 *DESCRIPTION
1 928d886d4e8454f3db823a37d4de465f *LICENSE
2 1ce9ebcadbe312056258a8f41326b685 *NAMESPACE
3 313d3adca091ef0a5997a0bf74c05e61 *R/RcppExports.R
4 1bdc1df668054061a499fd86dbeef5ab *R/aaa.R
5 16501add0944b61f30d83e263b8e8d1d *R/display_ease.R
6 96179175a1b2714715bd51272b167f8b *R/interpolate_along.R
7 210b74ecfb81b7e59ad62d60411065fe *R/interpolate_at.R
8 0a8e1bd6c209027fa880190dcb0801d3 *R/interpolate_element.R
9 cc10f6bda97ee4a5b9482fadfe58c7e0 *R/interpolate_fill.R
10 fa58c8bac6ab8f305f19c81a75fc0730 *R/interpolate_state.R
11 689f558411e69e41e4e75f5369aeaf60 *R/tween.R
12 ac339e3835e902f17f662884605697e6 *R/tween_along.R
13 2d43ff320e0f18cae6f4d62fce5d9c94 *R/tween_appear.R
14 641fea63107e6850430abe0e1de68b73 *R/tween_at.R
15 a0fb7bf5931f79cdc9b3fe258a1b7af5 *R/tween_colour.R
16 9721b0743f541b5c29e1e03e150fd861 *R/tween_components.R
17 e2bf81312be495522d36feace8ca4291 *R/tween_constant.R
18 81d553e0dabc78640045286414615d9c *R/tween_date.R
19 c043ef5f53d196435d92b7502733ed98 *R/tween_datetime.R
20 c3d9bd610ec0ebf6843938b52ba9a238 *R/tween_elements.R
21 ead890774e462247a42cff161142c73d *R/tween_events.R
22 8d2d40175112d9250bbf643846105c5f *R/tween_fill.R
23 3fbebb9b93bfc70f98c8d4da699a7517 *R/tween_numeric.R
24 391009a63a320512bafdfc940d0aa50e *R/tween_state.R
25 812405ce92dfc8a9e81a5a823894cc10 *R/tween_states.R
26 96d0cc4763f6e260723404181527692d *R/tweenr_package.R
27 7c25a1760eb4d2c1eaad187a63f8792a *README.md
28 a7d5791f172a3bec357efeb97420bb15 *man/display_ease.Rd
29 34366927919391bd1a708125f2175dd4 *man/dot-complete_states.Rd
30 4c6856bef70b38658bdb9adf438ddbf8 *man/dot-get_last_frame.Rd
31 822defaec9293e5bce6728c6bfcecddc *man/dot-max_id.Rd
32 690fc06d8dff1acdfe0bd31a3475408c *man/figures/README-unnamed-chunk-3.gif
33 2dadfaa78bd7bc38097a1be9fbd75780 *man/figures/README-unnamed-chunk-4-1.png
34 a43cef038c756170afdfda6598b4886c *man/figures/logo.png
35 4bfb05de15f5ea7ad46e96577a2bedcc *man/reexports.Rd
36 d8719148815e87dbba9859db35580d4c *man/tween.Rd
37 bc68775c38b034cc4d24deae25a6ecac *man/tween_along.Rd
38 f3ac36b46eda0ed8ebdb82a6f3856c2d *man/tween_appear.Rd
39 5ae8335a6fb227f5334ca7e2d863aa99 *man/tween_at.Rd
40 bad8b26b955f205ab8f06dd0aaf6fb73 *man/tween_components.Rd
41 9a85615c0e8118222f300eeacc37bda0 *man/tween_elements.Rd
42 ce4b2a862ea15359ed9b0ef3bc606e05 *man/tween_events.Rd
43 27b0ed281713d21cae636526fe08fb06 *man/tween_fill.Rd
44 45a6c662bde72d3ca31f6f128ce0c17f *man/tween_state.Rd
45 a78da1ea3e528145730e1e63624b919a *man/tween_states.Rd
46 8655be1ce7f753485c94e2e4cdee6066 *man/tweenr-package.Rd
47 ec84e616c2be105b238e96a615188688 *src/RcppExports.cpp
48 bef46ca72aef6dffb9ae1fc728aef864 *src/easing.c
49 20db4b5dfde1a8274bafe699cb5b5cc4 *src/easing.h
50 6e674ad562cd298af44d1e801ea6b510 *src/interpolators.cpp
51 aa895b44ba533f702387d9ec557e501a *tests/testthat.R
52 642f1ef1e7a912267fc9891a21216cc4 *tests/testthat/test-along.R
53 ee87f10b41a70e3ca3ef3e90f5e1a505 *tests/testthat/test-at.R
54 925c0539a4fdf0c24b2344cd0cadb0ab *tests/testthat/test-components.R
55 7d3b896a697948cda844ebdc6f0188ef *tests/testthat/test-events.R
56 6159b10fcca398bb4731d00bfa6b6342 *tests/testthat/test-fill.R
57 8801c912dc4fa55e6074f6e0eee83f2d *tests/testthat/test-state.R
+50
-0
NAMESPACE less more
0 # Generated by roxygen2: do not edit by hand
1
2 export("%>%")
3 export(.complete_states)
4 export(.get_first_frame)
5 export(.get_last_frame)
6 export(.has_frames)
7 export(.max_id)
8 export(.with_later_frames)
9 export(.with_prior_frames)
10 export(close_state)
11 export(display_ease)
12 export(keep_state)
13 export(open_state)
14 export(tween)
15 export(tween_along)
16 export(tween_appear)
17 export(tween_at)
18 export(tween_color)
19 export(tween_color_t)
20 export(tween_colour)
21 export(tween_colour_t)
22 export(tween_components)
23 export(tween_constant)
24 export(tween_constant_t)
25 export(tween_date)
26 export(tween_date_t)
27 export(tween_datetime)
28 export(tween_datetime_t)
29 export(tween_elements)
30 export(tween_events)
31 export(tween_fill)
32 export(tween_numeric)
33 export(tween_numeric_t)
34 export(tween_state)
35 export(tween_states)
36 export(tween_t)
37 importFrom(Rcpp,sourceCpp)
38 importFrom(farver,convert_colour)
39 importFrom(grDevices,col2rgb)
40 importFrom(grDevices,rgb)
41 importFrom(graphics,plot)
42 importFrom(magrittr,"%>%")
43 importFrom(rlang,"%||%")
44 importFrom(rlang,enquo)
45 importFrom(rlang,eval_tidy)
46 importFrom(rlang,quo_is_missing)
47 importFrom(rlang,quo_is_null)
48 importFrom(utils,head)
49 useDynLib(tweenr)
+115
-0
R/RcppExports.R less more
0 # Generated by using Rcpp::compileAttributes() -> do not edit by hand
1 # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
2
3 numeric_state_interpolator <- function(data, states) {
4 .Call('_tweenr_numeric_state_interpolator', PACKAGE = 'tweenr', data, states)
5 }
6
7 colour_state_interpolator <- function(data, states) {
8 .Call('_tweenr_colour_state_interpolator', PACKAGE = 'tweenr', data, states)
9 }
10
11 constant_state_interpolator <- function(data, states) {
12 .Call('_tweenr_constant_state_interpolator', PACKAGE = 'tweenr', data, states)
13 }
14
15 list_state_interpolator <- function(data, states) {
16 .Call('_tweenr_list_state_interpolator', PACKAGE = 'tweenr', data, states)
17 }
18
19 numlist_state_interpolator <- function(data, states) {
20 .Call('_tweenr_numlist_state_interpolator', PACKAGE = 'tweenr', data, states)
21 }
22
23 phase_state_interpolator <- function(data, states) {
24 .Call('_tweenr_phase_state_interpolator', PACKAGE = 'tweenr', data, states)
25 }
26
27 numeric_element_interpolator <- function(data, group, frame, ease) {
28 .Call('_tweenr_numeric_element_interpolator', PACKAGE = 'tweenr', data, group, frame, ease)
29 }
30
31 colour_element_interpolator <- function(data, group, frame, ease) {
32 .Call('_tweenr_colour_element_interpolator', PACKAGE = 'tweenr', data, group, frame, ease)
33 }
34
35 constant_element_interpolator <- function(data, group, frame, ease) {
36 .Call('_tweenr_constant_element_interpolator', PACKAGE = 'tweenr', data, group, frame, ease)
37 }
38
39 list_element_interpolator <- function(data, group, frame, ease) {
40 .Call('_tweenr_list_element_interpolator', PACKAGE = 'tweenr', data, group, frame, ease)
41 }
42
43 numlist_element_interpolator <- function(data, group, frame, ease) {
44 .Call('_tweenr_numlist_element_interpolator', PACKAGE = 'tweenr', data, group, frame, ease)
45 }
46
47 phase_element_interpolator <- function(data, group, frame, ease) {
48 .Call('_tweenr_phase_element_interpolator', PACKAGE = 'tweenr', data, group, frame, ease)
49 }
50
51 numeric_along_interpolator <- function(data, group, time, history, keep_last, nframes, ease) {
52 .Call('_tweenr_numeric_along_interpolator', PACKAGE = 'tweenr', data, group, time, history, keep_last, nframes, ease)
53 }
54
55 colour_along_interpolator <- function(data, group, time, history, keep_last, nframes, ease) {
56 .Call('_tweenr_colour_along_interpolator', PACKAGE = 'tweenr', data, group, time, history, keep_last, nframes, ease)
57 }
58
59 constant_along_interpolator <- function(data, group, time, history, keep_last, nframes, ease) {
60 .Call('_tweenr_constant_along_interpolator', PACKAGE = 'tweenr', data, group, time, history, keep_last, nframes, ease)
61 }
62
63 list_along_interpolator <- function(data, group, time, history, keep_last, nframes, ease) {
64 .Call('_tweenr_list_along_interpolator', PACKAGE = 'tweenr', data, group, time, history, keep_last, nframes, ease)
65 }
66
67 numlist_along_interpolator <- function(data, group, time, history, keep_last, nframes, ease) {
68 .Call('_tweenr_numlist_along_interpolator', PACKAGE = 'tweenr', data, group, time, history, keep_last, nframes, ease)
69 }
70
71 phase_along_interpolator <- function(group, time, history, keep_last, nframes) {
72 .Call('_tweenr_phase_along_interpolator', PACKAGE = 'tweenr', group, time, history, keep_last, nframes)
73 }
74
75 numeric_at_interpolator <- function(from, to, at, ease) {
76 .Call('_tweenr_numeric_at_interpolator', PACKAGE = 'tweenr', from, to, at, ease)
77 }
78
79 colour_at_interpolator <- function(from, to, at, ease) {
80 .Call('_tweenr_colour_at_interpolator', PACKAGE = 'tweenr', from, to, at, ease)
81 }
82
83 constant_at_interpolator <- function(from, to, at, ease) {
84 .Call('_tweenr_constant_at_interpolator', PACKAGE = 'tweenr', from, to, at, ease)
85 }
86
87 list_at_interpolator <- function(from, to, at, ease) {
88 .Call('_tweenr_list_at_interpolator', PACKAGE = 'tweenr', from, to, at, ease)
89 }
90
91 numlist_at_interpolator <- function(from, to, at, ease) {
92 .Call('_tweenr_numlist_at_interpolator', PACKAGE = 'tweenr', from, to, at, ease)
93 }
94
95 numeric_fill_interpolator <- function(data, ease) {
96 .Call('_tweenr_numeric_fill_interpolator', PACKAGE = 'tweenr', data, ease)
97 }
98
99 colour_fill_interpolator <- function(data, ease) {
100 .Call('_tweenr_colour_fill_interpolator', PACKAGE = 'tweenr', data, ease)
101 }
102
103 constant_fill_interpolator <- function(data, ease) {
104 .Call('_tweenr_constant_fill_interpolator', PACKAGE = 'tweenr', data, ease)
105 }
106
107 list_fill_interpolator <- function(data, ease) {
108 .Call('_tweenr_list_fill_interpolator', PACKAGE = 'tweenr', data, ease)
109 }
110
111 numlist_fill_interpolator <- function(data, ease) {
112 .Call('_tweenr_numlist_fill_interpolator', PACKAGE = 'tweenr', data, ease)
113 }
114
+132
-0
R/aaa.R less more
0 BASEDATE <- Sys.Date() - as.numeric(Sys.Date())
1 BASEDATETIME <- Sys.time() - as.numeric(Sys.time())
2
3 validEase <- c(
4 "linear",
5 "quadratic-in",
6 "quadratic-out",
7 "quadratic-in-out",
8 "cubic-in",
9 "cubic-out",
10 "cubic-in-out",
11 "quartic-in",
12 "quartic-out",
13 "quartic-in-out",
14 "quintic-in",
15 "quintic-out",
16 "quintic-in-out",
17 "sine-in",
18 "sine-out",
19 "sine-in-out",
20 "circular-in",
21 "circular-out",
22 "circular-in-out",
23 "exponential-in",
24 "exponential-out",
25 "exponential-in-out",
26 "elastic-in",
27 "elastic-out",
28 "elastic-in-out",
29 "back-in",
30 "back-out",
31 "back-in-out",
32 "bounce-in",
33 "bounce-out",
34 "bounce-in-out"
35 )
36
37 #' @importFrom magrittr %>%
38 #' @export
39 magrittr::`%>%`
40
41 col_classes <- function(data) {
42 classes <- sapply(data, function(d) {
43 if (is.numeric(d)) {
44 'numeric'
45 } else if (is.logical(d)) {
46 'logical'
47 } else if (is.factor(d)) {
48 'factor'
49 } else if (is.character(d)) {
50 colour <- try(suppressWarnings(col2rgb(d)), silent = TRUE)
51 if (all(is.na(d)) || inherits(colour, 'try-error') || anyNA(colour) || all(grepl('^(\\d|\\.)+$', d))) {
52 'character'
53 } else {
54 'colour'
55 }
56 } else if (inherits(d, 'Date')) {
57 'date'
58 } else if (inherits(d, 'POSIXt')) {
59 'datetime'
60 } else if (is.list(d)) {
61 if (all(vapply(d, is.numeric, logical(1)))) 'numlist'
62 else 'list'
63 } else {
64 'constant'
65 }
66 })
67 names(classes) <- names(data)
68 classes[names(classes) == '.phase'] <- 'phase'
69 classes
70 }
71
72 prepareTween <- function(data, n, ease) {
73 if (!is.list(data)) {
74 data <- as.list(data)
75 }
76 if (length(unique(lengths(data))) != 1) {
77 stop('All elements in data must have the same length')
78 }
79 if (!all(ease %in% validEase)) {
80 stop('ease must be the name of a valid easing function')
81 }
82 n <- c(rep(n, length.out = length(data) - 1) - 1, 1)
83 ease <- c(rep(ease, length.out = length(data) - 1), 'constant')
84 states <- data.frame(
85 state = seq_along(data) - 1,
86 nframes = n,
87 ease = ease,
88 stringsAsFactors = FALSE
89 )
90 list(
91 data = data,
92 states = states
93 )
94 }
95
96 prepareTweenTranspose <- function(data, n, ease) {
97 if (!is.list(data)) {
98 data <- list(data)
99 }
100 if (!all(ease %in% validEase)) {
101 stop('ease must be the name of a valid easing function')
102 }
103 n <- rep(n, length.out = length(data))
104 n <- Map(function(n, l) {
105 s <- floor(n / l)
106 s <- rep(s, l)
107 overhead <- n - sum(s)
108 if (overhead) {
109 s <- s + rep(floor(overhead / l), l)
110 addInd <- sample(length(s), overhead %% l)
111 s[addInd] <- s[addInd] + 1
112 }
113 c(s, 1)
114 }, n = n - 1, l = lengths(data) - 1)
115 n <- unlist(n)
116 ease <- rep(ease, length.out = length(data))
117 ease <- rep(ease, lengths(data) - 1)
118 easeSplit <- split(ease, rep(seq_along(data), lengths(data) - 1))
119 ease <- unlist(lapply(easeSplit, append, values = 'constant'))
120 data <- as.list(unlist(data))
121 states <- data.frame(
122 state = seq_along(data) - 1,
123 nframes = n,
124 ease = ease,
125 stringsAsFactors = FALSE
126 )
127 list(
128 data = data,
129 states = states
130 )
131 }
+57
-0
R/display_ease.R less more
0 #' Display an easing function
1 #'
2 #' This simple helper lets you explore how the different easing functions govern
3 #' the interpolation of data.
4 #'
5 #' @details
6 #' How transitions proceed between states are defined by an easing function. The
7 #' easing function converts the parameterized progression from one state to the
8 #' next to a new number between 0 and 1. `linear` easing is equivalent to
9 #' an identity function that returns the input unchanged. In addition there are
10 #' a range of additional easers available, each with three modifiers.
11 #'
12 #' \strong{Easing modifiers:}
13 #' \describe{
14 #' \item{-in}{The easing function is applied as-is}
15 #' \item{-out}{The easing function is applied in reverse}
16 #' \item{-in-out}{The first half of the transition it is applied as-is, while
17 #' in the last half it is reversed}
18 #' }
19 #'
20 #' \strong{Easing functions}
21 #' \describe{
22 #' \item{quadratic}{Models a power-of-2 function}
23 #' \item{cubic}{Models a power-of-3 function}
24 #' \item{quartic}{Models a power-of-4 function}
25 #' \item{quintic}{Models a power-of-5 function}
26 #' \item{sine}{Models a sine function}
27 #' \item{circular}{Models a pi/2 circle arc}
28 #' \item{exponential}{Models an exponential function}
29 #' \item{elastic}{Models an elastic release of energy}
30 #' \item{back}{Models a pullback and relase}
31 #' \item{bounce}{Models the bouncing of a ball}
32 #' }
33 #'
34 #' In addition to this function a good animated explanation can be found
35 #' [here](http://easings.net).
36 #'
37 #' @param ease The name of the easing function to display (see details)
38 #'
39 #' @return This function is called for its side effects
40 #'
41 #' @examples
42 #' # The default - identity
43 #' display_ease('linear')
44 #'
45 #' # A more fancy easer
46 #' display_ease('elastic-in')
47 #'
48 #' @importFrom graphics plot
49 #' @export
50 #'
51 display_ease <- function(ease) {
52 easepoints <- tween_numeric(c(0, 1), 100, ease)[[1]]
53 progress <- seq(0, 1, length.out = 100)
54 plot(progress, easepoints, type = 'l', main = ease, xlab = 'In',
55 ylab = 'Out', bty = 'n')
56 }
+66
-0
R/interpolate_along.R less more
0 interpolate_numeric_along <- function(data, group, frame, nframes, ease, history, keep_last) {
1 numeric_along_interpolator(data, group, frame, history, keep_last, nframes, ease)
2 }
3 interpolate_logical_along <- function(data, group, frame, nframes, ease, history, keep_last) {
4 res <- numeric_along_interpolator(data, group, frame, history, keep_last, nframes, ease)
5 res[['data']] <- as.logical(round(res[['data']]))
6 res
7 }
8 #' @importFrom grDevices col2rgb rgb
9 #' @importFrom farver convert_colour
10 interpolate_colour_along <- function(data, group, frame, nframes, ease, history, keep_last) {
11 col <- t(col2rgb(data, alpha = TRUE))
12 data <- convert_colour(col[,1:3, drop = FALSE], from = 'rgb', to = 'lab')
13 int_col <- colour_along_interpolator(cbind(data, col[,4]), group, frame, history, keep_last, nframes, ease)
14 int_col_convert <- convert_colour(as.matrix(int_col[, c('data1', 'data2', 'data3')]), from = 'lab', to = 'rgb')
15 int_col_convert[int_col_convert > 255] <- 255
16 int_col_convert[int_col_convert < 0] <- 0
17 int_col$data4[int_col$data4 < 0] <- 0
18 data.frame(
19 data = rgb(int_col_convert[, 1], int_col_convert[, 2], int_col_convert[, 3], int_col$data4, maxColorValue = 255),
20 group = int_col$group,
21 frame = int_col$frame,
22 stringsAsFactors = FALSE
23 )
24 }
25 interpolate_constant_along <- function(data, group, frame, nframes, ease, history, keep_last) {
26 constant_along_interpolator(data, group, frame, history, keep_last, nframes, ease)
27 }
28 interpolate_character_along <- function(data, group, frame, nframes, ease, history, keep_last) {
29 constant_along_interpolator(data, group, frame, history, keep_last, nframes, ease)
30 }
31 interpolate_date_along <- function(data, group, frame, nframes, ease, history, keep_last) {
32 data <- as.numeric(data)
33 res <- interpolate_numeric_along(data, group, frame, nframes, ease, history, keep_last)
34 res[['data']] <- as.Date(res[['data']], origin = BASEDATE)
35 res
36 }
37 interpolate_datetime_along <- function(data, group, frame, nframes, ease, history, keep_last) {
38 if (inherits(data, 'POSIXlt')) {
39 warning("POSIXlt converted to POSIXct")
40 }
41 data <- as.numeric(data)
42 res <- interpolate_numeric_along(data, group, frame, nframes, ease, history, keep_last)
43 res[['data']] <- as.POSIXct(res[['data']], origin = BASEDATETIME)
44 res
45 }
46 interpolate_factor_along <- function(data, group, frame, nframes, ease, history, keep_last) {
47 all_levels <- levels(data)
48 data <- as.character(data)
49 res <- interpolate_character_along(data, group, frame, nframes, ease, history, keep_last)
50 res[['data']] <- factor(res[['data']], all_levels)
51 res
52 }
53 interpolate_list_along <- function(data, group, frame, nframes, ease, history, keep_last) {
54 new_data <- list_along_interpolator(data, group, frame, history, keep_last, nframes, ease)
55 attributes(new_data$data) <- attributes(data)
56 new_data
57 }
58 interpolate_numlist_along <- function(data, group, frame, nframes, ease, history, keep_last) {
59 new_data <- numlist_along_interpolator(data, group, frame, history, keep_last, nframes, ease)
60 attributes(new_data$data) <- attributes(data)
61 new_data
62 }
63 get_phase_along <- function(group, frame, nframes, history, keep_last) {
64 phase_along_interpolator(group, frame, history, keep_last, nframes)
65 }
+58
-0
R/interpolate_at.R less more
0 interpolate_numeric_at <- function(from, to, at, ease) {
1 numeric_at_interpolator(from, to, at, ease)
2 }
3
4 interpolate_logical_at <- function(from, to, at, ease) {
5 as.logical(round(numeric_at_interpolator(from, to, at, ease)))
6 }
7
8 interpolate_colour_at <- function(from, to, at, ease) {
9 from <- t(col2rgb(from, alpha = TRUE))
10 from[, 1:3] <- convert_colour(from[, 1:3, drop = FALSE], from = 'rgb', to = 'lab')
11 to <- t(col2rgb(to, alpha = TRUE))
12 to[, 1:3] <- convert_colour(to[, 1:3, drop = FALSE], from = 'rgb', to = 'lab')
13 data <- colour_at_interpolator(from, to, at, ease)
14 data[, 1:3] <- convert_colour(data[, 1:3, drop = FALSE], from = 'lab', to = 'rgb')
15 data[data > 255] <- 255
16 data[data < 0] <- 0
17 rgb(data, alpha = data[, 4], maxColorValue = 255L)
18 }
19
20 interpolate_character_at <- function(from, to, at, ease) {
21 constant_at_interpolator(from, to, at, ease)
22 }
23
24 interpolate_constant_at <- function(from, to, at, ease) {
25 constant_at_interpolator(from, to, at, ease)
26 }
27
28 interpolate_date_at <- function(from, to, at, ease) {
29 data <- numeric_at_interpolator(as.numeric(from), as.numeric(to), at, ease)
30 as.Date(data, origin = BASEDATE)
31 }
32
33 interpolate_datetime_at <- function(from, to, at, ease) {
34 if (inherits(from, 'POSIXlt')) {
35 warning("POSIXlt converted to POSIXct")
36 }
37 data <- numeric_at_interpolator(as.numeric(from), as.numeric(to), at, ease)
38 as.POSIXct(data, origin = BASEDATETIME)
39 }
40
41 interpolate_factor_at <- function(from, to, at, ease) {
42 all_levels <- unique(c(levels(from), levels(to)))
43 data <- constant_at_interpolator(as.character(from), as.character(to), at, ease)
44 factor(data, all_levels)
45 }
46
47 interpolate_list_at <- function(from, to, at, ease) {
48 data <- list_at_interpolator(from, to, at, ease)
49 attributes(data) <- attributes(from)
50 data
51 }
52
53 interpolate_numlist_at <- function(from, to, at, ease) {
54 data <- numlist_at_interpolator(from, to, at, ease)
55 attributes(data) <- attributes(from)
56 data
57 }
+66
-0
R/interpolate_element.R less more
0 interpolate_numeric_element <- function(data, group, frame, ease) {
1 numeric_element_interpolator(data, group, frame, ease)
2 }
3 interpolate_logical_element <- function(data, group, frame, ease) {
4 res <- numeric_element_interpolator(as.numeric(data), group, frame, ease)
5 res[['data']] <- as.logical(round(res[['data']]))
6 res
7 }
8 #' @importFrom grDevices col2rgb rgb
9 #' @importFrom farver convert_colour
10 interpolate_colour_element <- function(data, group, frame, ease) {
11 col <- t(col2rgb(data, alpha = TRUE))
12 data <- convert_colour(col[,1:3, drop = FALSE], from = 'rgb', to = 'lab')
13 int_col <- colour_element_interpolator(cbind(data, col[,4]), group, frame, ease)
14 int_col_convert <- convert_colour(as.matrix(int_col[, c('data1', 'data2', 'data3')]), from = 'lab', to = 'rgb')
15 int_col_convert[int_col_convert > 255] <- 255
16 int_col_convert[int_col_convert < 0] <- 0
17 int_col$data4[int_col$data4 < 0] <- 0
18 data.frame(
19 data = rgb(int_col_convert[, 1], int_col_convert[, 2], int_col_convert[, 3], int_col$data4, maxColorValue = 255),
20 group = int_col$group,
21 frame = int_col$frame,
22 stringsAsFactors = FALSE
23 )
24 }
25 interpolate_constant_element <- function(data, group, frame, ease) {
26 constant_element_interpolator(data, group, frame, ease)
27 }
28 interpolate_character_element <- function(data, group, frame, ease) {
29 interpolate_constant_element(data, group, frame, ease)
30 }
31 interpolate_date_element <- function(data, group, frame, ease) {
32 data <- as.numeric(data)
33 res <- interpolate_numeric_element(data, group, frame, ease)
34 res[['data']] <- as.Date(res[['data']], origin = BASEDATE)
35 res
36 }
37 interpolate_datetime_element <- function(data, group, frame, ease) {
38 if (inherits(data, 'POSIXlt')) {
39 warning("POSIXlt converted to POSIXct")
40 }
41 data <- as.numeric(data)
42 res <- interpolate_numeric_element(data, group, frame, ease)
43 res[['data']] <- as.POSIXct(res[['data']], origin = BASEDATETIME)
44 res
45 }
46 interpolate_factor_element <- function(data, group, frame, ease) {
47 all_levels <- levels(data)
48 data <- as.character(data)
49 res <- interpolate_character_element(data, group, frame, ease)
50 res[['data']] <- factor(res[['data']], all_levels)
51 res
52 }
53 interpolate_list_element <- function(data, group, frame, ease) {
54 new_data <- list_element_interpolator(data, group, frame, ease)
55 attributes(new_data$data) <- attributes(data)
56 new_data
57 }
58 interpolate_numlist_element <- function(data, group, frame, ease) {
59 new_data <- numlist_element_interpolator(data, group, frame, ease)
60 attributes(new_data$data) <- attributes(data)
61 new_data
62 }
63 get_phase_element <- function(data, group, frame, ease) {
64 phase_element_interpolator(data, group, frame, ease)
65 }
+52
-0
R/interpolate_fill.R less more
0 interpolate_numeric_fill <- function(data, ease) {
1 numeric_fill_interpolator(data, ease)
2 }
3 interpolate_logical_fill <- function(data, ease) {
4 as.logical(round(numeric_fill_interpolator(as.numeric(data), ease)))
5 }
6 #' @importFrom grDevices col2rgb rgb
7 #' @importFrom farver convert_colour
8 interpolate_colour_fill <- function(data, ease) {
9 NA_col <- is.na(data)
10 data <- t(col2rgb(data, alpha = TRUE))
11 data[, 1:3] <- convert_colour(data[, 1:3, drop = FALSE], from = 'rgb', to = 'lab')
12 data[NA_col,] <- NA
13 data <- colour_fill_interpolator(data, ease)
14 NA_col <- is.na(data[, 1])
15 data[NA_col, 1:3] <- convert_colour(data[NA_col, 1:3, drop = FALSE], from = 'lab', to = 'rgb')
16 data[data > 255] <- 255
17 data[data < 0] <- 0
18 all_data <- rep(NA, nrow(data))
19 all_data[!NA_col] <- rgb(data[!NA_col, , drop = FALSE], alpha = data[!NA_col, 4], maxColorValue = 255L)
20 all_data
21 }
22 interpolate_constant_fill <- function(data, ease) {
23 constant_fill_interpolator(data, ease)
24 }
25 interpolate_character_fill <- function(data, ease) {
26 interpolate_constant_fill(data, ease)
27 }
28 interpolate_date_fill <- function(data, ease) {
29 data <- lapply(data, as.numeric)
30 as.Date(interpolate_numeric_fill(data, ease), origin = BASEDATE)
31 }
32 interpolate_datetime_fill <- function(data, ease) {
33 if (inherits(data, 'POSIXlt')) {
34 warning("POSIXlt converted to POSIXct")
35 }
36 as.POSIXct(interpolate_numeric_fill(as.numeric(data), ease), origin = BASEDATETIME)
37 }
38 interpolate_factor_fill <- function(data, ease) {
39 all_levels <- levels(data)
40 factor(interpolate_character_fill(as.character(data), ease), all_levels)
41 }
42 interpolate_list_fill <- function(data, ease) {
43 new_data <- list_fill_interpolator(data, ease)
44 attributes(new_data) <- attributes(data)
45 new_data
46 }
47 interpolate_numlist_fill <- function(data, ease) {
48 new_data <- numlist_fill_interpolator(lapply(data, as.numeric), ease)
49 attributes(new_data) <- attributes(data)
50 new_data
51 }
+59
-0
R/interpolate_state.R less more
0 interpolate_numeric_state <- function(data, states) {
1 numeric_state_interpolator(data, states)
2 }
3 interpolate_logical_state <- function(data, states) {
4 as.logical(round(numeric_state_interpolator(lapply(data, as.numeric), states)))
5 }
6 #' @importFrom grDevices col2rgb rgb
7 #' @importFrom farver convert_colour
8 interpolate_colour_state <- function(data, states) {
9 data <- lapply(data, function(d){
10 col <- t(col2rgb(d, alpha = TRUE))
11 col_conv <- convert_colour(col[,1:3, drop = FALSE], from = 'rgb', to = 'lab')
12 cbind(col_conv, col[,4])
13 })
14 int_col <- colour_state_interpolator(data, states)
15 alpha <- int_col[,4]
16 alpha[alpha > 255] <- 255
17 alpha[alpha < 0] <- 0
18 int_col <- convert_colour(int_col[, 1:3, drop = FALSE], from = 'lab', to = 'rgb')
19 int_col[int_col > 255] <- 255
20 int_col[int_col < 0] <- 0
21 rgb(int_col[, 1], int_col[, 2], int_col[, 3], alpha, maxColorValue = 255)
22 }
23 interpolate_constant_state <- function(data, states) {
24 constant_state_interpolator(data, states)
25 }
26 interpolate_character_state <- function(data, states) {
27 interpolate_constant_state(data, states)
28 }
29 interpolate_date_state <- function(data, states) {
30 data <- lapply(data, as.numeric)
31 as.Date(interpolate_numeric_state(data, states), origin = BASEDATE)
32 }
33 interpolate_datetime_state <- function(data, states) {
34 if (inherits(data[[1]], 'POSIXlt')) {
35 warning("POSIXlt converted to POSIXct")
36 }
37 data <- lapply(data, as.numeric)
38 as.POSIXct(interpolate_numeric_state(data, states), origin = BASEDATETIME)
39 }
40 interpolate_factor_state <- function(data, states) {
41 all_levels <- Reduce(union, lapply(data, levels))
42 data <- lapply(data, as.character)
43 factor(interpolate_character_state(data, states), all_levels)
44 }
45 interpolate_list_state <- function(data, states) {
46 new_data <- list_state_interpolator(data, states)
47 attributes(new_data) <- attributes(data)
48 new_data
49 }
50 interpolate_numlist_state <- function(data, states) {
51 new_data <- numlist_state_interpolator(lapply(data, lapply, as.numeric), states)
52 attributes(new_data) <- attributes(data)
53 new_data
54 }
55
56 get_phase_state <- function(data, states) {
57 phase_state_interpolator(data, states)
58 }
+116
-0
R/tween.R less more
0 #' Create simple tweens
1 #'
2 #' This set of functions can be used to interpolate between single data types,
3 #' i.e. data not part of data.frames but stored in vectors. All functions come
4 #' in two flavours: the standard and a *_t version. The standard reads the data
5 #' as a list of states, each tween matched element-wise from state to state. The
6 #' *_t version uses the transposed representation where each element is a vector
7 #' of states. The standard approach can be used when each tween has the same
8 #' number of states and you want to control the number of point in each state
9 #' transition. The latter is useful when each tween consists of different
10 #' numbers of states and/or you want to specify the total number of points for
11 #' each tween.
12 #'
13 #' @section Difference Between `tween_numeric` and `approx()`:
14 #' `tween_numeric` (and `tween_numeric_t`) is superficially equivalent to
15 #' [stats::approx()], but there are differences.
16 #' [stats::approx()] will create evenly spaced points, at the expense
17 #' of not including the actual points in the input, while the reverse is true
18 #' for `tween_numeric`. Apart from that `tween_numeric` of course supports easing
19 #' functions and is vectorized.
20 #'
21 #' @details
22 #' `tween` and `tween_t` are wrappers around the other functions that tries to guess
23 #' the type of input data and choose the appropriate tween function. Unless you
24 #' have data that could be understood as a colour but is in fact a character
25 #' vector it should be safe to use these wrappers. It is probably safer and more
26 #' verbose to use the explicit functions within package code as they circumvent
27 #' the type inference and checks whether the input data matches the tween
28 #' function.
29 #'
30 #' `tween_numeric` will provide a linear interpolation between the points based on
31 #' the sequence returned by the easing function. `tween_date` and `tween_datetime`
32 #' converts to numeric, produces the tweening, and converts back again.
33 #' `tween_colour` converts colours into Lab and does the interpolation there,
34 #' converting back to sRGB after the tweening is done. `tween_constant` is a
35 #' catchall that converts the input into character and interpolates by switching
36 #' between states halfway through the transition.
37 #'
38 #' The meaning of the `n` and `ease` arguments differs somewhat
39 #' between the standard and *_t versions of the functions. In the standard
40 #' function `n` and `ease` refers to the length and easing function of
41 #' each transition, being recycled if necessary to `length(data) - 1`. In
42 #' the *_t functions `n` and `ease` refers to the total length of each
43 #' tween and the easing function to be applied to all transition for each tween.
44 #' The will both be recycled to `length(data)`.
45 #'
46 #' @param data A list of vectors or a single vector. In the standard functions
47 #' each element in the list must be of equal length; for the *_t functions
48 #' lengths can differ. If a single vector is used it will be eqivalent to using
49 #' `as.list(data)` for the standard functions and `list(data)` for the
50 #' *_t functions.
51 #'
52 #' @param n The number of elements per transition or tween. See details
53 #'
54 #' @param ease The easing function to use for each transition or tween. See
55 #' details. Defaults to `'linear'`
56 #'
57 #' @return A list with an element for each tween. That means that the length of
58 #' the return is equal to the length of the elements in `data` for the
59 #' standard functions and equal to the length of `data` for the *_t
60 #' functions.
61 #'
62 #' @examples
63 #' tween_numeric(list(1:3, 10:8, c(20, 60, 30)), 10)
64 #'
65 #' tween_colour_t(list(colours()[1:4], colours()[1:2], colours()[25:100]), 100)
66 #'
67 #' @export
68 #'
69 tween <- function(data, n, ease = 'linear') {
70 type <- guessType(data)
71 switch(
72 type,
73 numeric = tween_numeric(data, n, ease),
74 date = tween_date(data, n, ease),
75 datetime = tween_datetime(data, n, ease),
76 colour = tween_colour(data, n, ease),
77 tween_constant_t(data, n, ease)
78 )
79 }
80 #' @rdname tween
81 #' @export
82 tween_t <- function(data, n, ease = 'linear') {
83 type <- guessType(data)
84 switch(
85 type,
86 numeric = tween_numeric_t(data, n, ease),
87 date = tween_date_t(data, n, ease),
88 datetime = tween_datetime_t(data, n, ease),
89 colour = tween_colour_t(data, n, ease),
90 tween_constant_t(data, n, ease)
91 )
92 }
93 #' @importFrom utils head
94 guessType <- function(data) {
95 data <- unlist(data)
96 if (is.character(data)) {
97 convert <- try(suppressWarnings(col2rgb(head(data, 100))),
98 silent = TRUE)
99 if (!inherits(convert, 'try-error')) {
100 if (!anyNA(convert)) {
101 return('colour')
102 }
103 }
104 }
105 if (inherits(data, 'Date')) {
106 return('date')
107 }
108 if (inherits(data, 'POSIXt')) {
109 return('datetime')
110 }
111 if (is.numeric(data)) {
112 return('numeric')
113 }
114 'unknown'
115 }
+83
-0
R/tween_along.R less more
0 #' Interpolate data along a given dimension
1 #'
2 #' This tween takes groups of rows along with the time for each row and
3 #' calculates the exact value at each at each frame. Further it allows for
4 #' keeping the subsequent raw data from previous frame as well as letting the
5 #' final row linger beyond its time. It especially useful for data that should
6 #' be visualised as lines that are drawn along the x-axis, but can of course
7 #' also be used for other dimensions as well (even dimensions not corresponding
8 #' to any axis).
9 #'
10 #' @inheritParams tween_components
11 #' @param along The "time" point for each row
12 #' @param history Should earlier datapoints be kept in subsequent frames
13 #' @param keep_last Should the last point of each id be kept beyond its time
14 #'
15 #' @return A data.frame with the same columns as `.data` along with `.id` giving
16 #' the component id, `.phase` giving the state of each component in each frame,
17 #' and `.frame` giving the frame membership of each row.
18 #'
19 #' @family data.frame tween
20 #'
21 #' @importFrom rlang enquo quo_is_null eval_tidy
22 #' @export
23 tween_along <- function(.data, ease, nframes, along, id = NULL, range = NULL, history = TRUE, keep_last = FALSE) {
24 along <- enquo(along)
25 along <- as.numeric(eval_tidy(along, .data))
26 id <- enquo(id)
27 id <- if (quo_is_null(id)) rep(1, nrow(.data)) else eval_tidy(id, .data)
28 .data <- .complete_along(.data, along, id)
29
30 if (length(ease) == 1) ease <- rep(ease, ncol(.data) - 3)
31 if (length(ease) == ncol(.data) - 3) {
32 ease <- c(ease, 'linear', 'linear', 'linear') # To account for .phase and .id columns
33 } else {
34 stop('Ease must be either a single string or one for each column', call. = FALSE)
35 }
36 stopifnot(length(nframes) == 1 && is.numeric(nframes) && nframes %% 1 == 0)
37
38 timerange <- if (is.null(range)) range(.data$.time) else range
39 timerange <- as.numeric(timerange)
40 if (diff(timerange) == 0) stop('range must have a length', call. = FALSE)
41 framelength <- diff(timerange) / (nframes - 1)
42 frame <- 1 + (nframes - 1) * (.data$.time - timerange[1]) / diff(timerange)
43 colClasses <- col_classes(.data)
44 tweendata <- lapply(seq_along(.data), function(i) {
45 d <- .data[[i]]
46 e <- ease[i]
47 switch(
48 colClasses[i],
49 numeric = interpolate_numeric_along(d, .data$.id, frame, nframes, e, history, keep_last),
50 logical = interpolate_logical_along(d, .data$.id, frame, nframes, e, history, keep_last),
51 factor = interpolate_factor_along(d, .data$.id, frame, nframes, e, history, keep_last),
52 character = interpolate_character_along(d, .data$.id, frame, nframes, e, history, keep_last),
53 colour = interpolate_colour_along(d, .data$.id, frame, nframes, e, history, keep_last),
54 date = interpolate_date_along(d, .data$.id, frame, nframes, e, history, keep_last),
55 datetime = interpolate_datetime_along(d, .data$.id, frame, nframes, e, history, keep_last),
56 constant = interpolate_constant_along(d, .data$.id, frame, nframes, e, history, keep_last),
57 numlist = interpolate_numlist_along(d, .data$.id, frame, nframes, e, history, keep_last),
58 list = interpolate_list_along(d, .data$.id, frame, nframes, e, history, keep_last),
59 phase = get_phase_along(.data$.id, frame, nframes, history, keep_last)
60 )
61 })
62 tweenInfo <- tweendata[[1]][, c('group', 'frame')]
63 tweendata <- lapply(tweendata, `[[`, i = 'data')
64 tweendata <- structure(tweendata, names = names(.data), row.names = seq_along(tweendata[[1]]), class = 'data.frame')
65 tweendata$.frame <- tweenInfo$frame
66 tweendata$.id <- tweenInfo$group
67 attr(tweendata, 'framelength') <- framelength
68 tweendata[order(tweendata$.frame, tweendata$.id), , drop = FALSE]
69 }
70
71 .complete_along <- function(data, along, id) {
72 if (length(along) != nrow(data) || length(id) != nrow(data)) {
73 stop('along and id must be the same length as the number of rows in data', call. = FALSE)
74 }
75 data <- data[order(id), , drop = FALSE]
76 along <- along[order(id)]
77 id <- sort(id)
78 data$.id <- id
79 data$.phase <- 'raw'
80 data$.time <- along
81 data
82 }
+57
-0
R/tween_appear.R less more
0 #' Tween a data.frame of appearances
1 #'
2 #' This function is intended for use when you have a data.frame of events at
3 #' different time points. This could be the appearance of an observation for
4 #' example. This function replicates your data `nframes` times and
5 #' calculates the duration of each frame. At each frame each row is
6 #' assigned an age based on the progression of frames and the entry point of in
7 #' time for that row. A negative age means that the row has not appeared yet.
8 #'
9 #' @param data A data.frame to tween
10 #'
11 #' @param time The name of the column that holds the time dimension. This does
12 #' not need to hold time data in the strictest sence - any numerical type will
13 #' do
14 #'
15 #' @param timerange The range of time to create the tween for. If missing it
16 #' will defaults to the range of the time column
17 #'
18 #' @param nframes The number of frames to create for the tween. If missing it
19 #' will create a frame for each full unit in `timerange` (e.g.
20 #' `timerange = c(1, 10)` will give `nframes = 10`)
21 #'
22 #' @return A data.frame as `data` but repeated `nframes` times and
23 #' with the additional columns `.age` and `.frame`
24 #'
25 #' @family data.frame tween
26 #'
27 #' @examples
28 #' data <- data.frame(
29 #' x = rnorm(100),
30 #' y = rnorm(100),
31 #' time = sample(50, 100, replace = TRUE)
32 #' )
33 #'
34 #' data <- tween_appear(data, 'time', nframes = 200)
35 #'
36 #' @export
37 #'
38 tween_appear <- function(data, time, timerange, nframes) {
39 if (missing(timerange) || is.null(timerange)) {
40 timerange <- range(data[[time]])
41 }
42 if (missing(nframes) || is.null(nframes)) {
43 nframes <- ceiling(diff(timerange) + 1)
44 }
45 framelength <- diff(timerange) / nframes
46
47 tweendata <- lapply(seq_len(nframes) - 1, function(f) {
48 timepoint <- f * framelength
49 data$.age <- timepoint - data[[time]]
50 data$.frame <- f
51 data
52 })
53 tweendata <- do.call(rbind, tweendata)
54 attr(tweendata, 'framelength') <- framelength
55 tweendata
56 }
+64
-0
R/tween_at.R less more
0 #' Get a specific position between two states
1 #'
2 #' This tween allows you to query a specific postion between two states rather
3 #' than generate evenly spaced states. It can work with either data.frames or
4 #' single vectors and each row/element can have its own position and easing.
5 #'
6 #' @param from,to A data.frame or vector of the same type. If either is of
7 #' length/nrow 1 it will get repeated to match the length of the other
8 #' @param at A numeric between 0 and 1 recycled to match the nrow/length of
9 #' `from`
10 #' @param ease A character vector giving valid easing functions. Recycled to
11 #' match the ncol of `from`
12 #'
13 #' @return If `from`/`to` is a data.frame then a data.frame with the same
14 #' columns. If `from`/`to` is a vector then a vector.
15 #'
16 #' @export
17 #'
18 #' @examples
19 #' tween_at(mtcars[1:6, ], mtcars[6:1, ], runif(6), 'cubic-in-out')
20 #'
21 tween_at <- function(from, to, at, ease) {
22 single_vec <- !is.data.frame(from)
23 if (single_vec) {
24 if (length(from) == 0 || length(to) == 0) return(to[integer()])
25 from_df <- data.frame(data = rep(NA, length(from)))
26 to_df <- data.frame(data = rep(NA, length(to)))
27 from_df$data <- from
28 to_df$data <- to
29 from <- from_df
30 to <- to_df
31 } else {
32 if (nrow(from) == 0 || nrow(to) == 0) return(to[integer(), ])
33 }
34 if (length(at) == 0) stop('at must have length > 0', call. = FALSE)
35 if (nrow(from) == 1) from <- from[rep(1, nrow(to)), , drop = FALSE]
36 if (nrow(to) == 1) to <- to[rep(1, nrow(from)), , drop = FALSE]
37 if (nrow(from) != nrow(to)) {
38 stop('from and to must be same length', call. = FALSE)
39 }
40 stopifnot(names(from) == names(to))
41 at <- rep(at, length.out = nrow(from))
42 ease <- rep(ease, length.out = ncol(from))
43 classes <- col_classes(from)
44 stopifnot(identical(classes, col_classes(to)))
45 tweendata <- lapply(seq_along(classes), function(i) {
46 switch(
47 classes[i],
48 numeric = interpolate_numeric_at(from[[i]], to[[i]], at, ease[i]),
49 logical = interpolate_logical_at(from[[i]], to[[i]], at, ease[i]),
50 factor = interpolate_factor_at(from[[i]], to[[i]], at, ease[i]),
51 character = interpolate_character_at(from[[i]], to[[i]], at, ease[i]),
52 colour = interpolate_colour_at(from[[i]], to[[i]], at, ease[i]),
53 date = interpolate_date_at(from[[i]], to[[i]], at, ease[i]),
54 datetime = interpolate_datetime_at(from[[i]], to[[i]], at, ease[i]),
55 constant = interpolate_constant_at(from[[i]], to[[i]], at, ease[i]),
56 numlist = interpolate_numlist_at(from[[i]], to[[i]], at, ease[i]),
57 list = interpolate_list_at(from[[i]], to[[i]], at, ease[i])
58 )
59 })
60 if (single_vec) return(tweendata[[1]])
61
62 structure(tweendata, names = names(from), row.names = seq_along(tweendata[[1]]), class = 'data.frame')
63 }
+37
-0
R/tween_colour.R less more
0 #' @rdname tween
1 #'
2 #' @export
3 tween_colour <- function(data, n, ease = 'linear') {
4 data <- as.list(data)
5 prepData <- prepareTween(data, n, ease)
6 if (anyNA(suppressWarnings(col2rgb(unlist(prepData$data))))) {
7 stop('all elements in data must be convertible to colour')
8 }
9 tweendata <- do.call(interpolate_colour_state, prepData)
10 unname(split(tweendata,
11 rep(seq_along(data[[1]]), length.out = length(tweendata))))
12 }
13 #' @rdname tween
14 #'
15 #' @export
16 tween_color <- tween_colour
17
18 #' @rdname tween
19 #'
20 #' @export
21 tween_colour_t <- function(data, n, ease = 'linear') {
22 if (!is.list(data)) {
23 data <- list(data)
24 }
25 prepData <- prepareTweenTranspose(data, n, ease)
26 if (anyNA(suppressWarnings(col2rgb(unlist(prepData$data))))) {
27 stop('all elements in data must be convertible to colour')
28 }
29 tweendata <- do.call(interpolate_colour_state, prepData)
30 unname(split(tweendata,
31 rep(seq_along(data), rep(n, length.out = length(data)))))
32 }
33 #' @rdname tween
34 #'
35 #' @export
36 tween_color_t <- tween_colour_t
+136
-0
R/tween_components.R less more
0 #' Interpolate individual component
1 #'
2 #' This function is much like [tween_elements()] but with a slightly different
3 #' syntax and support for many of the newer features such as enter/exits and
4 #' tween phase identification. Furthermore it uses tidy evaluation for time and
5 #' id, making it easier to change these on the fly. The biggest change in terms
6 #' of functionality compared to `tween_elements()` is that the easing function
7 #' is now given per column and not per row. If different easing functions are
8 #' needed for each transition then `tween_elements()` is needed.
9 #'
10 #' @inheritParams tween_state
11 #'
12 #' @param .data A data.frame with components at different stages
13 #'
14 #' @param time An unquoted expression giving the timepoint for the different
15 #' stages of the components. Will be evaluated in the context of `.data` so can
16 #' refer to a column from that
17 #'
18 #' @param id An unquoted expression giving the component id for each row. Will
19 #' be evaluated in the context of `.data` so can refer to a column from that
20 #'
21 #' @param range The range of time points to include in the tween. If `NULL` it
22 #' will use the range of `time`
23 #'
24 #' @param enter_length,exit_length The lenght of the opening and closing
25 #' transitions if `enter` and/or `exit` is given. Measured in the same units as
26 #' `time`
27 #'
28 #' @return A data.frame with the same columns as `.data` along with `.id` giving
29 #' the component id, `.phase` giving the state of each component in each frame,
30 #' and `.frame` giving the frame membership of each row.
31 #'
32 #' @family data.frame tween
33 #'
34 #' @examples
35 #'
36 #' from_zero <- function(x) {x$x <- 0; x}
37 #'
38 #' data <- data.frame(
39 #' x = c(1, 2, 2, 1, 2, 2),
40 #' y = c(1, 2, 2, 2, 1, 1),
41 #' time = c(1, 4, 10, 4, 8, 10),
42 #' id = c(1, 1, 1, 2, 2, 2)
43 #' )
44 #'
45 #' data <- tween_components(data, 'cubic-in-out', nframes = 100, time = time,
46 #' id = id, enter = from_zero, enter_length = 4)
47 #'
48 #' @export
49 #' @importFrom rlang enquo eval_tidy
50 #'
51 tween_components <- function(.data, ease, nframes, time, id = NULL, range = NULL, enter = NULL, exit = NULL, enter_length = 0, exit_length = 0) {
52 time <- enquo(time)
53 time <- eval_tidy(time, .data)
54 id <- enquo(id)
55 id <- if (quo_is_null(id)) rep(1, nrow(.data)) else eval_tidy(id, .data)
56 if (is.null(enter_length)) enter_length <- 0
57 if (is.null(exit_length)) exit_length <- 0
58 .data <- .complete_components(.data, time, id, enter, exit, enter_length, exit_length)
59
60 .tween_individuals(.data, ease, nframes, range)
61 }
62
63 .tween_individuals <- function(.data, ease, nframes, range) {
64 if (nframes == 0) return(.data[integer(), , drop = FALSE])
65 if (nrow(.data) == 0) return(.data)
66 if (length(ease) == 1) ease <- rep(ease, ncol(.data) - 3)
67 if (length(ease) == ncol(.data) - 3) {
68 ease <- c(ease, 'linear', 'linear', 'linear') # To account for .phase and .id columns
69 } else {
70 stop('Ease must be either a single string or one for each column', call. = FALSE)
71 }
72 stopifnot(length(nframes) == 1 && is.numeric(nframes) && nframes %% 1 == 0)
73
74 timerange <- if (is.null(range)) range(.data$.time) else range
75 if (diff(timerange) == 0) stop('range must have a length', call. = FALSE)
76 framelength <- diff(timerange) / (nframes - 1)
77 .data <- .data[order(.data$.id, .data$.time), , drop = FALSE]
78 frame <- round((.data$.time - min(timerange[1])) / framelength) + 1
79 .data$.time <- NULL
80 colClasses <- col_classes(.data)
81 tweendata <- lapply(seq_along(.data), function(i) {
82 d <- .data[[i]]
83 e <- rep(ease[i], length(d))
84 switch(
85 colClasses[i],
86 numeric = interpolate_numeric_element(d, .data$.id, frame, e),
87 logical = interpolate_logical_element(d, .data$.id, frame, e),
88 factor = interpolate_factor_element(d, .data$.id, frame, e),
89 character = interpolate_character_element(d, .data$.id, frame, e),
90 colour = interpolate_colour_element(d, .data$.id, frame, e),
91 date = interpolate_date_element(d, .data$.id, frame, e),
92 datetime = interpolate_datetime_element(d, .data$.id, frame, e),
93 constant = interpolate_constant_element(d, .data$.id, frame, e),
94 numlist = interpolate_numlist_element(d, .data$.id, frame, e),
95 list = interpolate_list_element(d, .data$.id, frame, e),
96 phase = get_phase_element(d, .data$.id, frame, e)
97 )
98 })
99 tweenInfo <- tweendata[[1]][, c('group', 'frame')]
100 tweendata <- lapply(tweendata, `[[`, i = 'data')
101 tweendata <- structure(tweendata, names = names(.data), row.names = seq_along(tweendata[[1]]), class = 'data.frame')
102 tweendata$.frame <- tweenInfo$frame
103 tweendata$.id <- tweenInfo$group
104 tweendata <- tweendata[tweendata$.frame >= 1 & tweendata$.frame <= nframes, , drop = FALSE]
105 attr(tweendata, 'framelength') <- framelength
106 tweendata[order(tweendata$.frame, tweendata$.id), , drop = FALSE]
107 }
108
109 .complete_components <- function(data, time, id, enter, exit, enter_length, exit_length) {
110 if (length(id) != nrow(data) || length(time) != nrow(data)) {
111 stop('id and time must have the same length as the number of rows in data', call. = FALSE)
112 }
113 data$.id <- id
114 data$.phase <- rep('raw', nrow(data))
115 data$.time <- time
116 if (any(!is.null(enter), !is.null(exit))) {
117 time_ord <- order(time)
118 if (!is.null(enter)) {
119 enter_data <- enter(data[time_ord[!duplicated(id[time_ord])], , drop = FALSE])
120 enter_data$.phase <- 'enter'
121 enter_data$.time <- enter_data$.time - enter_length
122 } else {
123 enter_data <- data[0, , drop = FALSE]
124 }
125 if (!is.null(exit)) {
126 exit_data <- exit(data[time_ord[!duplicated(id[time_ord], fromLast = TRUE)], , drop = FALSE])
127 exit_data$.phase <- 'exit'
128 exit_data$.time <- exit_data$.time + exit_length
129 } else {
130 exit_data <- data[0, , drop = FALSE]
131 }
132 data <- rbind(enter_data, data, exit_data)
133 }
134 data
135 }
+25
-0
R/tween_constant.R less more
0 #' @rdname tween
1 #'
2 #' @export
3 tween_constant <- function(data, n, ease = 'linear') {
4 data <- as.list(data)
5 data <- lapply(data, as.character)
6 prepData <- prepareTween(data, n, ease)
7 tweendata <- do.call(interpolate_character_state, prepData)
8 unname(split(tweendata,
9 rep(seq_along(data[[1]]), length.out = length(tweendata))))
10 }
11
12 #' @rdname tween
13 #'
14 #' @export
15 tween_constant_t <- function(data, n, ease = 'linear') {
16 if (!is.list(data)) {
17 data <- list(data)
18 }
19 data <- lapply(data, as.character)
20 prepData <- prepareTweenTranspose(data, n, ease)
21 tweendata <- do.call(interpolate_character_state, prepData)
22 unname(split(tweendata,
23 rep(seq_along(data), rep(n, length.out = length(data)))))
24 }
+29
-0
R/tween_date.R less more
0 #' @rdname tween
1 #'
2 #' @export
3 tween_date <- function(data, n, ease = 'linear') {
4 data <- as.list(data)
5 prepData <- prepareTween(data, n, ease)
6 if (!all(sapply(prepData$data, inherits, what = 'Date'))) {
7 stop('data must consist of Date elements')
8 }
9 tweendata <- do.call(interpolate_date_state, prepData)
10 unname(split(tweendata,
11 rep(seq_along(data[[1]]), length.out = length(tweendata))))
12 }
13
14 #' @rdname tween
15 #'
16 #' @export
17 tween_date_t <- function(data, n, ease = 'linear') {
18 if (!is.list(data)) {
19 data <- list(data)
20 }
21 prepData <- prepareTweenTranspose(data, n, ease)
22 if (!all(sapply(prepData$data, inherits, what = 'Date'))) {
23 stop('data must consist of Date elements')
24 }
25 tweendata <- do.call(interpolate_date_state, prepData)
26 unname(split(tweendata,
27 rep(seq_along(data), rep(n, length.out = length(data)))))
28 }
+29
-0
R/tween_datetime.R less more
0 #' @rdname tween
1 #'
2 #' @export
3 tween_datetime <- function(data, n, ease = 'linear') {
4 data <- as.list(data)
5 prepData <- prepareTween(data, n, ease)
6 if (!all(sapply(prepData$data, inherits, what = 'POSIXt'))) {
7 stop('data must consist of POSIXt elements')
8 }
9 tweendata <- do.call(interpolate_datetime_state, prepData)
10 unname(split(tweendata,
11 rep(seq_along(data[[1]]), length.out = length(tweendata))))
12 }
13
14 #' @rdname tween
15 #'
16 #' @export
17 tween_datetime_t <- function(data, n, ease = 'linear') {
18 if (!is.list(data)) {
19 data <- list(data)
20 }
21 prepData <- prepareTweenTranspose(data, n, ease)
22 if (!all(sapply(prepData$data, inherits, what = 'POSIXt'))) {
23 stop('data must consist of POSIXt elements')
24 }
25 tweendata <- do.call(interpolate_datetime_state, prepData)
26 unname(split(tweendata,
27 rep(seq_along(data), rep(n, length.out = length(data)))))
28 }
+88
-0
R/tween_elements.R less more
0 #' Create frames based on individual element states
1 #'
2 #' This function creates tweens for each observation individually, in cases
3 #' where the data doesn't pass through collective states but consists of fully
4 #' independent transitions. Each observation is identified by an id and each
5 #' state must have a time associated with it.
6 #'
7 #' @param data A data.frame consisting at least of a column giving the
8 #' observation id, a column giving timepoints for each state and a column giving
9 #' the easing to apply when transitioning away from the state.
10 #'
11 #' @param time The name of the column holding timepoints
12 #'
13 #' @param group The name of the column holding the observation id
14 #'
15 #' @param ease The name of the column holding the easing function name
16 #'
17 #' @param timerange The range of time to span. If missing it will default to
18 #' \code{range(data[[time]])}
19 #'
20 #' @param nframes The number of frames to generate. If missing it will default
21 #' to `ceiling(diff(timerange) + 1)` (At least one frame for each
22 #' individual timepoint)
23 #'
24 #' @return A data.frame with the same columns as `data` except for the
25 #' group and ease columns, but replicated `nframes` times. Two additional
26 #' columns called `.frame` and `.group` will be added giving the frame
27 #' number and observation id for each row.
28 #'
29 #' @family data.frame tween
30 #'
31 #' @examples
32 #' data <- data.frame(
33 #' x = c(1, 2, 2, 1, 2, 2),
34 #' y = c(1, 2, 2, 2, 1, 1),
35 #' time = c(1, 4, 10, 4, 8, 10),
36 #' group = c(1, 1, 1, 2, 2, 2),
37 #' ease = rep('cubic-in-out', 6)
38 #' )
39 #'
40 #' data <- tween_elements(data, 'time', 'group', 'ease', nframes = 100)
41 #'
42 #' @export
43 #'
44 tween_elements <- function(data, time, group, ease, timerange, nframes) {
45 if (!all(data[[ease]] %in% validEase)) {
46 stop("All names given in the easing column must be valid easers")
47 }
48
49 if (missing(timerange) || is.null(timerange)) {
50 timerange <- range(data[[time]])
51 }
52 if (missing(nframes) || is.null(nframes)) {
53 nframes <- ceiling(diff(timerange) + 1)
54 }
55 framelength <- diff(timerange) / nframes
56 specialCols <- c(group, ease)
57 data <- data[order(data[[group]], data[[time]]), ]
58 group <- as.character(data[[group]])
59 frame <- round((data[[time]] - timerange[1]) / framelength)
60 ease <- as.character(data[[ease]])
61 data <- data[, !names(data) %in% specialCols, drop = FALSE]
62
63 colClasses <- col_classes(data)
64 tweendata <- lapply(seq_along(data), function(i) {
65 d <- data[[i]]
66 switch(
67 colClasses[i],
68 numeric = interpolate_numeric_element(d, group, frame, ease),
69 logical = interpolate_logical_element(d, group, frame, ease),
70 factor = interpolate_factor_element(d, group, frame, ease),
71 character = interpolate_character_element(d, group, frame, ease),
72 colour = interpolate_colour_element(d, group, frame, ease),
73 date = interpolate_date_element(d, group, frame, ease),
74 datetime = interpolate_datetime_element(d, group, frame, ease),
75 constant = interpolate_constant_element(d, group, frame, ease),
76 numlist = interpolate_numlist_element(d, group, frame, ease),
77 list = interpolate_list_element(d, group, frame, ease)
78 )
79 })
80 tweenInfo <- tweendata[[1]][, c('group', 'frame')]
81 tweendata <- as.data.frame(lapply(tweendata, `[[`, i = 'data'))
82 names(tweendata) <- names(data)
83 tweendata$.frame <- tweenInfo$frame
84 tweendata$.group <- tweenInfo$group
85 attr(tweendata, 'framelength') <- framelength
86 tweendata[order(tweendata$.frame, tweendata$.group), ]
87 }
+94
-0
R/tween_events.R less more
0 #' Transition in and out of events
1 #'
2 #' This tweening function is a more powerful version of [tween_appear()], with
3 #' support for newer features such as enter/exits and tween phase
4 #' identification. The tweener treats each row in the data as unique events in
5 #' time, and creates frames with the correct events present at any given time.
6 #'
7 #' @param start,end The start (and potential end) of the event encoded in the
8 #' row, as unquoted expressions. Will be evaluated in the context of `.data` so
9 #' can refer to columns in it. If `end = NULL` the event will be without extend
10 #' and only visible in a single frame, unless `enter` and/or `exit` is given.
11 #'
12 #' @inheritParams tween_components
13 #'
14 #' @return A data.frame with the same columns as `.data` along with `.id` giving
15 #' the component id, `.phase` giving the state of each component in each frame,
16 #' and `.frame` giving the frame membership of each row.
17 #'
18 #' @family data.frame tween
19 #'
20 #' @importFrom rlang enquo quo_is_missing eval_tidy
21 #' @export
22 #'
23 #' @examples
24 #' d <- data.frame(
25 #' x = runif(20),
26 #' y = runif(20),
27 #' time = runif(20),
28 #' duration = runif(20, max = 0.1)
29 #' )
30 #' from_left <- function(x) {
31 #' x$x <- -0.5
32 #' x
33 #' }
34 #' to_right <- function(x) {
35 #' x$x <- 1.5
36 #' x
37 #' }
38 #'
39 #' tween_events(d, 'cubic-in-out', 50, start = time, end = time + duration,
40 #' enter = from_left, exit = to_right, enter_length = 0.1,
41 #' exit_length = 0.05)
42 #'
43 tween_events <- function(.data, ease, nframes, start, end = NULL, range = NULL, enter = NULL, exit = NULL, enter_length = 0, exit_length = 0) {
44 start <- enquo(start)
45 if (quo_is_missing(start)) stop('start must be provided', call. = FALSE)
46 start <- eval_tidy(start, .data)
47 end <- enquo(end)
48 end <- eval_tidy(end, .data)
49 enter_length <- enquo(enter_length)
50 enter_length <- eval_tidy(enter_length, .data)
51 exit_length <- enquo(exit_length)
52 exit_length <- eval_tidy(exit_length, .data)
53
54 if (is.null(enter_length)) enter_length <- 0
55 if (is.null(exit_length)) exit_length <- 0
56 .data <- .complete_events(.data, start, end, enter, exit, enter_length, exit_length)
57
58 .tween_individuals(.data, ease, nframes, range)
59 }
60
61 .complete_events <- function(data, start, end, enter, exit, enter_length, exit_length) {
62 data$.id <- seq_len(nrow(data))
63 data$.phase <- rep("raw", nrow(data))
64 start <- rep(start, length.out = nrow(data))
65 if (is.null(end)) {
66 event_end <- data[0, , drop = FALSE]
67 end <- start[0]
68 } else {
69 event_end <- data
70 end <- rep(end, length.out = nrow(data))
71 data$.phase <- 'static'
72 }
73 if (is.null(enter)) {
74 enter_data <- data[0, , drop = FALSE]
75 enter_time <- start[0]
76 } else {
77 enter_data <- enter(data)
78 enter_data$.phase <- 'enter'
79 enter_time <- start - enter_length
80 }
81 if (is.null(exit)) {
82 exit_data <- data[0, , drop = FALSE]
83 exit_time <- start[0]
84 } else {
85 exit_data <- exit(data)
86 exit_data$.phase <- 'exit'
87 exit_time <- (if (length(end) == 0) start else end) + exit_length
88 }
89 data <- rbind(enter_data, data, event_end, exit_data)
90 time <- c(enter_time, start, end, exit_time)
91 data$.time <- time
92 data
93 }
+52
-0
R/tween_fill.R less more
0 #' Fill out missing values by interpolation
1 #'
2 #' This tween fills out `NA` elements (or `NULL` elements if `data` is a list)
3 #' by interpolating between the prior and next non-missing values.
4 #'
5 #' @param data A data.frame or vector.
6 #' @param ease A character vector giving valid easing functions. Recycled to
7 #' match the ncol of `data`
8 #'
9 #' @return If `data` is a data.frame then a data.frame with the same
10 #' columns. If `data` is a vector then a vector.
11 #'
12 #' @export
13 #'
14 #' @examples
15 #' # Single vector
16 #' tween_fill(c(1, NA, NA, NA, NA, NA, 2, 6, NA, NA, NA, -2), 'cubic-in-out')
17 #'
18 #' # Data frame
19 #' tween_fill(mtcars[c(1, NA, NA, NA, NA, 4, NA, NA, NA, 10), ], 'cubic-in')
20 #'
21 tween_fill <- function(data, ease) {
22 single_vec <- !is.data.frame(data)
23 if (single_vec) {
24 if (length(data) == 0) return(data[integer()])
25 data_df <- data.frame(data = rep(NA, length(data)))
26 data_df$data <- data
27 data <- data_df
28 } else {
29 if (nrow(data) == 0) return(data[integer(), ])
30 }
31 ease <- rep(ease, length.out = ncol(data))
32 classes <- col_classes(data)
33 tweendata <- lapply(seq_along(classes), function(i) {
34 switch(
35 classes[i],
36 numeric = interpolate_numeric_fill(data[[i]], ease[i]),
37 logical = interpolate_logical_fill(data[[i]], ease[i]),
38 factor = interpolate_factor_fill(data[[i]], ease[i]),
39 character = interpolate_character_fill(data[[i]], ease[i]),
40 colour = interpolate_colour_fill(data[[i]], ease[i]),
41 date = interpolate_date_fill(data[[i]], ease[i]),
42 datetime = interpolate_datetime_fill(data[[i]], ease[i]),
43 constant = interpolate_constant_fill(data[[i]], ease[i]),
44 numlist = interpolate_numlist_fill(data[[i]], ease[i]),
45 list = interpolate_list_fill(data[[i]], ease[i])
46 )
47 })
48 if (single_vec) return(tweendata[[1]])
49
50 structure(tweendata, names = names(data), row.names = seq_along(tweendata[[1]]), class = 'data.frame')
51 }
+29
-0
R/tween_numeric.R less more
0 #' @rdname tween
1 #'
2 #' @export
3 tween_numeric <- function(data, n, ease = 'linear') {
4 data <- as.list(data)
5 prepData <- prepareTween(data, n, ease)
6 if (!all(sapply(prepData$data, is.numeric))) {
7 stop('data must consist of numeric elements')
8 }
9 tweendata <- do.call(interpolate_numeric_state, prepData)
10 unname(split(tweendata,
11 rep(seq_along(data[[1]]), length.out = length(tweendata))))
12 }
13
14 #' @rdname tween
15 #'
16 #' @export
17 tween_numeric_t <- function(data, n, ease = 'linear') {
18 if (!is.list(data)) {
19 data <- list(data)
20 }
21 prepData <- prepareTweenTranspose(data, n, ease)
22 if (!all(sapply(prepData$data, is.numeric))) {
23 stop('data must consist of numeric elements')
24 }
25 tweendata <- do.call(interpolate_numeric_state, prepData)
26 unname(split(tweendata,
27 rep(seq_along(data), rep(n, length.out = length(data)))))
28 }
+376
-0
R/tween_state.R less more
0 #' Compose tweening between states
1 #'
2 #' The `tween_state()` is a counterpart to `tween_states()` that is aimed at
3 #' letting you gradually build up a scene by composing state changes one by one.
4 #' This setup lets you take more control over each state change and allows you
5 #' to work with datasets with uneven number of rows, flexibly specifying what
6 #' should happen with entering and exiting data. `keep_state()` is a simpel
7 #' helper for letting you pause at a state. `open_state()` is a shortcut from
8 #' tweening from an empty dataset with a given `enter()` function while
9 #' `close_state()` is the same but will instead tween into an empty dataset with
10 #' a given `exit()` function.
11 #'
12 #' @param .data A data.frame to start from. If `.data` is the result of a prior
13 #' tween, only the last frame will be used for the tween. The new tween will
14 #' then be added to the prior tween
15 #'
16 #' @param to A data.frame to end at. It must contain the same columns as .data
17 #' (exluding `.frame`)
18 #'
19 #' @param ease The easing function to use. Either a single string or one for
20 #' each column in the data set.
21 #'
22 #' @param nframes The number of frames to calculate for the tween
23 #'
24 #' @param id The column to match observations on. If `NULL` observations will be
25 #' matched by position. See the *Match, Enter, and Exit* section for more
26 #' information.
27 #'
28 #' @param enter,exit functions that calculate a start state for new observations
29 #' that appear in `to` or an end state for observations that are not present in
30 #' `to`. If `NULL` the new/old observations will not be part of the tween. The
31 #' function gets a data.frame with either the start state of the exiting
32 #' observations, or the end state of the entering observations and must return
33 #' a modified version of that data.frame. See the *Match, Enter, and Exit*
34 #' section for more information.
35 #'
36 #' @return A data.frame containing all the intermediary states in the tween,
37 #' each state will be enumerated by the `.frame` column
38 #'
39 #' @section Match, Enter, and Exit:
40 #' When there are discrepancies between the two states to tweeen between you
41 #' need a way to resolve the discrepancy before calculating the intermediary
42 #' states. With discrepancies we mean that some data points are present in the
43 #' start state and not in the end state, and/or some are present in the end
44 #' state but not in the start state. A simple example is that the start state
45 #' contains 100 rows and the end state contains 70. There are 30 missing rows
46 #' that we need to do something about before we can calculate the tween.
47 #'
48 #' **Making pairs**
49 #' The first question to answer is "How do we know which observations are
50 #' disappearing (*exiting*) and/or appearing (*entering*)?". This is done with
51 #' the `id` argument which should give a column name to match rows between the
52 #' two states on. If `id = NULL` the rows will be matched by position (in the
53 #' above example the last 30 rows in the start state will be entering). The `id`
54 #' column must only contain unique values in order to work.
55 #'
56 #' **Making up states**
57 #' Once the rows in each state has been paired you'll end up with three sets of
58 #' data. One containing rows that is present in both the start and end state,
59 #' one containing rows only present in the start state, and one only containing
60 #' rows present in the end state. The first group is easy - here you just tween
61 #' between each rows - but for the other two we'll need some state to start or
62 #' end the tween with. This is really the purpose of the `enter` and `exit`
63 #' functions. They take a data frame containing the subset of data that has not
64 #' been matched and must return a new data frame giving the state that these
65 #' rows must be tweened from/into. A simple example could be an `enter` function
66 #' that sets the variable giving the opacity in the plot to 0 - this will make
67 #' the new points fade into view during the transition.
68 #'
69 #' **Ignoring discrepancies**
70 #' The default values for `enter` and `exit` is `NULL`. This value indicate that
71 #' non-matching rows should simply be ignored for the transition and simply
72 #' appear in the last frame of the tween. This is the default.
73 #'
74 #' @importFrom rlang enquo
75 #' @export
76 #'
77 #' @examples
78 #' data1 <- data.frame(
79 #' x = 1:20,
80 #' y = 0,
81 #' colour = 'forestgreen',
82 #' stringsAsFactors = FALSE
83 #' )
84 #' data2 <- data1
85 #' data2$x <- 20:1
86 #' data2$y <- 1
87 #'
88 #' data <- data1 %>%
89 #' tween_state(data2, 'linear', 50) %>%
90 #' keep_state(20) %>%
91 #' tween_state(data1, 'bounce-out', 50)
92 #'
93 #' # Using enter and exit (made up numbers)
94 #' df1 <- data.frame(
95 #' country = c('Denmark', 'Sweden', 'Norway'),
96 #' population = c(5e6, 10e6, 3.5e6)
97 #' )
98 #' df2 <- data.frame(
99 #' country = c('Denmark', 'Sweden', 'Norway', 'Finland'),
100 #' population = c(6e6, 10.5e6, 4e6, 3e6)
101 #' )
102 #' df3 <- data.frame(
103 #' country = c('Denmark', 'Norway'),
104 #' population = c(10e6, 6e6)
105 #' )
106 #' to_zero <- function(x) {
107 #' x$population <- 0
108 #' x
109 #' }
110 #' pop_devel <- df1 %>%
111 #' tween_state(df2, 'cubic-in-out', 50, id = country, enter = to_zero) %>%
112 #' tween_state(df3, 'cubic-in-out', 50, id = country, enter = to_zero,
113 #' exit = to_zero)
114 #'
115 tween_state <- function(.data, to, ease, nframes, id = NULL, enter = NULL, exit = NULL) {
116 from <- .get_last_frame(.data)
117 from$.phase <- rep('raw', length = nrow(from))
118 to$.phase <- rep('raw', length = nrow(to))
119 to$.id <- rep(NA_integer_, length = nrow(to))
120 id <- enquo(id)
121 if (.has_frames(.data)) nframes <- nframes + 1
122 if (!setequal(names(from), names(to))) {
123 stop('from and to must have identical columns', call. = FALSE)
124 }
125
126 if (nrow(from) == 0 && nrow(to) == 0) {
127 return(.with_prior_frames(.data, from, nframes))
128 }
129
130 to <- to[, match(names(from), names(to)), drop = FALSE]
131 if (length(ease) == 1) ease <- rep(ease, ncol(from) - 2)
132 if (length(ease) == ncol(from) - 2) {
133 ease <- c(ease, 'linear', 'linear') # To account for .phase and .id columns
134 } else {
135 stop('Ease must be either a single string or one for each column', call. = FALSE)
136 }
137 stopifnot(length(nframes) == 1 && is.numeric(nframes) && nframes %% 1 == 0)
138
139 classes <- if (nrow(from) == 0) col_classes(to) else col_classes(from)
140 if (nrow(from) > 0 && nrow(to) > 0) stopifnot(identical(classes, col_classes(to)))
141 full_set <- .complete_states(from, to, id, enter, exit, .max_id(.data))
142 to$.id <- full_set$orig_to
143
144 tweendata <- lapply(seq_along(classes), function(i) {
145 d <- list(full_set$from[[i]], full_set$to[[i]])
146 state <- simple_state(nframes, ease[i])
147 switch(
148 classes[i],
149 numeric = interpolate_numeric_state(d, state),
150 logical = interpolate_logical_state(d, state),
151 factor = interpolate_factor_state(d, state),
152 character = interpolate_character_state(d, state),
153 colour = interpolate_colour_state(d, state),
154 date = interpolate_date_state(d, state),
155 datetime = interpolate_datetime_state(d, state),
156 constant = interpolate_constant_state(d, state),
157 numlist = interpolate_numlist_state(d, state),
158 list = interpolate_list_state(d, state),
159 phase = get_phase_state(d, state)
160 )
161 })
162 tweendata <- structure(tweendata, names = names(full_set$from), row.names = seq_along(tweendata[[1]]), class = 'data.frame')
163 tweendata$.frame <- rep(seq_len(nframes - 1), each = nrow(full_set$from))
164 tweendata <- rbind(
165 if (nframes > 1) cbind(from, .frame = rep(1, nrow(from))) else NULL,
166 tweendata[tweendata$.frame != 1, , drop = FALSE],
167 cbind(to, .frame = rep(nframes, nrow(to)))
168 )
169 .with_prior_frames(.data, tweendata, nframes)
170 }
171 #' @rdname tween_state
172 #' @export
173 keep_state <- function(.data, nframes) {
174 state <- .get_last_frame(.data)
175 state$.phase <- rep('raw', length = nrow(state))
176 if (.has_frames(.data)) nframes <- nframes + 1
177 if (nrow(state) == 0) {
178 return(.with_prior_frames(.data, state, nframes))
179 }
180 states <- state[rep(seq_len(nrow(state)), nframes), , drop = FALSE]
181 states$.phase[seq_len(nrow(state) * (nframes - 1))] <- 'static'
182 states$.frame <- rep(seq_len(nframes), each = nrow(state))
183 .with_prior_frames(.data, states, nframes)
184 }
185 #' @rdname tween_state
186 #' @export
187 open_state <- function(.data, ease, nframes, enter) {
188 to <- .get_first_frame(.data)
189 if (.has_frames(.data)) nframes <- nframes + 1
190 tweendata <- tween_state(to[0, , drop = FALSE], to, ease, nframes, enter = enter)
191 .with_later_frames(.data, tweendata, nframes)
192 }
193 #' @rdname tween_state
194 #' @export
195 close_state <- function(.data, ease, nframes, exit) {
196 from <- .get_last_frame(.data)
197 if (.has_frames(.data)) nframes <- nframes + 1
198 tweendata <- tween_state(from, from[0, , drop = FALSE], ease, nframes, exit = exit)
199 .with_prior_frames(.data, tweendata, nframes)
200 }
201 #' Helpers for working with tweened data
202 #'
203 #' These are internal helpers for extracting and inserting data into a
204 #' data.frame of tweened states.
205 #'
206 #' @param data,prior,later A data.frame. If a `.frame` column exists it will be interpreted
207 #' as a data.frame containing multiple states
208 #'
209 #' @param new_tween The result of a tweening
210 #'
211 #' @return A data.frame
212 #' @keywords internal
213 #' @export
214 #'
215 .get_last_frame <- function(data) {
216 nframes <- attr(data, 'nframes')
217 data <- if (!is.null(nframes)) {
218 data[data$.frame == nframes, names(data) != '.frame', drop = FALSE]
219 } else if ('.frame' %in% names(data)) {
220 data[data$.frame == max(data$.frame), names(data) != '.frame', drop = FALSE]
221 } else {
222 data
223 }
224 if (is.null(data$.id)) {
225 data$.id <- seq_len(nrow(data))
226 }
227 data
228 }
229 #' @rdname dot-get_last_frame
230 #' @export
231 .get_first_frame <- function(data) {
232 data <- if ('.frame' %in% names(data)) {
233 data[data$.frame == 1, names(data) != '.frame', drop = FALSE]
234 } else {
235 data
236 }
237 if (is.null(data$.id)) {
238 data$.id <- seq_len(nrow(data))
239 }
240 data
241 }
242 #' @rdname dot-get_last_frame
243 #' @export
244 .with_prior_frames <- function(prior, new_tween, nframes) {
245 nframes_before <- attr(prior, 'nframes')
246 if (is.null(nframes_before) && nrow(prior) > 0 && '.frame' %in% names(prior)) nframes_before <- max(prior$.frame)
247 frames <- if (!is.null(nframes_before)) {
248 prior <- prior[prior$.frame != nframes_before, , drop = FALSE]
249 new_tween$.frame <- new_tween$.frame + nframes_before - 1
250 rbind(prior, new_tween)
251 } else {
252 nframes_before <- 1
253 new_tween
254 }
255 attr(frames, 'nframes') <- nframes + nframes_before - 1
256 attr(frames, 'max_id') <- find_max_id(prior, new_tween)
257 frames
258 }
259 #' @rdname dot-get_last_frame
260 #' @export
261 .with_later_frames <- function(later, new_tween, nframes) {
262 nframes_before <- attr(later, 'nframes')
263 nframes_before <- if (is.null(nframes_before) && nrow(later) > 0 && '.frame' %in% names(later)) max(later$.frame) else 1
264 frames <- if ('.frame' %in% names(later)) {
265 later <- later[later$.frame != 1, , drop = FALSE]
266 later$.frame <- later$.frame + max(new_tween$.frame)
267 rbind(new_tween, later)
268 } else {
269 new_tween
270 }
271 attr(frames, 'nframes') <- nframes + nframes_before - 1
272 attr(frames, 'max_id') <- find_max_id(later, new_tween)
273 frames
274 }
275 find_max_id <- function(data, new) {
276 max_new <- if (nrow(new) == 0) 0 else max(new$.id)
277 max(max_new, .max_id(data))
278 }
279 #' Get the highest id occuring in a dataset
280 #'
281 #' This is helper for `tween_state` related functions to get the currently
282 #' highest `.id` in a frame collection
283 #'
284 #' @param data A data.frame as returned by `tween_state`
285 #'
286 #' @return An integer giving the currently highest id
287 #'
288 #' @keywords internal
289 #' @export
290 .max_id <- function(data) {
291 max_id <- attr(data, 'max_id')
292 if (is.null(max_id) && nrow(data) > 0 && !is.null(data$.id)) max_id <- max(data$.id)
293 else max_id <- nrow(data)
294 max_id
295 }
296 #' Fill in missing rows using enter and exit functions
297 #'
298 #' This function figures out which rows are missing in either state and applies
299 #' the provided `enter` and `exit` functions to fill in the blanks and provide
300 #' a 1-to-1 relation between the rows in `from` and `to`.
301 #'
302 #' @param from,to Data.frames to tween between
303 #'
304 #' @param id The name of the column that holds the matching id
305 #'
306 #' @param enter,exit functions to fill out missing rows in `from` and `to`
307 #' respectively
308 #'
309 #' @return A list with the elements `from` and `to` holding the filled out
310 #' versions of `from` and `to`
311 #'
312 #' @keywords internal
313 #' @importFrom rlang eval_tidy %||%
314 #' @export
315 .complete_states <- function(from, to, id, enter, exit, max_id) {
316 from_id <- eval_tidy(id, from) %||% seq_len(nrow(from))
317 to_id <- eval_tidy(id, to) %||% seq_len(nrow(to))
318 if (length(from_id) != nrow(from) || length(to_id) != nrow(to)) {
319 stop('id must match the length of the data', call. = FALSE)
320 }
321 n_to <- nrow(to)
322 if (anyDuplicated(from_id) || anyDuplicated(to_id) || !setequal(from_id, to_id)) {
323 from_id <- paste(from_id, count_occourance(from_id), sep = '_')
324 to_id <- paste(to_id, count_occourance(to_id), sep = '_')
325 entering <- !to_id %in% from_id
326 exiting <- !from_id %in% to_id
327 exits <- from[entering, , drop = FALSE]
328
329 if (is.null(enter) || sum(entering) == 0) {
330 to <- to[!entering, , drop = FALSE]
331 to_id <- to_id[!entering]
332 enters <- to[0, , drop = FALSE]
333 enter_id <- to_id[0]
334 } else {
335 stopifnot(is.function(enter))
336 enters <- enter(to[entering, , drop = FALSE])
337 enters$.phase <- 'enter'
338 enter_id <- to_id[entering]
339 }
340 if (is.null(exit) || sum(exiting) == 0) {
341 from <- from[!exiting, , drop = FALSE]
342 from_id <- from_id[!exiting]
343 exits <- from[0, , drop = FALSE]
344 exit_id <- from_id[0]
345 } else {
346 stopifnot(is.function(exit))
347 exits <- exit(from[exiting, , drop = FALSE])
348 exits$.phase <- 'exit'
349 exit_id <- from_id[exiting]
350 }
351 from <- rbind(from, enters)
352 from_id <- c(from_id, enter_id)
353 to <- rbind(to, exits)
354 to_id <- c(to_id, exit_id)
355 }
356 from$.id[is.na(from$.id)] <- seq_len(sum(is.na(from$.id))) + max_id
357 orig_to_id <- from$.id[match(to_id, from_id)][seq_len(n_to)]
358 to <- to[match(from_id, to_id), , drop = FALSE]
359 to$.id <- from$.id
360
361 list(from = from, to = to, orig_to = orig_to_id)
362 }
363 #' @rdname dot-get_last_frame
364 #' @export
365 .has_frames <- function(data) {
366 !is.null(attr(data, 'nframes')) || !is.null(data$.frame)
367 }
368 simple_state <- function(n, ease) {
369 data.frame(state = c(0, 1), nframes = c(n - 1, 0), ease = c(ease, 'constant'), stringsAsFactors = FALSE)
370 }
371
372 count_occourance <- function(x) {
373 if (length(x) == 0) return(integer(0))
374 unsplit(lapply(split(x, x), seq_along), x)
375 }
+115
-0
R/tween_states.R less more
0 #' Tween a list of data.frames representing states
1 #'
2 #' This function is intended to create smooth transitions between states of
3 #' data. States are defined as full data.frames or data.frames containing only
4 #' the columns with change. Each state can have a defined period of pause, the
5 #' transition length between each states can be defined as well as the easing
6 #' function.
7 #'
8 #' @param data A list of data.frames. Each data.frame must contain the same
9 #' number of rows, but only the first data.frame needs to contain all columns.
10 #' Subsequent data.frames need only contain the columns that shows change.
11 #'
12 #' @param tweenlength The lengths of the transitions between each state.
13 #'
14 #' @param statelength The length of the pause at each state.
15 #'
16 #' @param ease The easing functions to use for the transitions. See details.
17 #'
18 #' @param nframes The number of frames to generate. The actual number of frames
19 #' might end up being higher depending on the regularity of `tweenlength`
20 #' and `statelength`.
21 #'
22 #' @return A data.frame with the same columns as the first data.frame in
23 #' `data`, but replicated `nframes` times. An additional column called
24 #' `.frame` will be added giving the frame number.
25 #'
26 #' @family data.frame tween
27 #'
28 #' @examples
29 #' data1 <- data.frame(
30 #' x = 1:20,
31 #' y = 0,
32 #' colour = 'forestgreen',
33 #' stringsAsFactors = FALSE
34 #' )
35 #' data2 <- data1
36 #' data2$x <- 20:1
37 #' data2$y <- 1
38 #'
39 #' data <- tween_states(list(data1, data2), 3, 1, 'cubic-in-out', 100)
40 #'
41 #' @export
42 #'
43 tween_states <- function(data, tweenlength, statelength, ease, nframes) {
44 if (!(is.list(data) && all(sapply(data, is.data.frame)))) {
45 stop('data must be a list of data.frames')
46 }
47 if (length(data) == 1) {
48 stop('data must contain multiple states')
49 }
50 if (length(unique(sapply(data, nrow))) != 1) {
51 stop('All elements in data must have the same number of rows')
52 }
53 data <- lapply(data, function(d) {
54 d$.phase <- 'raw'
55 d
56 })
57 origNames <- names(data[[1]])
58 if (!is.list(ease)) ease <- as.list(ease)
59 allNames <- unlist(lapply(data, names))
60 if (!all(allNames %in% origNames)) {
61 stop('All columns must be specified in the original data.frame')
62 }
63 nstates <- length(data)
64 tweenlength <- rep(tweenlength, nstates)[seq_len(nstates - 1)]
65 statelength <- rep(statelength, nstates)[seq_len(nstates)]
66 ease <- rep(ease, nstates)[seq_len(nstates - 1)]
67 pauseIndex <- which(rep(c(TRUE, FALSE), length.out = 2*nstates - 1))
68 tweenIndex <- which(rep(c(FALSE, TRUE), length.out = 2*nstates - 1))
69 statesOrder <- order(c(pauseIndex, tweenIndex))
70 states <- data.frame(
71 length = c(statelength, tweenlength)[statesOrder],
72 nframes = NA_integer_,
73 state = NA_integer_,
74 stringsAsFactors = FALSE
75 )
76 states$state <- rep(seq_len(nstates) - 1, each = 2, length.out = nrow(states))
77 states$ease <- lapply(c(rep(list('constant'), nstates), ease)[statesOrder], function(e) {
78 structure(rep(e, length.out = length(origNames)), names = origNames)
79 })
80 fullLength <- sum(states$length)
81 framelength <- fullLength/nframes
82 states$nframes <- round(states$length / framelength)
83 nframes <- sum(states$nframes)
84 framelength <- fullLength/nframes
85 data <- Reduce(function(l, r) {
86 extraCols <- !names(l[[length(l)]]) %in% names(r);
87 append(l, list(cbind(r, l[[length(l)]][, extraCols])))
88 }, data[-1], data[1])
89 colClasses <- col_classes(data[[1]])
90 tweendata <- lapply(names(data[[1]]), function(name) {
91 d <- lapply(data, `[[`, i = name)
92 d_states <- states
93 d_states$ease <- vapply(d_states$ease, `[`, character(1), i = name)
94 switch(
95 colClasses[name],
96 numeric = interpolate_numeric_state(d, d_states),
97 logical = interpolate_logical_state(d, d_states),
98 factor = interpolate_factor_state(d, d_states),
99 character = interpolate_character_state(d, d_states),
100 colour = interpolate_colour_state(d, d_states),
101 date = interpolate_date_state(d, d_states),
102 datetime = interpolate_datetime_state(d, d_states),
103 constant = interpolate_constant_state(d, d_states),
104 numlist = interpolate_numlist_state(d, d_states),
105 list = interpolate_list_state(d, d_states),
106 phase = get_phase_state(d, d_states)
107 )
108 })
109 tweendata <- structure(tweendata, names = names(data[[1]]), row.names = seq_along(tweendata[[1]]), class = 'data.frame')
110 tweendata$.id <- rep(seq_len(nrow(data[[1]])), each = nframes)
111 tweendata$.frame <- rep(seq_len(nframes), each = nrow(data[[1]]))
112 attr(tweendata, 'framelength') <- framelength
113 tweendata
114 }
+17
-0
R/tweenr_package.R less more
0 #' @details
1 #' tweenr is a small collection of functions to help you in creating
2 #' intermediary representations of your data, i.e. interpolating states of data.
3 #' As such it's a great match for packages such as animate and gganimate, since
4 #' it can work directly with data.frames of data, but it also provide fast and
5 #' efficient interpolaters for numeric, date, datetime and colour that are
6 #' vectorized and thus more efficient to use than the build in interpolation
7 #' functions (mainly [stats::approx()] and
8 #' [grDevices::colorRamp()]).
9 #'
10 #' The main functions for data.frames are [tween_states()],
11 #' [tween_elements()] and [tween_appear()], while the
12 #' standard interpolaters can be found at [tween()]
13 #'
14 #' @useDynLib tweenr
15 #' @importFrom Rcpp sourceCpp
16 '_PACKAGE'
+94
-0
README.md less more
0
1 <!-- README.md is generated from README.Rmd. Please edit that file -->
2 tweenr <img src="man/figures/logo.png" align="right" />
3 =======================================================
4
5 [![Travis-CI Build Status](https://travis-ci.org/thomasp85/tweenr.svg?branch=master)](https://travis-ci.org/thomasp85/tweenr) [![AppVeyor Build Status](https://ci.appveyor.com/api/projects/status/github/thomasp85/tweenr?branch=master&svg=true)](https://ci.appveyor.com/project/thomasp85/tweenr) [![CRAN\_Release\_Badge](http://www.r-pkg.org/badges/version-ago/tweenr)](https://CRAN.R-project.org/package=tweenr) [![CRAN\_Download\_Badge](http://cranlogs.r-pkg.org/badges/tweenr)](https://CRAN.R-project.org/package=tweenr) [![Coverage Status](https://img.shields.io/codecov/c/github/thomasp85/tweenr/master.svg)](https://codecov.io/github/thomasp85/tweenr?branch=master)
6
7 What is this?
8 -------------
9
10 `tweenr` is a package for interpolating data, mainly for animations. It provides a range of functions that take data of different forms and calculate intermediary values. It supports all atomic vector types along with `factor`, `Date`, `POSIXct`, characters representing colours, and `list`. `tweenr` is used extensibly by [`gganimate`](https://github.com/thomasp85/gganimate) to create smooth animations, but can also be used by itself to prepare data for animation in another framework.
11
12 How do I get it?
13 ----------------
14
15 `tweenr` is available on CRAN and can be installed with `install.packages('tweenr')`. In order to get the development version you can install it from github with `devtools`
16
17 ``` r
18 #install.packages('devtools')
19 devtools::install_github('thomasp85/tweenr')
20 ```
21
22 An example
23 ----------
24
25 Following is an example of using the pipeable `tween_state()` function with our belowed iris data:
26
27 ``` r
28 library(tweenr)
29 library(ggplot2)
30
31 # Prepare the data with some extra columns
32 iris$col <- c('firebrick', 'forestgreen', 'steelblue')[as.integer(iris$Species)]
33 iris$size <- 4
34 iris$alpha <- 1
35 iris <- split(iris, iris$Species)
36
37 # Here comes tweenr
38 iris_tween <- iris$setosa %>%
39 tween_state(iris$versicolor, ease = 'cubic-in-out', nframes = 30) %>%
40 keep_state(10) %>%
41 tween_state(iris$virginica, ease = 'elastic-out', nframes = 30) %>%
42 keep_state(10) %>%
43 tween_state(iris$setosa, ease = 'quadratic-in', nframes = 30) %>%
44 keep_state(10)
45
46 # Animate it to show the effect
47 p_base <- ggplot() +
48 geom_point(aes(x = Petal.Length, y = Petal.Width, alpha = alpha, colour = col,
49 size = size)) +
50 scale_colour_identity() +
51 scale_alpha_identity() +
52 scale_size_identity() +
53 coord_cartesian(xlim = range(iris_tween$Petal.Length),
54 ylim = range(iris_tween$Petal.Width))
55 iris_tween <- split(iris_tween, iris_tween$.frame)
56 for (d in iris_tween) {
57 p <- p_base %+% d
58 plot(p)
59 }
60 ```
61
62 ![](man/figures/README-unnamed-chunk-3.gif)
63
64 Other functions
65 ---------------
66
67 Besides the `tween_state()`/`keep_state()` combo showcased above, there are a slew of other functions meant for data in different formats
68
69 **`tween_components`** takes a single data.frame, a vector of ids identifying recurrent elements, and a vector of timepoints for each row and interpolate each element between its specified time points.
70
71 **`tween_events`** takes a single data.frame where each row encodes a single unique event, along with a start, and end time and expands the data across a given number of frames.
72
73 **`tween_along`** takes a single data.frame along with an id and timepoint vector and calculate evenly spaced intermediary values with the possibility of keeping old values at each frame.
74
75 **`tween_at`** takes two data.frames or vectors along with a numeric vector giving the interpolation point between the two data.frames to calculate.
76
77 **`tween_fill`** fills missing values in a vector or data.frame by interpolating between previous and next non-missing elements
78
79 Easing
80 ------
81
82 In order to get smooth transitions you'd often want a non-linear interpolation. This can be achieved by using an easing function to translate the equidistant interpolation points into new ones. `tweenr` has support for a wide range of different easing functions, all of which can be previewed using `display_ease()` as here where the popular *cubic-in-out* is shown:
83
84 ``` r
85 tweenr::display_ease('cubic-in-out')
86 ```
87
88 ![](man/figures/README-unnamed-chunk-4-1.png)
89
90 Spatial interpolations
91 ----------------------
92
93 The purpose of `tweenr` is to interpolate values independently. If paths and polygons needs to be transitioned the [`transformr`](https://github.com/thomasp85/transformr) package should be used as it expands tweenr into the spatial realm
+58
-0
man/display_ease.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/display_ease.R
2 \name{display_ease}
3 \alias{display_ease}
4 \title{Display an easing function}
5 \usage{
6 display_ease(ease)
7 }
8 \arguments{
9 \item{ease}{The name of the easing function to display (see details)}
10 }
11 \value{
12 This function is called for its side effects
13 }
14 \description{
15 This simple helper lets you explore how the different easing functions govern
16 the interpolation of data.
17 }
18 \details{
19 How transitions proceed between states are defined by an easing function. The
20 easing function converts the parameterized progression from one state to the
21 next to a new number between 0 and 1. \code{linear} easing is equivalent to
22 an identity function that returns the input unchanged. In addition there are
23 a range of additional easers available, each with three modifiers.
24
25 \strong{Easing modifiers:}
26 \describe{
27 \item{-in}{The easing function is applied as-is}
28 \item{-out}{The easing function is applied in reverse}
29 \item{-in-out}{The first half of the transition it is applied as-is, while
30 in the last half it is reversed}
31 }
32
33 \strong{Easing functions}
34 \describe{
35 \item{quadratic}{Models a power-of-2 function}
36 \item{cubic}{Models a power-of-3 function}
37 \item{quartic}{Models a power-of-4 function}
38 \item{quintic}{Models a power-of-5 function}
39 \item{sine}{Models a sine function}
40 \item{circular}{Models a pi/2 circle arc}
41 \item{exponential}{Models an exponential function}
42 \item{elastic}{Models an elastic release of energy}
43 \item{back}{Models a pullback and relase}
44 \item{bounce}{Models the bouncing of a ball}
45 }
46
47 In addition to this function a good animated explanation can be found
48 \href{http://easings.net}{here}.
49 }
50 \examples{
51 # The default - identity
52 display_ease('linear')
53
54 # A more fancy easer
55 display_ease('elastic-in')
56
57 }
+26
-0
man/dot-complete_states.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/tween_state.R
2 \name{.complete_states}
3 \alias{.complete_states}
4 \title{Fill in missing rows using enter and exit functions}
5 \usage{
6 .complete_states(from, to, id, enter, exit, max_id)
7 }
8 \arguments{
9 \item{from, to}{Data.frames to tween between}
10
11 \item{id}{The name of the column that holds the matching id}
12
13 \item{enter, exit}{functions to fill out missing rows in \code{from} and \code{to}
14 respectively}
15 }
16 \value{
17 A list with the elements \code{from} and \code{to} holding the filled out
18 versions of \code{from} and \code{to}
19 }
20 \description{
21 This function figures out which rows are missing in either state and applies
22 the provided \code{enter} and \code{exit} functions to fill in the blanks and provide
23 a 1-to-1 relation between the rows in \code{from} and \code{to}.
24 }
25 \keyword{internal}
+34
-0
man/dot-get_last_frame.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/tween_state.R
2 \name{.get_last_frame}
3 \alias{.get_last_frame}
4 \alias{.get_first_frame}
5 \alias{.with_prior_frames}
6 \alias{.with_later_frames}
7 \alias{.has_frames}
8 \title{Helpers for working with tweened data}
9 \usage{
10 .get_last_frame(data)
11
12 .get_first_frame(data)
13
14 .with_prior_frames(prior, new_tween, nframes)
15
16 .with_later_frames(later, new_tween, nframes)
17
18 .has_frames(data)
19 }
20 \arguments{
21 \item{data, prior, later}{A data.frame. If a \code{.frame} column exists it will be interpreted
22 as a data.frame containing multiple states}
23
24 \item{new_tween}{The result of a tweening}
25 }
26 \value{
27 A data.frame
28 }
29 \description{
30 These are internal helpers for extracting and inserting data into a
31 data.frame of tweened states.
32 }
33 \keyword{internal}
+19
-0
man/dot-max_id.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/tween_state.R
2 \name{.max_id}
3 \alias{.max_id}
4 \title{Get the highest id occuring in a dataset}
5 \usage{
6 .max_id(data)
7 }
8 \arguments{
9 \item{data}{A data.frame as returned by \code{tween_state}}
10 }
11 \value{
12 An integer giving the currently highest id
13 }
14 \description{
15 This is helper for \code{tween_state} related functions to get the currently
16 highest \code{.id} in a frame collection
17 }
18 \keyword{internal}
man/figures/README-unnamed-chunk-3.gif less more
Binary diff not shown
man/figures/README-unnamed-chunk-4-1.png less more
Binary diff not shown
man/figures/logo.png less more
Binary diff not shown
+16
-0
man/reexports.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/aaa.R
2 \docType{import}
3 \name{reexports}
4 \alias{reexports}
5 \alias{\%>\%}
6 \title{Objects exported from other packages}
7 \keyword{internal}
8 \description{
9 These objects are imported from other packages. Follow the links
10 below to see their documentation.
11
12 \describe{
13 \item{magrittr}{\code{\link[magrittr]{\%>\%}}}
14 }}
15
+119
-0
man/tween.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/tween.R, R/tween_colour.R, R/tween_constant.R,
2 % R/tween_date.R, R/tween_datetime.R, R/tween_numeric.R
3 \name{tween}
4 \alias{tween}
5 \alias{tween_t}
6 \alias{tween_colour}
7 \alias{tween_color}
8 \alias{tween_colour_t}
9 \alias{tween_color_t}
10 \alias{tween_constant}
11 \alias{tween_constant_t}
12 \alias{tween_date}
13 \alias{tween_date_t}
14 \alias{tween_datetime}
15 \alias{tween_datetime_t}
16 \alias{tween_numeric}
17 \alias{tween_numeric_t}
18 \title{Create simple tweens}
19 \usage{
20 tween(data, n, ease = "linear")
21
22 tween_t(data, n, ease = "linear")
23
24 tween_colour(data, n, ease = "linear")
25
26 tween_color(data, n, ease = "linear")
27
28 tween_colour_t(data, n, ease = "linear")
29
30 tween_color_t(data, n, ease = "linear")
31
32 tween_constant(data, n, ease = "linear")
33
34 tween_constant_t(data, n, ease = "linear")
35
36 tween_date(data, n, ease = "linear")
37
38 tween_date_t(data, n, ease = "linear")
39
40 tween_datetime(data, n, ease = "linear")
41
42 tween_datetime_t(data, n, ease = "linear")
43
44 tween_numeric(data, n, ease = "linear")
45
46 tween_numeric_t(data, n, ease = "linear")
47 }
48 \arguments{
49 \item{data}{A list of vectors or a single vector. In the standard functions
50 each element in the list must be of equal length; for the *_t functions
51 lengths can differ. If a single vector is used it will be eqivalent to using
52 \code{as.list(data)} for the standard functions and \code{list(data)} for the
53 *_t functions.}
54
55 \item{n}{The number of elements per transition or tween. See details}
56
57 \item{ease}{The easing function to use for each transition or tween. See
58 details. Defaults to \code{'linear'}}
59 }
60 \value{
61 A list with an element for each tween. That means that the length of
62 the return is equal to the length of the elements in \code{data} for the
63 standard functions and equal to the length of \code{data} for the *_t
64 functions.
65 }
66 \description{
67 This set of functions can be used to interpolate between single data types,
68 i.e. data not part of data.frames but stored in vectors. All functions come
69 in two flavours: the standard and a *_t version. The standard reads the data
70 as a list of states, each tween matched element-wise from state to state. The
71 *_t version uses the transposed representation where each element is a vector
72 of states. The standard approach can be used when each tween has the same
73 number of states and you want to control the number of point in each state
74 transition. The latter is useful when each tween consists of different
75 numbers of states and/or you want to specify the total number of points for
76 each tween.
77 }
78 \details{
79 \code{tween} and \code{tween_t} are wrappers around the other functions that tries to guess
80 the type of input data and choose the appropriate tween function. Unless you
81 have data that could be understood as a colour but is in fact a character
82 vector it should be safe to use these wrappers. It is probably safer and more
83 verbose to use the explicit functions within package code as they circumvent
84 the type inference and checks whether the input data matches the tween
85 function.
86
87 \code{tween_numeric} will provide a linear interpolation between the points based on
88 the sequence returned by the easing function. \code{tween_date} and \code{tween_datetime}
89 converts to numeric, produces the tweening, and converts back again.
90 \code{tween_colour} converts colours into Lab and does the interpolation there,
91 converting back to sRGB after the tweening is done. \code{tween_constant} is a
92 catchall that converts the input into character and interpolates by switching
93 between states halfway through the transition.
94
95 The meaning of the \code{n} and \code{ease} arguments differs somewhat
96 between the standard and *_t versions of the functions. In the standard
97 function \code{n} and \code{ease} refers to the length and easing function of
98 each transition, being recycled if necessary to \code{length(data) - 1}. In
99 the *_t functions \code{n} and \code{ease} refers to the total length of each
100 tween and the easing function to be applied to all transition for each tween.
101 The will both be recycled to \code{length(data)}.
102 }
103 \section{Difference Between \code{tween_numeric} and \code{approx()}}{
104
105 \code{tween_numeric} (and \code{tween_numeric_t}) is superficially equivalent to
106 \code{\link[stats:approx]{stats::approx()}}, but there are differences.
107 \code{\link[stats:approx]{stats::approx()}} will create evenly spaced points, at the expense
108 of not including the actual points in the input, while the reverse is true
109 for \code{tween_numeric}. Apart from that \code{tween_numeric} of course supports easing
110 functions and is vectorized.
111 }
112
113 \examples{
114 tween_numeric(list(1:3, 10:8, c(20, 60, 30)), 10)
115
116 tween_colour_t(list(colours()[1:4], colours()[1:2], colours()[25:100]), 100)
117
118 }
+50
-0
man/tween_along.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/tween_along.R
2 \name{tween_along}
3 \alias{tween_along}
4 \title{Interpolate data along a given dimension}
5 \usage{
6 tween_along(.data, ease, nframes, along, id = NULL, range = NULL,
7 history = TRUE, keep_last = FALSE)
8 }
9 \arguments{
10 \item{.data}{A data.frame with components at different stages}
11
12 \item{ease}{The easing function to use. Either a single string or one for
13 each column in the data set.}
14
15 \item{nframes}{The number of frames to calculate for the tween}
16
17 \item{along}{The "time" point for each row}
18
19 \item{id}{An unquoted expression giving the component id for each row. Will
20 be evaluated in the context of \code{.data} so can refer to a column from that}
21
22 \item{range}{The range of time points to include in the tween. If \code{NULL} it
23 will use the range of \code{time}}
24
25 \item{history}{Should earlier datapoints be kept in subsequent frames}
26
27 \item{keep_last}{Should the last point of each id be kept beyond its time}
28 }
29 \value{
30 A data.frame with the same columns as \code{.data} along with \code{.id} giving
31 the component id, \code{.phase} giving the state of each component in each frame,
32 and \code{.frame} giving the frame membership of each row.
33 }
34 \description{
35 This tween takes groups of rows along with the time for each row and
36 calculates the exact value at each at each frame. Further it allows for
37 keeping the subsequent raw data from previous frame as well as letting the
38 final row linger beyond its time. It especially useful for data that should
39 be visualised as lines that are drawn along the x-axis, but can of course
40 also be used for other dimensions as well (even dimensions not corresponding
41 to any axis).
42 }
43 \seealso{
44 Other data.frame tween: \code{\link{tween_appear}},
45 \code{\link{tween_components}},
46 \code{\link{tween_elements}}, \code{\link{tween_events}},
47 \code{\link{tween_states}}
48 }
49 \concept{data.frame tween}
+51
-0
man/tween_appear.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/tween_appear.R
2 \name{tween_appear}
3 \alias{tween_appear}
4 \title{Tween a data.frame of appearances}
5 \usage{
6 tween_appear(data, time, timerange, nframes)
7 }
8 \arguments{
9 \item{data}{A data.frame to tween}
10
11 \item{time}{The name of the column that holds the time dimension. This does
12 not need to hold time data in the strictest sence - any numerical type will
13 do}
14
15 \item{timerange}{The range of time to create the tween for. If missing it
16 will defaults to the range of the time column}
17
18 \item{nframes}{The number of frames to create for the tween. If missing it
19 will create a frame for each full unit in \code{timerange} (e.g.
20 \code{timerange = c(1, 10)} will give \code{nframes = 10})}
21 }
22 \value{
23 A data.frame as \code{data} but repeated \code{nframes} times and
24 with the additional columns \code{.age} and \code{.frame}
25 }
26 \description{
27 This function is intended for use when you have a data.frame of events at
28 different time points. This could be the appearance of an observation for
29 example. This function replicates your data \code{nframes} times and
30 calculates the duration of each frame. At each frame each row is
31 assigned an age based on the progression of frames and the entry point of in
32 time for that row. A negative age means that the row has not appeared yet.
33 }
34 \examples{
35 data <- data.frame(
36 x = rnorm(100),
37 y = rnorm(100),
38 time = sample(50, 100, replace = TRUE)
39 )
40
41 data <- tween_appear(data, 'time', nframes = 200)
42
43 }
44 \seealso{
45 Other data.frame tween: \code{\link{tween_along}},
46 \code{\link{tween_components}},
47 \code{\link{tween_elements}}, \code{\link{tween_events}},
48 \code{\link{tween_states}}
49 }
50 \concept{data.frame tween}
+31
-0
man/tween_at.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/tween_at.R
2 \name{tween_at}
3 \alias{tween_at}
4 \title{Get a specific position between two states}
5 \usage{
6 tween_at(from, to, at, ease)
7 }
8 \arguments{
9 \item{from, to}{A data.frame or vector of the same type. If either is of
10 length/nrow 1 it will get repeated to match the length of the other}
11
12 \item{at}{A numeric between 0 and 1 recycled to match the nrow/length of
13 \code{from}}
14
15 \item{ease}{A character vector giving valid easing functions. Recycled to
16 match the ncol of \code{from}}
17 }
18 \value{
19 If \code{from}/\code{to} is a data.frame then a data.frame with the same
20 columns. If \code{from}/\code{to} is a vector then a vector.
21 }
22 \description{
23 This tween allows you to query a specific postion between two states rather
24 than generate evenly spaced states. It can work with either data.frames or
25 single vectors and each row/element can have its own position and easing.
26 }
27 \examples{
28 tween_at(mtcars[1:6, ], mtcars[6:1, ], runif(6), 'cubic-in-out')
29
30 }
+82
-0
man/tween_components.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/tween_components.R
2 \name{tween_components}
3 \alias{tween_components}
4 \title{Interpolate individual component}
5 \usage{
6 tween_components(.data, ease, nframes, time, id = NULL, range = NULL,
7 enter = NULL, exit = NULL, enter_length = 0, exit_length = 0)
8 }
9 \arguments{
10 \item{.data}{A data.frame with components at different stages}
11
12 \item{ease}{The easing function to use. Either a single string or one for
13 each column in the data set.}
14
15 \item{nframes}{The number of frames to calculate for the tween}
16
17 \item{time}{An unquoted expression giving the timepoint for the different
18 stages of the components. Will be evaluated in the context of \code{.data} so can
19 refer to a column from that}
20
21 \item{id}{An unquoted expression giving the component id for each row. Will
22 be evaluated in the context of \code{.data} so can refer to a column from that}
23
24 \item{range}{The range of time points to include in the tween. If \code{NULL} it
25 will use the range of \code{time}}
26
27 \item{enter}{functions that calculate a start state for new observations
28 that appear in \code{to} or an end state for observations that are not present in
29 \code{to}. If \code{NULL} the new/old observations will not be part of the tween. The
30 function gets a data.frame with either the start state of the exiting
31 observations, or the end state of the entering observations and must return
32 a modified version of that data.frame. See the \emph{Match, Enter, and Exit}
33 section for more information.}
34
35 \item{exit}{functions that calculate a start state for new observations
36 that appear in \code{to} or an end state for observations that are not present in
37 \code{to}. If \code{NULL} the new/old observations will not be part of the tween. The
38 function gets a data.frame with either the start state of the exiting
39 observations, or the end state of the entering observations and must return
40 a modified version of that data.frame. See the \emph{Match, Enter, and Exit}
41 section for more information.}
42
43 \item{enter_length, exit_length}{The lenght of the opening and closing
44 transitions if \code{enter} and/or \code{exit} is given. Measured in the same units as
45 \code{time}}
46 }
47 \value{
48 A data.frame with the same columns as \code{.data} along with \code{.id} giving
49 the component id, \code{.phase} giving the state of each component in each frame,
50 and \code{.frame} giving the frame membership of each row.
51 }
52 \description{
53 This function is much like \code{\link[=tween_elements]{tween_elements()}} but with a slightly different
54 syntax and support for many of the newer features such as enter/exits and
55 tween phase identification. Furthermore it uses tidy evaluation for time and
56 id, making it easier to change these on the fly. The biggest change in terms
57 of functionality compared to \code{tween_elements()} is that the easing function
58 is now given per column and not per row. If different easing functions are
59 needed for each transition then \code{tween_elements()} is needed.
60 }
61 \examples{
62
63 from_zero <- function(x) {x$x <- 0; x}
64
65 data <- data.frame(
66 x = c(1, 2, 2, 1, 2, 2),
67 y = c(1, 2, 2, 2, 1, 1),
68 time = c(1, 4, 10, 4, 8, 10),
69 id = c(1, 1, 1, 2, 2, 2)
70 )
71
72 data <- tween_components(data, 'cubic-in-out', nframes = 100, time = time,
73 id = id, enter = from_zero, enter_length = 4)
74
75 }
76 \seealso{
77 Other data.frame tween: \code{\link{tween_along}},
78 \code{\link{tween_appear}}, \code{\link{tween_elements}},
79 \code{\link{tween_events}}, \code{\link{tween_states}}
80 }
81 \concept{data.frame tween}
+57
-0
man/tween_elements.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/tween_elements.R
2 \name{tween_elements}
3 \alias{tween_elements}
4 \title{Create frames based on individual element states}
5 \usage{
6 tween_elements(data, time, group, ease, timerange, nframes)
7 }
8 \arguments{
9 \item{data}{A data.frame consisting at least of a column giving the
10 observation id, a column giving timepoints for each state and a column giving
11 the easing to apply when transitioning away from the state.}
12
13 \item{time}{The name of the column holding timepoints}
14
15 \item{group}{The name of the column holding the observation id}
16
17 \item{ease}{The name of the column holding the easing function name}
18
19 \item{timerange}{The range of time to span. If missing it will default to
20 \code{range(data[[time]])}}
21
22 \item{nframes}{The number of frames to generate. If missing it will default
23 to \code{ceiling(diff(timerange) + 1)} (At least one frame for each
24 individual timepoint)}
25 }
26 \value{
27 A data.frame with the same columns as \code{data} except for the
28 group and ease columns, but replicated \code{nframes} times. Two additional
29 columns called \code{.frame} and \code{.group} will be added giving the frame
30 number and observation id for each row.
31 }
32 \description{
33 This function creates tweens for each observation individually, in cases
34 where the data doesn't pass through collective states but consists of fully
35 independent transitions. Each observation is identified by an id and each
36 state must have a time associated with it.
37 }
38 \examples{
39 data <- data.frame(
40 x = c(1, 2, 2, 1, 2, 2),
41 y = c(1, 2, 2, 2, 1, 1),
42 time = c(1, 4, 10, 4, 8, 10),
43 group = c(1, 1, 1, 2, 2, 2),
44 ease = rep('cubic-in-out', 6)
45 )
46
47 data <- tween_elements(data, 'time', 'group', 'ease', nframes = 100)
48
49 }
50 \seealso{
51 Other data.frame tween: \code{\link{tween_along}},
52 \code{\link{tween_appear}},
53 \code{\link{tween_components}},
54 \code{\link{tween_events}}, \code{\link{tween_states}}
55 }
56 \concept{data.frame tween}
+88
-0
man/tween_events.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/tween_events.R
2 \name{tween_events}
3 \alias{tween_events}
4 \title{Transition in and out of events}
5 \usage{
6 tween_events(.data, ease, nframes, start, end = NULL, range = NULL,
7 enter = NULL, exit = NULL, enter_length = 0, exit_length = 0)
8 }
9 \arguments{
10 \item{.data}{A data.frame with components at different stages}
11
12 \item{ease}{The easing function to use. Either a single string or one for
13 each column in the data set.}
14
15 \item{nframes}{The number of frames to calculate for the tween}
16
17 \item{start, end}{The start (and potential end) of the event encoded in the
18 row, as unquoted expressions. Will be evaluated in the context of \code{.data} so
19 can refer to columns in it. If \code{end = NULL} the event will be without extend
20 and only visible in a single frame, unless \code{enter} and/or \code{exit} is given.}
21
22 \item{range}{The range of time points to include in the tween. If \code{NULL} it
23 will use the range of \code{time}}
24
25 \item{enter}{functions that calculate a start state for new observations
26 that appear in \code{to} or an end state for observations that are not present in
27 \code{to}. If \code{NULL} the new/old observations will not be part of the tween. The
28 function gets a data.frame with either the start state of the exiting
29 observations, or the end state of the entering observations and must return
30 a modified version of that data.frame. See the \emph{Match, Enter, and Exit}
31 section for more information.}
32
33 \item{exit}{functions that calculate a start state for new observations
34 that appear in \code{to} or an end state for observations that are not present in
35 \code{to}. If \code{NULL} the new/old observations will not be part of the tween. The
36 function gets a data.frame with either the start state of the exiting
37 observations, or the end state of the entering observations and must return
38 a modified version of that data.frame. See the \emph{Match, Enter, and Exit}
39 section for more information.}
40
41 \item{enter_length}{The lenght of the opening and closing
42 transitions if \code{enter} and/or \code{exit} is given. Measured in the same units as
43 \code{time}}
44
45 \item{exit_length}{The lenght of the opening and closing
46 transitions if \code{enter} and/or \code{exit} is given. Measured in the same units as
47 \code{time}}
48 }
49 \value{
50 A data.frame with the same columns as \code{.data} along with \code{.id} giving
51 the component id, \code{.phase} giving the state of each component in each frame,
52 and \code{.frame} giving the frame membership of each row.
53 }
54 \description{
55 This tweening function is a more powerful version of \code{\link[=tween_appear]{tween_appear()}}, with
56 support for newer features such as enter/exits and tween phase
57 identification. The tweener treats each row in the data as unique events in
58 time, and creates frames with the correct events present at any given time.
59 }
60 \examples{
61 d <- data.frame(
62 x = runif(20),
63 y = runif(20),
64 time = runif(20),
65 duration = runif(20, max = 0.1)
66 )
67 from_left <- function(x) {
68 x$x <- -0.5
69 x
70 }
71 to_right <- function(x) {
72 x$x <- 1.5
73 x
74 }
75
76 tween_events(d, 'cubic-in-out', 50, start = time, end = time + duration,
77 enter = from_left, exit = to_right, enter_length = 0.1,
78 exit_length = 0.05)
79
80 }
81 \seealso{
82 Other data.frame tween: \code{\link{tween_along}},
83 \code{\link{tween_appear}},
84 \code{\link{tween_components}},
85 \code{\link{tween_elements}}, \code{\link{tween_states}}
86 }
87 \concept{data.frame tween}
+30
-0
man/tween_fill.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/tween_fill.R
2 \name{tween_fill}
3 \alias{tween_fill}
4 \title{Fill out missing values by interpolation}
5 \usage{
6 tween_fill(data, ease)
7 }
8 \arguments{
9 \item{data}{A data.frame or vector.}
10
11 \item{ease}{A character vector giving valid easing functions. Recycled to
12 match the ncol of \code{data}}
13 }
14 \value{
15 If \code{data} is a data.frame then a data.frame with the same
16 columns. If \code{data} is a vector then a vector.
17 }
18 \description{
19 This tween fills out \code{NA} elements (or \code{NULL} elements if \code{data} is a list)
20 by interpolating between the prior and next non-missing values.
21 }
22 \examples{
23 # Single vector
24 tween_fill(c(1, NA, NA, NA, NA, NA, 2, 6, NA, NA, NA, -2), 'cubic-in-out')
25
26 # Data frame
27 tween_fill(mtcars[c(1, NA, NA, NA, NA, 4, NA, NA, NA, 10), ], 'cubic-in')
28
29 }
+134
-0
man/tween_state.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/tween_state.R
2 \name{tween_state}
3 \alias{tween_state}
4 \alias{keep_state}
5 \alias{open_state}
6 \alias{close_state}
7 \title{Compose tweening between states}
8 \usage{
9 tween_state(.data, to, ease, nframes, id = NULL, enter = NULL,
10 exit = NULL)
11
12 keep_state(.data, nframes)
13
14 open_state(.data, ease, nframes, enter)
15
16 close_state(.data, ease, nframes, exit)
17 }
18 \arguments{
19 \item{.data}{A data.frame to start from. If \code{.data} is the result of a prior
20 tween, only the last frame will be used for the tween. The new tween will
21 then be added to the prior tween}
22
23 \item{to}{A data.frame to end at. It must contain the same columns as .data
24 (exluding \code{.frame})}
25
26 \item{ease}{The easing function to use. Either a single string or one for
27 each column in the data set.}
28
29 \item{nframes}{The number of frames to calculate for the tween}
30
31 \item{id}{The column to match observations on. If \code{NULL} observations will be
32 matched by position. See the \emph{Match, Enter, and Exit} section for more
33 information.}
34
35 \item{enter, exit}{functions that calculate a start state for new observations
36 that appear in \code{to} or an end state for observations that are not present in
37 \code{to}. If \code{NULL} the new/old observations will not be part of the tween. The
38 function gets a data.frame with either the start state of the exiting
39 observations, or the end state of the entering observations and must return
40 a modified version of that data.frame. See the \emph{Match, Enter, and Exit}
41 section for more information.}
42 }
43 \value{
44 A data.frame containing all the intermediary states in the tween,
45 each state will be enumerated by the \code{.frame} column
46 }
47 \description{
48 The \code{tween_state()} is a counterpart to \code{tween_states()} that is aimed at
49 letting you gradually build up a scene by composing state changes one by one.
50 This setup lets you take more control over each state change and allows you
51 to work with datasets with uneven number of rows, flexibly specifying what
52 should happen with entering and exiting data. \code{keep_state()} is a simpel
53 helper for letting you pause at a state. \code{open_state()} is a shortcut from
54 tweening from an empty dataset with a given \code{enter()} function while
55 \code{close_state()} is the same but will instead tween into an empty dataset with
56 a given \code{exit()} function.
57 }
58 \section{Match, Enter, and Exit}{
59
60 When there are discrepancies between the two states to tweeen between you
61 need a way to resolve the discrepancy before calculating the intermediary
62 states. With discrepancies we mean that some data points are present in the
63 start state and not in the end state, and/or some are present in the end
64 state but not in the start state. A simple example is that the start state
65 contains 100 rows and the end state contains 70. There are 30 missing rows
66 that we need to do something about before we can calculate the tween.
67
68 \strong{Making pairs}
69 The first question to answer is "How do we know which observations are
70 disappearing (\emph{exiting}) and/or appearing (\emph{entering})?". This is done with
71 the \code{id} argument which should give a column name to match rows between the
72 two states on. If \code{id = NULL} the rows will be matched by position (in the
73 above example the last 30 rows in the start state will be entering). The \code{id}
74 column must only contain unique values in order to work.
75
76 \strong{Making up states}
77 Once the rows in each state has been paired you'll end up with three sets of
78 data. One containing rows that is present in both the start and end state,
79 one containing rows only present in the start state, and one only containing
80 rows present in the end state. The first group is easy - here you just tween
81 between each rows - but for the other two we'll need some state to start or
82 end the tween with. This is really the purpose of the \code{enter} and \code{exit}
83 functions. They take a data frame containing the subset of data that has not
84 been matched and must return a new data frame giving the state that these
85 rows must be tweened from/into. A simple example could be an \code{enter} function
86 that sets the variable giving the opacity in the plot to 0 - this will make
87 the new points fade into view during the transition.
88
89 \strong{Ignoring discrepancies}
90 The default values for \code{enter} and \code{exit} is \code{NULL}. This value indicate that
91 non-matching rows should simply be ignored for the transition and simply
92 appear in the last frame of the tween. This is the default.
93 }
94
95 \examples{
96 data1 <- data.frame(
97 x = 1:20,
98 y = 0,
99 colour = 'forestgreen',
100 stringsAsFactors = FALSE
101 )
102 data2 <- data1
103 data2$x <- 20:1
104 data2$y <- 1
105
106 data <- data1 \%>\%
107 tween_state(data2, 'linear', 50) \%>\%
108 keep_state(20) \%>\%
109 tween_state(data1, 'bounce-out', 50)
110
111 # Using enter and exit (made up numbers)
112 df1 <- data.frame(
113 country = c('Denmark', 'Sweden', 'Norway'),
114 population = c(5e6, 10e6, 3.5e6)
115 )
116 df2 <- data.frame(
117 country = c('Denmark', 'Sweden', 'Norway', 'Finland'),
118 population = c(6e6, 10.5e6, 4e6, 3e6)
119 )
120 df3 <- data.frame(
121 country = c('Denmark', 'Norway'),
122 population = c(10e6, 6e6)
123 )
124 to_zero <- function(x) {
125 x$population <- 0
126 x
127 }
128 pop_devel <- df1 \%>\%
129 tween_state(df2, 'cubic-in-out', 50, id = country, enter = to_zero) \%>\%
130 tween_state(df3, 'cubic-in-out', 50, id = country, enter = to_zero,
131 exit = to_zero)
132
133 }
+56
-0
man/tween_states.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/tween_states.R
2 \name{tween_states}
3 \alias{tween_states}
4 \title{Tween a list of data.frames representing states}
5 \usage{
6 tween_states(data, tweenlength, statelength, ease, nframes)
7 }
8 \arguments{
9 \item{data}{A list of data.frames. Each data.frame must contain the same
10 number of rows, but only the first data.frame needs to contain all columns.
11 Subsequent data.frames need only contain the columns that shows change.}
12
13 \item{tweenlength}{The lengths of the transitions between each state.}
14
15 \item{statelength}{The length of the pause at each state.}
16
17 \item{ease}{The easing functions to use for the transitions. See details.}
18
19 \item{nframes}{The number of frames to generate. The actual number of frames
20 might end up being higher depending on the regularity of \code{tweenlength}
21 and \code{statelength}.}
22 }
23 \value{
24 A data.frame with the same columns as the first data.frame in
25 \code{data}, but replicated \code{nframes} times. An additional column called
26 \code{.frame} will be added giving the frame number.
27 }
28 \description{
29 This function is intended to create smooth transitions between states of
30 data. States are defined as full data.frames or data.frames containing only
31 the columns with change. Each state can have a defined period of pause, the
32 transition length between each states can be defined as well as the easing
33 function.
34 }
35 \examples{
36 data1 <- data.frame(
37 x = 1:20,
38 y = 0,
39 colour = 'forestgreen',
40 stringsAsFactors = FALSE
41 )
42 data2 <- data1
43 data2$x <- 20:1
44 data2$y <- 1
45
46 data <- tween_states(list(data1, data2), 3, 1, 'cubic-in-out', 100)
47
48 }
49 \seealso{
50 Other data.frame tween: \code{\link{tween_along}},
51 \code{\link{tween_appear}},
52 \code{\link{tween_components}},
53 \code{\link{tween_elements}}, \code{\link{tween_events}}
54 }
55 \concept{data.frame tween}
+42
-0
man/tweenr-package.Rd less more
0 % Generated by roxygen2: do not edit by hand
1 % Please edit documentation in R/tweenr_package.R
2 \docType{package}
3 \name{tweenr-package}
4 \alias{tweenr}
5 \alias{tweenr-package}
6 \title{tweenr: Interpolate Data for Smooth Animations}
7 \description{
8 \if{html}{\figure{logo.png}{options: align='right'}}
9
10 In order to create smooth animation between states of data,
11 tweening is necessary. This package provides a range of functions for
12 creating tweened data that can be used as basis for animation. Furthermore
13 it adds a number of vectorized interpolaters for common R data
14 types such as numeric, date and colour.
15 }
16 \details{
17 tweenr is a small collection of functions to help you in creating
18 intermediary representations of your data, i.e. interpolating states of data.
19 As such it's a great match for packages such as animate and gganimate, since
20 it can work directly with data.frames of data, but it also provide fast and
21 efficient interpolaters for numeric, date, datetime and colour that are
22 vectorized and thus more efficient to use than the build in interpolation
23 functions (mainly \code{\link[stats:approx]{stats::approx()}} and
24 \code{\link[grDevices:colorRamp]{grDevices::colorRamp()}}).
25
26 The main functions for data.frames are \code{\link[=tween_states]{tween_states()}},
27 \code{\link[=tween_elements]{tween_elements()}} and \code{\link[=tween_appear]{tween_appear()}}, while the
28 standard interpolaters can be found at \code{\link[=tween]{tween()}}
29 }
30 \seealso{
31 Useful links:
32 \itemize{
33 \item \url{https://github.com/thomasp85/tweenr}
34 \item Report bugs at \url{https://github.com/thomasp85/tweenr/issues}
35 }
36
37 }
38 \author{
39 \strong{Maintainer}: Thomas Lin Pedersen \email{thomasp85@gmail.com}
40
41 }
+430
-0
src/RcppExports.cpp less more
0 // Generated by using Rcpp::compileAttributes() -> do not edit by hand
1 // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393
2
3 #include <Rcpp.h>
4
5 using namespace Rcpp;
6
7 // numeric_state_interpolator
8 NumericVector numeric_state_interpolator(List data, DataFrame states);
9 RcppExport SEXP _tweenr_numeric_state_interpolator(SEXP dataSEXP, SEXP statesSEXP) {
10 BEGIN_RCPP
11 Rcpp::RObject rcpp_result_gen;
12 Rcpp::RNGScope rcpp_rngScope_gen;
13 Rcpp::traits::input_parameter< List >::type data(dataSEXP);
14 Rcpp::traits::input_parameter< DataFrame >::type states(statesSEXP);
15 rcpp_result_gen = Rcpp::wrap(numeric_state_interpolator(data, states));
16 return rcpp_result_gen;
17 END_RCPP
18 }
19 // colour_state_interpolator
20 NumericMatrix colour_state_interpolator(List data, DataFrame states);
21 RcppExport SEXP _tweenr_colour_state_interpolator(SEXP dataSEXP, SEXP statesSEXP) {
22 BEGIN_RCPP
23 Rcpp::RObject rcpp_result_gen;
24 Rcpp::RNGScope rcpp_rngScope_gen;
25 Rcpp::traits::input_parameter< List >::type data(dataSEXP);
26 Rcpp::traits::input_parameter< DataFrame >::type states(statesSEXP);
27 rcpp_result_gen = Rcpp::wrap(colour_state_interpolator(data, states));
28 return rcpp_result_gen;
29 END_RCPP
30 }
31 // constant_state_interpolator
32 CharacterVector constant_state_interpolator(List data, DataFrame states);
33 RcppExport SEXP _tweenr_constant_state_interpolator(SEXP dataSEXP, SEXP statesSEXP) {
34 BEGIN_RCPP
35 Rcpp::RObject rcpp_result_gen;
36 Rcpp::RNGScope rcpp_rngScope_gen;
37 Rcpp::traits::input_parameter< List >::type data(dataSEXP);
38 Rcpp::traits::input_parameter< DataFrame >::type states(statesSEXP);
39 rcpp_result_gen = Rcpp::wrap(constant_state_interpolator(data, states));
40 return rcpp_result_gen;
41 END_RCPP
42 }
43 // list_state_interpolator
44 List list_state_interpolator(List data, DataFrame states);
45 RcppExport SEXP _tweenr_list_state_interpolator(SEXP dataSEXP, SEXP statesSEXP) {
46 BEGIN_RCPP
47 Rcpp::RObject rcpp_result_gen;
48 Rcpp::RNGScope rcpp_rngScope_gen;
49 Rcpp::traits::input_parameter< List >::type data(dataSEXP);
50 Rcpp::traits::input_parameter< DataFrame >::type states(statesSEXP);
51 rcpp_result_gen = Rcpp::wrap(list_state_interpolator(data, states));
52 return rcpp_result_gen;
53 END_RCPP
54 }
55 // numlist_state_interpolator
56 List numlist_state_interpolator(List data, DataFrame states);
57 RcppExport SEXP _tweenr_numlist_state_interpolator(SEXP dataSEXP, SEXP statesSEXP) {
58 BEGIN_RCPP
59 Rcpp::RObject rcpp_result_gen;
60 Rcpp::RNGScope rcpp_rngScope_gen;
61 Rcpp::traits::input_parameter< List >::type data(dataSEXP);
62 Rcpp::traits::input_parameter< DataFrame >::type states(statesSEXP);
63 rcpp_result_gen = Rcpp::wrap(numlist_state_interpolator(data, states));
64 return rcpp_result_gen;
65 END_RCPP
66 }
67 // phase_state_interpolator
68 CharacterVector phase_state_interpolator(List data, DataFrame states);
69 RcppExport SEXP _tweenr_phase_state_interpolator(SEXP dataSEXP, SEXP statesSEXP) {
70 BEGIN_RCPP
71 Rcpp::RObject rcpp_result_gen;
72 Rcpp::RNGScope rcpp_rngScope_gen;
73 Rcpp::traits::input_parameter< List >::type data(dataSEXP);
74 Rcpp::traits::input_parameter< DataFrame >::type states(statesSEXP);
75 rcpp_result_gen = Rcpp::wrap(phase_state_interpolator(data, states));
76 return rcpp_result_gen;
77 END_RCPP
78 }
79 // numeric_element_interpolator
80 DataFrame numeric_element_interpolator(NumericVector data, CharacterVector group, IntegerVector frame, CharacterVector ease);
81 RcppExport SEXP _tweenr_numeric_element_interpolator(SEXP dataSEXP, SEXP groupSEXP, SEXP frameSEXP, SEXP easeSEXP) {
82 BEGIN_RCPP
83 Rcpp::RObject rcpp_result_gen;
84 Rcpp::RNGScope rcpp_rngScope_gen;
85 Rcpp::traits::input_parameter< NumericVector >::type data(dataSEXP);
86 Rcpp::traits::input_parameter< CharacterVector >::type group(groupSEXP);
87 Rcpp::traits::input_parameter< IntegerVector >::type frame(frameSEXP);
88 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
89 rcpp_result_gen = Rcpp::wrap(numeric_element_interpolator(data, group, frame, ease));
90 return rcpp_result_gen;
91 END_RCPP
92 }
93 // colour_element_interpolator
94 DataFrame colour_element_interpolator(NumericMatrix data, CharacterVector group, IntegerVector frame, CharacterVector ease);
95 RcppExport SEXP _tweenr_colour_element_interpolator(SEXP dataSEXP, SEXP groupSEXP, SEXP frameSEXP, SEXP easeSEXP) {
96 BEGIN_RCPP
97 Rcpp::RObject rcpp_result_gen;
98 Rcpp::RNGScope rcpp_rngScope_gen;
99 Rcpp::traits::input_parameter< NumericMatrix >::type data(dataSEXP);
100 Rcpp::traits::input_parameter< CharacterVector >::type group(groupSEXP);
101 Rcpp::traits::input_parameter< IntegerVector >::type frame(frameSEXP);
102 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
103 rcpp_result_gen = Rcpp::wrap(colour_element_interpolator(data, group, frame, ease));
104 return rcpp_result_gen;
105 END_RCPP
106 }
107 // constant_element_interpolator
108 DataFrame constant_element_interpolator(CharacterVector data, CharacterVector group, IntegerVector frame, CharacterVector ease);
109 RcppExport SEXP _tweenr_constant_element_interpolator(SEXP dataSEXP, SEXP groupSEXP, SEXP frameSEXP, SEXP easeSEXP) {
110 BEGIN_RCPP
111 Rcpp::RObject rcpp_result_gen;
112 Rcpp::RNGScope rcpp_rngScope_gen;
113 Rcpp::traits::input_parameter< CharacterVector >::type data(dataSEXP);
114 Rcpp::traits::input_parameter< CharacterVector >::type group(groupSEXP);
115 Rcpp::traits::input_parameter< IntegerVector >::type frame(frameSEXP);
116 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
117 rcpp_result_gen = Rcpp::wrap(constant_element_interpolator(data, group, frame, ease));
118 return rcpp_result_gen;
119 END_RCPP
120 }
121 // list_element_interpolator
122 List list_element_interpolator(List data, CharacterVector group, IntegerVector frame, CharacterVector ease);
123 RcppExport SEXP _tweenr_list_element_interpolator(SEXP dataSEXP, SEXP groupSEXP, SEXP frameSEXP, SEXP easeSEXP) {
124 BEGIN_RCPP
125 Rcpp::RObject rcpp_result_gen;
126 Rcpp::RNGScope rcpp_rngScope_gen;
127 Rcpp::traits::input_parameter< List >::type data(dataSEXP);
128 Rcpp::traits::input_parameter< CharacterVector >::type group(groupSEXP);
129 Rcpp::traits::input_parameter< IntegerVector >::type frame(frameSEXP);
130 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
131 rcpp_result_gen = Rcpp::wrap(list_element_interpolator(data, group, frame, ease));
132 return rcpp_result_gen;
133 END_RCPP
134 }
135 // numlist_element_interpolator
136 List numlist_element_interpolator(List data, CharacterVector group, IntegerVector frame, CharacterVector ease);
137 RcppExport SEXP _tweenr_numlist_element_interpolator(SEXP dataSEXP, SEXP groupSEXP, SEXP frameSEXP, SEXP easeSEXP) {
138 BEGIN_RCPP
139 Rcpp::RObject rcpp_result_gen;
140 Rcpp::RNGScope rcpp_rngScope_gen;
141 Rcpp::traits::input_parameter< List >::type data(dataSEXP);
142 Rcpp::traits::input_parameter< CharacterVector >::type group(groupSEXP);
143 Rcpp::traits::input_parameter< IntegerVector >::type frame(frameSEXP);
144 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
145 rcpp_result_gen = Rcpp::wrap(numlist_element_interpolator(data, group, frame, ease));
146 return rcpp_result_gen;
147 END_RCPP
148 }
149 // phase_element_interpolator
150 DataFrame phase_element_interpolator(CharacterVector data, CharacterVector group, IntegerVector frame, CharacterVector ease);
151 RcppExport SEXP _tweenr_phase_element_interpolator(SEXP dataSEXP, SEXP groupSEXP, SEXP frameSEXP, SEXP easeSEXP) {
152 BEGIN_RCPP
153 Rcpp::RObject rcpp_result_gen;
154 Rcpp::RNGScope rcpp_rngScope_gen;
155 Rcpp::traits::input_parameter< CharacterVector >::type data(dataSEXP);
156 Rcpp::traits::input_parameter< CharacterVector >::type group(groupSEXP);
157 Rcpp::traits::input_parameter< IntegerVector >::type frame(frameSEXP);
158 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
159 rcpp_result_gen = Rcpp::wrap(phase_element_interpolator(data, group, frame, ease));
160 return rcpp_result_gen;
161 END_RCPP
162 }
163 // numeric_along_interpolator
164 DataFrame numeric_along_interpolator(NumericVector data, CharacterVector group, NumericVector time, bool history, bool keep_last, int nframes, CharacterVector ease);
165 RcppExport SEXP _tweenr_numeric_along_interpolator(SEXP dataSEXP, SEXP groupSEXP, SEXP timeSEXP, SEXP historySEXP, SEXP keep_lastSEXP, SEXP nframesSEXP, SEXP easeSEXP) {
166 BEGIN_RCPP
167 Rcpp::RObject rcpp_result_gen;
168 Rcpp::RNGScope rcpp_rngScope_gen;
169 Rcpp::traits::input_parameter< NumericVector >::type data(dataSEXP);
170 Rcpp::traits::input_parameter< CharacterVector >::type group(groupSEXP);
171 Rcpp::traits::input_parameter< NumericVector >::type time(timeSEXP);
172 Rcpp::traits::input_parameter< bool >::type history(historySEXP);
173 Rcpp::traits::input_parameter< bool >::type keep_last(keep_lastSEXP);
174 Rcpp::traits::input_parameter< int >::type nframes(nframesSEXP);
175 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
176 rcpp_result_gen = Rcpp::wrap(numeric_along_interpolator(data, group, time, history, keep_last, nframes, ease));
177 return rcpp_result_gen;
178 END_RCPP
179 }
180 // colour_along_interpolator
181 DataFrame colour_along_interpolator(NumericMatrix data, CharacterVector group, NumericVector time, bool history, bool keep_last, int nframes, CharacterVector ease);
182 RcppExport SEXP _tweenr_colour_along_interpolator(SEXP dataSEXP, SEXP groupSEXP, SEXP timeSEXP, SEXP historySEXP, SEXP keep_lastSEXP, SEXP nframesSEXP, SEXP easeSEXP) {
183 BEGIN_RCPP
184 Rcpp::RObject rcpp_result_gen;
185 Rcpp::RNGScope rcpp_rngScope_gen;
186 Rcpp::traits::input_parameter< NumericMatrix >::type data(dataSEXP);
187 Rcpp::traits::input_parameter< CharacterVector >::type group(groupSEXP);
188 Rcpp::traits::input_parameter< NumericVector >::type time(timeSEXP);
189 Rcpp::traits::input_parameter< bool >::type history(historySEXP);
190 Rcpp::traits::input_parameter< bool >::type keep_last(keep_lastSEXP);
191 Rcpp::traits::input_parameter< int >::type nframes(nframesSEXP);
192 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
193 rcpp_result_gen = Rcpp::wrap(colour_along_interpolator(data, group, time, history, keep_last, nframes, ease));
194 return rcpp_result_gen;
195 END_RCPP
196 }
197 // constant_along_interpolator
198 DataFrame constant_along_interpolator(CharacterVector data, CharacterVector group, NumericVector time, bool history, bool keep_last, int nframes, CharacterVector ease);
199 RcppExport SEXP _tweenr_constant_along_interpolator(SEXP dataSEXP, SEXP groupSEXP, SEXP timeSEXP, SEXP historySEXP, SEXP keep_lastSEXP, SEXP nframesSEXP, SEXP easeSEXP) {
200 BEGIN_RCPP
201 Rcpp::RObject rcpp_result_gen;
202 Rcpp::RNGScope rcpp_rngScope_gen;
203 Rcpp::traits::input_parameter< CharacterVector >::type data(dataSEXP);
204 Rcpp::traits::input_parameter< CharacterVector >::type group(groupSEXP);
205 Rcpp::traits::input_parameter< NumericVector >::type time(timeSEXP);
206 Rcpp::traits::input_parameter< bool >::type history(historySEXP);
207 Rcpp::traits::input_parameter< bool >::type keep_last(keep_lastSEXP);
208 Rcpp::traits::input_parameter< int >::type nframes(nframesSEXP);
209 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
210 rcpp_result_gen = Rcpp::wrap(constant_along_interpolator(data, group, time, history, keep_last, nframes, ease));
211 return rcpp_result_gen;
212 END_RCPP
213 }
214 // list_along_interpolator
215 List list_along_interpolator(List data, CharacterVector group, NumericVector time, bool history, bool keep_last, int nframes, CharacterVector ease);
216 RcppExport SEXP _tweenr_list_along_interpolator(SEXP dataSEXP, SEXP groupSEXP, SEXP timeSEXP, SEXP historySEXP, SEXP keep_lastSEXP, SEXP nframesSEXP, SEXP easeSEXP) {
217 BEGIN_RCPP
218 Rcpp::RObject rcpp_result_gen;
219 Rcpp::RNGScope rcpp_rngScope_gen;
220 Rcpp::traits::input_parameter< List >::type data(dataSEXP);
221 Rcpp::traits::input_parameter< CharacterVector >::type group(groupSEXP);
222 Rcpp::traits::input_parameter< NumericVector >::type time(timeSEXP);
223 Rcpp::traits::input_parameter< bool >::type history(historySEXP);
224 Rcpp::traits::input_parameter< bool >::type keep_last(keep_lastSEXP);
225 Rcpp::traits::input_parameter< int >::type nframes(nframesSEXP);
226 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
227 rcpp_result_gen = Rcpp::wrap(list_along_interpolator(data, group, time, history, keep_last, nframes, ease));
228 return rcpp_result_gen;
229 END_RCPP
230 }
231 // numlist_along_interpolator
232 List numlist_along_interpolator(List data, CharacterVector group, NumericVector time, bool history, bool keep_last, int nframes, CharacterVector ease);
233 RcppExport SEXP _tweenr_numlist_along_interpolator(SEXP dataSEXP, SEXP groupSEXP, SEXP timeSEXP, SEXP historySEXP, SEXP keep_lastSEXP, SEXP nframesSEXP, SEXP easeSEXP) {
234 BEGIN_RCPP
235 Rcpp::RObject rcpp_result_gen;
236 Rcpp::RNGScope rcpp_rngScope_gen;
237 Rcpp::traits::input_parameter< List >::type data(dataSEXP);
238 Rcpp::traits::input_parameter< CharacterVector >::type group(groupSEXP);
239 Rcpp::traits::input_parameter< NumericVector >::type time(timeSEXP);
240 Rcpp::traits::input_parameter< bool >::type history(historySEXP);
241 Rcpp::traits::input_parameter< bool >::type keep_last(keep_lastSEXP);
242 Rcpp::traits::input_parameter< int >::type nframes(nframesSEXP);
243 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
244 rcpp_result_gen = Rcpp::wrap(numlist_along_interpolator(data, group, time, history, keep_last, nframes, ease));
245 return rcpp_result_gen;
246 END_RCPP
247 }
248 // phase_along_interpolator
249 DataFrame phase_along_interpolator(CharacterVector group, NumericVector time, bool history, bool keep_last, int nframes);
250 RcppExport SEXP _tweenr_phase_along_interpolator(SEXP groupSEXP, SEXP timeSEXP, SEXP historySEXP, SEXP keep_lastSEXP, SEXP nframesSEXP) {
251 BEGIN_RCPP
252 Rcpp::RObject rcpp_result_gen;
253 Rcpp::RNGScope rcpp_rngScope_gen;
254 Rcpp::traits::input_parameter< CharacterVector >::type group(groupSEXP);
255 Rcpp::traits::input_parameter< NumericVector >::type time(timeSEXP);
256 Rcpp::traits::input_parameter< bool >::type history(historySEXP);
257 Rcpp::traits::input_parameter< bool >::type keep_last(keep_lastSEXP);
258 Rcpp::traits::input_parameter< int >::type nframes(nframesSEXP);
259 rcpp_result_gen = Rcpp::wrap(phase_along_interpolator(group, time, history, keep_last, nframes));
260 return rcpp_result_gen;
261 END_RCPP
262 }
263 // numeric_at_interpolator
264 NumericVector numeric_at_interpolator(NumericVector from, NumericVector to, NumericVector at, CharacterVector ease);
265 RcppExport SEXP _tweenr_numeric_at_interpolator(SEXP fromSEXP, SEXP toSEXP, SEXP atSEXP, SEXP easeSEXP) {
266 BEGIN_RCPP
267 Rcpp::RObject rcpp_result_gen;
268 Rcpp::RNGScope rcpp_rngScope_gen;
269 Rcpp::traits::input_parameter< NumericVector >::type from(fromSEXP);
270 Rcpp::traits::input_parameter< NumericVector >::type to(toSEXP);
271 Rcpp::traits::input_parameter< NumericVector >::type at(atSEXP);
272 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
273 rcpp_result_gen = Rcpp::wrap(numeric_at_interpolator(from, to, at, ease));
274 return rcpp_result_gen;
275 END_RCPP
276 }
277 // colour_at_interpolator
278 NumericMatrix colour_at_interpolator(NumericMatrix from, NumericMatrix to, NumericVector at, CharacterVector ease);
279 RcppExport SEXP _tweenr_colour_at_interpolator(SEXP fromSEXP, SEXP toSEXP, SEXP atSEXP, SEXP easeSEXP) {
280 BEGIN_RCPP
281 Rcpp::RObject rcpp_result_gen;
282 Rcpp::RNGScope rcpp_rngScope_gen;
283 Rcpp::traits::input_parameter< NumericMatrix >::type from(fromSEXP);
284 Rcpp::traits::input_parameter< NumericMatrix >::type to(toSEXP);
285 Rcpp::traits::input_parameter< NumericVector >::type at(atSEXP);
286 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
287 rcpp_result_gen = Rcpp::wrap(colour_at_interpolator(from, to, at, ease));
288 return rcpp_result_gen;
289 END_RCPP
290 }
291 // constant_at_interpolator
292 CharacterVector constant_at_interpolator(CharacterVector from, CharacterVector to, NumericVector at, CharacterVector ease);
293 RcppExport SEXP _tweenr_constant_at_interpolator(SEXP fromSEXP, SEXP toSEXP, SEXP atSEXP, SEXP easeSEXP) {
294 BEGIN_RCPP
295 Rcpp::RObject rcpp_result_gen;
296 Rcpp::RNGScope rcpp_rngScope_gen;
297 Rcpp::traits::input_parameter< CharacterVector >::type from(fromSEXP);
298 Rcpp::traits::input_parameter< CharacterVector >::type to(toSEXP);
299 Rcpp::traits::input_parameter< NumericVector >::type at(atSEXP);
300 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
301 rcpp_result_gen = Rcpp::wrap(constant_at_interpolator(from, to, at, ease));
302 return rcpp_result_gen;
303 END_RCPP
304 }
305 // list_at_interpolator
306 List list_at_interpolator(List from, List to, NumericVector at, CharacterVector ease);
307 RcppExport SEXP _tweenr_list_at_interpolator(SEXP fromSEXP, SEXP toSEXP, SEXP atSEXP, SEXP easeSEXP) {
308 BEGIN_RCPP
309 Rcpp::RObject rcpp_result_gen;
310 Rcpp::RNGScope rcpp_rngScope_gen;
311 Rcpp::traits::input_parameter< List >::type from(fromSEXP);
312 Rcpp::traits::input_parameter< List >::type to(toSEXP);
313 Rcpp::traits::input_parameter< NumericVector >::type at(atSEXP);
314 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
315 rcpp_result_gen = Rcpp::wrap(list_at_interpolator(from, to, at, ease));
316 return rcpp_result_gen;
317 END_RCPP
318 }
319 // numlist_at_interpolator
320 List numlist_at_interpolator(List from, List to, NumericVector at, CharacterVector ease);
321 RcppExport SEXP _tweenr_numlist_at_interpolator(SEXP fromSEXP, SEXP toSEXP, SEXP atSEXP, SEXP easeSEXP) {
322 BEGIN_RCPP
323 Rcpp::RObject rcpp_result_gen;
324 Rcpp::RNGScope rcpp_rngScope_gen;
325 Rcpp::traits::input_parameter< List >::type from(fromSEXP);
326 Rcpp::traits::input_parameter< List >::type to(toSEXP);
327 Rcpp::traits::input_parameter< NumericVector >::type at(atSEXP);
328 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
329 rcpp_result_gen = Rcpp::wrap(numlist_at_interpolator(from, to, at, ease));
330 return rcpp_result_gen;
331 END_RCPP
332 }
333 // numeric_fill_interpolator
334 NumericVector numeric_fill_interpolator(NumericVector data, CharacterVector ease);
335 RcppExport SEXP _tweenr_numeric_fill_interpolator(SEXP dataSEXP, SEXP easeSEXP) {
336 BEGIN_RCPP
337 Rcpp::RObject rcpp_result_gen;
338 Rcpp::RNGScope rcpp_rngScope_gen;
339 Rcpp::traits::input_parameter< NumericVector >::type data(dataSEXP);
340 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
341 rcpp_result_gen = Rcpp::wrap(numeric_fill_interpolator(data, ease));
342 return rcpp_result_gen;
343 END_RCPP
344 }
345 // colour_fill_interpolator
346 NumericMatrix colour_fill_interpolator(NumericMatrix data, CharacterVector ease);
347 RcppExport SEXP _tweenr_colour_fill_interpolator(SEXP dataSEXP, SEXP easeSEXP) {
348 BEGIN_RCPP
349 Rcpp::RObject rcpp_result_gen;
350 Rcpp::RNGScope rcpp_rngScope_gen;
351 Rcpp::traits::input_parameter< NumericMatrix >::type data(dataSEXP);
352 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
353 rcpp_result_gen = Rcpp::wrap(colour_fill_interpolator(data, ease));
354 return rcpp_result_gen;
355 END_RCPP
356 }
357 // constant_fill_interpolator
358 CharacterVector constant_fill_interpolator(CharacterVector data, CharacterVector ease);
359 RcppExport SEXP _tweenr_constant_fill_interpolator(SEXP dataSEXP, SEXP easeSEXP) {
360 BEGIN_RCPP
361 Rcpp::RObject rcpp_result_gen;
362 Rcpp::RNGScope rcpp_rngScope_gen;
363 Rcpp::traits::input_parameter< CharacterVector >::type data(dataSEXP);
364 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
365 rcpp_result_gen = Rcpp::wrap(constant_fill_interpolator(data, ease));
366 return rcpp_result_gen;
367 END_RCPP
368 }
369 // list_fill_interpolator
370 List list_fill_interpolator(List data, CharacterVector ease);
371 RcppExport SEXP _tweenr_list_fill_interpolator(SEXP dataSEXP, SEXP easeSEXP) {
372 BEGIN_RCPP
373 Rcpp::RObject rcpp_result_gen;
374 Rcpp::RNGScope rcpp_rngScope_gen;
375 Rcpp::traits::input_parameter< List >::type data(dataSEXP);
376 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
377 rcpp_result_gen = Rcpp::wrap(list_fill_interpolator(data, ease));
378 return rcpp_result_gen;
379 END_RCPP
380 }
381 // numlist_fill_interpolator
382 List numlist_fill_interpolator(List data, CharacterVector ease);
383 RcppExport SEXP _tweenr_numlist_fill_interpolator(SEXP dataSEXP, SEXP easeSEXP) {
384 BEGIN_RCPP
385 Rcpp::RObject rcpp_result_gen;
386 Rcpp::RNGScope rcpp_rngScope_gen;
387 Rcpp::traits::input_parameter< List >::type data(dataSEXP);
388 Rcpp::traits::input_parameter< CharacterVector >::type ease(easeSEXP);
389 rcpp_result_gen = Rcpp::wrap(numlist_fill_interpolator(data, ease));
390 return rcpp_result_gen;
391 END_RCPP
392 }
393
394 static const R_CallMethodDef CallEntries[] = {
395 {"_tweenr_numeric_state_interpolator", (DL_FUNC) &_tweenr_numeric_state_interpolator, 2},
396 {"_tweenr_colour_state_interpolator", (DL_FUNC) &_tweenr_colour_state_interpolator, 2},
397 {"_tweenr_constant_state_interpolator", (DL_FUNC) &_tweenr_constant_state_interpolator, 2},
398 {"_tweenr_list_state_interpolator", (DL_FUNC) &_tweenr_list_state_interpolator, 2},
399 {"_tweenr_numlist_state_interpolator", (DL_FUNC) &_tweenr_numlist_state_interpolator, 2},
400 {"_tweenr_phase_state_interpolator", (DL_FUNC) &_tweenr_phase_state_interpolator, 2},
401 {"_tweenr_numeric_element_interpolator", (DL_FUNC) &_tweenr_numeric_element_interpolator, 4},
402 {"_tweenr_colour_element_interpolator", (DL_FUNC) &_tweenr_colour_element_interpolator, 4},
403 {"_tweenr_constant_element_interpolator", (DL_FUNC) &_tweenr_constant_element_interpolator, 4},
404 {"_tweenr_list_element_interpolator", (DL_FUNC) &_tweenr_list_element_interpolator, 4},
405 {"_tweenr_numlist_element_interpolator", (DL_FUNC) &_tweenr_numlist_element_interpolator, 4},
406 {"_tweenr_phase_element_interpolator", (DL_FUNC) &_tweenr_phase_element_interpolator, 4},
407 {"_tweenr_numeric_along_interpolator", (DL_FUNC) &_tweenr_numeric_along_interpolator, 7},
408 {"_tweenr_colour_along_interpolator", (DL_FUNC) &_tweenr_colour_along_interpolator, 7},
409 {"_tweenr_constant_along_interpolator", (DL_FUNC) &_tweenr_constant_along_interpolator, 7},
410 {"_tweenr_list_along_interpolator", (DL_FUNC) &_tweenr_list_along_interpolator, 7},
411 {"_tweenr_numlist_along_interpolator", (DL_FUNC) &_tweenr_numlist_along_interpolator, 7},
412 {"_tweenr_phase_along_interpolator", (DL_FUNC) &_tweenr_phase_along_interpolator, 5},
413 {"_tweenr_numeric_at_interpolator", (DL_FUNC) &_tweenr_numeric_at_interpolator, 4},
414 {"_tweenr_colour_at_interpolator", (DL_FUNC) &_tweenr_colour_at_interpolator, 4},
415 {"_tweenr_constant_at_interpolator", (DL_FUNC) &_tweenr_constant_at_interpolator, 4},
416 {"_tweenr_list_at_interpolator", (DL_FUNC) &_tweenr_list_at_interpolator, 4},
417 {"_tweenr_numlist_at_interpolator", (DL_FUNC) &_tweenr_numlist_at_interpolator, 4},
418 {"_tweenr_numeric_fill_interpolator", (DL_FUNC) &_tweenr_numeric_fill_interpolator, 2},
419 {"_tweenr_colour_fill_interpolator", (DL_FUNC) &_tweenr_colour_fill_interpolator, 2},
420 {"_tweenr_constant_fill_interpolator", (DL_FUNC) &_tweenr_constant_fill_interpolator, 2},
421 {"_tweenr_list_fill_interpolator", (DL_FUNC) &_tweenr_list_fill_interpolator, 2},
422 {"_tweenr_numlist_fill_interpolator", (DL_FUNC) &_tweenr_numlist_fill_interpolator, 2},
423 {NULL, NULL, 0}
424 };
425
426 RcppExport void R_init_tweenr(DllInfo *dll) {
427 R_registerRoutines(dll, NULL, CallEntries, NULL, NULL);
428 R_useDynamicSymbols(dll, FALSE);
429 }
+302
-0
src/easing.c less more
0 //
1 // easing.c
2 //
3 // Copyright (c) 2011, Auerhaus Development, LLC
4 //
5 // This program is free software. It comes without any warranty, to
6 // the extent permitted by applicable law. You can redistribute it
7 // and/or modify it under the terms of the Do What The Fuck You Want
8 // To Public License, Version 2, as published by Sam Hocevar. See
9 // http://sam.zoy.org/wtfpl/COPYING for more details.
10 //
11
12 #include <math.h>
13 #include "easing.h"
14
15 // Modeled after the line y = x
16 AHFloat LinearInterpolation(AHFloat p)
17 {
18 return p;
19 }
20
21 // Modeled after the parabola y = x^2
22 AHFloat QuadraticEaseIn(AHFloat p)
23 {
24 return p * p;
25 }
26
27 // Modeled after the parabola y = -x^2 + 2x
28 AHFloat QuadraticEaseOut(AHFloat p)
29 {
30 return -(p * (p - 2));
31 }
32
33 // Modeled after the piecewise quadratic
34 // y = (1/2)((2x)^2) ; [0, 0.5)
35 // y = -(1/2)((2x-1)*(2x-3) - 1) ; [0.5, 1]
36 AHFloat QuadraticEaseInOut(AHFloat p)
37 {
38 if(p < 0.5)
39 {
40 return 2 * p * p;
41 }
42 else
43 {
44 return (-2 * p * p) + (4 * p) - 1;
45 }
46 }
47
48 // Modeled after the cubic y = x^3
49 AHFloat CubicEaseIn(AHFloat p)
50 {
51 return p * p * p;
52 }
53
54 // Modeled after the cubic y = (x - 1)^3 + 1
55 AHFloat CubicEaseOut(AHFloat p)
56 {
57 AHFloat f = (p - 1);
58 return f * f * f + 1;
59 }
60
61 // Modeled after the piecewise cubic
62 // y = (1/2)((2x)^3) ; [0, 0.5)
63 // y = (1/2)((2x-2)^3 + 2) ; [0.5, 1]
64 AHFloat CubicEaseInOut(AHFloat p)
65 {
66 if(p < 0.5)
67 {
68 return 4 * p * p * p;
69 }
70 else
71 {
72 AHFloat f = ((2 * p) - 2);
73 return 0.5 * f * f * f + 1;
74 }
75 }
76
77 // Modeled after the quartic x^4
78 AHFloat QuarticEaseIn(AHFloat p)
79 {
80 return p * p * p * p;
81 }
82
83 // Modeled after the quartic y = 1 - (x - 1)^4
84 AHFloat QuarticEaseOut(AHFloat p)
85 {
86 AHFloat f = (p - 1);
87 return f * f * f * (1 - p) + 1;
88 }
89
90 // Modeled after the piecewise quartic
91 // y = (1/2)((2x)^4) ; [0, 0.5)
92 // y = -(1/2)((2x-2)^4 - 2) ; [0.5, 1]
93 AHFloat QuarticEaseInOut(AHFloat p)
94 {
95 if(p < 0.5)
96 {
97 return 8 * p * p * p * p;
98 }
99 else
100 {
101 AHFloat f = (p - 1);
102 return -8 * f * f * f * f + 1;
103 }
104 }
105
106 // Modeled after the quintic y = x^5
107 AHFloat QuinticEaseIn(AHFloat p)
108 {
109 return p * p * p * p * p;
110 }
111
112 // Modeled after the quintic y = (x - 1)^5 + 1
113 AHFloat QuinticEaseOut(AHFloat p)
114 {
115 AHFloat f = (p - 1);
116 return f * f * f * f * f + 1;
117 }
118
119 // Modeled after the piecewise quintic
120 // y = (1/2)((2x)^5) ; [0, 0.5)
121 // y = (1/2)((2x-2)^5 + 2) ; [0.5, 1]
122 AHFloat QuinticEaseInOut(AHFloat p)
123 {
124 if(p < 0.5)
125 {
126 return 16 * p * p * p * p * p;
127 }
128 else
129 {
130 AHFloat f = ((2 * p) - 2);
131 return 0.5 * f * f * f * f * f + 1;
132 }
133 }
134
135 // Modeled after quarter-cycle of sine wave
136 AHFloat SineEaseIn(AHFloat p)
137 {
138 return sin((p - 1) * M_PI_2) + 1;
139 }
140
141 // Modeled after quarter-cycle of sine wave (different phase)
142 AHFloat SineEaseOut(AHFloat p)
143 {
144 return sin(p * M_PI_2);
145 }
146
147 // Modeled after half sine wave
148 AHFloat SineEaseInOut(AHFloat p)
149 {
150 return 0.5 * (1 - cos(p * M_PI));
151 }
152
153 // Modeled after shifted quadrant IV of unit circle
154 AHFloat CircularEaseIn(AHFloat p)
155 {
156 return 1 - sqrt(1 - (p * p));
157 }
158
159 // Modeled after shifted quadrant II of unit circle
160 AHFloat CircularEaseOut(AHFloat p)
161 {
162 return sqrt((2 - p) * p);
163 }
164
165 // Modeled after the piecewise circular function
166 // y = (1/2)(1 - sqrt(1 - 4x^2)) ; [0, 0.5)
167 // y = (1/2)(sqrt(-(2x - 3)*(2x - 1)) + 1) ; [0.5, 1]
168 AHFloat CircularEaseInOut(AHFloat p)
169 {
170 if(p < 0.5)
171 {
172 return 0.5 * (1 - sqrt(1 - 4 * (p * p)));
173 }
174 else
175 {
176 return 0.5 * (sqrt(-((2 * p) - 3) * ((2 * p) - 1)) + 1);
177 }
178 }
179
180 // Modeled after the exponential function y = 2^(10(x - 1))
181 AHFloat ExponentialEaseIn(AHFloat p)
182 {
183 return (p == 0.0) ? p : pow(2, 10 * (p - 1));
184 }
185
186 // Modeled after the exponential function y = -2^(-10x) + 1
187 AHFloat ExponentialEaseOut(AHFloat p)
188 {
189 return (p == 1.0) ? p : 1 - pow(2, -10 * p);
190 }
191
192 // Modeled after the piecewise exponential
193 // y = (1/2)2^(10(2x - 1)) ; [0,0.5)
194 // y = -(1/2)*2^(-10(2x - 1))) + 1 ; [0.5,1]
195 AHFloat ExponentialEaseInOut(AHFloat p)
196 {
197 if(p == 0.0 || p == 1.0) return p;
198
199 if(p < 0.5)
200 {
201 return 0.5 * pow(2, (20 * p) - 10);
202 }
203 else
204 {
205 return -0.5 * pow(2, (-20 * p) + 10) + 1;
206 }
207 }
208
209 // Modeled after the damped sine wave y = sin(13pi/2*x)*pow(2, 10 * (x - 1))
210 AHFloat ElasticEaseIn(AHFloat p)
211 {
212 return sin(13 * M_PI_2 * p) * pow(2, 10 * (p - 1));
213 }
214
215 // Modeled after the damped sine wave y = sin(-13pi/2*(x + 1))*pow(2, -10x) + 1
216 AHFloat ElasticEaseOut(AHFloat p)
217 {
218 return sin(-13 * M_PI_2 * (p + 1)) * pow(2, -10 * p) + 1;
219 }
220
221 // Modeled after the piecewise exponentially-damped sine wave:
222 // y = (1/2)*sin(13pi/2*(2*x))*pow(2, 10 * ((2*x) - 1)) ; [0,0.5)
223 // y = (1/2)*(sin(-13pi/2*((2x-1)+1))*pow(2,-10(2*x-1)) + 2) ; [0.5, 1]
224 AHFloat ElasticEaseInOut(AHFloat p)
225 {
226 if(p < 0.5)
227 {
228 return 0.5 * sin(13 * M_PI_2 * (2 * p)) * pow(2, 10 * ((2 * p) - 1));
229 }
230 else
231 {
232 return 0.5 * (sin(-13 * M_PI_2 * ((2 * p - 1) + 1)) * pow(2, -10 * (2 * p - 1)) + 2);
233 }
234 }
235
236 // Modeled after the overshooting cubic y = x^3-x*sin(x*pi)
237 AHFloat BackEaseIn(AHFloat p)
238 {
239 return p * p * p - p * sin(p * M_PI);
240 }
241
242 // Modeled after overshooting cubic y = 1-((1-x)^3-(1-x)*sin((1-x)*pi))
243 AHFloat BackEaseOut(AHFloat p)
244 {
245 AHFloat f = (1 - p);
246 return 1 - (f * f * f - f * sin(f * M_PI));
247 }
248
249 // Modeled after the piecewise overshooting cubic function:
250 // y = (1/2)*((2x)^3-(2x)*sin(2*x*pi)) ; [0, 0.5)
251 // y = (1/2)*(1-((1-x)^3-(1-x)*sin((1-x)*pi))+1) ; [0.5, 1]
252 AHFloat BackEaseInOut(AHFloat p)
253 {
254 if(p < 0.5)
255 {
256 AHFloat f = 2 * p;
257 return 0.5 * (f * f * f - f * sin(f * M_PI));
258 }
259 else
260 {
261 AHFloat f = (1 - (2*p - 1));
262 return 0.5 * (1 - (f * f * f - f * sin(f * M_PI))) + 0.5;
263 }
264 }
265
266 AHFloat BounceEaseIn(AHFloat p)
267 {
268 return 1 - BounceEaseOut(1 - p);
269 }
270
271 AHFloat BounceEaseOut(AHFloat p)
272 {
273 if(p < 4/11.0)
274 {
275 return (121 * p * p)/16.0;
276 }
277 else if(p < 8/11.0)
278 {
279 return (363/40.0 * p * p) - (99/10.0 * p) + 17/5.0;
280 }
281 else if(p < 9/10.0)
282 {
283 return (4356/361.0 * p * p) - (35442/1805.0 * p) + 16061/1805.0;
284 }
285 else
286 {
287 return (54/5.0 * p * p) - (513/25.0 * p) + 268/25.0;
288 }
289 }
290
291 AHFloat BounceEaseInOut(AHFloat p)
292 {
293 if(p < 0.5)
294 {
295 return 0.5 * BounceEaseIn(p*2);
296 }
297 else
298 {
299 return 0.5 * BounceEaseOut(p * 2 - 1) + 0.5;
300 }
301 }
+89
-0
src/easing.h less more
0 //
1 // easing.h
2 //
3 // Copyright (c) 2011, Auerhaus Development, LLC
4 //
5 // This program is free software. It comes without any warranty, to
6 // the extent permitted by applicable law. You can redistribute it
7 // and/or modify it under the terms of the Do What The Fuck You Want
8 // To Public License, Version 2, as published by Sam Hocevar. See
9 // http://sam.zoy.org/wtfpl/COPYING for more details.
10 //
11
12 #ifndef AH_EASING_H
13 #define AH_EASING_H
14
15 #if defined(__LP64__) && !defined(AH_EASING_USE_DBL_PRECIS)
16 #define AH_EASING_USE_DBL_PRECIS
17 #endif
18
19 #ifdef AH_EASING_USE_DBL_PRECIS
20 #define AHFloat double
21 #else
22 #define AHFloat float
23 #endif
24
25 #if defined __cplusplus
26 extern "C" {
27 #endif
28
29 typedef AHFloat (*AHEasingFunction)(AHFloat);
30
31 // Linear interpolation (no easing)
32 AHFloat LinearInterpolation(AHFloat p);
33
34 // Quadratic easing; p^2
35 AHFloat QuadraticEaseIn(AHFloat p);
36 AHFloat QuadraticEaseOut(AHFloat p);
37 AHFloat QuadraticEaseInOut(AHFloat p);
38
39 // Cubic easing; p^3
40 AHFloat CubicEaseIn(AHFloat p);
41 AHFloat CubicEaseOut(AHFloat p);
42 AHFloat CubicEaseInOut(AHFloat p);
43
44 // Quartic easing; p^4
45 AHFloat QuarticEaseIn(AHFloat p);
46 AHFloat QuarticEaseOut(AHFloat p);
47 AHFloat QuarticEaseInOut(AHFloat p);
48
49 // Quintic easing; p^5
50 AHFloat QuinticEaseIn(AHFloat p);
51 AHFloat QuinticEaseOut(AHFloat p);
52 AHFloat QuinticEaseInOut(AHFloat p);
53
54 // Sine wave easing; sin(p * PI/2)
55 AHFloat SineEaseIn(AHFloat p);
56 AHFloat SineEaseOut(AHFloat p);
57 AHFloat SineEaseInOut(AHFloat p);
58
59 // Circular easing; sqrt(1 - p^2)
60 AHFloat CircularEaseIn(AHFloat p);
61 AHFloat CircularEaseOut(AHFloat p);
62 AHFloat CircularEaseInOut(AHFloat p);
63
64 // Exponential easing, base 2
65 AHFloat ExponentialEaseIn(AHFloat p);
66 AHFloat ExponentialEaseOut(AHFloat p);
67 AHFloat ExponentialEaseInOut(AHFloat p);
68
69 // Exponentially-damped sine wave easing
70 AHFloat ElasticEaseIn(AHFloat p);
71 AHFloat ElasticEaseOut(AHFloat p);
72 AHFloat ElasticEaseInOut(AHFloat p);
73
74 // Overshooting cubic easing;
75 AHFloat BackEaseIn(AHFloat p);
76 AHFloat BackEaseOut(AHFloat p);
77 AHFloat BackEaseInOut(AHFloat p);
78
79 // Exponentially-decaying bounce easing
80 AHFloat BounceEaseIn(AHFloat p);
81 AHFloat BounceEaseOut(AHFloat p);
82 AHFloat BounceEaseInOut(AHFloat p);
83
84 #ifdef __cplusplus
85 }
86 #endif
87
88 #endif
+1285
-0
src/interpolators.cpp less more
0 #include <Rcpp.h>
1 #include "easing.h"
2
3 using namespace Rcpp;
4
5 enum easeEnum {
6 linear,
7 quadratic_in,
8 quadratic_out,
9 quadratic_in_out,
10 cubic_in,
11 cubic_out,
12 cubic_in_out,
13 quartic_in,
14 quartic_out,
15 quartic_in_out,
16 quintic_in,
17 quintic_out,
18 quintic_in_out,
19 sine_in,
20 sine_out,
21 sine_in_out,
22 circular_in,
23 circular_out,
24 circular_in_out,
25 exponential_in,
26 exponential_out,
27 exponential_in_out,
28 elastic_in,
29 elastic_out,
30 elastic_in_out,
31 back_in,
32 back_out,
33 back_in_out,
34 bounce_in,
35 bounce_out,
36 bounce_in_out,
37 UNKNOWN
38 };
39 easeEnum hashEase(std::string ease) {
40 if (ease == "linear") return linear;
41 if (ease == "quadratic-in") return quadratic_in;
42 if (ease == "quadratic-out") return quadratic_out;
43 if (ease == "quadratic-in-out") return quadratic_in_out;
44 if (ease == "cubic-in") return cubic_in;
45 if (ease == "cubic-out") return cubic_out;
46 if (ease == "cubic-in-out") return cubic_in_out;
47 if (ease == "quartic-in") return quartic_in;
48 if (ease == "quartic-out") return quartic_out;
49 if (ease == "quartic-in-out") return quartic_in_out;
50 if (ease == "quintic-in") return quintic_in;
51 if (ease == "quintic-out") return quintic_out;
52 if (ease == "quintic-in-out") return quintic_in_out;
53 if (ease == "sine-in") return sine_in;
54 if (ease == "sine-out") return sine_out;
55 if (ease == "sine-in-out") return sine_in_out;
56 if (ease == "circular-in") return circular_in;
57 if (ease == "circular-out") return circular_out;
58 if (ease == "circular-in-out") return circular_in_out;
59 if (ease == "exponential-in") return exponential_in;
60 if (ease == "exponential-out") return exponential_out;
61 if (ease == "exponential-in-out") return exponential_in_out;
62 if (ease == "elastic-in") return elastic_in;
63 if (ease == "elastic-out") return elastic_out;
64 if (ease == "elastic-in-out") return elastic_in_out;
65 if (ease == "back-in") return back_in;
66 if (ease == "back-out") return back_out;
67 if (ease == "back-in-out") return back_in_out;
68 if (ease == "bounce-in") return bounce_in;
69 if (ease == "bounce-out") return bounce_out;
70 if (ease == "bounce-in-out") return bounce_in_out;
71 return UNKNOWN;
72 }
73
74 std::vector<double> easeSeq(std::string easer, int length) {
75 std::vector<double> res(length);
76 double p;
77 // Just linear for now
78 for(int i = 0; i < length; ++i) {
79 p = double(i) / length;
80 switch (hashEase(easer)) {
81 case linear:
82 res[i] = LinearInterpolation(p);
83 break;
84 case quadratic_in:
85 res[i] = QuadraticEaseIn(p);
86 break;
87 case quadratic_out:
88 res[i] = QuadraticEaseOut(p);
89 break;
90 case quadratic_in_out:
91 res[i] = QuadraticEaseInOut(p);
92 break;
93 case cubic_in:
94 res[i] = CubicEaseIn(p);
95 break;
96 case cubic_out:
97 res[i] = CubicEaseOut(p);
98 break;
99 case cubic_in_out:
100 res[i] = CubicEaseInOut(p);
101 break;
102 case quartic_in:
103 res[i] = QuarticEaseIn(p);
104 break;
105 case quartic_out:
106 res[i] = QuarticEaseOut(p);
107 break;
108 case quartic_in_out:
109 res[i] = QuarticEaseInOut(p);
110 break;
111 case quintic_in:
112 res[i] = QuinticEaseIn(p);
113 break;
114 case quintic_out:
115 res[i] = QuinticEaseOut(p);
116 break;
117 case quintic_in_out:
118 res[i] = QuinticEaseInOut(p);
119 break;
120 case sine_in:
121 res[i] = SineEaseIn(p);
122 break;
123 case sine_out:
124 res[i] = SineEaseOut(p);
125 break;
126 case sine_in_out:
127 res[i] = SineEaseInOut(p);
128 break;
129 case circular_in:
130 res[i] = CircularEaseIn(p);
131 break;
132 case circular_out:
133 res[i] = CircularEaseOut(p);
134 break;
135 case circular_in_out:
136 res[i] = CircularEaseInOut(p);
137 break;
138 case exponential_in:
139 res[i] = ExponentialEaseIn(p);
140 break;
141 case exponential_out:
142 res[i] = ExponentialEaseOut(p);
143 break;
144 case exponential_in_out:
145 res[i] = ExponentialEaseInOut(p);
146 break;
147 case elastic_in:
148 res[i] = ElasticEaseIn(p);
149 break;
150 case elastic_out:
151 res[i] = ElasticEaseOut(p);
152 break;
153 case elastic_in_out:
154 res[i] = ElasticEaseInOut(p);
155 break;
156 case back_in:
157 res[i] = BackEaseIn(p);
158 break;
159 case back_out:
160 res[i] = BackEaseOut(p);
161 break;
162 case back_in_out:
163 res[i] = BackEaseInOut(p);
164 break;
165 case bounce_in:
166 res[i] = BounceEaseIn(p);
167 break;
168 case bounce_out:
169 res[i] = BounceEaseOut(p);
170 break;
171 case bounce_in_out:
172 res[i] = BounceEaseInOut(p);
173 break;
174 case UNKNOWN:
175 stop("Unknown easing function");
176 }
177 }
178 return res;
179 }
180 double easePos(double p, std::string easer) {
181 double p_new;
182 switch (hashEase(easer)) {
183 case linear:
184 p_new = LinearInterpolation(p);
185 break;
186 case quadratic_in:
187 p_new = QuadraticEaseIn(p);
188 break;
189 case quadratic_out:
190 p_new = QuadraticEaseOut(p);
191 break;
192 case quadratic_in_out:
193 p_new = QuadraticEaseInOut(p);
194 break;
195 case cubic_in:
196 p_new = CubicEaseIn(p);
197 break;
198 case cubic_out:
199 p_new = CubicEaseOut(p);
200 break;
201 case cubic_in_out:
202 p_new = CubicEaseInOut(p);
203 break;
204 case quartic_in:
205 p_new = QuarticEaseIn(p);
206 break;
207 case quartic_out:
208 p_new = QuarticEaseOut(p);
209 break;
210 case quartic_in_out:
211 p_new = QuarticEaseInOut(p);
212 break;
213 case quintic_in:
214 p_new = QuinticEaseIn(p);
215 break;
216 case quintic_out:
217 p_new = QuinticEaseOut(p);
218 break;
219 case quintic_in_out:
220 p_new = QuinticEaseInOut(p);
221 break;
222 case sine_in:
223 p_new = SineEaseIn(p);
224 break;
225 case sine_out:
226 p_new = SineEaseOut(p);
227 break;
228 case sine_in_out:
229 p_new = SineEaseInOut(p);
230 break;
231 case circular_in:
232 p_new = CircularEaseIn(p);
233 break;
234 case circular_out:
235 p_new = CircularEaseOut(p);
236 break;
237 case circular_in_out:
238 p_new = CircularEaseInOut(p);
239 break;
240 case exponential_in:
241 p_new = ExponentialEaseIn(p);
242 break;
243 case exponential_out:
244 p_new = ExponentialEaseOut(p);
245 break;
246 case exponential_in_out:
247 p_new = ExponentialEaseInOut(p);
248 break;
249 case elastic_in:
250 p_new = ElasticEaseIn(p);
251 break;
252 case elastic_out:
253 p_new = ElasticEaseOut(p);
254 break;
255 case elastic_in_out:
256 p_new = ElasticEaseInOut(p);
257 break;
258 case back_in:
259 p_new = BackEaseIn(p);
260 break;
261 case back_out:
262 p_new = BackEaseOut(p);
263 break;
264 case back_in_out:
265 p_new = BackEaseInOut(p);
266 break;
267 case bounce_in:
268 p_new = BounceEaseIn(p);
269 break;
270 case bounce_out:
271 p_new = BounceEaseOut(p);
272 break;
273 case bounce_in_out:
274 p_new = BounceEaseInOut(p);
275 break;
276 case UNKNOWN:
277 stop("Unknown easing function");
278 }
279 return p_new;
280 }
281
282
283 //[[Rcpp::export]]
284 NumericVector numeric_state_interpolator(List data, DataFrame states) {
285 IntegerVector state_index = states("state");
286 NumericVector nframes_per_state = states("nframes");
287 std::vector<std::string> easer = states("ease");
288 int nelements = as<NumericVector>(data(0)).size();
289 int nstates = states.nrows();
290 int nframes = sum(nframes_per_state);
291 int frame = 0;
292 int state, element, currentframe, res_index;
293 NumericVector res(nelements * nframes);
294
295 for (state = 0; state < nstates; ++state) {
296 if (easer[state] == "constant") {
297 NumericVector state_from = data(state_index(state));
298 for (currentframe = 0; currentframe < nframes_per_state(state); ++currentframe) {
299 res_index = (frame + currentframe) * nelements;
300 for (element = 0; element < nelements; ++element) {
301 res[res_index] = state_from[element];
302 ++res_index;
303 }
304 }
305 } else {
306 std::vector<double> ease_points = easeSeq(easer[state], nframes_per_state(state));
307 NumericVector state_from = data(state_index(state));
308 NumericVector state_to = data(state_index(state) + 1);
309 for (element = 0; element < nelements; ++element) {
310 for (currentframe = 0; currentframe < nframes_per_state(state); ++currentframe) {
311 res_index = (frame + currentframe) * nelements + element;
312 res[res_index] = state_from[element] + ease_points[currentframe] * (state_to[element] - state_from[element]);
313 }
314 }
315 }
316 frame += nframes_per_state(state);
317 }
318
319 return res;
320 }
321
322 //[[Rcpp::export]]
323 NumericMatrix colour_state_interpolator(List data, DataFrame states) {
324 IntegerVector state_index = states("state");
325 NumericVector nframes_per_state = states("nframes");
326 std::vector<std::string> easer = states("ease");
327 int nelements = as<NumericMatrix>(data(0)).nrow();
328 int nstates = states.nrows();
329 int nframes = sum(nframes_per_state);
330 int frame = 0;
331 int state, element, currentframe, res_index;
332 NumericMatrix res(nelements * nframes, 4);
333
334 for (state = 0; state < nstates; ++state) {
335 if (easer[state] == "constant") {
336 NumericMatrix state_from = data(state_index(state));
337 for (currentframe = 0; currentframe < nframes_per_state(state); ++currentframe) {
338 res_index = (frame + currentframe) * nelements;
339 for (element = 0; element < nelements; ++element) {
340 res(res_index, 0) = state_from(element, 0);
341 res(res_index, 1) = state_from(element, 1);
342 res(res_index, 2) = state_from(element, 2);
343 res(res_index, 3) = state_from(element, 3);
344 ++res_index;
345 }
346 }
347 } else {
348 std::vector<double> ease_points = easeSeq(easer[state], nframes_per_state(state));
349 NumericMatrix state_from = data(state_index(state));
350 NumericMatrix state_to = data(state_index(state) + 1);
351 for (element = 0; element < nelements; ++element) {
352 for (currentframe = 0; currentframe < nframes_per_state(state); ++currentframe) {
353 res_index = (frame + currentframe) * nelements + element;
354 res(res_index, 0) = state_from(element, 0) + ease_points[currentframe] * (state_to(element, 0) - state_from(element, 0));
355 res(res_index, 1) = state_from(element, 1) + ease_points[currentframe] * (state_to(element, 1) - state_from(element, 1));
356 res(res_index, 2) = state_from(element, 2) + ease_points[currentframe] * (state_to(element, 2) - state_from(element, 2));
357 res(res_index, 3) = state_from(element, 3) + ease_points[currentframe] * (state_to(element, 3) - state_from(element, 3));
358 }
359 }
360 }
361 frame += nframes_per_state(state);
362 }
363
364 return res;
365 }
366
367 //[[Rcpp::export]]
368 CharacterVector constant_state_interpolator(List data, DataFrame states) {
369 IntegerVector state_index = states("state");
370 NumericVector nframes_per_state = states("nframes");
371 std::vector<std::string> easer = states("ease");
372 int nelements = as<CharacterVector>(data(0)).size();
373 int nstates = states.nrows();
374 int nframes = sum(nframes_per_state);
375 int frame = 0;
376 int state, element, currentframe, res_index;
377 CharacterVector res(nelements * nframes);
378
379 for (state = 0; state < nstates; ++state) {
380 if (easer[state] == "constant") {
381 CharacterVector state_from = data(state_index(state));
382 for (currentframe = 0; currentframe < nframes_per_state(state); ++currentframe) {
383 res_index = (frame + currentframe) * nelements;
384 for (element = 0; element < nelements; ++element) {
385 res[res_index] = state_from[element];
386 ++res_index;
387 }
388 }
389 } else {
390 std::vector<double> ease_points = easeSeq(easer[state], nframes_per_state(state));
391 CharacterVector state_from = data(state_index(state));
392 CharacterVector state_to = data(state_index(state) + 1);
393 for (element = 0; element < nelements; ++element) {
394 for (currentframe = 0; currentframe < nframes_per_state(state); ++currentframe) {
395 res_index = (frame + currentframe) * nelements + element;
396 if (ease_points[currentframe] < 0.5) {
397 res[res_index] = state_from[element];
398 } else {
399 res[res_index] = state_to[element];
400 }
401 }
402 }
403 }
404 frame += nframes_per_state(state);
405 }
406
407 return res;
408 }
409 //[[Rcpp::export]]
410 List list_state_interpolator(List data, DataFrame states) {
411 IntegerVector state_index = states("state");
412 NumericVector nframes_per_state = states("nframes");
413 std::vector<std::string> easer = states("ease");
414 int nelements = as<List>(data(0)).size();
415 int nstates = states.nrows();
416 int nframes = sum(nframes_per_state);
417 int frame = 0;
418 int state, element, currentframe, res_index;
419 List res(nelements * nframes);
420
421 for (state = 0; state < nstates; ++state) {
422 if (easer[state] == "constant") {
423 List state_from = data(state_index(state));
424 for (currentframe = 0; currentframe < nframes_per_state(state); ++currentframe) {
425 res_index = (frame + currentframe) * nelements;
426 for (element = 0; element < nelements; ++element) {
427 res[res_index] = state_from[element];
428 ++res_index;
429 }
430 }
431 } else {
432 std::vector<double> ease_points = easeSeq(easer[state], nframes_per_state(state));
433 List state_from = data(state_index(state));
434 List state_to = data(state_index(state) + 1);
435 for (element = 0; element < nelements; ++element) {
436 for (currentframe = 0; currentframe < nframes_per_state(state); ++currentframe) {
437 res_index = (frame + currentframe) * nelements + element;
438 if (ease_points[currentframe] < 0.5) {
439 res[res_index] = state_from[element];
440 } else {
441 res[res_index] = state_to[element];
442 }
443 }
444 }
445 }
446 frame += nframes_per_state(state);
447 }
448
449 return res;
450 }
451 NumericVector align_num_elem(NumericVector from, NumericVector to) {
452 NumericVector res;
453 if (from.size() < to.size()) {
454 if (from.size() == 0) {
455 res = NumericVector(to.size(), mean(to));
456 } else {
457 res = NumericVector(to.size());
458 for (int i = 0; i < res.size(); ++i) {
459 res[i] = from[i % from.size()];
460 }
461 }
462 } else {
463 res = from;
464 }
465 return res;
466 }
467 //[[Rcpp::export]]
468 List numlist_state_interpolator(List data, DataFrame states) {
469 IntegerVector state_index = states("state");
470 NumericVector nframes_per_state = states("nframes");
471 std::vector<std::string> easer = states("ease");
472 int nelements = as<List>(data(0)).size();
473 int nstates = states.nrows();
474 int nframes = sum(nframes_per_state);
475 int frame = 0;
476 int state, element, currentframe, res_index;
477 List res(nelements * nframes);
478
479 for (state = 0; state < nstates; ++state) {
480 if (easer[state] == "constant") {
481 List state_from = data(state_index(state));
482 for (currentframe = 0; currentframe < nframes_per_state(state); ++currentframe) {
483 res_index = (frame + currentframe) * nelements;
484 for (element = 0; element < nelements; ++element) {
485 res[res_index] = state_from[element];
486 ++res_index;
487 }
488 }
489 } else {
490 std::vector<double> ease_points = easeSeq(easer[state], nframes_per_state(state));
491 List state_from = data(state_index(state));
492 List state_to = data(state_index(state) + 1);
493 for (element = 0; element < nelements; ++element) {
494 NumericVector state_from_vec = state_from[element];
495 NumericVector state_to_vec = state_to[element];
496 state_from_vec = align_num_elem(state_from_vec, state_to_vec);
497 state_to_vec = align_num_elem(state_to_vec, state_from_vec);
498 for (currentframe = 0; currentframe < nframes_per_state(state); ++currentframe) {
499 res_index = (frame + currentframe) * nelements + element;
500 NumericVector state_vec = state_from_vec + ease_points[currentframe] * (state_to_vec - state_from_vec);
501 res[res_index] = state_vec;
502 }
503 }
504 }
505 frame += nframes_per_state(state);
506 }
507
508 return res;
509 }
510
511 //[[Rcpp::export]]
512 CharacterVector phase_state_interpolator(List data, DataFrame states) {
513 IntegerVector state_index = states("state");
514 NumericVector nframes_per_state = states("nframes");
515 std::vector<std::string> easer = states("ease");
516 int nelements = as<CharacterVector>(data(0)).size();
517 int nstates = states.nrows();
518 int nframes = sum(nframes_per_state);
519 int frame = 0;
520 int state, element, currentframe, res_index;
521 CharacterVector res(nelements * nframes);
522
523 for (state = 0; state < nstates; ++state) {
524 if (easer[state] == "constant") {
525 CharacterVector state_from = data(state_index(state));
526 for (currentframe = 0; currentframe < nframes_per_state(state); ++currentframe) {
527 std::string type = currentframe == nframes_per_state(state) - 1 ? "raw" : "static";
528 res_index = (frame + currentframe) * nelements;
529 for (element = 0; element < nelements; ++element) {
530 res[res_index] = type;
531 ++res_index;
532 }
533 }
534 } else {
535 std::vector<double> ease_points = easeSeq(easer[state], nframes_per_state(state));
536 CharacterVector state_from = data(state_index(state));
537 CharacterVector state_to = data(state_index(state) + 1);
538 for (element = 0; element < nelements; ++element) {
539 std::string type = state_from[element] == "enter" ? "enter" : state_to[element] == "exit" ? "exit" : "transition";
540 for (currentframe = 0; currentframe < nframes_per_state(state); ++currentframe) {
541 res_index = (frame + currentframe) * nelements + element;
542 res[res_index] = type;
543 }
544 }
545 }
546 frame += nframes_per_state(state);
547 }
548
549 return res;
550 }
551
552 //[[Rcpp::export]]
553 DataFrame numeric_element_interpolator(NumericVector data, CharacterVector group, IntegerVector frame, CharacterVector ease) {
554 std::deque<double> tweendata;
555 std::deque<std::string> tweengroup;
556 std::deque<int> tweenframe;
557 int i, j, nframes;
558 std::string groupString;
559 std::string currentGroup = as<std::string>(group[0]);
560
561 for (i = 1; i < data.size(); ++i) {
562 groupString = as<std::string>(group[i]);
563 if (currentGroup.compare(groupString) == 0) {
564 nframes = frame[i] - frame[i-1];
565 std::vector<double> ease_points = easeSeq(as<std::string>(ease[i-1]), nframes);
566 for (j = 0; j < ease_points.size(); ++j) {
567 tweendata.push_back(data[i - 1] + ease_points[j] * (data[i] - data[i - 1]));
568 tweengroup.push_back(groupString);
569 tweenframe.push_back(j + frame[i-1]);
570 }
571 } else {
572 tweendata.push_back(data[i - 1]);
573 tweengroup.push_back(currentGroup);
574 tweenframe.push_back(frame[i-1]);
575 currentGroup = groupString;
576 }
577 }
578 tweendata.push_back(data[i - 1]);
579 tweengroup.push_back(currentGroup);
580 tweenframe.push_back(frame[i-1]);
581
582 return DataFrame::create(
583 Named("data") = wrap(tweendata),
584 Named("group") = wrap(tweengroup),
585 Named("frame") = wrap(tweenframe),
586 Named("stringsAsFactors") = false
587 );
588 }
589
590 //[[Rcpp::export]]
591 DataFrame colour_element_interpolator(NumericMatrix data, CharacterVector group, IntegerVector frame, CharacterVector ease) {
592 std::deque<double> tweendata1;
593 std::deque<double> tweendata2;
594 std::deque<double> tweendata3;
595 std::deque<double> tweendata4;
596 std::deque<std::string> tweengroup;
597 std::deque<int> tweenframe;
598 int i, j, nframes;
599 std::string groupString;
600 std::string currentGroup = as<std::string>(group[0]);
601
602 for (i = 1; i < data.nrow(); ++i) {
603 groupString = as<std::string>(group[i]);
604 if (currentGroup.compare(groupString) == 0) {
605 nframes = frame[i] - frame[i-1];
606 std::vector<double> ease_points = easeSeq(as<std::string>(ease[i-1]), nframes);
607 for (j = 0; j < ease_points.size(); ++j) {
608 tweendata1.push_back(data(i - 1, 0) + ease_points[j] * (data(i, 0) - data(i - 1, 0)));
609 tweendata2.push_back(data(i - 1, 1) + ease_points[j] * (data(i, 1) - data(i - 1, 1)));
610 tweendata3.push_back(data(i - 1, 2) + ease_points[j] * (data(i, 2) - data(i - 1, 2)));
611 tweendata4.push_back(data(i - 1, 3) + ease_points[j] * (data(i, 3) - data(i - 1, 3)));
612 tweengroup.push_back(groupString);
613 tweenframe.push_back(j + frame[i-1]);
614 }
615 } else {
616 tweendata1.push_back(data(i - 1, 0));
617 tweendata2.push_back(data(i - 1, 1));
618 tweendata3.push_back(data(i - 1, 2));
619 tweendata4.push_back(data(i - 1, 3));
620 tweengroup.push_back(currentGroup);
621 tweenframe.push_back(frame[i-1]);
622 currentGroup = groupString;
623 }
624 }
625 tweendata1.push_back(data(i - 1, 0));
626 tweendata2.push_back(data(i - 1, 1));
627 tweendata3.push_back(data(i - 1, 2));
628 tweendata4.push_back(data(i - 1, 3));
629 tweengroup.push_back(currentGroup);
630 tweenframe.push_back(frame[i-1]);
631
632 return DataFrame::create(
633 Named("data1") = wrap(tweendata1),
634 Named("data2") = wrap(tweendata2),
635 Named("data3") = wrap(tweendata3),
636 Named("data4") = wrap(tweendata4),
637 Named("group") = wrap(tweengroup),
638 Named("frame") = wrap(tweenframe),
639 Named("stringsAsFactors") = false
640 );
641 }
642
643 //[[Rcpp::export]]
644 DataFrame constant_element_interpolator(CharacterVector data, CharacterVector group, IntegerVector frame, CharacterVector ease) {
645 std::deque<std::string> tweendata;
646 std::deque<std::string> tweengroup;
647 std::deque<int> tweenframe;
648 int i, j, nframes;
649 std::string groupString;
650 std::string currentGroup = as<std::string>(group[0]);
651
652 for (i = 1; i < data.size(); ++i) {
653 groupString = as<std::string>(group[i]);
654 if (currentGroup.compare(groupString) == 0) {
655 nframes = frame[i] - frame[i-1];
656 std::vector<double> ease_points = easeSeq(as<std::string>(ease[i-1]), nframes);
657 for (j = 0; j < ease_points.size(); ++j) {
658 if (ease_points[j] < 0.5) {
659 tweendata.push_back(as<std::string>(data[i - 1]));
660 } else {
661 tweendata.push_back(as<std::string>(data[i]));
662 }
663 tweengroup.push_back(groupString);
664 tweenframe.push_back(j + frame[i-1]);
665 }
666 } else {
667 tweendata.push_back(as<std::string>(data[i - 1]));
668 tweengroup.push_back(currentGroup);
669 tweenframe.push_back(frame[i-1]);
670 currentGroup = groupString;
671 }
672
673 }
674 tweendata.push_back(as<std::string>(data[i - 1]));
675 tweengroup.push_back(currentGroup);
676 tweenframe.push_back(frame[i-1]);
677
678 return DataFrame::create(
679 Named("data") = wrap(tweendata),
680 Named("group") = wrap(tweengroup),
681 Named("frame") = wrap(tweenframe),
682 Named("stringsAsFactors") = false
683 );
684 }
685
686 //[[Rcpp::export]]
687 List list_element_interpolator(List data, CharacterVector group, IntegerVector frame, CharacterVector ease) {
688 std::deque<SEXP> tweendata;
689 std::deque<std::string> tweengroup;
690 std::deque<int> tweenframe;
691 int i, j, nframes;
692 std::string groupString;
693 std::string currentGroup = as<std::string>(group[0]);
694
695 for (i = 1; i < data.size(); ++i) {
696 groupString = as<std::string>(group[i]);
697 if (currentGroup.compare(groupString) == 0) {
698 nframes = frame[i] - frame[i-1];
699 std::vector<double> ease_points = easeSeq(as<std::string>(ease[i-1]), nframes);
700 for (j = 0; j < ease_points.size(); ++j) {
701 if (ease_points[j] < 0.5) {
702 tweendata.push_back(data[i - 1]);
703 } else {
704 tweendata.push_back(data[i]);
705 }
706 tweengroup.push_back(groupString);
707 tweenframe.push_back(j + frame[i-1]);
708 }
709 } else {
710 tweendata.push_back(data[i - 1]);
711 tweengroup.push_back(currentGroup);
712 tweenframe.push_back(frame[i-1]);
713 currentGroup = groupString;
714 }
715
716 }
717 tweendata.push_back(data[i - 1]);
718 tweengroup.push_back(currentGroup);
719 tweenframe.push_back(frame[i-1]);
720 List tweendata_list = wrap(tweendata);
721 IntegerVector frame_vec = wrap(tweenframe);
722 CharacterVector group_vec = wrap(tweengroup);
723 List res = List::create(
724 Named("data") = tweendata_list,
725 Named("group") = group_vec,
726 Named("frame") = frame_vec
727 );
728 res.attr("class") = "data.frame";
729 res.attr("row.names") = seq_along(frame_vec);
730 return res;
731 }
732
733 //[[Rcpp::export]]
734 List numlist_element_interpolator(List data, CharacterVector group, IntegerVector frame, CharacterVector ease) {
735 std::deque<NumericVector> tweendata;
736 std::deque<std::string> tweengroup;
737 std::deque<int> tweenframe;
738 int i, j, nframes;
739 std::string groupString;
740 std::string currentGroup = as<std::string>(group[0]);
741
742 for (i = 1; i < data.size(); ++i) {
743 groupString = as<std::string>(group[i]);
744 if (currentGroup.compare(groupString) == 0) {
745 nframes = frame[i] - frame[i-1];
746 std::vector<double> ease_points = easeSeq(as<std::string>(ease[i-1]), nframes);
747 NumericVector state_from_vec = data[i - 1];
748 NumericVector state_to_vec = data[i];
749 state_from_vec = align_num_elem(state_from_vec, state_to_vec);
750 state_to_vec = align_num_elem(state_to_vec, state_from_vec);
751 for (j = 0; j < ease_points.size(); ++j) {
752 NumericVector state_vec = state_from_vec + ease_points[j] * (state_to_vec - state_from_vec);
753 tweendata.push_back(state_vec);
754 tweengroup.push_back(groupString);
755 tweenframe.push_back(j + frame[i-1]);
756 }
757 } else {
758 tweendata.push_back(data[i - 1]);
759 tweengroup.push_back(currentGroup);
760 tweenframe.push_back(frame[i-1]);
761 currentGroup = groupString;
762 }
763
764 }
765 tweendata.push_back(data[i - 1]);
766 tweengroup.push_back(currentGroup);
767 tweenframe.push_back(frame[i-1]);
768 List tweendata_list = wrap(tweendata);
769 IntegerVector frame_vec = wrap(tweenframe);
770 CharacterVector group_vec = wrap(tweengroup);
771 List res = List::create(
772 Named("data") = tweendata_list,
773 Named("group") = group_vec,
774 Named("frame") = frame_vec
775 );
776 res.attr("class") = "data.frame";
777 res.attr("row.names") = seq_along(frame_vec);
778 return res;
779 }
780
781 //[[Rcpp::export]]
782 DataFrame phase_element_interpolator(CharacterVector data, CharacterVector group, IntegerVector frame, CharacterVector ease) {
783 std::deque<std::string> tweendata;
784 std::deque<std::string> tweengroup;
785 std::deque<int> tweenframe;
786 int i, j, nframes;
787 std::string groupString;
788 std::string currentGroup = as<std::string>(group[0]);
789
790 for (i = 1; i < data.size(); ++i) {
791 groupString = as<std::string>(group[i]);
792 if (currentGroup.compare(groupString) == 0) {
793 nframes = frame[i] - frame[i-1];
794 std::string type = data[i - 1] == "enter" ? "enter" : data[i] == "exit" ? "exit" : data[i - 1] == "static" ? "static" : "transition";
795 for (j = 0; j < nframes; ++j) {
796 if (j == 0 && (type == "transition" || type == "exit")) {
797 tweendata.push_back("raw");
798 } else {
799 tweendata.push_back(type);
800 }
801 tweengroup.push_back(groupString);
802 tweenframe.push_back(j + frame[i-1]);
803 }
804 } else {
805 tweendata.push_back(as<std::string>(data[i - 1]));
806 tweengroup.push_back(currentGroup);
807 tweenframe.push_back(frame[i-1]);
808 currentGroup = groupString;
809 }
810
811 }
812 tweendata.push_back(as<std::string>(data[i - 1]));
813 tweengroup.push_back(currentGroup);
814 tweenframe.push_back(frame[i-1]);
815
816 return DataFrame::create(
817 Named("data") = wrap(tweendata),
818 Named("group") = wrap(tweengroup),
819 Named("frame") = wrap(tweenframe),
820 Named("stringsAsFactors") = false
821 );
822 }
823
824 //[[Rcpp::export]]
825 DataFrame numeric_along_interpolator(NumericVector data, CharacterVector group, NumericVector time, bool history, bool keep_last, int nframes, CharacterVector ease) {
826 std::deque<double> tweendata;
827 std::deque<std::string> tweengroup;
828 std::deque<int> tweenframe;
829 std::string easer = as<std::string>(ease);
830
831 int i,j,jj;
832 bool before,after,same,last;
833 double pos,interp;
834
835 for (i = 1; i <= nframes; ++i) {
836 for (j = 0; j < data.size(); ++j) {
837 last = j == data.size() - 1;
838 jj = last ? j : j + 1;
839 before = time[j] <= i;
840 after = time[jj] > i;
841 same = group[j] == group[jj];
842 if ((history && same && before) || ((!same || last) && keep_last && before)) {
843 tweendata.push_back(data[j]);
844 tweengroup.push_back(as<std::string>(group[j]));
845 tweenframe.push_back(i);
846 }
847 if (same && before == after) {
848 pos = (i - time[j]) / (time[jj] - time[j]);
849 pos = easePos(pos, easer);
850 interp = data[j] + (data[jj] - data[j]) * pos;
851 tweendata.push_back(interp);
852 tweengroup.push_back(as<std::string>(group[j]));
853 tweenframe.push_back(i);
854 }
855 }
856 }
857
858 return DataFrame::create(
859 Named("data") = wrap(tweendata),
860 Named("group") = wrap(tweengroup),
861 Named("frame") = wrap(tweenframe),
862 Named("stringsAsFactors") = false
863 );
864 }
865 //[[Rcpp::export]]
866 DataFrame colour_along_interpolator(NumericMatrix data, CharacterVector group, NumericVector time, bool history, bool keep_last, int nframes, CharacterVector ease) {
867 std::deque<double> tweendata1;
868 std::deque<double> tweendata2;
869 std::deque<double> tweendata3;
870 std::deque<double> tweendata4;
871
872 std::deque<std::string> tweengroup;
873 std::deque<int> tweenframe;
874 std::string easer = as<std::string>(ease);
875
876 int i,j,jj;
877 bool before,after,same,last;
878 double pos;
879
880 for (i = 1; i <= nframes; ++i) {
881 for (j = 0; j < data.nrow(); ++j) {
882 last = j == data.nrow() - 1;
883 jj = last ? j : j + 1;
884 before = time[j] <= i;
885 after = time[jj] > i;
886 same = group[j] == group[jj];
887 if ((history && same && before) || ((!same || last) && keep_last && before)) {
888 tweendata1.push_back(data(j, 0));
889 tweendata2.push_back(data(j, 1));
890 tweendata3.push_back(data(j, 2));
891 tweendata4.push_back(data(j, 3));
892 tweengroup.push_back(as<std::string>(group[j]));
893 tweenframe.push_back(i);
894 }
895 if (same && before == after) {
896 pos = (i - time[j]) / (time[j + 1] - time[j]);
897 pos = easePos(pos, easer);
898 tweendata1.push_back(data(j, 0) + (data(j + 1, 0) - data(j, 0)) * pos);
899 tweendata2.push_back(data(j, 1) + (data(j + 1, 1) - data(j, 1)) * pos);
900 tweendata3.push_back(data(j, 2) + (data(j + 1, 2) - data(j, 2)) * pos);
901 tweendata4.push_back(data(j, 3) + (data(j + 1, 3) - data(j, 3)) * pos);
902 tweengroup.push_back(as<std::string>(group[j]));
903 tweenframe.push_back(i);
904 }
905 }
906 }
907
908 return DataFrame::create(
909 Named("data1") = wrap(tweendata1),
910 Named("data2") = wrap(tweendata2),
911 Named("data3") = wrap(tweendata3),
912 Named("data4") = wrap(tweendata4),
913 Named("group") = wrap(tweengroup),
914 Named("frame") = wrap(tweenframe),
915 Named("stringsAsFactors") = false
916 );
917 }
918
919 //[[Rcpp::export]]
920 DataFrame constant_along_interpolator(CharacterVector data, CharacterVector group, NumericVector time, bool history, bool keep_last, int nframes, CharacterVector ease) {
921 std::deque<std::string> tweendata;
922 std::deque<std::string> tweengroup;
923 std::deque<int> tweenframe;
924 std::string easer = as<std::string>(ease);
925
926 int i,j,jj;
927 bool before,after,same,last;
928 double pos;
929
930 for (i = 1; i <= nframes; ++i) {
931 for (j = 0; j < data.size(); ++j) {
932 last = j == data.size() - 1;
933 jj = last ? j : j + 1;
934 before = time[j] <= i;
935 after = time[jj] > i;
936 same = group[j] == group[jj];
937 if ((history && same && before) || ((!same || last) && keep_last && before)) {
938 tweendata.push_back(as<std::string>(data[j]));
939 tweengroup.push_back(as<std::string>(group[j]));
940 tweenframe.push_back(i);
941 }
942 if (same && before == after) {
943 pos = (i - time[j]) / (time[j + 1] - time[j]);
944 pos = easePos(pos, easer);
945 if (pos < 0.5) {
946 tweendata.push_back(as<std::string>(data[j]));
947 } else {
948 tweendata.push_back(as<std::string>(data[j + 1]));
949 }
950 tweengroup.push_back(as<std::string>(group[j]));
951 tweenframe.push_back(i);
952 }
953 }
954 }
955
956 return DataFrame::create(
957 Named("data") = wrap(tweendata),
958 Named("group") = wrap(tweengroup),
959 Named("frame") = wrap(tweenframe),
960 Named("stringsAsFactors") = false
961 );
962 }
963
964 //[[Rcpp::export]]
965 List list_along_interpolator(List data, CharacterVector group, NumericVector time, bool history, bool keep_last, int nframes, CharacterVector ease) {
966 std::deque<SEXP> tweendata;
967 std::deque<std::string> tweengroup;
968 std::deque<int> tweenframe;
969 std::string easer = as<std::string>(ease);
970
971 int i,j,jj;
972 bool before,after,same,last;
973 double pos;
974
975 for (i = 1; i <= nframes; ++i) {
976 for (j = 0; j < data.size(); ++j) {
977 last = j == data.size() - 1;
978 jj = last ? j : j + 1;
979 before = time[j] <= i;
980 after = time[jj] > i;
981 same = group[j] == group[jj];
982 if ((history && same && before) || ((!same || last) && keep_last && before)) {
983 tweendata.push_back(data[j]);
984 tweengroup.push_back(as<std::string>(group[j]));
985 tweenframe.push_back(i);
986 }
987 if (same && before == after) {
988 pos = (i - time[j]) / (time[j + 1] - time[j]);
989 pos = easePos(pos, easer);
990 if (pos < 0.5) {
991 tweendata.push_back(data[j]);
992 } else {
993 tweendata.push_back(data[j + 1]);
994 }
995 tweengroup.push_back(as<std::string>(group[j]));
996 tweenframe.push_back(i);
997 }
998 }
999 }
1000
1001 List tweendata_list = wrap(tweendata);
1002 IntegerVector frame_vec = wrap(tweenframe);
1003 CharacterVector group_vec = wrap(tweengroup);
1004 List res = List::create(
1005 Named("data") = tweendata_list,
1006 Named("group") = group_vec,
1007 Named("frame") = frame_vec
1008 );
1009 res.attr("class") = "data.frame";
1010 res.attr("row.names") = seq_along(frame_vec);
1011 return res;
1012 }
1013 //[[Rcpp::export]]
1014 List numlist_along_interpolator(List data, CharacterVector group, NumericVector time, bool history, bool keep_last, int nframes, CharacterVector ease) {
1015 std::deque<NumericVector> tweendata;
1016 std::deque<std::string> tweengroup;
1017 std::deque<int> tweenframe;
1018 std::string easer = as<std::string>(ease);
1019
1020 int i,j,jj;
1021 bool before,after,same,last;
1022 double pos;
1023
1024 for (i = 1; i <= nframes; ++i) {
1025 for (j = 0; j < data.size(); ++j) {
1026 last = j == data.size() - 1;
1027 jj = last ? j : j + 1;
1028 before = time[j] <= i;
1029 after = time[jj] > i;
1030 same = group[j] == group[jj];
1031 if ((history && same && before) || ((!same || last) && keep_last && before)) {
1032 tweendata.push_back(data[j]);
1033 tweengroup.push_back(as<std::string>(group[j]));
1034 tweenframe.push_back(i);
1035 }
1036 if (same && before == after) {
1037 NumericVector state_from_vec = data[j];
1038 NumericVector state_to_vec = data[j + 1];
1039 state_from_vec = align_num_elem(state_from_vec, state_to_vec);
1040 state_to_vec = align_num_elem(state_to_vec, state_from_vec);
1041 pos = (i - time[j]) / (time[j + 1] - time[j]);
1042 pos = easePos(pos, easer);
1043 NumericVector state_vec = state_from_vec + pos * (state_to_vec - state_from_vec);
1044 tweendata.push_back(state_vec);
1045 tweengroup.push_back(as<std::string>(group[j]));
1046 tweenframe.push_back(i);
1047 }
1048 }
1049 }
1050
1051 List tweendata_list = wrap(tweendata);
1052 IntegerVector frame_vec = wrap(tweenframe);
1053 CharacterVector group_vec = wrap(tweengroup);
1054 List res = List::create(
1055 Named("data") = tweendata_list,
1056 Named("group") = group_vec,
1057 Named("frame") = frame_vec
1058 );
1059 res.attr("class") = "data.frame";
1060 res.attr("row.names") = seq_along(frame_vec);
1061 return res;
1062 }
1063 //[[Rcpp::export]]
1064 DataFrame phase_along_interpolator(CharacterVector group, NumericVector time, bool history, bool keep_last, int nframes) {
1065 std::deque<std::string> tweendata;
1066 std::deque<std::string> tweengroup;
1067 std::deque<int> tweenframe;
1068
1069 int i,j,jj;
1070 bool before,after,same,last;
1071
1072 for (i = 1; i <= nframes; ++i) {
1073 for (j = 0; j < group.size(); ++j) {
1074 last = j == group.size() - 1;
1075 jj = last ? j : j + 1;
1076 before = time[j] <= i;
1077 after = time[jj] > i;
1078 same = group[j] == group[jj];
1079 if ((history && same && before) || ((!same || last) && keep_last && before)) {
1080 tweendata.push_back("raw");
1081 tweengroup.push_back(as<std::string>(group[j]));
1082 tweenframe.push_back(i);
1083 }
1084 if (same && before == after) {
1085 tweendata.push_back("transition");
1086 tweengroup.push_back(as<std::string>(group[j]));
1087 tweenframe.push_back(i);
1088 }
1089 }
1090 }
1091
1092 return DataFrame::create(
1093 Named("data") = wrap(tweendata),
1094 Named("group") = wrap(tweengroup),
1095 Named("frame") = wrap(tweenframe),
1096 Named("stringsAsFactors") = false
1097 );
1098 }
1099
1100 //[[Rcpp::export]]
1101 NumericVector numeric_at_interpolator(NumericVector from, NumericVector to, NumericVector at, CharacterVector ease) {
1102 int n = from.size(), i;
1103 double pos;
1104 std::string easer = as<std::string>(ease);
1105 NumericVector res(n);
1106
1107 for (i = 0; i < n; ++i) {
1108 pos = easePos(at[i], easer);
1109 res[i] = from[i] + (to[i] - from[i]) * pos;
1110 }
1111
1112 return res;
1113 }
1114 //[[Rcpp::export]]
1115 NumericMatrix colour_at_interpolator(NumericMatrix from, NumericMatrix to, NumericVector at, CharacterVector ease) {
1116 int n = from.nrow(), i;
1117 double pos;
1118 std::string easer = as<std::string>(ease);
1119 NumericMatrix res(n, from.ncol());
1120
1121 for (i = 0; i < n; ++i) {
1122 pos = easePos(at[i], easer);
1123 res(i, _) = from(i, _) + (to(i, _) - from(i, _)) * pos;
1124 }
1125
1126 return res;
1127 }
1128 //[[Rcpp::export]]
1129 CharacterVector constant_at_interpolator(CharacterVector from, CharacterVector to, NumericVector at, CharacterVector ease) {
1130 int n = from.size(), i;
1131 double pos;
1132 std::string easer = as<std::string>(ease);
1133 CharacterVector res(n);
1134
1135 for (i = 0; i < n; ++i) {
1136 pos = easePos(at[i], easer);
1137 res[i] = pos < 0.5 ? from[i] : to[i];
1138 }
1139
1140 return res;
1141 }
1142 //[[Rcpp::export]]
1143 List list_at_interpolator(List from, List to, NumericVector at, CharacterVector ease) {
1144 int n = from.size(), i;
1145 double pos;
1146 std::string easer = as<std::string>(ease);
1147 List res(n);
1148
1149 for (i = 0; i < n; ++i) {
1150 pos = easePos(at[i], easer);
1151 res[i] = pos < 0.5 ? from[i] : to[i];
1152 }
1153
1154 return res;
1155 }
1156 //[[Rcpp::export]]
1157 List numlist_at_interpolator(List from, List to, NumericVector at, CharacterVector ease) {
1158 int n = from.size(), i;
1159 double pos;
1160 std::string easer = as<std::string>(ease);
1161 List res(n);
1162
1163 for (i = 0; i < n; ++i) {
1164 NumericVector state_from_vec = from[i];
1165 NumericVector state_to_vec = to[i];
1166 state_from_vec = align_num_elem(state_from_vec, state_to_vec);
1167 state_to_vec = align_num_elem(state_to_vec, state_from_vec);
1168 pos = easePos(at[i], easer);
1169 NumericVector state_vec = state_from_vec + pos * (state_to_vec - state_from_vec);
1170 res[i] = state_vec;
1171 }
1172
1173 return res;
1174 }
1175 //[[Rcpp::export]]
1176 NumericVector numeric_fill_interpolator(NumericVector data, CharacterVector ease) {
1177 NumericVector res(data.size(), NA_REAL);
1178 int i,j,last = -1;
1179 std::string easer = as<std::string>(ease);
1180 std::vector<double> easepos;
1181
1182 for (i = 0; i < data.size(); ++i) {
1183 if (NumericVector::is_na(data[i])) continue;
1184 if (last != -1) {
1185 easepos = easeSeq(easer, i - last);
1186 for (j = 1; j < easepos.size(); ++j) {
1187 res[last + j] = data[last] + easepos[j] * (data[i] - data[last]);
1188 }
1189 }
1190 res[i] = data[i];
1191 last = i;
1192 }
1193
1194 return res;
1195 }
1196 //[[Rcpp::export]]
1197 NumericMatrix colour_fill_interpolator(NumericMatrix data, CharacterVector ease) {
1198 NumericMatrix res(data.nrow(), data.ncol());
1199 std::fill(res.begin(), res.end(), NA_REAL);
1200 int i,j,last = -1;
1201 std::string easer = as<std::string>(ease);
1202 std::vector<double> easepos;
1203
1204 for (i = 0; i < data.nrow(); ++i) {
1205 if (NumericVector::is_na(data(i, 0))) continue;
1206 if (last != -1) {
1207 easepos = easeSeq(easer, i - last);
1208 for (j = 1; j < easepos.size(); ++j) {
1209 res(last + j, _) = data(last, _) + easepos[j] * (data(i, _) - data(last, _));
1210 }
1211 }
1212 res(i, _) = data(i, _);
1213 last = i;
1214 }
1215
1216 return res;
1217 }
1218 //[[Rcpp::export]]
1219 CharacterVector constant_fill_interpolator(CharacterVector data, CharacterVector ease) {
1220 CharacterVector res(data.size(), NA_STRING);
1221 int i,j,last = -1;
1222 std::string easer = as<std::string>(ease);
1223 std::vector<double> easepos;
1224
1225 for (i = 0; i < data.size(); ++i) {
1226 if (CharacterVector::is_na(data[i])) continue;
1227 if (last != -1) {
1228 easepos = easeSeq(easer, i - last);
1229 for (j = 1; j < easepos.size(); ++j) {
1230 res[last + j] = easepos[j] < 0.5 ? data[last] : data[i];
1231 }
1232 }
1233 res[i] = data[i];
1234 last = i;
1235 }
1236
1237 return res;
1238 }
1239 //[[Rcpp::export]]
1240 List list_fill_interpolator(List data, CharacterVector ease) {
1241 List res(data.size());
1242 int i,j,last = -1;
1243 std::string easer = as<std::string>(ease);
1244 std::vector<double> easepos;
1245
1246 for (i = 0; i < data.size(); ++i) {
1247 if (data[i]==R_NilValue) continue;
1248 if (last != -1) {
1249 easepos = easeSeq(easer, i - last);
1250 for (j = 1; j < easepos.size(); ++j) {
1251 res[last + j] = easepos[j] < 0.5 ? data[last] : data[i];
1252 }
1253 }
1254 res[i] = data[i];
1255 last = i;
1256 }
1257 return res;
1258 }
1259 //[[Rcpp::export]]
1260 List numlist_fill_interpolator(List data, CharacterVector ease) {
1261 List res(data.size());
1262 int i,j,last = -1;
1263 std::string easer = as<std::string>(ease);
1264 std::vector<double> easepos;
1265
1266 for (i = 0; i < data.size(); ++i) {
1267 if (data[i]==R_NilValue) continue;
1268 if (last != -1) {
1269 easepos = easeSeq(easer, i - last);
1270 NumericVector state_from_vec = data[last];
1271 NumericVector state_to_vec = data[i];
1272 state_from_vec = align_num_elem(state_from_vec, state_to_vec);
1273 state_to_vec = align_num_elem(state_to_vec, state_from_vec);
1274 res[last] = data[last];
1275 for (j = 1; j < easepos.size(); ++j) {
1276 NumericVector state_vec = state_from_vec + easepos[j] * (state_to_vec - state_from_vec);
1277 res[last + j] = state_vec;
1278 }
1279 }
1280 res[i] = data[i];
1281 last = i;
1282 }
1283 return res;
1284 }
+28
-0
tests/testthat/test-along.R less more
0 context("along")
1
2 df <- data.frame(
3 x = c(1, 5, 7, 10),
4 y = c(4, 3, 7, -1),
5 col = c('black', 'red', 'green', 'blue'),
6 type = letters[1:4],
7 stringsAsFactors = FALSE
8 )
9
10 test_that("tween_along works", {
11 tween <- tween_along(df, ease = 'linear', nframes = 10, along = x)
12 expect_equal(nrow(tween), 30)
13 expect_equal(tween$col[22], '#77B784FF')
14 expect_equal(tween$y[8], 3.25)
15
16 tween <- tween_along(df, ease = 'linear', nframes = 10, along = x, history = FALSE)
17 expect_equal(nrow(tween), 9)
18 expect_equal(tween$col[8], '#77B784FF')
19 expect_equal(tween$y[2], 3.75)
20 })
21
22 test_that("tween_along throws errors", {
23 expect_error(tween_along(df, ease = 'linear', nframes = 10, along = 1))
24 expect_error(tween_along(df, ease = 'linear', nframes = 10, along = x, id = 1))
25 expect_error(tween_along(df, ease = 'linear', nframes = 10, along = x, range = c(0, 0)))
26 expect_error(tween_along(df[1,], ease = 'linear', nframes = 10, along = x))
27 })
+33
-0
tests/testthat/test-at.R less more
0 context("at")
1
2 df1 <- data.frame(x = 1:2, y = 4:5, col = 'black', type = letters[1:2], stringsAsFactors = FALSE)
3 df2 <- data.frame(x = 11:12, y = 14:15, col = 'white', type = letters[1], stringsAsFactors = FALSE)
4
5 test_that("tween_at works", {
6 tween <- tween_at(df1, df2, 0.5, 'linear')
7 expect_equal(nrow(tween), 2)
8 expect_named(tween, names(df1))
9 expect_equal(tween$x, c(6, 7))
10 expect_equal(tween$col[1], '#767676FF')
11 })
12
13 test_that("tween_at handles weird input", {
14 tween <- tween_at(df1, df2[1,], 0.5, 'linear')
15 expect_equal(nrow(tween), 2)
16 tween <- tween_at(df1[1,], df2, 0.5, 'linear')
17 expect_equal(nrow(tween), 2)
18 tween <- tween_at(df1, df2[integer(),], 0.5, 'linear')
19 expect_equal(nrow(tween), 0)
20 tween <- tween_at(df1[integer(),], df2, 0.5, 'linear')
21 expect_equal(nrow(tween), 0)
22 expect_error(tween_at(df1[c(1,2,1), ], df2, 0.5, 'linear'))
23 expect_error(tween_at(df1, df2, numeric(), 'linear'))
24 expect_error(tween_at(df1, df2, 0.5, character()))
25 })
26
27 test_that('tween_at works with vectors', {
28 tween <- tween_at(df1$x, df2$x, 0.5, 'linear')
29 expect_is(tween, 'numeric')
30 expect_equal(tween, c(6,7))
31 expect_error(tween_at(df1$x, df2$col))
32 })
+49
-0
tests/testthat/test-components.R less more
0 context("components")
1
2 df <- data.frame(
3 x = c(1, 5, 7, 10),
4 y = c(4, 3, 7, -1),
5 col = c('black', 'red', 'green', 'blue'),
6 type = letters[1:4],
7 stringsAsFactors = FALSE
8 )
9
10 test_that("tween_components works", {
11 tween <- tween_components(df, 'linear', nframes = 10, time = c(1, 7, 13, 20))
12 expect_equal(nrow(tween), 10)
13 expect_equal(tween$x[6], 19/3)
14 expect_equal(tween$col[2], '#52170AFF')
15 expect_equal(max(tween$.frame), 10)
16 expect_true(all(tween$.phase[c(1,4,7,10)] == 'raw'))
17 expect_true(all(tween$.phase[-c(1,4,7,10)] == 'transition'))
18
19 tween <- tween_components(df, 'linear', nframes = 10, time = c(1, 7, 13, 20), rep(c(1,2), 2))
20 expect_equal(nrow(tween), 14)
21 expect_equal(tween$x[12], 25/3)
22 expect_equal(tween$col[2], '#152910FF')
23 expect_equal(max(tween$.frame), 10)
24 expect_true(all(tween$.phase[c(1,5,10,14)] == 'raw'))
25 expect_true(all(tween$.phase[-c(1,5,10,14)] == 'transition'))
26 })
27
28 test_that("enter/exit works", {
29 tween <- tween_components(df, 'linear', nframes = 20, time = c(1, 7, 13, 20), enter = function(df) {
30 df$x <- 0
31 df$col <- 'red'
32 df
33 }, enter_length = 3)
34 expect_equal(nrow(tween), 20)
35 expect_equal(tween$x[3], 2/3, tolerance = 1e-7)
36 expect_equal(tween$col[2], '#A41A0AFF')
37 expect_equal(max(tween$.frame), 20)
38 expect_true(all(tween$.phase[1:3] == 'enter'))
39 })
40
41 test_that("weird input gets caught", {
42 tween <- tween_components(df, 'linear', nframes = 0, time = c(1, 7, 13, 20))
43 expect_equal(nrow(tween), 0)
44 tween <- tween_components(df[integer(), ], 'linear', nframes = 10, time = numeric())
45 expect_equal(nrow(tween), 0)
46 expect_error(tween_components(df, 'linear', nframes = 10, time = 1))
47 expect_error(tween_components(df, 'linear', nframes = 0, time = c(1, 7, 13, 20), id = 1))
48 })
+40
-0
tests/testthat/test-events.R less more
0 context("events")
1
2 df <- data.frame(
3 x = c(1, 5, 7, 10),
4 y = c(4, 3, 7, -1),
5 col = c('black', 'red', 'green', 'blue'),
6 type = letters[1:4],
7 stringsAsFactors = FALSE
8 )
9
10 test_that("tween_events works", {
11 tween <- tween_events(df, 'linear', 20, x, x + 2)
12 expect_equal(nrow(tween), 17)
13 expect_equal(max(tween$.frame), 20)
14 expect_true(all(tween$.phase[c(4, 8, 13, 17)] == 'raw'))
15 expect_true(all(tween$.phase[-c(4, 8, 13, 17)] == 'static'))
16
17
18 tween <- tween_events(df, 'linear', 20, x, enter = function(df) {
19 df$x <- 0
20 df$col <- 'red'
21 df
22 }, enter_length = 3)
23
24
25 expect_equal(nrow(tween), 23)
26 expect_equal(max(tween$.frame), 20)
27 expect_true(all(tween$.phase[c(6, 13, 17, 23)] == 'raw'))
28 expect_true(all(tween$.phase[-c(6, 13, 17, 23)] == 'enter'))
29 expect_equal(tween$x[2], 0.2)
30 expect_equal(tween$col[3], '#931B0BFF')
31 })
32
33 test_that("weird input gets handled", {
34 expect_error(tween_events(df, 'linear', 20))
35 tween <- tween_events(df, 'linear', 0, x)
36 expect_equal(nrow(tween), 0)
37 tween <- tween_events(df[integer(), ], 'linear', 10, x)
38 expect_equal(nrow(tween), 0)
39 })
+19
-0
tests/testthat/test-fill.R less more
0 context("fill")
1
2 df <- data.frame(
3 x = c(1, NA, NA, NA, 6, 4, NA, NA, NA, NA, 20),
4 type = c('a', NA, NA, NA, 'b', 'c', NA, NA, NA, NA, 'd'),
5 col = c('red', NA, NA, NA, 'blue', 'green', NA, NA, NA, NA, 'black'),
6 stringsAsFactors = FALSE
7 )
8 test_that("tween_fill works", {
9 tween <- tween_fill(df, 'linear')
10 expect_equal(dim(df), dim(tween))
11 expect_equal(tween$x[3], 3.5)
12 expect_equal(tween$col[10], '#110010FF')
13
14 expect_equal(tween_fill(df$col, 'linear'), tween$col)
15
16 tween <- tween_fill(df[-c(1, 11), 1], 'linear')
17 expect_equal(tween, df$x[-c(1, 11)])
18 })
+34
-0
tests/testthat/test-state.R less more
0 context("state")
1
2 df1 <- data.frame(x = 1:2, y = 4:5, col = 'black', type = letters[1:2], stringsAsFactors = FALSE)
3 df2 <- data.frame(x = 11:12, y = 14:15, col = 'white', type = letters[1], stringsAsFactors = FALSE)
4
5 test_that("tween_state works", {
6 tween <- tween_state(df1, df2, ease = 'linear', nframes = 5)
7 expect_equal(max(tween$.frame), 5)
8 expect_true(all(tween$.phase[c(1:2, 9:10)] == 'raw'))
9 expect_true(all(tween$.phase[c(3:8)] == 'transition'))
10 expect_true(all(tween$.id == rep(1:2, 5)))
11 expect_equal(tween$col[5], '#767676FF')
12 expect_equal(tween$x[7], 8.5)
13 expect_equal(tween$type[4:5], c('b', 'a'))
14 })
15
16 test_that("keep_state works", {
17 keep <- keep_state(df1, 5)
18 expect_equal(max(keep$.frame), 5)
19 expect_true(all(keep$.phase[c(9:10)] == 'raw'))
20 expect_true(all(keep$.phase[c(1:8)] == 'static'))
21 })
22
23 test_that("enter/exit works", {
24 tween <- tween_state(df1, df2[1,, drop = FALSE], 'linear', 5, exit = function(df) {
25 df$x <- 0
26 df$col <- 'red'
27 df
28 })
29 expect_equal(nrow(tween), 9)
30 expect_true(all(tween$.phase[c(4,6,8)] == 'exit'))
31 expect_equal(tween$col[8], '#BA1808FF')
32 expect_equal(tween$x[8], 0.5)
33 })
+4
-0
tests/testthat.R less more
0 library(testthat)
1 library(tweenr)
2
3 test_check("tweenr")