├── .github ├── .gitignore └── workflows │ ├── R-CMD-check.yaml │ ├── pkgdown.yaml │ ├── pr-commands.yaml │ └── test-coverage.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── NAMESPACE ├── NEWS.md ├── R ├── aaa.R ├── cpp11.R ├── display_ease.R ├── gen.R ├── gen_along.R ├── gen_at.R ├── gen_components.R ├── gen_events.R ├── gen_keyframe.R ├── get_frame.R ├── interpolate_along.R ├── interpolate_at.R ├── interpolate_element.R ├── interpolate_element_at.R ├── interpolate_fill.R ├── interpolate_state.R ├── tween.R ├── tween_along.R ├── tween_appear.R ├── tween_at.R ├── tween_colour.R ├── tween_components.R ├── tween_constant.R ├── tween_date.R ├── tween_datetime.R ├── tween_elements.R ├── tween_events.R ├── tween_fill.R ├── tween_numeric.R ├── tween_state.R ├── tween_states.R └── tweenr_package.R ├── README.Rmd ├── README.md ├── _pkgdown.yml ├── codecov.yml ├── cran-comments.md ├── man ├── display_ease.Rd ├── dot-complete_states.Rd ├── dot-get_last_frame.Rd ├── dot-max_id.Rd ├── figures │ ├── README-unnamed-chunk-3.gif │ ├── README-unnamed-chunk-4-1.png │ ├── logo.png │ └── logo.svg ├── gen_along.Rd ├── gen_at.Rd ├── gen_components.Rd ├── gen_events.Rd ├── gen_internal.Rd ├── gen_keyframe.Rd ├── get_frame.Rd ├── interpolate_custom_at.Rd ├── prepare_keyframes.Rd ├── reexports.Rd ├── tween.Rd ├── tween_along.Rd ├── tween_appear.Rd ├── tween_at.Rd ├── tween_at_t.Rd ├── tween_components.Rd ├── tween_elements.Rd ├── tween_events.Rd ├── tween_fill.Rd ├── tween_state.Rd ├── tween_states.Rd ├── tweenr-package.Rd └── vec_tween_class.Rd ├── pkgdown └── favicon │ ├── apple-touch-icon-120x120.png │ ├── apple-touch-icon-152x152.png │ ├── apple-touch-icon-180x180.png │ ├── apple-touch-icon-60x60.png │ ├── apple-touch-icon-76x76.png │ ├── apple-touch-icon.png │ ├── favicon-16x16.png │ ├── favicon-32x32.png │ └── favicon.ico ├── revdep ├── README.md ├── cran.md ├── failures.md └── problems.md ├── src ├── .gitignore ├── along.cpp ├── at.cpp ├── cpp11.cpp ├── easing.c ├── easing.h ├── element.cpp ├── element_at.cpp ├── fill.cpp ├── state.cpp └── utils.h └── tests ├── testthat.R └── testthat ├── test-along.R ├── test-at.R ├── test-components.R ├── test-events.R ├── test-fill.R └── test-state.R /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | # 4 | # NOTE: This workflow is overkill for most R packages and 5 | # check-standard.yaml is likely a better choice. 6 | # usethis::use_github_action("check-standard") will install it. 7 | on: 8 | push: 9 | branches: [main, master] 10 | pull_request: 11 | branches: [main, master] 12 | 13 | name: R-CMD-check 14 | 15 | jobs: 16 | R-CMD-check: 17 | runs-on: ${{ matrix.config.os }} 18 | 19 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 20 | 21 | strategy: 22 | fail-fast: false 23 | matrix: 24 | config: 25 | - {os: macos-latest, r: 'release'} 26 | 27 | - {os: windows-latest, r: 'release'} 28 | # Use 3.6 to trigger usage of RTools35 29 | - {os: windows-latest, r: '3.6'} 30 | # use 4.1 to check with rtools40's older compiler 31 | - {os: windows-latest, r: '4.1'} 32 | 33 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 34 | - {os: ubuntu-latest, r: 'release'} 35 | - {os: ubuntu-latest, r: 'oldrel-1'} 36 | - {os: ubuntu-latest, r: 'oldrel-2'} 37 | - {os: ubuntu-latest, r: 'oldrel-3'} 38 | - {os: ubuntu-latest, r: 'oldrel-4'} 39 | 40 | env: 41 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 42 | R_KEEP_PKG_SOURCE: yes 43 | 44 | steps: 45 | - uses: actions/checkout@v4 46 | 47 | - uses: r-lib/actions/setup-pandoc@v2 48 | 49 | - uses: r-lib/actions/setup-r@v2 50 | with: 51 | r-version: ${{ matrix.config.r }} 52 | http-user-agent: ${{ matrix.config.http-user-agent }} 53 | use-public-rspm: true 54 | 55 | - uses: r-lib/actions/setup-r-dependencies@v2 56 | with: 57 | extra-packages: any::rcmdcheck 58 | needs: check 59 | 60 | - uses: r-lib/actions/check-r-package@v2 61 | with: 62 | upload-snapshots: true 63 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | jobs: 15 | pkgdown: 16 | runs-on: ubuntu-latest 17 | # Only restrict concurrency for non-PR jobs 18 | concurrency: 19 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 20 | env: 21 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 22 | permissions: 23 | contents: write 24 | steps: 25 | - uses: actions/checkout@v4 26 | 27 | - uses: r-lib/actions/setup-pandoc@v2 28 | 29 | - uses: r-lib/actions/setup-r@v2 30 | with: 31 | use-public-rspm: true 32 | 33 | - uses: r-lib/actions/setup-r-dependencies@v2 34 | with: 35 | extra-packages: any::pkgdown, local::. 36 | needs: website 37 | 38 | - name: Build site 39 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 40 | shell: Rscript {0} 41 | 42 | - name: Deploy to GitHub pages 🚀 43 | if: github.event_name != 'pull_request' 44 | uses: JamesIves/github-pages-deploy-action@v4.5.0 45 | with: 46 | clean: false 47 | branch: gh-pages 48 | folder: docs 49 | -------------------------------------------------------------------------------- /.github/workflows/pr-commands.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | issue_comment: 5 | types: [created] 6 | 7 | name: Commands 8 | 9 | jobs: 10 | document: 11 | if: ${{ github.event.issue.pull_request && (github.event.comment.author_association == 'MEMBER' || github.event.comment.author_association == 'OWNER') && startsWith(github.event.comment.body, '/document') }} 12 | name: document 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | steps: 17 | - uses: actions/checkout@v4 18 | 19 | - uses: r-lib/actions/pr-fetch@v2 20 | with: 21 | repo-token: ${{ secrets.GITHUB_TOKEN }} 22 | 23 | - uses: r-lib/actions/setup-r@v2 24 | with: 25 | use-public-rspm: true 26 | 27 | - uses: r-lib/actions/setup-r-dependencies@v2 28 | with: 29 | extra-packages: any::roxygen2 30 | needs: pr-document 31 | 32 | - name: Document 33 | run: roxygen2::roxygenise() 34 | shell: Rscript {0} 35 | 36 | - name: commit 37 | run: | 38 | git config --local user.name "$GITHUB_ACTOR" 39 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 40 | git add man/\* NAMESPACE 41 | git commit -m 'Document' 42 | 43 | - uses: r-lib/actions/pr-push@v2 44 | with: 45 | repo-token: ${{ secrets.GITHUB_TOKEN }} 46 | 47 | style: 48 | if: ${{ github.event.issue.pull_request && (github.event.comment.author_association == 'MEMBER' || github.event.comment.author_association == 'OWNER') && startsWith(github.event.comment.body, '/style') }} 49 | name: style 50 | runs-on: ubuntu-latest 51 | env: 52 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 53 | steps: 54 | - uses: actions/checkout@v4 55 | 56 | - uses: r-lib/actions/pr-fetch@v2 57 | with: 58 | repo-token: ${{ secrets.GITHUB_TOKEN }} 59 | 60 | - uses: r-lib/actions/setup-r@v2 61 | 62 | - name: Install dependencies 63 | run: install.packages("styler") 64 | shell: Rscript {0} 65 | 66 | - name: Style 67 | run: styler::style_pkg() 68 | shell: Rscript {0} 69 | 70 | - name: commit 71 | run: | 72 | git config --local user.name "$GITHUB_ACTOR" 73 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 74 | git add \*.R 75 | git commit -m 'Style' 76 | 77 | - uses: r-lib/actions/pr-push@v2 78 | with: 79 | repo-token: ${{ secrets.GITHUB_TOKEN }} 80 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: test-coverage 10 | 11 | jobs: 12 | test-coverage: 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | 17 | steps: 18 | - uses: actions/checkout@v4 19 | 20 | - uses: r-lib/actions/setup-r@v2 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v2 25 | with: 26 | extra-packages: any::covr 27 | needs: coverage 28 | 29 | - name: Test coverage 30 | run: | 31 | covr::codecov( 32 | quiet = FALSE, 33 | clean = FALSE, 34 | install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") 35 | ) 36 | shell: Rscript {0} 37 | 38 | - name: Show testthat output 39 | if: always() 40 | run: | 41 | ## -------------------------------------------------------------------- 42 | find ${{ runner.temp }}/package -name 'testthat.Rout*' -exec cat '{}' \; || true 43 | shell: bash 44 | 45 | - name: Upload test results 46 | if: failure() 47 | uses: actions/upload-artifact@v4 48 | with: 49 | name: coverage-test-failures 50 | path: ${{ runner.temp }}/package 51 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | *.Rproj 5 | .Rbuildignore 6 | README_cache 7 | docs 8 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: tweenr 2 | Type: Package 3 | Title: Interpolate Data for Smooth Animations 4 | Version: 2.0.3.9000 5 | Authors@R: 6 | c(person(given = "Thomas Lin", 7 | family = "Pedersen", 8 | role = c("aut", "cre"), 9 | email = "thomasp85@gmail.com", 10 | comment = c(ORCID = "0000-0002-5147-4711"))) 11 | Maintainer: Thomas Lin Pedersen 12 | Description: In order to create smooth animation between states of data, 13 | tweening is necessary. This package provides a range of functions for 14 | creating tweened data that can be used as basis for animation. Furthermore 15 | it adds a number of vectorized interpolaters for common R data 16 | types such as numeric, date and colour. 17 | URL: https://github.com/thomasp85/tweenr 18 | BugReports: https://github.com/thomasp85/tweenr/issues 19 | License: MIT + file LICENSE 20 | Encoding: UTF-8 21 | Depends: R (>= 3.2.0) 22 | Imports: 23 | farver, 24 | magrittr, 25 | rlang, 26 | vctrs 27 | LinkingTo: 28 | cpp11 (>= 0.4.2) 29 | RoxygenNote: 7.2.3 30 | Roxygen: list(markdown=TRUE) 31 | Suggests: testthat, 32 | covr 33 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2018 2 | COPYRIGHT HOLDER: Thomas Lin Pedersen 3 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(convert_generator,along_generator) 4 | S3method(convert_generator,component_generator) 5 | S3method(convert_generator,default) 6 | S3method(convert_generator,keyframe_generator) 7 | S3method(get_frame,along_generator) 8 | S3method(get_frame,component_generator) 9 | S3method(get_frame,keyframe_generator) 10 | S3method(get_raw_frames,along_generator) 11 | S3method(get_raw_frames,component_generator) 12 | S3method(get_raw_frames,keyframe_generator) 13 | S3method(vec_tween_class,Date) 14 | S3method(vec_tween_class,POSIXt) 15 | S3method(vec_tween_class,character) 16 | S3method(vec_tween_class,default) 17 | S3method(vec_tween_class,factor) 18 | S3method(vec_tween_class,list) 19 | S3method(vec_tween_class,logical) 20 | S3method(vec_tween_class,numeric) 21 | export("%>%") 22 | export("col_types<-") 23 | export("ease_type<-") 24 | export("frame_times<-") 25 | export("gen_data<-") 26 | export("generator_settings<-") 27 | export("keyframes<-") 28 | export(.complete_states) 29 | export(.get_first_frame) 30 | export(.get_last_frame) 31 | export(.has_frames) 32 | export(.max_id) 33 | export(.with_later_frames) 34 | export(.with_prior_frames) 35 | export(PHASE_LEVELS) 36 | export(add_keyframe) 37 | export(add_pause) 38 | export(close_state) 39 | export(col_classes) 40 | export(col_types) 41 | export(data_frame_to_gen) 42 | export(display_ease) 43 | export(ease_type) 44 | export(frame_times) 45 | export(gen_along) 46 | export(gen_at) 47 | export(gen_components) 48 | export(gen_data) 49 | export(gen_events) 50 | export(gen_keyframe) 51 | export(gen_to_data_frame) 52 | export(generator_settings) 53 | export(get_frame) 54 | export(get_raw_frames) 55 | export(interpolate_custom_at) 56 | export(is_generator) 57 | export(keep_state) 58 | export(keyframes) 59 | export(open_state) 60 | export(prepare_keyframes) 61 | export(tween) 62 | export(tween_along) 63 | export(tween_appear) 64 | export(tween_at) 65 | export(tween_at_t) 66 | export(tween_color) 67 | export(tween_color_t) 68 | export(tween_colour) 69 | export(tween_colour_t) 70 | export(tween_components) 71 | export(tween_constant) 72 | export(tween_constant_t) 73 | export(tween_date) 74 | export(tween_date_t) 75 | export(tween_datetime) 76 | export(tween_datetime_t) 77 | export(tween_elements) 78 | export(tween_events) 79 | export(tween_fill) 80 | export(tween_numeric) 81 | export(tween_numeric_t) 82 | export(tween_state) 83 | export(tween_states) 84 | export(tween_t) 85 | export(vec_tween_class) 86 | importFrom(farver,decode_colour) 87 | importFrom(farver,encode_colour) 88 | importFrom(graphics,plot) 89 | importFrom(magrittr,"%>%") 90 | importFrom(rlang,"%||%") 91 | importFrom(rlang,as_function) 92 | importFrom(rlang,enquo) 93 | importFrom(rlang,eval_tidy) 94 | importFrom(rlang,is_integerish) 95 | importFrom(rlang,quo_is_missing) 96 | importFrom(rlang,quo_is_null) 97 | importFrom(vctrs,vec_cbind) 98 | importFrom(vctrs,vec_rbind) 99 | useDynLib(tweenr, .registration = TRUE) 100 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # tweenr (development version) 2 | 3 | # tweenr 2.0.3 4 | 5 | * Fix coercion bug from the switch to vctrs 6 | * At `tween_at_t()` for interpolating a full data frame at multiple locations 7 | 8 | # tweenr 2.0.2 9 | 10 | * Fixed a recycling bug in `tween_state()` 11 | 12 | # tweenr 2.0.1 13 | 14 | * Fix bug in logical state interpolation due to wrong argument order passing 15 | 16 | # tweenr 2.0.0 17 | 18 | * Added generator versions of `at`, `along`, `event`, `components`, and `state` 19 | tweens that output a single frame at a time at any fractional time point 20 | * Allow lambda-style functions in `enter`/`exit` 21 | 22 | # tweenr 1.0.2 23 | 24 | * Added a `NEWS.md` file to track changes to the package. 25 | * Fixed numerous small bugs 26 | -------------------------------------------------------------------------------- /R/aaa.R: -------------------------------------------------------------------------------- 1 | BASEDATE <- Sys.Date() - as.numeric(Sys.Date()) 2 | BASEDATETIME <- Sys.time() - as.numeric(Sys.time()) 3 | 4 | validEase <- c( 5 | "linear", 6 | "quadratic-in", 7 | "quadratic-out", 8 | "quadratic-in-out", 9 | "cubic-in", 10 | "cubic-out", 11 | "cubic-in-out", 12 | "quartic-in", 13 | "quartic-out", 14 | "quartic-in-out", 15 | "quintic-in", 16 | "quintic-out", 17 | "quintic-in-out", 18 | "sine-in", 19 | "sine-out", 20 | "sine-in-out", 21 | "circular-in", 22 | "circular-out", 23 | "circular-in-out", 24 | "exponential-in", 25 | "exponential-out", 26 | "exponential-in-out", 27 | "elastic-in", 28 | "elastic-out", 29 | "elastic-in-out", 30 | "back-in", 31 | "back-out", 32 | "back-in-out", 33 | "bounce-in", 34 | "bounce-out", 35 | "bounce-in-out" 36 | ) 37 | 38 | #' @importFrom magrittr %>% 39 | #' @export 40 | magrittr::`%>%` 41 | 42 | #' @rdname gen_internal 43 | #' @export 44 | #' @importFrom farver decode_colour 45 | col_classes <- function(data) { 46 | classes <- vapply(data, vec_tween_class, character(1)) 47 | names(classes) <- names(data) 48 | classes[names(classes) == '.phase'] <- 'phase' 49 | classes 50 | } 51 | 52 | #' Get the nominal class of a vector 53 | #' 54 | #' @param x a vector 55 | #' 56 | #' @export 57 | #' @keywords internal 58 | vec_tween_class <- function(x) { 59 | UseMethod('vec_tween_class') 60 | } 61 | #' @export 62 | vec_tween_class.default <- function(x) 'constant' 63 | #' @export 64 | vec_tween_class.numeric <- function(x) 'numeric' 65 | #' @export 66 | vec_tween_class.logical <- function(x) 'logical' 67 | #' @export 68 | vec_tween_class.factor <- function(x) 'factor' 69 | #' @export 70 | vec_tween_class.character <- function(x) { 71 | colour <- try(suppressWarnings(decode_colour(x)), silent = TRUE) 72 | if (all(is.na(x)) || inherits(colour, 'try-error') || any(is.na(x) != is.na(colour[, 1])) || all(grepl('^(\\d|\\.)+$', x))) { 73 | 'character' 74 | } else { 75 | 'colour' 76 | } 77 | } 78 | #' @export 79 | vec_tween_class.Date <- function(x) 'date' 80 | #' @export 81 | vec_tween_class.POSIXt <- function(x) 'datetime' 82 | #' @export 83 | vec_tween_class.list <- function(x) { 84 | if (all(vapply(x, is.numeric, logical(1)))) 'numlist' 85 | else 'list' 86 | } 87 | 88 | prepareTween <- function(data, n, ease) { 89 | if (!is.list(data)) { 90 | data <- as.list(data) 91 | } 92 | if (length(unique(lengths(data))) != 1) { 93 | stop('All elements in data must have the same length') 94 | } 95 | if (!all(ease %in% validEase)) { 96 | stop('ease must be the name of a valid easing function') 97 | } 98 | n <- c(rep(n, length.out = length(data) - 1) - 1, 1) 99 | ease <- c(rep(ease, length.out = length(data) - 1), 'constant') 100 | states <- data.frame( 101 | state = seq_along(data) - 1L, 102 | nframes = as.integer(n), 103 | ease = ease, 104 | stringsAsFactors = FALSE 105 | ) 106 | list( 107 | data = data, 108 | states = states 109 | ) 110 | } 111 | 112 | prepareTweenTranspose <- function(data, n, ease) { 113 | if (!is.list(data)) { 114 | data <- list(data) 115 | } 116 | if (!all(ease %in% validEase)) { 117 | stop('ease must be the name of a valid easing function') 118 | } 119 | n <- rep(n, length.out = length(data)) 120 | n <- Map(function(n, l) { 121 | s <- floor(n / l) 122 | s <- rep(s, l) 123 | overhead <- n - sum(s) 124 | if (overhead) { 125 | s <- s + rep(floor(overhead / l), l) 126 | addInd <- seq_len(n - sum(s)) 127 | s[addInd] <- s[addInd] + 1 128 | } 129 | c(s, 1) 130 | }, n = n - 1, l = lengths(data) - 1) 131 | n <- unlist(n) 132 | ease <- rep(ease, length.out = length(data)) 133 | ease <- rep(ease, lengths(data) - 1) 134 | easeSplit <- split(ease, rep(seq_along(data), lengths(data) - 1)) 135 | ease <- unlist(lapply(easeSplit, append, values = 'constant')) 136 | data <- as.list(unlist(data)) 137 | states <- data.frame( 138 | state = seq_along(data) - 1L, 139 | nframes = as.integer(n), 140 | ease = ease, 141 | stringsAsFactors = FALSE 142 | ) 143 | list( 144 | data = data, 145 | states = states 146 | ) 147 | } 148 | 149 | first <- function(x) x[[1]] 150 | `first<-` <- function(x, value) { 151 | x[[1]] <- value 152 | x 153 | } 154 | last <- function(x) x[[length(x)]] 155 | `last<-` <- function(x, value) { 156 | x[[length(x)]] <- value 157 | x 158 | } 159 | -------------------------------------------------------------------------------- /R/cpp11.R: -------------------------------------------------------------------------------- 1 | # Generated by cpp11: do not edit by hand 2 | 3 | numeric_along_interpolator <- function(data, group, time, history, keep_last, frames, ease) { 4 | .Call(`_tweenr_numeric_along_interpolator`, data, group, time, history, keep_last, frames, ease) 5 | } 6 | 7 | colour_along_interpolator <- function(data, group, time, history, keep_last, frames, ease) { 8 | .Call(`_tweenr_colour_along_interpolator`, data, group, time, history, keep_last, frames, ease) 9 | } 10 | 11 | constant_along_interpolator <- function(data, group, time, history, keep_last, frames, ease) { 12 | .Call(`_tweenr_constant_along_interpolator`, data, group, time, history, keep_last, frames, ease) 13 | } 14 | 15 | list_along_interpolator <- function(data, group, time, history, keep_last, frames, ease) { 16 | .Call(`_tweenr_list_along_interpolator`, data, group, time, history, keep_last, frames, ease) 17 | } 18 | 19 | numlist_along_interpolator <- function(data, group, time, history, keep_last, frames, ease) { 20 | .Call(`_tweenr_numlist_along_interpolator`, data, group, time, history, keep_last, frames, ease) 21 | } 22 | 23 | phase_along_interpolator <- function(group, time, history, keep_last, frames) { 24 | .Call(`_tweenr_phase_along_interpolator`, group, time, history, keep_last, frames) 25 | } 26 | 27 | numeric_at_interpolator <- function(from, to, at, ease) { 28 | .Call(`_tweenr_numeric_at_interpolator`, from, to, at, ease) 29 | } 30 | 31 | colour_at_interpolator <- function(from, to, at, ease) { 32 | .Call(`_tweenr_colour_at_interpolator`, from, to, at, ease) 33 | } 34 | 35 | constant_at_interpolator <- function(from, to, at, ease) { 36 | .Call(`_tweenr_constant_at_interpolator`, from, to, at, ease) 37 | } 38 | 39 | list_at_interpolator <- function(from, to, at, ease) { 40 | .Call(`_tweenr_list_at_interpolator`, from, to, at, ease) 41 | } 42 | 43 | numlist_at_interpolator <- function(from, to, at, ease) { 44 | .Call(`_tweenr_numlist_at_interpolator`, from, to, at, ease) 45 | } 46 | 47 | numeric_at_t_interpolator <- function(from, to, at, ease) { 48 | .Call(`_tweenr_numeric_at_t_interpolator`, from, to, at, ease) 49 | } 50 | 51 | colour_at_t_interpolator <- function(from, to, at, ease) { 52 | .Call(`_tweenr_colour_at_t_interpolator`, from, to, at, ease) 53 | } 54 | 55 | constant_at_t_interpolator <- function(from, to, at, ease) { 56 | .Call(`_tweenr_constant_at_t_interpolator`, from, to, at, ease) 57 | } 58 | 59 | list_at_t_interpolator <- function(from, to, at, ease) { 60 | .Call(`_tweenr_list_at_t_interpolator`, from, to, at, ease) 61 | } 62 | 63 | numlist_at_t_interpolator <- function(from, to, at, ease) { 64 | .Call(`_tweenr_numlist_at_t_interpolator`, from, to, at, ease) 65 | } 66 | 67 | numeric_element_interpolator <- function(data, group, frame, ease) { 68 | .Call(`_tweenr_numeric_element_interpolator`, data, group, frame, ease) 69 | } 70 | 71 | colour_element_interpolator <- function(data, group, frame, ease) { 72 | .Call(`_tweenr_colour_element_interpolator`, data, group, frame, ease) 73 | } 74 | 75 | constant_element_interpolator <- function(data, group, frame, ease) { 76 | .Call(`_tweenr_constant_element_interpolator`, data, group, frame, ease) 77 | } 78 | 79 | list_element_interpolator <- function(data, group, frame, ease) { 80 | .Call(`_tweenr_list_element_interpolator`, data, group, frame, ease) 81 | } 82 | 83 | numlist_element_interpolator <- function(data, group, frame, ease) { 84 | .Call(`_tweenr_numlist_element_interpolator`, data, group, frame, ease) 85 | } 86 | 87 | phase_element_interpolator <- function(data, group, frame, ease) { 88 | .Call(`_tweenr_phase_element_interpolator`, data, group, frame, ease) 89 | } 90 | 91 | numeric_element_at_interpolator <- function(data, group, time, at, ease) { 92 | .Call(`_tweenr_numeric_element_at_interpolator`, data, group, time, at, ease) 93 | } 94 | 95 | colour_element_at_interpolator <- function(data, group, time, at, ease) { 96 | .Call(`_tweenr_colour_element_at_interpolator`, data, group, time, at, ease) 97 | } 98 | 99 | constant_element_at_interpolator <- function(data, group, time, at, ease) { 100 | .Call(`_tweenr_constant_element_at_interpolator`, data, group, time, at, ease) 101 | } 102 | 103 | list_element_at_interpolator <- function(data, group, time, at, ease) { 104 | .Call(`_tweenr_list_element_at_interpolator`, data, group, time, at, ease) 105 | } 106 | 107 | numlist_element_at_interpolator <- function(data, group, time, at, ease) { 108 | .Call(`_tweenr_numlist_element_at_interpolator`, data, group, time, at, ease) 109 | } 110 | 111 | phase_element_at_interpolator <- function(data, group, time, at, ease) { 112 | .Call(`_tweenr_phase_element_at_interpolator`, data, group, time, at, ease) 113 | } 114 | 115 | numeric_fill_interpolator <- function(data, ease) { 116 | .Call(`_tweenr_numeric_fill_interpolator`, data, ease) 117 | } 118 | 119 | colour_fill_interpolator <- function(data, ease) { 120 | .Call(`_tweenr_colour_fill_interpolator`, data, ease) 121 | } 122 | 123 | constant_fill_interpolator <- function(data, ease) { 124 | .Call(`_tweenr_constant_fill_interpolator`, data, ease) 125 | } 126 | 127 | list_fill_interpolator <- function(data, ease) { 128 | .Call(`_tweenr_list_fill_interpolator`, data, ease) 129 | } 130 | 131 | numlist_fill_interpolator <- function(data, ease) { 132 | .Call(`_tweenr_numlist_fill_interpolator`, data, ease) 133 | } 134 | 135 | numeric_state_interpolator <- function(data, states) { 136 | .Call(`_tweenr_numeric_state_interpolator`, data, states) 137 | } 138 | 139 | colour_state_interpolator <- function(data, states) { 140 | .Call(`_tweenr_colour_state_interpolator`, data, states) 141 | } 142 | 143 | constant_state_interpolator <- function(data, states) { 144 | .Call(`_tweenr_constant_state_interpolator`, data, states) 145 | } 146 | 147 | list_state_interpolator <- function(data, states) { 148 | .Call(`_tweenr_list_state_interpolator`, data, states) 149 | } 150 | 151 | numlist_state_interpolator <- function(data, states) { 152 | .Call(`_tweenr_numlist_state_interpolator`, data, states) 153 | } 154 | 155 | phase_state_interpolator <- function(data, states) { 156 | .Call(`_tweenr_phase_state_interpolator`, data, states) 157 | } 158 | -------------------------------------------------------------------------------- /R/display_ease.R: -------------------------------------------------------------------------------- 1 | #' Display an easing function 2 | #' 3 | #' This simple helper lets you explore how the different easing functions govern 4 | #' the interpolation of data. 5 | #' 6 | #' @details 7 | #' How transitions proceed between states are defined by an easing function. The 8 | #' easing function converts the parameterized progression from one state to the 9 | #' next to a new number between 0 and 1. `linear` easing is equivalent to 10 | #' an identity function that returns the input unchanged. In addition there are 11 | #' a range of additional easers available, each with three modifiers. 12 | #' 13 | #' \strong{Easing modifiers:} 14 | #' \describe{ 15 | #' \item{-in}{The easing function is applied as-is} 16 | #' \item{-out}{The easing function is applied in reverse} 17 | #' \item{-in-out}{The first half of the transition it is applied as-is, while 18 | #' in the last half it is reversed} 19 | #' } 20 | #' 21 | #' \strong{Easing functions} 22 | #' \describe{ 23 | #' \item{quadratic}{Models a power-of-2 function} 24 | #' \item{cubic}{Models a power-of-3 function} 25 | #' \item{quartic}{Models a power-of-4 function} 26 | #' \item{quintic}{Models a power-of-5 function} 27 | #' \item{sine}{Models a sine function} 28 | #' \item{circular}{Models a pi/2 circle arc} 29 | #' \item{exponential}{Models an exponential function} 30 | #' \item{elastic}{Models an elastic release of energy} 31 | #' \item{back}{Models a pullback and relase} 32 | #' \item{bounce}{Models the bouncing of a ball} 33 | #' } 34 | #' 35 | #' In addition to this function a good animated explanation can be found 36 | #' [here](https://easings.net). 37 | #' 38 | #' @param ease The name of the easing function to display (see details) 39 | #' 40 | #' @return This function is called for its side effects 41 | #' 42 | #' @examples 43 | #' # The default - identity 44 | #' display_ease('linear') 45 | #' 46 | #' # A more fancy easer 47 | #' display_ease('elastic-in') 48 | #' 49 | #' @importFrom graphics plot 50 | #' @export 51 | #' 52 | display_ease <- function(ease) { 53 | easepoints <- tween_numeric(c(0, 1), 100, ease)[[1]] 54 | progress <- seq(0, 1, length.out = 100) 55 | plot(progress, easepoints, type = 'l', main = ease, xlab = 'In', 56 | ylab = 'Out', bty = 'n') 57 | } 58 | -------------------------------------------------------------------------------- /R/gen.R: -------------------------------------------------------------------------------- 1 | #' Generator internals 2 | #' 3 | #' @param x A generator object 4 | #' 5 | #' @return Various data 6 | #' 7 | #' @name gen_internal 8 | #' @rdname gen_internal 9 | #' 10 | #' @keywords internal 11 | #' 12 | NULL 13 | 14 | #' @rdname gen_internal 15 | #' @export 16 | PHASE_LEVELS <- c("raw", "static", "transition", "enter", "exit") 17 | 18 | #' @rdname gen_internal 19 | #' @export 20 | is_generator <- function(x) inherits(x, "frame_generator") 21 | 22 | #' @rdname gen_internal 23 | #' @export 24 | generator_settings <- function(x) attr(x, "generator_settings") 25 | 26 | #' @rdname gen_internal 27 | #' @export 28 | `generator_settings<-` <- function(x, value) { 29 | attr(x, "generator_settings") <- value 30 | x 31 | } 32 | 33 | #' @rdname gen_internal 34 | #' @export 35 | ease_type <- function(x) generator_settings(x)$ease_type 36 | 37 | #' @rdname gen_internal 38 | #' @export 39 | `ease_type<-` <- function(x, value) { 40 | generator_settings(x)$ease_type <- value 41 | x 42 | } 43 | 44 | #' @rdname gen_internal 45 | #' @export 46 | col_types <- function(x) generator_settings(x)$col_types 47 | 48 | #' @rdname gen_internal 49 | #' @export 50 | `col_types<-` <- function(x, value) { 51 | generator_settings(x)$col_types <- value 52 | x 53 | } 54 | 55 | #' @rdname gen_internal 56 | #' @export 57 | gen_data <- function(x) generator_settings(x)$data 58 | 59 | #' @rdname gen_internal 60 | #' @export 61 | `gen_data<-` <- function(x, value) { 62 | generator_settings(x)$data <- value 63 | x 64 | } 65 | 66 | convert_generator <- function(x) { 67 | UseMethod('convert_generator') 68 | } 69 | #' @export 70 | convert_generator.default <- function(x) { 71 | list(data = x, settings = list(converter = function(x, ...) x)) 72 | } 73 | 74 | #' @rdname gen_internal 75 | #' @export 76 | gen_to_data_frame <- function(...) { 77 | data <- lapply(list(...), convert_generator) 78 | settings <- lapply(data, `[[`, 'settings') 79 | data <- lapply(data, `[[`, 'data') 80 | id <- rep(seq_along(data), vapply(data, nrow, integer(1))) 81 | data <- vec_rbind(data) 82 | attr(data, "generator_id") <- id 83 | attr(data, "generator_info") <- settings 84 | class(data) <- c("generator_df", class(data)) 85 | data 86 | } 87 | 88 | #' @rdname gen_internal 89 | #' @export 90 | data_frame_to_gen <- function(x) { 91 | if (!inherits(x, "generator_df")) { 92 | stop('This does not appear to be a generator in data frame disguise') 93 | } 94 | info <- attr(x, "generator_info") 95 | data <- split(data.frame(x), attr(x, "generator_id")) 96 | Map(function(data, info) { 97 | info$converter(data, info) 98 | }) 99 | } 100 | -------------------------------------------------------------------------------- /R/gen_along.R: -------------------------------------------------------------------------------- 1 | #' Generator for tweening along a variable 2 | #' 3 | #' This is a generator version of [tween_along()]. It returns a generator that 4 | #' can be used with [get_frame()] and [get_raw_frames()] to extract frames for 5 | #' a specific time point scaled between 0 and 1. 6 | #' 7 | #' @inheritParams tween_along 8 | #' 9 | #' @return An `along_generator` object 10 | #' 11 | #' @family Other generators 12 | #' 13 | #' @export 14 | #' @importFrom rlang eval_tidy enquo 15 | #' 16 | #' @examples 17 | #' # Default behaviour 18 | #' gen <- gen_along(airquality, ease = "linear", along = Day, id = Month) 19 | #' get_frame(gen, 0.22) 20 | #' 21 | #' # Overwrite keep_last or history in get_frame 22 | #' get_frame(gen, 0.67, history = FALSE) 23 | gen_along <- function(.data, ease, 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 | 29 | .data$.phase <- NULL 30 | if (length(ease) == 1) ease <- rep(ease, ncol(.data)) 31 | if (length(ease) == ncol(.data)) { 32 | ease <- c(ease, 'linear') # To account for .phase column 33 | } else { 34 | stop('Ease must be either a single string or one for each column', call. = FALSE) 35 | } 36 | 37 | .data$.phase <- rep_len(factor("raw", levels = PHASE_LEVELS), nrow(.data)) 38 | d_order <- order(id, along) 39 | if (is.null(range)) range <- range(along) 40 | class(.data) <- c(c("along_generator", "frame_generator"), class(.data)) 41 | generator_settings(.data) <- list( 42 | data = .data[d_order, ], 43 | id = id[d_order], 44 | along = along[d_order], 45 | range = range, 46 | ease_type = ease, 47 | history = history, 48 | keep_last = keep_last, 49 | col_types = col_classes(.data) 50 | ) 51 | .data 52 | } 53 | #' @export 54 | get_frame.along_generator <- function(generator, at, ..., history = NULL, keep_last = NULL) { 55 | d <- generator_settings(generator) 56 | # clamp between 0 and 1 57 | at <- min(max(at, 0), 1) 58 | range <- d$range 59 | 60 | # normalise to range 61 | at <- (range[2] - range[1]) * at + range[1] 62 | 63 | data <- gen_data(generator) 64 | ease <- ease_type(generator) 65 | type <- col_types(generator) 66 | if (is.null(history)) history <- d$history 67 | if (is.null(keep_last)) keep_last <- d$keep_last 68 | 69 | frame <- lapply(seq_along(data), function(i) { 70 | data <- data[[i]] 71 | e <- ease[i] 72 | switch( 73 | type[i], 74 | numeric = interpolate_numeric_along(data, d$id, d$along, at, e, history, keep_last)$data, 75 | logical = interpolate_logical_along(data, d$id, d$along, at, e, history, keep_last)$data, 76 | factor = interpolate_factor_along(data, d$id, d$along, at, e, history, keep_last)$data, 77 | character = interpolate_character_along(data, d$id, d$along, at, e, history, keep_last)$data, 78 | colour = interpolate_colour_along(data, d$id, d$along, at, e, history, keep_last)$data, 79 | date = interpolate_date_along(data, d$id, d$along, at, e, history, keep_last)$data, 80 | datetime = interpolate_datetime_along(data, d$id, d$along, at, e, history, keep_last)$data, 81 | constant = interpolate_constant_along(data, d$id, d$along, at, e, history, keep_last)$data, 82 | numlist = interpolate_numlist_along(data, d$id, d$along, at, e, history, keep_last)$data, 83 | list = interpolate_list_along(data, d$id, d$along, at, e, history, keep_last)$data, 84 | phase = get_phase_along(d$id, d$along, at, history, keep_last)$data 85 | ) 86 | }) 87 | structure(frame, names = names(data), row.names = .set_row_names(length(frame[[1]])), class = 'data.frame') 88 | } 89 | #' @export 90 | get_raw_frames.along_generator <- function(generator, at, before = 0, after = 0, ...) { 91 | d <- generator_settings(generator) 92 | 93 | # clamp between 0 and 1 94 | before <- min(max(at - before, 0), 1) 95 | after <- min(max(at + after, 0), 1) 96 | at <- min(max(at, 0), 1) 97 | range <- d$range 98 | 99 | # normalise to generator time 100 | at <- (range[2] - range[1]) * at + range[1] 101 | before <- (range[2] - range[1]) * before + range[1] 102 | after <- (range[2] - range[1]) * after + range[1] 103 | 104 | # Find before and after 105 | before <- d$along >= before & d$along < at 106 | after <- d$along > at & d$along <= after 107 | 108 | list( 109 | before = d$data[before, , drop = FALSE], 110 | after = d$data[after, , drop = FALSE] 111 | ) 112 | } 113 | 114 | #' @export 115 | convert_generator.along_generator <- function(x) { 116 | data <- gen_data(x) 117 | settings <- list( 118 | attributes = attributes(x), 119 | data = data.frame(x), 120 | converter = function(x, settings) { 121 | data <- settings$data 122 | attributes(data) <- settings$attributes 123 | gen_data(data) <- data.frame(x) 124 | data 125 | } 126 | ) 127 | list(data = data, settings = settings) 128 | } 129 | -------------------------------------------------------------------------------- /R/gen_at.R: -------------------------------------------------------------------------------- 1 | #' Generator for interpolating between two data frames 2 | #' 3 | #' This is a generator version of [tween_at()] with the additional functionality 4 | #' of supporting enter and exit functions. It returns a generator that can be 5 | #' used with [get_frame()] and [get_raw_frames()] to extract frames for a 6 | #' specific time point scaled between 0 and 1. 7 | #' 8 | #' @inheritParams tween_at 9 | #' @inheritParams tween_state 10 | #' 11 | #' @return A `keyframe_generator` object 12 | #' 13 | #' @family Other generators 14 | #' 15 | #' @export 16 | #' 17 | #' @examples 18 | #' gen <- gen_at(mtcars[1:6, ], mtcars[6:1, ], 'cubic-in-out') 19 | #' 20 | #' get_frame(gen, 0.3) 21 | gen_at <- function(from, to, ease, id = NULL, enter = NULL, exit = NULL) { 22 | gen <- gen_keyframe(from, 0) 23 | add_keyframe(gen, to, ease = ease, length = 1, id = {{ id }}, enter = enter, exit = exit) 24 | } 25 | -------------------------------------------------------------------------------- /R/gen_components.R: -------------------------------------------------------------------------------- 1 | #' Generator for tweening components separately from each other 2 | #' 3 | #' This is a generator versions of [tween_components()]. It returns a generator 4 | #' that can be used with [get_frame()] and [get_raw_frames()] to extract frames 5 | #' for a specific time point scaled between 0 and 1. 6 | #' 7 | #' @inheritParams tween_components 8 | #' 9 | #' @return A `component_generator` object 10 | #' 11 | #' @family Other generators 12 | #' 13 | #' @export 14 | #' @importFrom rlang eval_tidy enquo quo_is_null 15 | #' 16 | #' @examples 17 | #' from_zero <- function(x) {x$x <- 0; x} 18 | #' 19 | #' data <- data.frame( 20 | #' x = c(1, 2, 2, 1, 2, 2), 21 | #' y = c(1, 2, 2, 2, 1, 1), 22 | #' time = c(1, 4, 8, 4, 8, 10), 23 | #' id = c(1, 1, 1, 2, 2, 2) 24 | #' ) 25 | #' 26 | #' gen <- gen_components(data, 'cubic-in-out', time = time, id = id, 27 | #' enter = from_zero, enter_length = 4) 28 | #' 29 | #' get_frame(gen, 0.3) 30 | gen_components <- function(.data, ease, nframes, time, id = NULL, range = NULL, 31 | enter = NULL, exit = NULL, enter_length = 0, 32 | exit_length = 0) { 33 | time <- enquo(time) 34 | time <- eval_tidy(time, .data) 35 | id <- enquo(id) 36 | id <- if (quo_is_null(id)) rep(1, nrow(.data)) else eval_tidy(id, .data) 37 | if (is.null(enter_length)) enter_length <- 0 38 | if (is.null(exit_length)) exit_length <- 0 39 | 40 | .data$.phase <- NULL 41 | if (length(ease) == 1) ease <- rep(ease, ncol(.data)) 42 | if (length(ease) == ncol(.data)) { 43 | ease <- c(ease, 'linear') # To account for .phase column 44 | } else { 45 | stop('Ease must be either a single string or one for each column', call. = FALSE) 46 | } 47 | 48 | .data$.phase <- rep_len(factor("raw", levels = PHASE_LEVELS), nrow(.data)) 49 | class(.data) <- c(c("component_generator", "frame_generator"), class(.data)) 50 | 51 | gen_data <- .complete_components(.data, time, id, enter, exit, enter_length, exit_length) 52 | time <- gen_data$.time 53 | id <- gen_data$.id 54 | gen_data$.time <- NULL 55 | gen_data$.id <- NULL 56 | d_order <- order(id, time) 57 | if (is.null(range)) range <- range(time) 58 | if (diff(range) == 0) stop('range cannot be 0', call. = FALSE) 59 | 60 | generator_settings(.data) <- list( 61 | data = gen_data[d_order, ], 62 | id = id[d_order], 63 | time = time[d_order], 64 | range = range, 65 | ease_type = ease, 66 | col_types = col_classes(.data) 67 | ) 68 | 69 | .data 70 | } 71 | 72 | #' @export 73 | get_frame.component_generator <- function(generator, at, ...) { 74 | d <- generator_settings(generator) 75 | # clamp between 0 and 1 76 | at <- min(max(at, 0), 1) 77 | range <- d$range 78 | 79 | # normalise to range 80 | at <- (range[2] - range[1]) * at + range[1] 81 | 82 | data <- gen_data(generator) 83 | ease <- ease_type(generator) 84 | type <- col_types(generator) 85 | 86 | frame <- lapply(seq_along(data), function(i) { 87 | col <- data[[i]] 88 | e <- rep_len(ease[[i]], length(col)) 89 | switch( 90 | type[i], 91 | numeric = interpolate_numeric_element_at(col, d$id, d$time, at, e), 92 | logical = interpolate_logical_element_at(col, d$id, d$time, at, e), 93 | factor = interpolate_factor_element_at(col, d$id, d$time, at, e), 94 | character = interpolate_character_element_at(col, d$id, d$time, at, e), 95 | colour = interpolate_colour_element_at(col, d$id, d$time, at, e), 96 | date = interpolate_date_element_at(col, d$id, d$time, at, e), 97 | datetime = interpolate_datetime_element_at(col, d$id, d$time, at, e), 98 | constant = interpolate_constant_element_at(col, d$id, d$time, at, e), 99 | numlist = interpolate_numlist_element_at(col, d$id, d$time, at, e), 100 | list = interpolate_list_element_at(col, d$id, d$time, at, e), 101 | phase = get_phase_element_at(col, d$id, d$time, at, e) 102 | ) 103 | }) 104 | structure(frame, names = names(data), row.names = .set_row_names(length(frame[[1]])), class = 'data.frame') 105 | } 106 | #' @export 107 | get_raw_frames.component_generator <- function(generator, at, before = 0, after = 0, ...) { 108 | d <- generator_settings(generator) 109 | 110 | # clamp between 0 and 1 111 | before <- min(max(at - before, 0), 1) 112 | after <- min(max(at + after, 0), 1) 113 | at <- min(max(at, 0), 1) 114 | range <- d$range 115 | 116 | # normalise to generator time 117 | at <- (range[2] - range[1]) * at + range[1] 118 | before <- (range[2] - range[1]) * before + range[1] 119 | after <- (range[2] - range[1]) * after + range[1] 120 | 121 | # Find before and after 122 | before <- d$time >= before & d$time < at 123 | after <- d$time > at & d$time <= after 124 | raw <- d$data$.phase == 'raw' 125 | 126 | list( 127 | before = d$data[before & raw, , drop = FALSE], 128 | after = d$data[after & raw, , drop = FALSE] 129 | ) 130 | } 131 | 132 | 133 | #' @export 134 | convert_generator.component_generator <- convert_generator.along_generator 135 | -------------------------------------------------------------------------------- /R/gen_events.R: -------------------------------------------------------------------------------- 1 | #' Generator for tweening the appearance of elements 2 | #' 3 | #' This is a generator version of [tween_events()]. It returns a generator 4 | #' that can be used with [get_frame()] and [get_raw_frames()] to extract frames 5 | #' for a specific time point scaled between 0 and 1. 6 | #' 7 | #' @inheritParams tween_events 8 | #' 9 | #' @return A `component_generator` object 10 | #' 11 | #' @family Other generators 12 | #' 13 | #' @export 14 | #' @importFrom rlang enquo eval_tidy quo_is_missing 15 | #' 16 | #' @examples 17 | #' d <- data.frame( 18 | #' x = runif(20), 19 | #' y = runif(20), 20 | #' time = runif(20), 21 | #' duration = runif(20, max = 0.1) 22 | #' ) 23 | #' from_left <- function(x) { 24 | #' x$x <- -0.5 25 | #' x 26 | #' } 27 | #' to_right <- function(x) { 28 | #' x$x <- 1.5 29 | #' x 30 | #' } 31 | #' 32 | #' gen <- gen_events(d, 'cubic-in-out', start = time, end = time + duration, 33 | #' enter = from_left, exit = to_right, enter_length = 0.1, 34 | #' exit_length = 0.05) 35 | #' 36 | #' get_frame(gen, 0.65) 37 | #' 38 | gen_events <- function(.data, ease, start, end = NULL, range = NULL, enter = NULL, exit = NULL, enter_length = 0, exit_length = 0) { 39 | start <- enquo(start) 40 | if (quo_is_missing(start)) stop('start must be provided', call. = FALSE) 41 | start <- eval_tidy(start, .data) 42 | end <- enquo(end) 43 | end <- eval_tidy(end, .data) 44 | enter_length <- enquo(enter_length) 45 | enter_length <- eval_tidy(enter_length, .data) 46 | exit_length <- enquo(exit_length) 47 | exit_length <- eval_tidy(exit_length, .data) 48 | 49 | if (is.null(enter_length)) enter_length <- 0 50 | if (is.null(exit_length)) exit_length <- 0 51 | 52 | .data$.phase <- NULL 53 | if (length(ease) == 1) ease <- rep(ease, ncol(.data)) 54 | if (length(ease) == ncol(.data)) { 55 | ease <- c(ease, 'linear') # To account for .phase column 56 | } else { 57 | stop('Ease must be either a single string or one for each column', call. = FALSE) 58 | } 59 | 60 | .data$.phase <- rep_len(factor("raw", levels = PHASE_LEVELS), nrow(.data)) 61 | class(.data) <- c(c("component_generator", "frame_generator"), class(.data)) 62 | 63 | gen_data <- .complete_events(.data, start, end, enter, exit, enter_length, exit_length) 64 | 65 | time <- gen_data$.time 66 | id <- gen_data$.id 67 | gen_data$.time <- NULL 68 | gen_data$.id <- NULL 69 | d_order <- order(id, time) 70 | if (is.null(range)) range <- range(time) 71 | if (diff(range) == 0) stop('range cannot be 0', call. = FALSE) 72 | 73 | generator_settings(.data) <- list( 74 | data = gen_data[d_order, ], 75 | id = id[d_order], 76 | time = time[d_order], 77 | range = range, 78 | ease_type = ease, 79 | col_types = col_classes(.data) 80 | ) 81 | 82 | .data 83 | } 84 | -------------------------------------------------------------------------------- /R/get_frame.R: -------------------------------------------------------------------------------- 1 | #' Extract a frame from a generator 2 | #' 3 | #' Using the generators in tweenr you can avoid calculating all needed frames up 4 | #' front, which can be prohibitive in memory. With a generator you can use 5 | #' `get_frame()` to extract any frame at a fractional location between 0 and 1 6 | #' one by one as you need them. You can further get all raw data before and/or 7 | #' after a given point in time using `get_raw_frames()`. 8 | #' 9 | #' @param generator A `frame_generator` object 10 | #' @param at A scalar numeric between 0 and 1 11 | #' @param before,after Scalar numerics that define the time before and after 12 | #' `at` to search for raw data 13 | #' @param ... Arguments passed on to methods 14 | #' 15 | #' @export 16 | #' 17 | #' @examples 18 | #' data <- data.frame( 19 | #' x = c(1, 2, 2, 1, 2, 2), 20 | #' y = c(1, 2, 2, 2, 1, 1), 21 | #' time = c(1, 4, 8, 4, 8, 10), 22 | #' id = c(1, 1, 1, 2, 2, 2) 23 | #' ) 24 | #' 25 | #' gen <- gen_components(data, 'cubic-in-out', time = time, id = id) 26 | #' 27 | #' get_frame(gen, 0.3) 28 | #' 29 | #' get_raw_frames(gen, 0.5, before = 0.5, after = 0.2) 30 | get_frame <- function(generator, at, ...) { 31 | UseMethod("get_frame") 32 | } 33 | #' @rdname get_frame 34 | #' @export 35 | get_raw_frames <- function(generator, at, before = 0, after = 0, ...) { 36 | UseMethod("get_raw_frames") 37 | } 38 | -------------------------------------------------------------------------------- /R/interpolate_along.R: -------------------------------------------------------------------------------- 1 | interpolate_numeric_along <- function(data, group, frame, frames, ease, history, keep_last) { 2 | numeric_along_interpolator(as.numeric(data), as.integer(group), as.numeric(frame), as.logical(history), as.logical(keep_last), as.numeric(frames), as.character(ease)) 3 | } 4 | 5 | interpolate_logical_along <- function(data, group, frame, frames, ease, history, keep_last) { 6 | res <- interpolate_numeric_along(data, group, frame, frames, ease, history, keep_last) 7 | res[['data']] <- as.logical(round(res[['data']])) 8 | res 9 | } 10 | 11 | #' @importFrom farver decode_colour encode_colour 12 | interpolate_colour_along <- function(data, group, frame, frames, ease, history, keep_last) { 13 | data <- decode_colour(data, alpha = TRUE, to = 'lab') 14 | col <- colour_along_interpolator(data, as.integer(group), as.numeric(frame), as.logical(history), as.logical(keep_last), as.numeric(frames), as.character(ease)) 15 | data.frame( 16 | data = encode_colour(col[, 1:3, drop = FALSE], alpha = col[,4], from = 'lab'), 17 | group = col$group, 18 | frame = col$frame, 19 | stringsAsFactors = FALSE 20 | ) 21 | } 22 | 23 | interpolate_constant_along <- function(data, group, frame, frames, ease, history, keep_last) { 24 | constant_along_interpolator(as.character(data), as.integer(group), as.numeric(frame), as.logical(history), as.logical(keep_last), as.numeric(frames), as.character(ease)) 25 | } 26 | 27 | interpolate_character_along <- interpolate_constant_along 28 | 29 | interpolate_date_along <- function(data, group, frame, frames, ease, history, keep_last) { 30 | res <- interpolate_numeric_along(data, group, frame, frames, ease, history, keep_last) 31 | res[['data']] <- as.Date(res[['data']], origin = BASEDATE) 32 | res 33 | } 34 | interpolate_datetime_along <- function(data, group, frame, frames, ease, history, keep_last) { 35 | if (inherits(data, 'POSIXlt')) { 36 | warning("POSIXlt converted to POSIXct") 37 | data <- as.POSIXct(data) 38 | } 39 | tz <- attr(data, 'tzone') 40 | res <- interpolate_numeric_along(data, group, frame, frames, ease, history, keep_last) 41 | res[['data']] <- as.POSIXct(res[['data']], origin = BASEDATETIME, tz = tz) 42 | res 43 | } 44 | interpolate_factor_along <- function(data, group, frame, frames, ease, history, keep_last) { 45 | all_levels <- levels(data) 46 | ord <- is.ordered(data) 47 | res <- interpolate_character_along(data, group, frame, frames, ease, history, keep_last) 48 | res[['data']] <- if (ord) ordered(res[['data']], all_levels) else factor(res[['data']], all_levels) 49 | res 50 | } 51 | interpolate_list_along <- function(data, group, frame, frames, ease, history, keep_last) { 52 | new_data <- list_along_interpolator(as.list(data), as.integer(group), as.numeric(frame), as.logical(history), as.logical(keep_last), as.numeric(frames), as.character(ease)) 53 | attributes(new_data$data) <- attributes(data) 54 | new_data 55 | } 56 | interpolate_numlist_along <- function(data, group, frame, frames, ease, history, keep_last) { 57 | new_data <- numlist_along_interpolator(lapply(data, as.numeric), as.integer(group), as.numeric(frame), as.logical(history), as.logical(keep_last), as.numeric(frames), as.character(ease)) 58 | attributes(new_data$data) <- attributes(data) 59 | new_data 60 | } 61 | get_phase_along <- function(group, frame, frames, history, keep_last) { 62 | phase_along_interpolator(as.integer(group), as.numeric(frame), as.logical(history), as.logical(keep_last), as.numeric(frames)) 63 | } 64 | -------------------------------------------------------------------------------- /R/interpolate_at.R: -------------------------------------------------------------------------------- 1 | interpolate_numeric_at <- function(from, to, at, ease) { 2 | numeric_at_interpolator(as.numeric(from), as.numeric(to), as.numeric(at), as.character(ease)) 3 | } 4 | 5 | interpolate_logical_at <- function(from, to, at, ease) { 6 | as.logical(round(interpolate_numeric_at(from, to, at, ease))) 7 | } 8 | 9 | #' @importFrom farver decode_colour encode_colour 10 | interpolate_colour_at <- function(from, to, at, ease) { 11 | from <- decode_colour(from, alpha = TRUE, to = 'lab') 12 | to <- decode_colour(to, alpha = TRUE, to = 'lab') 13 | data <- colour_at_interpolator(from, to, as.numeric(at), as.character(ease)) 14 | encode_colour(data[, 1:3, drop = FALSE], alpha = data[,4], from = 'lab') 15 | } 16 | 17 | interpolate_constant_at <- function(from, to, at, ease) { 18 | constant_at_interpolator(as.character(from), as.character(to), as.numeric(at), as.character(ease)) 19 | } 20 | 21 | interpolate_character_at <- interpolate_constant_at 22 | 23 | interpolate_date_at <- function(from, to, at, ease) { 24 | data <- interpolate_numeric_at(from, to, at, ease) 25 | as.Date(data, origin = BASEDATE) 26 | } 27 | 28 | interpolate_datetime_at <- function(from, to, at, ease) { 29 | if (inherits(from, 'POSIXlt')) { 30 | warning("POSIXlt converted to POSIXct") 31 | from <- as.POSIXct(from) 32 | } 33 | tz <- attr(from, 'tzone') 34 | data <- interpolate_numeric_at(from, to, at, ease) 35 | as.POSIXct(data, origin = BASEDATETIME, tz = tz) 36 | } 37 | 38 | interpolate_factor_at <- function(from, to, at, ease) { 39 | all_levels <- unique(c(levels(from), levels(to))) 40 | data <- interpolate_constant_at(from, to, at, ease) 41 | if (is.ordered(from)) ordered(data, all_levels) else factor(data, all_levels) 42 | } 43 | 44 | interpolate_list_at <- function(from, to, at, ease) { 45 | data <- list_at_interpolator(as.list(from), as.list(to), as.numeric(at), as.character(ease)) 46 | attributes(data) <- attributes(from) 47 | data 48 | } 49 | 50 | interpolate_numlist_at <- function(from, to, at, ease) { 51 | data <- numlist_at_interpolator(lapply(from, as.numeric), lapply(to, as.numeric), as.numeric(at), as.character(ease)) 52 | attributes(data) <- attributes(from) 53 | data 54 | } 55 | 56 | interpolate_numeric_at_t <- function(from, to, at, ease) { 57 | numeric_at_t_interpolator(as.numeric(from), as.numeric(to), as.numeric(at), as.character(ease)) 58 | } 59 | 60 | interpolate_logical_at_t <- function(from, to, at, ease) { 61 | as.logical(round(interpolate_numeric_at_t(from, to, at, ease))) 62 | } 63 | 64 | #' @importFrom farver decode_colour encode_colour 65 | interpolate_colour_at_t <- function(from, to, at, ease) { 66 | from <- decode_colour(from, alpha = TRUE, to = 'lab') 67 | to <- decode_colour(to, alpha = TRUE, to = 'lab') 68 | data <- colour_at_t_interpolator(from, to, as.numeric(at), as.character(ease)) 69 | encode_colour(data[, 1:3, drop = FALSE], alpha = data[,4], from = 'lab') 70 | } 71 | 72 | interpolate_constant_at_t <- function(from, to, at, ease) { 73 | constant_at_t_interpolator(as.character(from), as.character(to), as.numeric(at), as.character(ease)) 74 | } 75 | 76 | interpolate_character_at_t <- interpolate_constant_at_t 77 | 78 | interpolate_date_at_t <- function(from, to, at, ease) { 79 | data <- interpolate_numeric_at(from, to, at, ease) 80 | as.Date(data, origin = BASEDATE) 81 | } 82 | 83 | interpolate_datetime_at_t <- function(from, to, at, ease) { 84 | if (inherits(from, 'POSIXlt')) { 85 | warning("POSIXlt converted to POSIXct") 86 | from <- as.POSIXct(from) 87 | } 88 | tz <- attr(from, 'tzone') 89 | data <- interpolate_numeric_at(from, to, at, ease) 90 | as.POSIXct(data, origin = BASEDATETIME, tz = tz) 91 | } 92 | 93 | interpolate_factor_at_t <- function(from, to, at, ease) { 94 | all_levels <- unique(c(levels(from), levels(to))) 95 | data <- interpolate_constant_at(from, to, at, ease) 96 | if (is.ordered(from)) ordered(data, all_levels) else factor(data, all_levels) 97 | } 98 | 99 | interpolate_list_at_t <- function(from, to, at, ease) { 100 | data <- list_at_t_interpolator(as.list(from), as.list(to), as.numeric(at), as.character(ease)) 101 | attributes(data) <- attributes(from) 102 | data 103 | } 104 | 105 | interpolate_numlist_at_t <- function(from, to, at, ease) { 106 | data <- numlist_at_t_interpolator(lapply(from, as.numeric), lapply(to, as.numeric), as.numeric(at), as.character(ease)) 107 | attributes(data) <- attributes(from) 108 | data 109 | } 110 | -------------------------------------------------------------------------------- /R/interpolate_element.R: -------------------------------------------------------------------------------- 1 | interpolate_numeric_element <- function(data, group, frame, ease) { 2 | numeric_element_interpolator(as.numeric(data), as.integer(group), as.integer(frame), as.character(ease)) 3 | } 4 | 5 | interpolate_logical_element <- function(data, group, frame, ease) { 6 | res <- interpolate_numeric_element(data, group, frame, ease) 7 | res[['data']] <- as.logical(round(res[['data']])) 8 | res 9 | } 10 | 11 | #' @importFrom farver decode_colour encode_colour 12 | interpolate_colour_element <- function(data, group, frame, ease) { 13 | data <- decode_colour(data, alpha = TRUE, to = 'lab') 14 | col <- colour_element_interpolator(data, as.integer(group), as.integer(frame), as.character(ease)) 15 | data.frame( 16 | data = encode_colour(col[, 1:3, drop = FALSE], alpha = col[,4], from = 'lab'), 17 | group = col$group, 18 | frame = col$frame, 19 | stringsAsFactors = FALSE 20 | ) 21 | } 22 | 23 | interpolate_constant_element <- function(data, group, frame, ease) { 24 | constant_element_interpolator(as.character(data), as.integer(group), as.integer(frame), as.character(ease)) 25 | } 26 | 27 | interpolate_character_element <- interpolate_constant_element 28 | 29 | interpolate_date_element <- function(data, group, frame, ease) { 30 | res <- interpolate_numeric_element(data, group, frame, ease) 31 | res[['data']] <- as.Date(res[['data']], origin = BASEDATE) 32 | res 33 | } 34 | 35 | interpolate_datetime_element <- function(data, group, frame, ease) { 36 | if (inherits(data, 'POSIXlt')) { 37 | warning("POSIXlt converted to POSIXct") 38 | data <- as.POSIXct(data) 39 | } 40 | tz <- attr(data, 'tzone') 41 | res <- interpolate_numeric_element(data, group, frame, ease) 42 | res[['data']] <- as.POSIXct(res[['data']], origin = BASEDATETIME, tz = tz) 43 | res 44 | } 45 | 46 | interpolate_factor_element <- function(data, group, frame, ease) { 47 | all_levels <- levels(data) 48 | ord <- is.ordered(data) 49 | res <- interpolate_character_element(data, group, frame, ease) 50 | res[['data']] <- if (ord) ordered(res[['data']], all_levels) else factor(res[['data']], all_levels) 51 | res 52 | } 53 | 54 | interpolate_list_element <- function(data, group, frame, ease) { 55 | new_data <- list_element_interpolator(as.list(data), as.integer(group), as.integer(frame), as.character(ease)) 56 | attributes(new_data$data) <- attributes(data) 57 | new_data 58 | } 59 | 60 | interpolate_numlist_element <- function(data, group, frame, ease) { 61 | new_data <- numlist_element_interpolator(lapply(data, as.numeric), as.integer(group), as.integer(frame), as.character(ease)) 62 | attributes(new_data$data) <- attributes(data) 63 | new_data 64 | } 65 | 66 | get_phase_element <- function(data, group, frame, ease) { 67 | phase_element_interpolator(as.character(data), as.integer(group), as.integer(frame), as.character(ease)) 68 | } 69 | -------------------------------------------------------------------------------- /R/interpolate_element_at.R: -------------------------------------------------------------------------------- 1 | interpolate_numeric_element_at <- function(data, group, time, at, ease) { 2 | numeric_element_at_interpolator(as.numeric(data), as.integer(group), as.numeric(time), as.numeric(at), as.character(ease)) 3 | } 4 | 5 | interpolate_logical_element_at <- function(data, group, time, at, ease) { 6 | as.logical(interpolate_numeric_element_at(data, group, time, at, ease)) 7 | } 8 | 9 | #' @importFrom farver decode_colour encode_colour 10 | interpolate_colour_element_at <- function(data, group, time, at, ease) { 11 | data <- decode_colour(data, alpha = TRUE, to = 'lab') 12 | col <- colour_element_at_interpolator(data, as.integer(group), as.numeric(time), as.numeric(at), as.character(ease)) 13 | encode_colour(col[, 1:3, drop = FALSE], alpha = col[,4], from = 'lab') 14 | } 15 | 16 | interpolate_constant_element_at <- function(data, group, time, at, ease) { 17 | constant_element_at_interpolator(as.character(data), as.integer(group), as.numeric(time), as.numeric(at), as.character(ease)) 18 | } 19 | 20 | interpolate_character_element_at <- interpolate_constant_element_at 21 | 22 | interpolate_date_element_at <- function(data, group, time, at, ease) { 23 | res <- interpolate_numeric_element_at(data, group, time, at, ease) 24 | as.Date(res, origin = BASEDATE) 25 | } 26 | 27 | interpolate_datetime_element_at <- function(data, group, time, at, ease) { 28 | if (inherits(data, 'POSIXlt')) { 29 | warning("POSIXlt converted to POSIXct") 30 | data <- as.POSIXct(data) 31 | } 32 | tz <- attr(data, 'tzone') 33 | res <- interpolate_numeric_element_at(data, group, time, at, ease) 34 | as.POSIXct(res, origin = BASEDATETIME, tz = tz) 35 | } 36 | 37 | interpolate_factor_element_at <- function(data, group, time, at, ease) { 38 | all_levels <- levels(data) 39 | ord <- is.ordered(data) 40 | res <- interpolate_character_element_at(data, group, time, at, ease) 41 | if (ord) ordered(res[['data']], all_levels) else factor(res[['data']], all_levels) 42 | } 43 | 44 | interpolate_list_element_at <- function(data, group, time, at, ease) { 45 | new_data <- list_element_at_interpolator(as.list(data), as.integer(group), as.numeric(time), as.numeric(at), as.character(ease)) 46 | attributes(new_data) <- attributes(data) 47 | new_data 48 | } 49 | 50 | interpolate_numlist_element_at <- function(data, group, time, at, ease) { 51 | new_data <- numlist_element_at_interpolator(lapply(data, as.numeric), as.integer(group), as.numeric(time), as.numeric(at), as.character(ease)) 52 | attributes(new_data) <- attributes(data) 53 | new_data 54 | } 55 | 56 | get_phase_element_at <- function(data, group, time, at, ease) { 57 | phase_element_at_interpolator(as.character(data), as.integer(group), as.numeric(time), as.numeric(at), as.character(ease)) 58 | } 59 | -------------------------------------------------------------------------------- /R/interpolate_fill.R: -------------------------------------------------------------------------------- 1 | interpolate_numeric_fill <- function(data, ease) { 2 | numeric_fill_interpolator(as.numeric(data), as.character(ease)) 3 | } 4 | 5 | interpolate_logical_fill <- function(data, ease) { 6 | as.logical(round(numeric_fill_interpolator(data, ease))) 7 | } 8 | 9 | #' @importFrom farver decode_colour encode_colour 10 | interpolate_colour_fill <- function(data, ease) { 11 | data <- decode_colour(data, alpha = TRUE, to = 'lab') 12 | data <- colour_fill_interpolator(data, as.character(ease)) 13 | encode_colour(data[, 1:3, drop = FALSE], alpha = data[,4], from = 'lab') 14 | } 15 | 16 | interpolate_constant_fill <- function(data, ease) { 17 | constant_fill_interpolator(as.character(data), as.character(ease)) 18 | } 19 | 20 | interpolate_character_fill <- interpolate_constant_fill 21 | 22 | interpolate_date_fill <- function(data, ease) { 23 | as.Date(interpolate_numeric_fill(data, ease), origin = BASEDATE) 24 | } 25 | 26 | interpolate_datetime_fill <- function(data, ease) { 27 | if (inherits(data, 'POSIXlt')) { 28 | warning("POSIXlt converted to POSIXct") 29 | data <- as.POSIXct(data) 30 | } 31 | as.POSIXct(interpolate_numeric_fill(data, ease), origin = BASEDATETIME, tz = attr(data, 'tzone')) 32 | } 33 | 34 | interpolate_factor_fill <- function(data, ease) { 35 | all_levels <- levels(data) 36 | ord <- is.ordered(data) 37 | data <- interpolate_character_fill(data, ease) 38 | if (ord) ordered(data, all_levels) else factor(data, all_levels) 39 | } 40 | 41 | interpolate_list_fill <- function(data, ease) { 42 | new_data <- list_fill_interpolator(as.list(data), as.character(ease)) 43 | attributes(new_data) <- attributes(data) 44 | new_data 45 | } 46 | 47 | interpolate_numlist_fill <- function(data, ease) { 48 | new_data <- numlist_fill_interpolator(lapply(data, as.numeric), as.character(ease)) 49 | attributes(new_data) <- attributes(data) 50 | new_data 51 | } 52 | -------------------------------------------------------------------------------- /R/interpolate_state.R: -------------------------------------------------------------------------------- 1 | interpolate_numeric_state <- function(data, states) { 2 | res <- numeric_state_interpolator(lapply(data, as.numeric), states) 3 | c(data[[1]][0], res) 4 | } 5 | 6 | interpolate_logical_state <- function(data, states) { 7 | res <- numeric_state_interpolator(lapply(data, as.numeric), states) 8 | as.logical(round(res)) 9 | } 10 | 11 | #' @importFrom farver decode_colour encode_colour 12 | interpolate_colour_state <- function(data, states) { 13 | data <- lapply(data, decode_colour, alpha = TRUE, to = 'lab') 14 | data <- colour_state_interpolator(data, states) 15 | encode_colour(data[, 1:3, drop = FALSE], alpha = data[,4], from = 'lab') 16 | } 17 | 18 | interpolate_constant_state <- function(data, states) { 19 | constant_state_interpolator(lapply(data, as.character), states) 20 | } 21 | interpolate_character_state <- interpolate_constant_state 22 | 23 | interpolate_date_state <- function(data, states) { 24 | as.Date(interpolate_numeric_state(data, states), origin = BASEDATE) 25 | } 26 | 27 | interpolate_datetime_state <- function(data, states) { 28 | if (inherits(data[[1]], 'POSIXlt')) { 29 | warning("POSIXlt converted to POSIXct") 30 | data[[1]] <- as.POSIXct(data[[1]]) 31 | } 32 | tz <- attr(data[[1]], 'tzone') 33 | as.POSIXct(interpolate_numeric_state(data, states), origin = BASEDATETIME, tz = tz) 34 | } 35 | 36 | interpolate_factor_state <- function(data, states) { 37 | all_levels <- Reduce(union, lapply(data, levels)) 38 | ord <- is.ordered(data[[1]]) 39 | data <- interpolate_character_state(data, states) 40 | if (ord) ordered(data, all_levels) else factor(data, all_levels) 41 | } 42 | 43 | interpolate_list_state <- function(data, states) { 44 | new_data <- list_state_interpolator(data, states) 45 | attributes(new_data) <- attributes(data) 46 | new_data 47 | } 48 | 49 | interpolate_numlist_state <- function(data, states) { 50 | new_data <- numlist_state_interpolator(lapply(data, lapply, as.numeric), states) 51 | attributes(new_data) <- attributes(data) 52 | new_data 53 | } 54 | 55 | get_phase_state <- function(data, states) { 56 | phase_state_interpolator(lapply(data, as.character), states) 57 | } 58 | -------------------------------------------------------------------------------- /R/tween.R: -------------------------------------------------------------------------------- 1 | #' Create simple tweens 2 | #' 3 | #' This set of functions can be used to interpolate between single data types, 4 | #' i.e. data not part of data.frames but stored in vectors. All functions come 5 | #' in two flavours: the standard and a *_t version. The standard reads the data 6 | #' as a list of states, each tween matched element-wise from state to state. The 7 | #' *_t version uses the transposed representation where each element is a vector 8 | #' of states. The standard approach can be used when each tween has the same 9 | #' number of states and you want to control the number of point in each state 10 | #' transition. The latter is useful when each tween consists of different 11 | #' numbers of states and/or you want to specify the total number of points for 12 | #' each tween. 13 | #' 14 | #' @section Difference Between `tween_numeric` and `approx()`: 15 | #' `tween_numeric` (and `tween_numeric_t`) is superficially equivalent to 16 | #' [stats::approx()], but there are differences. 17 | #' [stats::approx()] will create evenly spaced points, at the expense 18 | #' of not including the actual points in the input, while the reverse is true 19 | #' for `tween_numeric`. Apart from that `tween_numeric` of course supports easing 20 | #' functions and is vectorized. 21 | #' 22 | #' @details 23 | #' `tween` and `tween_t` are wrappers around the other functions that tries to guess 24 | #' the type of input data and choose the appropriate tween function. Unless you 25 | #' have data that could be understood as a colour but is in fact a character 26 | #' vector it should be safe to use these wrappers. It is probably safer and more 27 | #' verbose to use the explicit functions within package code as they circumvent 28 | #' the type inference and checks whether the input data matches the tween 29 | #' function. 30 | #' 31 | #' `tween_numeric` will provide a linear interpolation between the points based on 32 | #' the sequence returned by the easing function. `tween_date` and `tween_datetime` 33 | #' converts to numeric, produces the tweening, and converts back again. 34 | #' `tween_colour` converts colours into Lab and does the interpolation there, 35 | #' converting back to sRGB after the tweening is done. `tween_constant` is a 36 | #' catchall that converts the input into character and interpolates by switching 37 | #' between states halfway through the transition. 38 | #' 39 | #' The meaning of the `n` and `ease` arguments differs somewhat 40 | #' between the standard and *_t versions of the functions. In the standard 41 | #' function `n` and `ease` refers to the length and easing function of 42 | #' each transition, being recycled if necessary to `length(data) - 1`. In 43 | #' the *_t functions `n` and `ease` refers to the total length of each 44 | #' tween and the easing function to be applied to all transition for each tween. 45 | #' The will both be recycled to `length(data)`. 46 | #' 47 | #' @param data A list of vectors or a single vector. In the standard functions 48 | #' each element in the list must be of equal length; for the *_t functions 49 | #' lengths can differ. If a single vector is used it will be eqivalent to using 50 | #' `as.list(data)` for the standard functions and `list(data)` for the 51 | #' *_t functions. 52 | #' 53 | #' @param n The number of elements per transition or tween. See details 54 | #' 55 | #' @param ease The easing function to use for each transition or tween. See 56 | #' details. Defaults to `'linear'` 57 | #' 58 | #' @return A list with an element for each tween. That means that the length of 59 | #' the return is equal to the length of the elements in `data` for the 60 | #' standard functions and equal to the length of `data` for the *_t 61 | #' functions. 62 | #' 63 | #' @examples 64 | #' tween_numeric(list(1:3, 10:8, c(20, 60, 30)), 10) 65 | #' 66 | #' tween_colour_t(list(colours()[1:4], colours()[1:2], colours()[25:100]), 100) 67 | #' 68 | #' @export 69 | #' 70 | tween <- function(data, n, ease = 'linear') { 71 | type <- guessType(data) 72 | switch( 73 | type, 74 | numeric = tween_numeric(data, n, ease), 75 | date = tween_date(data, n, ease), 76 | datetime = tween_datetime(data, n, ease), 77 | colour = tween_colour(data, n, ease), 78 | tween_constant_t(data, n, ease) 79 | ) 80 | } 81 | #' @rdname tween 82 | #' @export 83 | tween_t <- function(data, n, ease = 'linear') { 84 | type <- guessType(data) 85 | switch( 86 | type, 87 | numeric = tween_numeric_t(data, n, ease), 88 | date = tween_date_t(data, n, ease), 89 | datetime = tween_datetime_t(data, n, ease), 90 | colour = tween_colour_t(data, n, ease), 91 | tween_constant_t(data, n, ease) 92 | ) 93 | } 94 | guessType <- function(data) { 95 | data <- unlist(data) 96 | col_classes(list(data)) 97 | } 98 | -------------------------------------------------------------------------------- /R/tween_along.R: -------------------------------------------------------------------------------- 1 | #' Interpolate data along a given dimension 2 | #' 3 | #' This tween takes groups of rows along with the time for each row and 4 | #' calculates the exact value at each at each frame. Further it allows for 5 | #' keeping the subsequent raw data from previous frame as well as letting the 6 | #' final row linger beyond its time. It especially useful for data that should 7 | #' be visualised as lines that are drawn along the x-axis, but can of course 8 | #' also be used for other dimensions as well (even dimensions not corresponding 9 | #' to any axis). 10 | #' 11 | #' @inheritParams tween_components 12 | #' @param along The "time" point for each row 13 | #' @param history Should earlier datapoints be kept in subsequent frames 14 | #' @param keep_last Should the last point of each id be kept beyond its time 15 | #' 16 | #' @return A data.frame with the same columns as `.data` along with `.id` giving 17 | #' the component id, `.phase` giving the state of each component in each frame, 18 | #' and `.frame` giving the frame membership of each row. 19 | #' 20 | #' @family data.frame tween 21 | #' 22 | #' @importFrom rlang enquo quo_is_null eval_tidy is_integerish 23 | #' @export 24 | tween_along <- function(.data, ease, nframes, along, id = NULL, range = NULL, history = TRUE, keep_last = FALSE) { 25 | along <- enquo(along) 26 | along <- as.numeric(eval_tidy(along, .data)) 27 | id <- enquo(id) 28 | id <- if (quo_is_null(id)) rep(1, nrow(.data)) else eval_tidy(id, .data) 29 | .data <- .complete_along(.data, along, id) 30 | 31 | if (length(ease) == 1) ease <- rep(ease, ncol(.data) - 3) 32 | if (length(ease) == ncol(.data) - 3) { 33 | ease <- c(ease, 'linear', 'linear', 'linear') # To account for .phase and .id columns 34 | } else { 35 | stop('Ease must be either a single string or one for each column', call. = FALSE) 36 | } 37 | if (!is_integerish(nframes, 1L)) { 38 | stop("`nframes` must be a single count", call. = FALSE) 39 | } 40 | 41 | timerange <- if (is.null(range)) range(.data$.time) else range 42 | timerange <- as.numeric(timerange) 43 | if (diff(timerange) == 0) stop('range must have a length', call. = FALSE) 44 | framelength <- diff(timerange) / (nframes - 1) 45 | frame <- 1 + (nframes - 1) * (.data$.time - timerange[1]) / diff(timerange) 46 | frames <- seq_len(nframes) 47 | groups <- unique(.data$.id) 48 | group <- match(.data$.id, groups) 49 | colClasses <- col_classes(.data) 50 | tweendata <- lapply(seq_along(.data), function(i) { 51 | d <- .data[[i]] 52 | e <- ease[i] 53 | switch( 54 | colClasses[i], 55 | numeric = interpolate_numeric_along(d, group, frame, frames, e, history, keep_last), 56 | logical = interpolate_logical_along(d, group, frame, frames, e, history, keep_last), 57 | factor = interpolate_factor_along(d, group, frame, frames, e, history, keep_last), 58 | character = interpolate_character_along(d, group, frame, frames, e, history, keep_last), 59 | colour = interpolate_colour_along(d, group, frame, frames, e, history, keep_last), 60 | date = interpolate_date_along(d, group, frame, frames, e, history, keep_last), 61 | datetime = interpolate_datetime_along(d, group, frame, frames, e, history, keep_last), 62 | constant = interpolate_constant_along(d, group, frame, frames, e, history, keep_last), 63 | numlist = interpolate_numlist_along(d, group, frame, frames, e, history, keep_last), 64 | list = interpolate_list_along(d, group, frame, frames, e, history, keep_last), 65 | phase = get_phase_along(group, frame, frames, history, keep_last) 66 | ) 67 | }) 68 | tweenInfo <- tweendata[[1]][, c('group', 'frame')] 69 | tweendata <- lapply(tweendata, `[[`, i = 'data') 70 | tweendata <- structure(tweendata, names = names(.data), row.names = .set_row_names(length(tweendata[[1]])), class = 'data.frame') 71 | tweendata$.frame <- tweenInfo$frame 72 | tweendata$.id <- tweenInfo$group 73 | tweendata$.time <- unsplit( 74 | lapply(split(tweendata$.time, tweendata$.frame), function(x) rlang::rep_along(x, max(x))), 75 | tweendata$.frame 76 | ) 77 | attr(tweendata, 'framelength') <- framelength 78 | tweendata[order(tweendata$.frame, tweendata$.id), , drop = FALSE] 79 | } 80 | 81 | .complete_along <- function(data, along, id) { 82 | if (length(along) != nrow(data) || length(id) != nrow(data)) { 83 | stop('along and id must be the same length as the number of rows in data', call. = FALSE) 84 | } 85 | data <- data[order(id), , drop = FALSE] 86 | along <- along[order(id)] 87 | id <- sort(id) 88 | data$.id <- id 89 | data$.phase <- 'raw' 90 | data$.time <- along 91 | data 92 | } 93 | -------------------------------------------------------------------------------- /R/tween_appear.R: -------------------------------------------------------------------------------- 1 | #' Tween a data.frame of appearances 2 | #' 3 | #' This function is intended for use when you have a data.frame of events at 4 | #' different time points. This could be the appearance of an observation for 5 | #' example. This function replicates your data `nframes` times and 6 | #' calculates the duration of each frame. At each frame each row is 7 | #' assigned an age based on the progression of frames and the entry point of in 8 | #' time for that row. A negative age means that the row has not appeared yet. 9 | #' 10 | #' @param data A data.frame to tween 11 | #' 12 | #' @param time The name of the column that holds the time dimension. This does 13 | #' not need to hold time data in the strictest sence - any numerical type will 14 | #' do 15 | #' 16 | #' @param timerange The range of time to create the tween for. If missing it 17 | #' will defaults to the range of the time column 18 | #' 19 | #' @param nframes The number of frames to create for the tween. If missing it 20 | #' will create a frame for each full unit in `timerange` (e.g. 21 | #' `timerange = c(1, 10)` will give `nframes = 10`) 22 | #' 23 | #' @return A data.frame as `data` but repeated `nframes` times and 24 | #' with the additional columns `.age` and `.frame` 25 | #' 26 | #' @family data.frame tween 27 | #' 28 | #' @importFrom vctrs vec_rbind 29 | #' 30 | #' @examples 31 | #' data <- data.frame( 32 | #' x = rnorm(100), 33 | #' y = rnorm(100), 34 | #' time = sample(50, 100, replace = TRUE) 35 | #' ) 36 | #' 37 | #' data <- tween_appear(data, 'time', nframes = 200) 38 | #' 39 | #' @export 40 | #' 41 | tween_appear <- function(data, time, timerange, nframes) { 42 | if (missing(timerange) || is.null(timerange)) { 43 | timerange <- range(data[[time]]) 44 | } 45 | if (missing(nframes) || is.null(nframes)) { 46 | nframes <- ceiling(diff(timerange) + 1) 47 | } 48 | framelength <- diff(timerange) / nframes 49 | frametimes <- seq(timerange[1], timerange[2], length.out = nframes) 50 | 51 | tweendata <- lapply(seq_along(frametimes), function(i) { 52 | data$.age <- frametimes[i] - data[[time]] 53 | data$.frame <- i 54 | data 55 | }) 56 | tweendata <- do.call(vec_rbind, tweendata) 57 | attr(tweendata, 'framelength') <- framelength 58 | tweendata 59 | } 60 | -------------------------------------------------------------------------------- /R/tween_at.R: -------------------------------------------------------------------------------- 1 | #' Get a specific position between two states 2 | #' 3 | #' This tween allows you to query a specific postion between two states rather 4 | #' than generate evenly spaced states. It can work with either data.frames or 5 | #' single vectors and each row/element can have its own position and easing. 6 | #' 7 | #' @param from,to A data.frame or vector of the same type. If either is of 8 | #' length/nrow 1 it will get repeated to match the length of the other 9 | #' @param at A numeric between 0 and 1 recycled to match the nrow/length of 10 | #' `from` 11 | #' @param ease A character vector giving valid easing functions. Recycled to 12 | #' match the ncol of `from` 13 | #' 14 | #' @return If `from`/`to` is a data.frame then a data.frame with the same 15 | #' columns. If `from`/`to` is a vector then a vector. 16 | #' 17 | #' @export 18 | #' 19 | #' @examples 20 | #' tween_at(mtcars[1:6, ], mtcars[6:1, ], runif(6), 'cubic-in-out') 21 | #' 22 | tween_at <- function(from, to, at, ease) { 23 | single_vec <- !is.data.frame(from) 24 | if (single_vec) { 25 | if (length(from) == 0 || length(to) == 0) return(to[integer()]) 26 | from_df <- data.frame(data = rep(NA, length(from))) 27 | to_df <- data.frame(data = rep(NA, length(to))) 28 | from_df$data <- from 29 | to_df$data <- to 30 | from <- from_df 31 | to <- to_df 32 | } else { 33 | if (nrow(from) == 0 || nrow(to) == 0) return(to[integer(), ]) 34 | } 35 | if (length(at) == 0) stop('at must have length > 0', call. = FALSE) 36 | if (nrow(from) == 1) from <- from[rep(1, nrow(to)), , drop = FALSE] 37 | if (nrow(to) == 1) to <- to[rep(1, nrow(from)), , drop = FALSE] 38 | if (nrow(from) != nrow(to)) { 39 | stop('from and to must be same length', call. = FALSE) 40 | } 41 | if (any(names(from) != names(to))) { 42 | stop('`from` and `to` must have the same columns', call. = FALSE) 43 | } 44 | at <- rep(at, length.out = nrow(from)) 45 | ease <- rep(ease, length.out = ncol(from)) 46 | classes <- col_classes(from) 47 | to_classes <- col_classes(to) 48 | mismatch <- to_classes != classes 49 | for (i in which(mismatch)) { 50 | all_na_to <- all(is.na(to[[i]])) 51 | all_na_from <- all(is.na(from[[i]])) 52 | if (all_na_from) { 53 | storage.mode(from[[i]]) <- storage.mode(to[[i]]) 54 | } else if (all_na_to) { 55 | storage.mode(to[[i]]) <- storage.mode(from[[i]]) 56 | } else { 57 | stop('The ', names(to)[i], 'column differs in type between the two inputs', call. = FALSE) 58 | } 59 | } 60 | tweendata <- lapply(seq_along(classes), function(i) { 61 | switch( 62 | classes[i], 63 | numeric = interpolate_numeric_at(from[[i]], to[[i]], at, ease[i]), 64 | logical = interpolate_logical_at(from[[i]], to[[i]], at, ease[i]), 65 | factor = interpolate_factor_at(from[[i]], to[[i]], at, ease[i]), 66 | character = interpolate_character_at(from[[i]], to[[i]], at, ease[i]), 67 | colour = interpolate_colour_at(from[[i]], to[[i]], at, ease[i]), 68 | date = interpolate_date_at(from[[i]], to[[i]], at, ease[i]), 69 | datetime = interpolate_datetime_at(from[[i]], to[[i]], at, ease[i]), 70 | constant = interpolate_constant_at(from[[i]], to[[i]], at, ease[i]), 71 | numlist = interpolate_numlist_at(from[[i]], to[[i]], at, ease[i]), 72 | list = interpolate_list_at(from[[i]], to[[i]], at, ease[i]), 73 | phase = ifelse(from[[i]] == "enter", "enter", ifelse(to[[i]] == "exit", "exit", "transition")) 74 | ) 75 | }) 76 | if (single_vec) return(tweendata[[1]]) 77 | 78 | structure(tweendata, names = names(from), row.names = .set_row_names(length(tweendata[[1]])), class = 'data.frame') 79 | } 80 | #' Get several specific position between two states 81 | #' 82 | #' This tween is a variation of [tween_at()]. Instead of having `at` refer to 83 | #' the tweening position of each row, each `at` will interpolate the full data 84 | #' at that position. 85 | #' 86 | #' @param from,to A data.frame or vector of the same type. If either is of 87 | #' length/nrow 1 it will get repeated to match the length of the other 88 | #' @param at A numeric vector with values between 0 and 1. 89 | #' @param ease A character vector giving valid easing functions. Recycled to 90 | #' match the ncol of `from` 91 | #' 92 | #' @return If `from`/`to` is a data.frame then a data.frame with the same 93 | #' columns. If `from`/`to` is a vector then a vector. 94 | #' 95 | #' @export 96 | #' 97 | #' @examples 98 | #' tween_at_t(mtcars[1:6, ], mtcars[6:1, ], runif(3), 'cubic-in-out') 99 | #' 100 | tween_at_t <- function(from, to, at, ease) { 101 | single_vec <- !is.data.frame(from) 102 | if (single_vec) { 103 | if (length(from) == 0 || length(to) == 0) return(to[integer()]) 104 | from_df <- data.frame(data = rep(NA, length(from))) 105 | to_df <- data.frame(data = rep(NA, length(to))) 106 | from_df$data <- from 107 | to_df$data <- to 108 | from <- from_df 109 | to <- to_df 110 | } else { 111 | if (nrow(from) == 0 || nrow(to) == 0) return(to[integer(), ]) 112 | } 113 | if (length(at) == 0) stop('at must have length > 0', call. = FALSE) 114 | if (nrow(from) == 1) from <- from[rep(1, nrow(to)), , drop = FALSE] 115 | if (nrow(to) == 1) to <- to[rep(1, nrow(from)), , drop = FALSE] 116 | if (nrow(from) != nrow(to)) { 117 | stop('from and to must be same length', call. = FALSE) 118 | } 119 | if (any(names(from) != names(to))) { 120 | stop('`from` and `to` must have the same columns', call. = FALSE) 121 | } 122 | ease <- rep(ease, length.out = ncol(from)) 123 | classes <- col_classes(from) 124 | to_classes <- col_classes(to) 125 | mismatch <- to_classes != classes 126 | for (i in which(mismatch)) { 127 | all_na_to <- all(is.na(to[[i]])) 128 | all_na_from <- all(is.na(from[[i]])) 129 | if (all_na_from) { 130 | storage.mode(from[[i]]) <- storage.mode(to[[i]]) 131 | } else if (all_na_to) { 132 | storage.mode(to[[i]]) <- storage.mode(from[[i]]) 133 | } else { 134 | stop('The ', names(to)[i], 'column differs in type between the two inputs', call. = FALSE) 135 | } 136 | } 137 | tweendata <- lapply(seq_along(classes), function(i) { 138 | switch( 139 | classes[i], 140 | numeric = interpolate_numeric_at_t(from[[i]], to[[i]], at, ease[i]), 141 | logical = interpolate_logical_at_t(from[[i]], to[[i]], at, ease[i]), 142 | factor = interpolate_factor_at_t(from[[i]], to[[i]], at, ease[i]), 143 | character = interpolate_character_at_t(from[[i]], to[[i]], at, ease[i]), 144 | colour = interpolate_colour_at_t(from[[i]], to[[i]], at, ease[i]), 145 | date = interpolate_date_at_t(from[[i]], to[[i]], at, ease[i]), 146 | datetime = interpolate_datetime_at_t(from[[i]], to[[i]], at, ease[i]), 147 | constant = interpolate_constant_at_t(from[[i]], to[[i]], at, ease[i]), 148 | numlist = interpolate_numlist_at_t(from[[i]], to[[i]], at, ease[i]), 149 | list = interpolate_list_at_t(from[[i]], to[[i]], at, ease[i]), 150 | phase = interpolate_phase_at_t(from[[i]], to[[i]], at) 151 | ) 152 | }) 153 | if (single_vec) return(tweendata[[1]]) 154 | 155 | tweendata$.frame <- rep(seq_along(at), each = length(tweendata[[1]])) 156 | 157 | structure(tweendata, names = names(from), row.names = .set_row_names(length(tweendata[[1]])), class = 'data.frame') 158 | } 159 | 160 | interpolate_phase_at_t <- function(from, to, at) { 161 | phase <- rep(ifelse(from == "enter", "enter", ifelse(to == "exit", "exit", "transition")), times = length(at)) 162 | start_or_end <- at %in% c(0, 1) 163 | if (any(start_or_end)) { 164 | start_or_end <- rep(start_or_end, each = length(from)) 165 | phase[phase == "transition" & start_or_end] <- "raw" 166 | } 167 | phase 168 | } 169 | -------------------------------------------------------------------------------- /R/tween_colour.R: -------------------------------------------------------------------------------- 1 | #' @rdname tween 2 | #' 3 | #' @export 4 | tween_colour <- function(data, n, ease = 'linear') { 5 | data <- as.list(data) 6 | prepData <- prepareTween(data, n, ease) 7 | tweendata <- do.call(interpolate_colour_state, prepData) 8 | unname(split(tweendata, 9 | rep(seq_along(data[[1]]), length.out = length(tweendata)))) 10 | } 11 | #' @rdname tween 12 | #' 13 | #' @export 14 | tween_color <- tween_colour 15 | 16 | #' @rdname tween 17 | #' 18 | #' @export 19 | tween_colour_t <- function(data, n, ease = 'linear') { 20 | if (!is.list(data)) { 21 | data <- list(data) 22 | } 23 | prepData <- prepareTweenTranspose(data, n, ease) 24 | tweendata <- do.call(interpolate_colour_state, prepData) 25 | unname(split(tweendata, 26 | rep(seq_along(data), rep(n, length.out = length(data))))) 27 | } 28 | #' @rdname tween 29 | #' 30 | #' @export 31 | tween_color_t <- tween_colour_t 32 | -------------------------------------------------------------------------------- /R/tween_components.R: -------------------------------------------------------------------------------- 1 | #' Interpolate individual component 2 | #' 3 | #' This function is much like [tween_elements()] but with a slightly different 4 | #' syntax and support for many of the newer features such as enter/exits and 5 | #' tween phase identification. Furthermore it uses tidy evaluation for time and 6 | #' id, making it easier to change these on the fly. The biggest change in terms 7 | #' of functionality compared to `tween_elements()` is that the easing function 8 | #' is now given per column and not per row. If different easing functions are 9 | #' needed for each transition then `tween_elements()` is needed. 10 | #' 11 | #' @inheritParams tween_state 12 | #' 13 | #' @param .data A data.frame with components at different stages 14 | #' 15 | #' @param time An unquoted expression giving the timepoint for the different 16 | #' stages of the components. Will be evaluated in the context of `.data` so can 17 | #' refer to a column from that 18 | #' 19 | #' @param id An unquoted expression giving the component id for each row. Will 20 | #' be evaluated in the context of `.data` so can refer to a column from that 21 | #' 22 | #' @param range The range of time points to include in the tween. If `NULL` it 23 | #' will use the range of `time` 24 | #' 25 | #' @param enter_length,exit_length The lenght of the opening and closing 26 | #' transitions if `enter` and/or `exit` is given. Measured in the same units as 27 | #' `time` 28 | #' 29 | #' @return A data.frame with the same columns as `.data` along with `.id` giving 30 | #' the component id, `.phase` giving the state of each component in each frame, 31 | #' and `.frame` giving the frame membership of each row. 32 | #' 33 | #' @family data.frame tween 34 | #' 35 | #' @examples 36 | #' 37 | #' from_zero <- function(x) {x$x <- 0; x} 38 | #' 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 | #' id = c(1, 1, 1, 2, 2, 2) 44 | #' ) 45 | #' 46 | #' data <- tween_components(data, 'cubic-in-out', nframes = 100, time = time, 47 | #' id = id, enter = from_zero, enter_length = 4) 48 | #' 49 | #' @export 50 | #' @importFrom rlang enquo eval_tidy 51 | #' 52 | tween_components <- function(.data, ease, nframes, time, id = NULL, range = NULL, enter = NULL, exit = NULL, enter_length = 0, exit_length = 0) { 53 | time <- enquo(time) 54 | time <- eval_tidy(time, .data) 55 | id <- enquo(id) 56 | id <- if (quo_is_null(id)) rep(1, nrow(.data)) else eval_tidy(id, .data) 57 | if (is.null(enter_length)) enter_length <- 0 58 | if (is.null(exit_length)) exit_length <- 0 59 | .data <- .complete_components(.data, time, id, enter, exit, enter_length, exit_length) 60 | 61 | .tween_individuals(.data, ease, nframes, range) 62 | } 63 | 64 | .tween_individuals <- function(.data, ease, nframes, range) { 65 | if (nframes == 0) return(.data[integer(), , drop = FALSE]) 66 | if (nrow(.data) == 0) return(.data) 67 | if (length(ease) == 1) ease <- rep(ease, ncol(.data) - 3) 68 | if (length(ease) == ncol(.data) - 3) { 69 | ease <- c(ease, 'linear', 'linear', 'linear') # To account for .phase and .id columns 70 | } else { 71 | stop('Ease must be either a single string or one for each column', call. = FALSE) 72 | } 73 | if (!is_integerish(nframes, 1L)) { 74 | stop("`nframes` must be a single count", call. = FALSE) 75 | } 76 | 77 | timerange <- if (is.null(range)) range(.data$.time) else range 78 | if (diff(timerange) == 0) stop('range must have a length', call. = FALSE) 79 | framelength <- diff(timerange) / (nframes - 1) 80 | .data <- .data[order(.data$.id, .data$.time), , drop = FALSE] 81 | frame <- round((.data$.time - min(timerange[1])) / framelength) + 1 82 | .data$.time <- NULL 83 | colClasses <- col_classes(.data) 84 | tweendata <- lapply(seq_along(.data), function(i) { 85 | d <- .data[[i]] 86 | e <- rep(ease[i], length(d)) 87 | switch( 88 | colClasses[i], 89 | numeric = interpolate_numeric_element(d, .data$.id, frame, e), 90 | logical = interpolate_logical_element(d, .data$.id, frame, e), 91 | factor = interpolate_factor_element(d, .data$.id, frame, e), 92 | character = interpolate_character_element(d, .data$.id, frame, e), 93 | colour = interpolate_colour_element(d, .data$.id, frame, e), 94 | date = interpolate_date_element(d, .data$.id, frame, e), 95 | datetime = interpolate_datetime_element(d, .data$.id, frame, e), 96 | constant = interpolate_constant_element(d, .data$.id, frame, e), 97 | numlist = interpolate_numlist_element(d, .data$.id, frame, e), 98 | list = interpolate_list_element(d, .data$.id, frame, e), 99 | phase = get_phase_element(d, .data$.id, frame, e) 100 | ) 101 | }) 102 | tweenInfo <- tweendata[[1]][, c('group', 'frame')] 103 | tweendata <- lapply(tweendata, `[[`, i = 'data') 104 | tweendata <- structure(tweendata, names = names(.data), row.names = .set_row_names(length(tweendata[[1]])), class = 'data.frame') 105 | tweendata$.frame <- tweenInfo$frame 106 | tweendata$.id <- tweenInfo$group 107 | tweendata <- tweendata[tweendata$.frame >= 1 & tweendata$.frame <= nframes, , drop = FALSE] 108 | attr(tweendata, 'framelength') <- framelength 109 | tweendata[order(tweendata$.frame, tweendata$.id), , drop = FALSE] 110 | } 111 | 112 | #' @importFrom vctrs vec_rbind 113 | #' @importFrom rlang as_function 114 | .complete_components <- function(data, time, id, enter, exit, enter_length, exit_length) { 115 | if (length(id) != nrow(data) || length(time) != nrow(data)) { 116 | stop('id and time must have the same length as the number of rows in data', call. = FALSE) 117 | } 118 | data$.id <- id 119 | data$.phase <- rep('raw', nrow(data)) 120 | data$.time <- time 121 | if (any(!is.null(enter), !is.null(exit))) { 122 | time_ord <- order(time) 123 | if (!is.null(enter)) { 124 | enter_data <- as_function(enter)(data[time_ord[!duplicated(id[time_ord])], , drop = FALSE]) 125 | enter_data$.phase <- 'enter' 126 | enter_data$.time <- enter_data$.time - enter_length 127 | } else { 128 | enter_data <- data[0, , drop = FALSE] 129 | } 130 | if (!is.null(exit)) { 131 | exit_data <- as_function(exit)(data[time_ord[!duplicated(id[time_ord], fromLast = TRUE)], , drop = FALSE]) 132 | exit_data$.phase <- 'exit' 133 | exit_data$.time <- exit_data$.time + exit_length 134 | } else { 135 | exit_data <- data[0, , drop = FALSE] 136 | } 137 | data <- vec_rbind(enter_data, data, exit_data) 138 | } 139 | data 140 | } 141 | -------------------------------------------------------------------------------- /R/tween_constant.R: -------------------------------------------------------------------------------- 1 | #' @rdname tween 2 | #' 3 | #' @export 4 | tween_constant <- function(data, n, ease = 'linear') { 5 | data <- as.list(data) 6 | data <- lapply(data, as.character) 7 | prepData <- prepareTween(data, n, ease) 8 | tweendata <- do.call(interpolate_character_state, prepData) 9 | unname(split(tweendata, 10 | rep(seq_along(data[[1]]), length.out = length(tweendata)))) 11 | } 12 | 13 | #' @rdname tween 14 | #' 15 | #' @export 16 | tween_constant_t <- function(data, n, ease = 'linear') { 17 | if (!is.list(data)) { 18 | data <- list(data) 19 | } 20 | data <- lapply(data, as.character) 21 | prepData <- prepareTweenTranspose(data, n, ease) 22 | tweendata <- do.call(interpolate_character_state, prepData) 23 | unname(split(tweendata, 24 | rep(seq_along(data), rep(n, length.out = length(data))))) 25 | } 26 | -------------------------------------------------------------------------------- /R/tween_date.R: -------------------------------------------------------------------------------- 1 | #' @rdname tween 2 | #' 3 | #' @export 4 | tween_date <- function(data, n, ease = 'linear') { 5 | data <- as.list(data) 6 | prepData <- prepareTween(data, n, ease) 7 | if (!all(sapply(prepData$data, inherits, what = 'Date'))) { 8 | stop('data must consist of Date elements') 9 | } 10 | tweendata <- do.call(interpolate_date_state, prepData) 11 | unname(split(tweendata, 12 | rep(seq_along(data[[1]]), length.out = length(tweendata)))) 13 | } 14 | 15 | #' @rdname tween 16 | #' 17 | #' @export 18 | tween_date_t <- function(data, n, ease = 'linear') { 19 | if (!is.list(data)) { 20 | data <- list(data) 21 | } 22 | prepData <- prepareTweenTranspose(data, n, ease) 23 | if (!all(sapply(prepData$data, inherits, what = 'Date'))) { 24 | stop('data must consist of Date elements') 25 | } 26 | tweendata <- do.call(interpolate_date_state, prepData) 27 | unname(split(tweendata, 28 | rep(seq_along(data), rep(n, length.out = length(data))))) 29 | } 30 | -------------------------------------------------------------------------------- /R/tween_datetime.R: -------------------------------------------------------------------------------- 1 | #' @rdname tween 2 | #' 3 | #' @export 4 | tween_datetime <- function(data, n, ease = 'linear') { 5 | data <- as.list(data) 6 | prepData <- prepareTween(data, n, ease) 7 | if (!all(sapply(prepData$data, inherits, what = 'POSIXt'))) { 8 | stop('data must consist of POSIXt elements') 9 | } 10 | tweendata <- do.call(interpolate_datetime_state, prepData) 11 | unname(split(tweendata, 12 | rep(seq_along(data[[1]]), length.out = length(tweendata)))) 13 | } 14 | 15 | #' @rdname tween 16 | #' 17 | #' @export 18 | tween_datetime_t <- function(data, n, ease = 'linear') { 19 | if (!is.list(data)) { 20 | data <- list(data) 21 | } 22 | prepData <- prepareTweenTranspose(data, n, ease) 23 | if (!all(sapply(prepData$data, inherits, what = 'POSIXt'))) { 24 | stop('data must consist of POSIXt elements') 25 | } 26 | tweendata <- do.call(interpolate_datetime_state, prepData) 27 | unname(split(tweendata, 28 | rep(seq_along(data), rep(n, length.out = length(data))))) 29 | } 30 | -------------------------------------------------------------------------------- /R/tween_elements.R: -------------------------------------------------------------------------------- 1 | #' Create frames based on individual element states 2 | #' 3 | #' This function creates tweens for each observation individually, in cases 4 | #' where the data doesn't pass through collective states but consists of fully 5 | #' independent transitions. Each observation is identified by an id and each 6 | #' state must have a time associated with it. 7 | #' 8 | #' @param data A data.frame consisting at least of a column giving the 9 | #' observation id, a column giving timepoints for each state and a column giving 10 | #' the easing to apply when transitioning away from the state. 11 | #' 12 | #' @param time The name of the column holding timepoints 13 | #' 14 | #' @param group The name of the column holding the observation id 15 | #' 16 | #' @param ease The name of the column holding the easing function name 17 | #' 18 | #' @param timerange The range of time to span. If missing it will default to 19 | #' \code{range(data[[time]])} 20 | #' 21 | #' @param nframes The number of frames to generate. If missing it will default 22 | #' to `ceiling(diff(timerange) + 1)` (At least one frame for each 23 | #' individual timepoint) 24 | #' 25 | #' @return A data.frame with the same columns as `data` except for the 26 | #' group and ease columns, but replicated `nframes` times. Two additional 27 | #' columns called `.frame` and `.group` will be added giving the frame 28 | #' number and observation id for each row. 29 | #' 30 | #' @family data.frame tween 31 | #' 32 | #' @examples 33 | #' data <- data.frame( 34 | #' x = c(1, 2, 2, 1, 2, 2), 35 | #' y = c(1, 2, 2, 2, 1, 1), 36 | #' time = c(1, 4, 10, 4, 8, 10), 37 | #' group = c(1, 1, 1, 2, 2, 2), 38 | #' ease = rep('cubic-in-out', 6) 39 | #' ) 40 | #' 41 | #' data <- tween_elements(data, 'time', 'group', 'ease', nframes = 100) 42 | #' 43 | #' @export 44 | #' 45 | tween_elements <- function(data, time, group, ease, timerange, nframes) { 46 | if (!all(data[[ease]] %in% validEase)) { 47 | stop("All names given in the easing column must be valid easers") 48 | } 49 | 50 | if (missing(timerange) || is.null(timerange)) { 51 | timerange <- range(data[[time]]) 52 | } 53 | if (missing(nframes) || is.null(nframes)) { 54 | nframes <- ceiling(diff(timerange) + 1) 55 | } 56 | framelength <- diff(timerange) / nframes 57 | specialCols <- c(group, ease) 58 | data <- data[order(data[[group]], data[[time]]), ] 59 | groups <- unique(data[[group]]) 60 | group <- match(data[[group]], groups) 61 | frame <- round((data[[time]] - timerange[1]) / framelength) 62 | ease <- as.character(data[[ease]]) 63 | data <- data[, !names(data) %in% specialCols, drop = FALSE] 64 | 65 | colClasses <- col_classes(data) 66 | tweendata <- lapply(seq_along(data), function(i) { 67 | d <- data[[i]] 68 | switch( 69 | colClasses[i], 70 | numeric = interpolate_numeric_element(d, group, frame, ease), 71 | logical = interpolate_logical_element(d, group, frame, ease), 72 | factor = interpolate_factor_element(d, group, frame, ease), 73 | character = interpolate_character_element(d, group, frame, ease), 74 | colour = interpolate_colour_element(d, group, frame, ease), 75 | date = interpolate_date_element(d, group, frame, ease), 76 | datetime = interpolate_datetime_element(d, group, frame, ease), 77 | constant = interpolate_constant_element(d, group, frame, ease), 78 | numlist = interpolate_numlist_element(d, group, frame, ease), 79 | list = interpolate_list_element(d, group, frame, ease) 80 | ) 81 | }) 82 | tweenInfo <- tweendata[[1]][, c('group', 'frame')] 83 | tweendata <- as.data.frame(lapply(tweendata, `[[`, i = 'data')) 84 | names(tweendata) <- names(data) 85 | tweendata$.frame <- tweenInfo$frame 86 | tweendata$.group <- groups[tweenInfo$group] 87 | attr(tweendata, 'framelength') <- framelength 88 | tweendata[order(tweendata$.frame, tweendata$.group), ] 89 | } 90 | -------------------------------------------------------------------------------- /R/tween_events.R: -------------------------------------------------------------------------------- 1 | #' Transition in and out of events 2 | #' 3 | #' This tweening function is a more powerful version of [tween_appear()], with 4 | #' support for newer features such as enter/exits and tween phase 5 | #' identification. The tweener treats each row in the data as unique events in 6 | #' time, and creates frames with the correct events present at any given time. 7 | #' 8 | #' @param start,end The start (and potential end) of the event encoded in the 9 | #' row, as unquoted expressions. Will be evaluated in the context of `.data` so 10 | #' can refer to columns in it. If `end = NULL` the event will be without extend 11 | #' and only visible in a single frame, unless `enter` and/or `exit` is given. 12 | #' 13 | #' @inheritParams tween_components 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_missing eval_tidy 22 | #' @export 23 | #' 24 | #' @examples 25 | #' d <- data.frame( 26 | #' x = runif(20), 27 | #' y = runif(20), 28 | #' time = runif(20), 29 | #' duration = runif(20, max = 0.1) 30 | #' ) 31 | #' from_left <- function(x) { 32 | #' x$x <- -0.5 33 | #' x 34 | #' } 35 | #' to_right <- function(x) { 36 | #' x$x <- 1.5 37 | #' x 38 | #' } 39 | #' 40 | #' tween_events(d, 'cubic-in-out', 50, start = time, end = time + duration, 41 | #' enter = from_left, exit = to_right, enter_length = 0.1, 42 | #' exit_length = 0.05) 43 | #' 44 | tween_events <- function(.data, ease, nframes, start, end = NULL, range = NULL, enter = NULL, exit = NULL, enter_length = 0, exit_length = 0) { 45 | start <- enquo(start) 46 | if (quo_is_missing(start)) stop('start must be provided', call. = FALSE) 47 | start <- eval_tidy(start, .data) 48 | end <- enquo(end) 49 | end <- eval_tidy(end, .data) 50 | enter_length <- enquo(enter_length) 51 | enter_length <- eval_tidy(enter_length, .data) 52 | exit_length <- enquo(exit_length) 53 | exit_length <- eval_tidy(exit_length, .data) 54 | 55 | if (is.null(enter_length)) enter_length <- 0 56 | if (is.null(exit_length)) exit_length <- 0 57 | .data <- .complete_events(.data, start, end, enter, exit, enter_length, exit_length) 58 | 59 | .tween_individuals(.data, ease, nframes, range) 60 | } 61 | 62 | #' @importFrom vctrs vec_rbind 63 | #' @importFrom rlang as_function 64 | .complete_events <- function(data, start, end, enter, exit, enter_length, exit_length) { 65 | data$.id <- seq_len(nrow(data)) 66 | data$.phase <- rep("raw", nrow(data)) 67 | start <- rep(start, length.out = nrow(data)) 68 | if (is.null(end)) { 69 | event_end <- data[0, , drop = FALSE] 70 | end <- start[0] 71 | } else { 72 | event_end <- data 73 | end <- rep(end, length.out = nrow(data)) 74 | data$.phase <- 'static' 75 | } 76 | if (is.null(enter)) { 77 | enter_data <- data[0, , drop = FALSE] 78 | enter_time <- start[0] 79 | } else { 80 | enter_data <- as_function(enter)(data) 81 | enter_data$.phase <- 'enter' 82 | enter_time <- start - enter_length 83 | } 84 | if (is.null(exit)) { 85 | exit_data <- data[0, , drop = FALSE] 86 | exit_time <- start[0] 87 | } else { 88 | exit_data <- as_function(exit)(data) 89 | exit_data$.phase <- 'exit' 90 | exit_time <- (if (length(end) == 0) start else end) + exit_length 91 | } 92 | data <- vec_rbind(enter_data, data, event_end, exit_data) 93 | time <- c(enter_time, start, end, exit_time) 94 | data$.time <- time 95 | data 96 | } 97 | -------------------------------------------------------------------------------- /R/tween_fill.R: -------------------------------------------------------------------------------- 1 | #' Fill out missing values by interpolation 2 | #' 3 | #' This tween fills out `NA` elements (or `NULL` elements if `data` is a list) 4 | #' by interpolating between the prior and next non-missing values. 5 | #' 6 | #' @param data A data.frame or vector. 7 | #' @param ease A character vector giving valid easing functions. Recycled to 8 | #' match the ncol of `data` 9 | #' 10 | #' @return If `data` is a data.frame then a data.frame with the same 11 | #' columns. If `data` is a vector then a vector. 12 | #' 13 | #' @export 14 | #' 15 | #' @examples 16 | #' # Single vector 17 | #' tween_fill(c(1, NA, NA, NA, NA, NA, 2, 6, NA, NA, NA, -2), 'cubic-in-out') 18 | #' 19 | #' # Data frame 20 | #' tween_fill(mtcars[c(1, NA, NA, NA, NA, 4, NA, NA, NA, 10), ], 'cubic-in') 21 | #' 22 | tween_fill <- function(data, ease) { 23 | single_vec <- !is.data.frame(data) 24 | if (single_vec) { 25 | if (length(data) == 0) return(data[integer()]) 26 | data_df <- data.frame(data = rep(NA, length(data))) 27 | data_df$data <- data 28 | data <- data_df 29 | } else { 30 | if (nrow(data) == 0) return(data[integer(), ]) 31 | } 32 | ease <- rep(ease, length.out = ncol(data)) 33 | classes <- col_classes(data) 34 | tweendata <- lapply(seq_along(classes), function(i) { 35 | switch( 36 | classes[i], 37 | numeric = interpolate_numeric_fill(data[[i]], ease[i]), 38 | logical = interpolate_logical_fill(data[[i]], ease[i]), 39 | factor = interpolate_factor_fill(data[[i]], ease[i]), 40 | character = interpolate_character_fill(data[[i]], ease[i]), 41 | colour = interpolate_colour_fill(data[[i]], ease[i]), 42 | date = interpolate_date_fill(data[[i]], ease[i]), 43 | datetime = interpolate_datetime_fill(data[[i]], ease[i]), 44 | constant = interpolate_constant_fill(data[[i]], ease[i]), 45 | numlist = interpolate_numlist_fill(data[[i]], ease[i]), 46 | list = interpolate_list_fill(data[[i]], ease[i]) 47 | ) 48 | }) 49 | if (single_vec) return(tweendata[[1]]) 50 | 51 | structure(tweendata, names = names(data), row.names = .set_row_names(length(tweendata[[1]])), class = 'data.frame') 52 | } 53 | -------------------------------------------------------------------------------- /R/tween_numeric.R: -------------------------------------------------------------------------------- 1 | #' @rdname tween 2 | #' 3 | #' @export 4 | tween_numeric <- function(data, n, ease = 'linear') { 5 | data <- as.list(data) 6 | prepData <- prepareTween(data, n, ease) 7 | if (!all(sapply(prepData$data, is.numeric))) { 8 | stop('data must consist of numeric elements') 9 | } 10 | tweendata <- do.call(interpolate_numeric_state, prepData) 11 | unname(split(tweendata, 12 | rep(seq_along(data[[1]]), length.out = length(tweendata)))) 13 | } 14 | 15 | #' @rdname tween 16 | #' 17 | #' @export 18 | tween_numeric_t <- function(data, n, ease = 'linear') { 19 | if (!is.list(data)) { 20 | data <- list(data) 21 | } 22 | prepData <- prepareTweenTranspose(data, n, ease) 23 | if (!all(sapply(prepData$data, is.numeric))) { 24 | stop('data must consist of numeric elements') 25 | } 26 | tweendata <- do.call(interpolate_numeric_state, prepData) 27 | unname(split(tweendata, 28 | rep(seq_along(data), rep(n, length.out = length(data))))) 29 | } 30 | -------------------------------------------------------------------------------- /R/tween_states.R: -------------------------------------------------------------------------------- 1 | #' Tween a list of data.frames representing states 2 | #' 3 | #' This function is intended to create smooth transitions between states of 4 | #' data. States are defined as full data.frames or data.frames containing only 5 | #' the columns with change. Each state can have a defined period of pause, the 6 | #' transition length between each states can be defined as well as the easing 7 | #' function. 8 | #' 9 | #' @param 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 | #' @param tweenlength The lengths of the transitions between each state. 14 | #' 15 | #' @param statelength The length of the pause at each state. 16 | #' 17 | #' @param ease The easing functions to use for the transitions. See details. 18 | #' 19 | #' @param nframes The number of frames to generate. The actual number of frames 20 | #' might end up being higher depending on the regularity of `tweenlength` 21 | #' and `statelength`. 22 | #' 23 | #' @return A data.frame with the same columns as the first data.frame in 24 | #' `data`, but replicated `nframes` times. An additional column called 25 | #' `.frame` will be added giving the frame number. 26 | #' 27 | #' @family data.frame tween 28 | #' 29 | #' @importFrom vctrs vec_cbind 30 | #' 31 | #' @examples 32 | #' data1 <- data.frame( 33 | #' x = 1:20, 34 | #' y = 0, 35 | #' colour = 'forestgreen', 36 | #' stringsAsFactors = FALSE 37 | #' ) 38 | #' data2 <- data1 39 | #' data2$x <- 20:1 40 | #' data2$y <- 1 41 | #' 42 | #' data <- tween_states(list(data1, data2), 3, 1, 'cubic-in-out', 100) 43 | #' 44 | #' @export 45 | #' 46 | tween_states <- function(data, tweenlength, statelength, ease, nframes) { 47 | if (!(is.list(data) && all(sapply(data, is.data.frame)))) { 48 | stop('data must be a list of data.frames') 49 | } 50 | if (length(data) == 1) { 51 | stop('data must contain multiple states') 52 | } 53 | if (length(unique(sapply(data, nrow))) != 1) { 54 | stop('All elements in data must have the same number of rows') 55 | } 56 | data <- lapply(data, function(d) { 57 | d$.phase <- 'raw' 58 | d 59 | }) 60 | origNames <- names(data[[1]]) 61 | if (!is.list(ease)) ease <- as.list(ease) 62 | allNames <- unlist(lapply(data, names)) 63 | if (!all(allNames %in% origNames)) { 64 | stop('All columns must be specified in the original data.frame') 65 | } 66 | nstates <- length(data) 67 | tweenlength <- rep(tweenlength, nstates)[seq_len(nstates - 1)] 68 | statelength <- rep(statelength, nstates)[seq_len(nstates)] 69 | ease <- rep(ease, nstates)[seq_len(nstates - 1)] 70 | pauseIndex <- which(rep(c(TRUE, FALSE), length.out = 2*nstates - 1)) 71 | tweenIndex <- which(rep(c(FALSE, TRUE), length.out = 2*nstates - 1)) 72 | statesOrder <- order(c(pauseIndex, tweenIndex)) 73 | states <- data.frame( 74 | length = c(statelength, tweenlength)[statesOrder], 75 | nframes = NA_integer_, 76 | state = NA_integer_, 77 | stringsAsFactors = FALSE 78 | ) 79 | states$state <- rep(seq_len(nstates) - 1L, each = 2, length.out = nrow(states)) 80 | states$ease <- lapply(c(rep(list('constant'), nstates), ease)[statesOrder], function(e) { 81 | structure(rep(e, length.out = length(origNames)), names = origNames) 82 | }) 83 | fullLength <- sum(states$length) 84 | framelength <- fullLength/nframes 85 | states$nframes <- as.integer(round(states$length / framelength)) 86 | nframes <- sum(states$nframes) 87 | framelength <- fullLength/nframes 88 | data <- Reduce(function(l, r) { 89 | extraCols <- !names(l[[length(l)]]) %in% names(r); 90 | append(l, list(vec_cbind(r, l[[length(l)]][, extraCols]))) 91 | }, data[-1], data[1]) 92 | colClasses <- col_classes(data[[1]]) 93 | tweendata <- lapply(names(data[[1]]), function(name) { 94 | d <- lapply(data, `[[`, i = name) 95 | d_states <- states 96 | d_states$ease <- vapply(d_states$ease, `[`, character(1), i = name) 97 | switch( 98 | colClasses[name], 99 | numeric = interpolate_numeric_state(d, d_states), 100 | logical = interpolate_logical_state(d, d_states), 101 | factor = interpolate_factor_state(d, d_states), 102 | character = interpolate_character_state(d, d_states), 103 | colour = interpolate_colour_state(d, d_states), 104 | date = interpolate_date_state(d, d_states), 105 | datetime = interpolate_datetime_state(d, d_states), 106 | constant = interpolate_constant_state(d, d_states), 107 | numlist = interpolate_numlist_state(d, d_states), 108 | list = interpolate_list_state(d, d_states), 109 | phase = get_phase_state(d, d_states) 110 | ) 111 | }) 112 | tweendata <- structure(tweendata, names = names(data[[1]]), row.names = .set_row_names(length(tweendata[[1]])), class = 'data.frame') 113 | tweendata$.id <- rep(seq_len(nrow(data[[1]])), each = nframes) 114 | tweendata$.frame <- rep(seq_len(nframes), each = nrow(data[[1]])) 115 | attr(tweendata, 'framelength') <- framelength 116 | tweendata 117 | } 118 | -------------------------------------------------------------------------------- /R/tweenr_package.R: -------------------------------------------------------------------------------- 1 | #' @details 2 | #' tweenr is a small collection of functions to help you in creating 3 | #' intermediary representations of your data, i.e. interpolating states of data. 4 | #' As such it's a great match for packages such as animate and gganimate, since 5 | #' it can work directly with data.frames of data, but it also provide fast and 6 | #' efficient interpolaters for numeric, date, datetime and colour that are 7 | #' vectorized and thus more efficient to use than the build in interpolation 8 | #' functions (mainly [stats::approx()] and 9 | #' [grDevices::colorRamp()]). 10 | #' 11 | #' The main functions for data.frames are [tween_states()], 12 | #' [tween_elements()] and [tween_appear()], while the 13 | #' standard interpolaters can be found at [tween()] 14 | #' 15 | #' @useDynLib tweenr, .registration = TRUE 16 | '_PACKAGE' 17 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, echo = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | dev = 'jpeg', 13 | ffmpeg.format='gif', 14 | interval = 1/15 15 | ) 16 | library(magrittr) 17 | ``` 18 | 19 | # tweenr 20 | 21 | 22 | [![R-CMD-check](https://github.com/thomasp85/tweenr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/thomasp85/tweenr/actions/workflows/R-CMD-check.yaml) 23 | [![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) 24 | 25 | 26 | ## What is this? 27 | `tweenr` is a package for interpolating data, mainly for animations. It provides 28 | a range of functions that take data of different forms and calculate 29 | intermediary values. It supports all atomic vector types along with `factor`, 30 | `Date`, `POSIXct`, characters representing colours, and `list`. `tweenr` is used 31 | extensibly by [`gganimate`](https://github.com/thomasp85/gganimate) to create 32 | smooth animations, but can also be used by itself to prepare data for animation 33 | in another framework. 34 | 35 | ## How do I get it? 36 | `tweenr` is available on CRAN and can be installed with 37 | `install.packages('tweenr')`. In order to get the development version you can 38 | install it from github with `devtools` 39 | 40 | ```{r, eval=FALSE} 41 | #install.packages('devtools') 42 | devtools::install_github('thomasp85/tweenr') 43 | ``` 44 | 45 | ## An example 46 | Following is an example of using the pipeable `tween_state()` function with our 47 | belowed iris data: 48 | 49 | ```{r, fig.show='animate', interval=1/10, message=FALSE, cache=TRUE} 50 | library(tweenr) 51 | library(ggplot2) 52 | 53 | # Prepare the data with some extra columns 54 | iris$col <- c('firebrick', 'forestgreen', 'steelblue')[as.integer(iris$Species)] 55 | iris$size <- 4 56 | iris$alpha <- 1 57 | iris <- split(iris, iris$Species) 58 | 59 | # Here comes tweenr 60 | iris_tween <- iris$setosa %>% 61 | tween_state(iris$versicolor, ease = 'cubic-in-out', nframes = 30) %>% 62 | keep_state(10) %>% 63 | tween_state(iris$virginica, ease = 'elastic-out', nframes = 30) %>% 64 | keep_state(10) %>% 65 | tween_state(iris$setosa, ease = 'quadratic-in', nframes = 30) %>% 66 | keep_state(10) 67 | 68 | # Animate it to show the effect 69 | p_base <- ggplot() + 70 | geom_point(aes(x = Petal.Length, y = Petal.Width, alpha = alpha, colour = col, 71 | size = size)) + 72 | scale_colour_identity() + 73 | scale_alpha_identity() + 74 | scale_size_identity() + 75 | coord_cartesian(xlim = range(iris_tween$Petal.Length), 76 | ylim = range(iris_tween$Petal.Width)) 77 | iris_tween <- split(iris_tween, iris_tween$.frame) 78 | for (d in iris_tween) { 79 | p <- p_base %+% d 80 | plot(p) 81 | } 82 | ``` 83 | 84 | ## Other functions 85 | Besides the `tween_state()`/`keep_state()` combo showcased above, there are a 86 | slew of other functions meant for data in different formats 87 | 88 | **`tween_components`** takes a single data.frame, a vector of ids identifying 89 | recurrent elements, and a vector of timepoints for each row and interpolate each 90 | element between its specified time points. 91 | 92 | **`tween_events`** takes a single data.frame where each row encodes a single 93 | unique event, along with a start, and end time and expands the data across a 94 | given number of frames. 95 | 96 | **`tween_along`** takes a single data.frame along with an id and timepoint 97 | vector and calculate evenly spaced intermediary values with the possibility of 98 | keeping old values at each frame. 99 | 100 | **`tween_at`** takes two data.frames or vectors along with a numeric vector 101 | giving the interpolation point between the two data.frames to calculate. 102 | 103 | **`tween_fill`** fills missing values in a vector or data.frame by interpolating 104 | between previous and next non-missing elements 105 | 106 | ## Easing 107 | In order to get smooth transitions you'd often want a non-linear interpolation. 108 | This can be achieved by using an easing function to translate the equidistant 109 | interpolation points into new ones. `tweenr` has support for a wide range of 110 | different easing functions, all of which can be previewed using `display_ease()` 111 | as here where the popular *cubic-in-out* is shown: 112 | 113 | ```{r, dev='png'} 114 | tweenr::display_ease('cubic-in-out') 115 | ``` 116 | 117 | ## Spatial interpolations 118 | The purpose of `tweenr` is to interpolate values independently. If paths and 119 | polygons needs to be transitioned the 120 | [`transformr`](https://github.com/thomasp85/transformr) package should be used 121 | as it expands tweenr into the spatial realm 122 | 123 | ```{r, echo=FALSE} 124 | path <- dirname(knitr::fig_path()) 125 | animations <- list.files(path, pattern = 'README-.*.gif') 126 | for (file in animations) { 127 | files <- list.files(path, pattern = paste0(sub('.gif', '', file), '.*jpeg'), full.names = TRUE) 128 | unlink(files) 129 | } 130 | ``` 131 | 132 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # tweenr 5 | 6 | 7 | 8 | [![R-CMD-check](https://github.com/thomasp85/tweenr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/thomasp85/tweenr/actions/workflows/R-CMD-check.yaml) 9 | [![CRAN_Release_Badge](http://www.r-pkg.org/badges/version-ago/tweenr)](https://CRAN.R-project.org/package=tweenr) 10 | [![CRAN_Download_Badge](http://cranlogs.r-pkg.org/badges/tweenr)](https://CRAN.R-project.org/package=tweenr) 11 | 12 | 13 | ## What is this? 14 | 15 | `tweenr` is a package for interpolating data, mainly for animations. It 16 | provides a range of functions that take data of different forms and 17 | calculate intermediary values. It supports all atomic vector types along 18 | with `factor`, `Date`, `POSIXct`, characters representing colours, and 19 | `list`. `tweenr` is used extensibly by 20 | [`gganimate`](https://github.com/thomasp85/gganimate) to create smooth 21 | animations, but can also be used by itself to prepare data for animation 22 | in another framework. 23 | 24 | ## How do I get it? 25 | 26 | `tweenr` is available on CRAN and can be installed with 27 | `install.packages('tweenr')`. In order to get the development version 28 | you can install it from github with `devtools` 29 | 30 | ``` r 31 | #install.packages('devtools') 32 | devtools::install_github('thomasp85/tweenr') 33 | ``` 34 | 35 | ## An example 36 | 37 | Following is an example of using the pipeable `tween_state()` function 38 | with our belowed iris data: 39 | 40 | ``` r 41 | library(tweenr) 42 | library(ggplot2) 43 | 44 | # Prepare the data with some extra columns 45 | iris$col <- c('firebrick', 'forestgreen', 'steelblue')[as.integer(iris$Species)] 46 | iris$size <- 4 47 | iris$alpha <- 1 48 | iris <- split(iris, iris$Species) 49 | 50 | # Here comes tweenr 51 | iris_tween <- iris$setosa %>% 52 | tween_state(iris$versicolor, ease = 'cubic-in-out', nframes = 30) %>% 53 | keep_state(10) %>% 54 | tween_state(iris$virginica, ease = 'elastic-out', nframes = 30) %>% 55 | keep_state(10) %>% 56 | tween_state(iris$setosa, ease = 'quadratic-in', nframes = 30) %>% 57 | keep_state(10) 58 | 59 | # Animate it to show the effect 60 | p_base <- ggplot() + 61 | geom_point(aes(x = Petal.Length, y = Petal.Width, alpha = alpha, colour = col, 62 | size = size)) + 63 | scale_colour_identity() + 64 | scale_alpha_identity() + 65 | scale_size_identity() + 66 | coord_cartesian(xlim = range(iris_tween$Petal.Length), 67 | ylim = range(iris_tween$Petal.Width)) 68 | iris_tween <- split(iris_tween, iris_tween$.frame) 69 | for (d in iris_tween) { 70 | p <- p_base %+% d 71 | plot(p) 72 | } 73 | ``` 74 | 75 | ![](man/figures/README-unnamed-chunk-3.gif) 76 | 77 | ## Other functions 78 | 79 | Besides the `tween_state()`/`keep_state()` combo showcased above, there 80 | are a slew of other functions meant for data in different formats 81 | 82 | **`tween_components`** takes a single data.frame, a vector of ids 83 | identifying recurrent elements, and a vector of timepoints for each row 84 | and interpolate each element between its specified time points. 85 | 86 | **`tween_events`** takes a single data.frame where each row encodes a 87 | single unique event, along with a start, and end time and expands the 88 | data across a given number of frames. 89 | 90 | **`tween_along`** takes a single data.frame along with an id and 91 | timepoint vector and calculate evenly spaced intermediary values with 92 | the possibility of keeping old values at each frame. 93 | 94 | **`tween_at`** takes two data.frames or vectors along with a numeric 95 | vector giving the interpolation point between the two data.frames to 96 | calculate. 97 | 98 | **`tween_fill`** fills missing values in a vector or data.frame by 99 | interpolating between previous and next non-missing elements 100 | 101 | ## Easing 102 | 103 | In order to get smooth transitions you’d often want a non-linear 104 | interpolation. This can be achieved by using an easing function to 105 | translate the equidistant interpolation points into new ones. `tweenr` 106 | has support for a wide range of different easing functions, all of which 107 | can be previewed using `display_ease()` as here where the popular 108 | *cubic-in-out* is shown: 109 | 110 | ``` r 111 | tweenr::display_ease('cubic-in-out') 112 | ``` 113 | 114 | ![](man/figures/README-unnamed-chunk-4-1.png) 115 | 116 | ## Spatial interpolations 117 | 118 | The purpose of `tweenr` is to interpolate values independently. If paths 119 | and polygons needs to be transitioned the 120 | [`transformr`](https://github.com/thomasp85/transformr) package should 121 | be used as it expands tweenr into the spatial realm 122 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | destination: docs 2 | url: https://tweenr.data-imaginist.com 3 | 4 | authors: 5 | Thomas Lin Pedersen: 6 | href: https://data-imaginist.com 7 | 8 | template: 9 | params: 10 | bootswatch: yeti 11 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | informational: true 10 | patch: 11 | default: 12 | target: auto 13 | threshold: 1% 14 | informational: true 15 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | This is a small patch release with various fixes 2 | 3 | ## revdepcheck results 4 | 5 | We checked 4 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. 6 | 7 | * We saw 0 new problems 8 | * We failed to check 0 packages 9 | -------------------------------------------------------------------------------- /man/display_ease.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/display_ease.R 3 | \name{display_ease} 4 | \alias{display_ease} 5 | \title{Display an easing function} 6 | \usage{ 7 | display_ease(ease) 8 | } 9 | \arguments{ 10 | \item{ease}{The name of the easing function to display (see details)} 11 | } 12 | \value{ 13 | This function is called for its side effects 14 | } 15 | \description{ 16 | This simple helper lets you explore how the different easing functions govern 17 | the interpolation of data. 18 | } 19 | \details{ 20 | How transitions proceed between states are defined by an easing function. The 21 | easing function converts the parameterized progression from one state to the 22 | next to a new number between 0 and 1. \code{linear} easing is equivalent to 23 | an identity function that returns the input unchanged. In addition there are 24 | a range of additional easers available, each with three modifiers. 25 | 26 | \strong{Easing modifiers:} 27 | \describe{ 28 | \item{-in}{The easing function is applied as-is} 29 | \item{-out}{The easing function is applied in reverse} 30 | \item{-in-out}{The first half of the transition it is applied as-is, while 31 | in the last half it is reversed} 32 | } 33 | 34 | \strong{Easing functions} 35 | \describe{ 36 | \item{quadratic}{Models a power-of-2 function} 37 | \item{cubic}{Models a power-of-3 function} 38 | \item{quartic}{Models a power-of-4 function} 39 | \item{quintic}{Models a power-of-5 function} 40 | \item{sine}{Models a sine function} 41 | \item{circular}{Models a pi/2 circle arc} 42 | \item{exponential}{Models an exponential function} 43 | \item{elastic}{Models an elastic release of energy} 44 | \item{back}{Models a pullback and relase} 45 | \item{bounce}{Models the bouncing of a ball} 46 | } 47 | 48 | In addition to this function a good animated explanation can be found 49 | \href{https://easings.net}{here}. 50 | } 51 | \examples{ 52 | # The default - identity 53 | display_ease('linear') 54 | 55 | # A more fancy easer 56 | display_ease('elastic-in') 57 | 58 | } 59 | -------------------------------------------------------------------------------- /man/dot-complete_states.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tween_state.R 3 | \name{.complete_states} 4 | \alias{.complete_states} 5 | \title{Fill in missing rows using enter and exit functions} 6 | \usage{ 7 | .complete_states(from, to, id, enter, exit, max_id) 8 | } 9 | \arguments{ 10 | \item{from, to}{Data.frames to tween between} 11 | 12 | \item{id}{The name of the column that holds the matching id} 13 | 14 | \item{enter, exit}{functions to fill out missing rows in \code{from} and \code{to} 15 | respectively} 16 | } 17 | \value{ 18 | A list with the elements \code{from} and \code{to} holding the filled out 19 | versions of \code{from} and \code{to} 20 | } 21 | \description{ 22 | This function figures out which rows are missing in either state and applies 23 | the provided \code{enter} and \code{exit} functions to fill in the blanks and provide 24 | a 1-to-1 relation between the rows in \code{from} and \code{to}. 25 | } 26 | \keyword{internal} 27 | -------------------------------------------------------------------------------- /man/dot-get_last_frame.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tween_state.R 3 | \name{.get_last_frame} 4 | \alias{.get_last_frame} 5 | \alias{.get_first_frame} 6 | \alias{.with_prior_frames} 7 | \alias{.with_later_frames} 8 | \alias{.has_frames} 9 | \title{Helpers for working with tweened data} 10 | \usage{ 11 | .get_last_frame(data) 12 | 13 | .get_first_frame(data) 14 | 15 | .with_prior_frames(prior, new_tween, nframes) 16 | 17 | .with_later_frames(later, new_tween, nframes) 18 | 19 | .has_frames(data) 20 | } 21 | \arguments{ 22 | \item{data, prior, later}{A data.frame. If a \code{.frame} column exists it will be interpreted 23 | as a data.frame containing multiple states} 24 | 25 | \item{new_tween}{The result of a tweening} 26 | } 27 | \value{ 28 | A data.frame 29 | } 30 | \description{ 31 | These are internal helpers for extracting and inserting data into a 32 | data.frame of tweened states. 33 | } 34 | \keyword{internal} 35 | -------------------------------------------------------------------------------- /man/dot-max_id.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tween_state.R 3 | \name{.max_id} 4 | \alias{.max_id} 5 | \title{Get the highest id occuring in a dataset} 6 | \usage{ 7 | .max_id(data) 8 | } 9 | \arguments{ 10 | \item{data}{A data.frame as returned by \code{tween_state}} 11 | } 12 | \value{ 13 | An integer giving the currently highest id 14 | } 15 | \description{ 16 | This is helper for \code{tween_state} related functions to get the currently 17 | highest \code{.id} in a frame collection 18 | } 19 | \keyword{internal} 20 | -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-3.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/tweenr/5f4ceb8a0d090142ec8da76b4c14e49d3573737e/man/figures/README-unnamed-chunk-3.gif -------------------------------------------------------------------------------- /man/figures/README-unnamed-chunk-4-1.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/tweenr/5f4ceb8a0d090142ec8da76b4c14e49d3573737e/man/figures/README-unnamed-chunk-4-1.png -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/tweenr/5f4ceb8a0d090142ec8da76b4c14e49d3573737e/man/figures/logo.png -------------------------------------------------------------------------------- /man/gen_along.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gen_along.R 3 | \name{gen_along} 4 | \alias{gen_along} 5 | \title{Generator for tweening along a variable} 6 | \usage{ 7 | gen_along( 8 | .data, 9 | ease, 10 | along, 11 | id = NULL, 12 | range = NULL, 13 | history = TRUE, 14 | keep_last = FALSE 15 | ) 16 | } 17 | \arguments{ 18 | \item{.data}{A data.frame with components at different stages} 19 | 20 | \item{ease}{The easing function to use. Either a single string or one for 21 | each column in the data set.} 22 | 23 | \item{along}{The "time" point for each row} 24 | 25 | \item{id}{An unquoted expression giving the component id for each row. Will 26 | be evaluated in the context of \code{.data} so can refer to a column from that} 27 | 28 | \item{range}{The range of time points to include in the tween. If \code{NULL} it 29 | will use the range of \code{time}} 30 | 31 | \item{history}{Should earlier datapoints be kept in subsequent frames} 32 | 33 | \item{keep_last}{Should the last point of each id be kept beyond its time} 34 | } 35 | \value{ 36 | An \code{along_generator} object 37 | } 38 | \description{ 39 | This is a generator version of \code{\link[=tween_along]{tween_along()}}. It returns a generator that 40 | can be used with \code{\link[=get_frame]{get_frame()}} and \code{\link[=get_raw_frames]{get_raw_frames()}} to extract frames for 41 | a specific time point scaled between 0 and 1. 42 | } 43 | \examples{ 44 | # Default behaviour 45 | gen <- gen_along(airquality, ease = "linear", along = Day, id = Month) 46 | get_frame(gen, 0.22) 47 | 48 | # Overwrite keep_last or history in get_frame 49 | get_frame(gen, 0.67, history = FALSE) 50 | } 51 | \seealso{ 52 | Other Other generators: 53 | \code{\link{gen_at}()}, 54 | \code{\link{gen_components}()}, 55 | \code{\link{gen_events}()}, 56 | \code{\link{gen_keyframe}()} 57 | } 58 | \concept{Other generators} 59 | -------------------------------------------------------------------------------- /man/gen_at.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gen_at.R 3 | \name{gen_at} 4 | \alias{gen_at} 5 | \title{Generator for interpolating between two data frames} 6 | \usage{ 7 | gen_at(from, to, ease, id = NULL, enter = NULL, exit = NULL) 8 | } 9 | \arguments{ 10 | \item{from, to}{A data.frame or vector of the same type. If either is of 11 | length/nrow 1 it will get repeated to match the length of the other} 12 | 13 | \item{ease}{A character vector giving valid easing functions. Recycled to 14 | match the ncol of \code{from}} 15 | 16 | \item{id}{The column to match observations on. If \code{NULL} observations will be 17 | matched by position. See the \emph{Match, Enter, and Exit} section for more 18 | information.} 19 | 20 | \item{enter, exit}{functions that calculate a start state for new observations 21 | that appear in \code{to} or an end state for observations that are not present in 22 | \code{to}. If \code{NULL} the new/old observations will not be part of the tween. The 23 | function gets a data.frame with either the start state of the exiting 24 | observations, or the end state of the entering observations and must return 25 | a modified version of that data.frame. See the \emph{Match, Enter, and Exit} 26 | section for more information.} 27 | } 28 | \value{ 29 | A \code{keyframe_generator} object 30 | } 31 | \description{ 32 | This is a generator version of \code{\link[=tween_at]{tween_at()}} with the additional functionality 33 | of supporting enter and exit functions. It returns a generator that can be 34 | used with \code{\link[=get_frame]{get_frame()}} and \code{\link[=get_raw_frames]{get_raw_frames()}} to extract frames for a 35 | specific time point scaled between 0 and 1. 36 | } 37 | \examples{ 38 | gen <- gen_at(mtcars[1:6, ], mtcars[6:1, ], 'cubic-in-out') 39 | 40 | get_frame(gen, 0.3) 41 | } 42 | \seealso{ 43 | Other Other generators: 44 | \code{\link{gen_along}()}, 45 | \code{\link{gen_components}()}, 46 | \code{\link{gen_events}()}, 47 | \code{\link{gen_keyframe}()} 48 | } 49 | \concept{Other generators} 50 | -------------------------------------------------------------------------------- /man/gen_components.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gen_components.R 3 | \name{gen_components} 4 | \alias{gen_components} 5 | \title{Generator for tweening components separately from each other} 6 | \usage{ 7 | gen_components( 8 | .data, 9 | ease, 10 | nframes, 11 | time, 12 | id = NULL, 13 | range = NULL, 14 | enter = NULL, 15 | exit = NULL, 16 | enter_length = 0, 17 | exit_length = 0 18 | ) 19 | } 20 | \arguments{ 21 | \item{.data}{A data.frame with components at different stages} 22 | 23 | \item{ease}{The easing function to use. Either a single string or one for 24 | each column in the data set.} 25 | 26 | \item{nframes}{The number of frames to calculate for the tween} 27 | 28 | \item{time}{An unquoted expression giving the timepoint for the different 29 | stages of the components. Will be evaluated in the context of \code{.data} so can 30 | refer to a column from that} 31 | 32 | \item{id}{An unquoted expression giving the component id for each row. Will 33 | be evaluated in the context of \code{.data} so can refer to a column from that} 34 | 35 | \item{range}{The range of time points to include in the tween. If \code{NULL} it 36 | will use the range of \code{time}} 37 | 38 | \item{enter, exit}{functions that calculate a start state for new observations 39 | that appear in \code{to} or an end state for observations that are not present in 40 | \code{to}. If \code{NULL} the new/old observations will not be part of the tween. The 41 | function gets a data.frame with either the start state of the exiting 42 | observations, or the end state of the entering observations and must return 43 | a modified version of that data.frame. See the \emph{Match, Enter, and Exit} 44 | section for more information.} 45 | 46 | \item{enter_length, exit_length}{The lenght of the opening and closing 47 | transitions if \code{enter} and/or \code{exit} is given. Measured in the same units as 48 | \code{time}} 49 | } 50 | \value{ 51 | A \code{component_generator} object 52 | } 53 | \description{ 54 | This is a generator versions of \code{\link[=tween_components]{tween_components()}}. It returns a generator 55 | that can be used with \code{\link[=get_frame]{get_frame()}} and \code{\link[=get_raw_frames]{get_raw_frames()}} to extract frames 56 | for a specific time point scaled between 0 and 1. 57 | } 58 | \examples{ 59 | from_zero <- function(x) {x$x <- 0; x} 60 | 61 | data <- data.frame( 62 | x = c(1, 2, 2, 1, 2, 2), 63 | y = c(1, 2, 2, 2, 1, 1), 64 | time = c(1, 4, 8, 4, 8, 10), 65 | id = c(1, 1, 1, 2, 2, 2) 66 | ) 67 | 68 | gen <- gen_components(data, 'cubic-in-out', time = time, id = id, 69 | enter = from_zero, enter_length = 4) 70 | 71 | get_frame(gen, 0.3) 72 | } 73 | \seealso{ 74 | Other Other generators: 75 | \code{\link{gen_along}()}, 76 | \code{\link{gen_at}()}, 77 | \code{\link{gen_events}()}, 78 | \code{\link{gen_keyframe}()} 79 | } 80 | \concept{Other generators} 81 | -------------------------------------------------------------------------------- /man/gen_events.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gen_events.R 3 | \name{gen_events} 4 | \alias{gen_events} 5 | \title{Generator for tweening the appearance of elements} 6 | \usage{ 7 | gen_events( 8 | .data, 9 | ease, 10 | start, 11 | end = NULL, 12 | range = NULL, 13 | enter = NULL, 14 | exit = NULL, 15 | enter_length = 0, 16 | exit_length = 0 17 | ) 18 | } 19 | \arguments{ 20 | \item{.data}{A data.frame with components at different stages} 21 | 22 | \item{ease}{The easing function to use. Either a single string or one for 23 | each column in the data set.} 24 | 25 | \item{start, end}{The start (and potential end) of the event encoded in the 26 | row, as unquoted expressions. Will be evaluated in the context of \code{.data} so 27 | can refer to columns in it. If \code{end = NULL} the event will be without extend 28 | and only visible in a single frame, unless \code{enter} and/or \code{exit} is given.} 29 | 30 | \item{range}{The range of time points to include in the tween. If \code{NULL} it 31 | will use the range of \code{time}} 32 | 33 | \item{enter, 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, exit_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 | \value{ 46 | A \code{component_generator} object 47 | } 48 | \description{ 49 | This is a generator version of \code{\link[=tween_events]{tween_events()}}. It returns a generator 50 | that can be used with \code{\link[=get_frame]{get_frame()}} and \code{\link[=get_raw_frames]{get_raw_frames()}} to extract frames 51 | for a specific time point scaled between 0 and 1. 52 | } 53 | \examples{ 54 | d <- data.frame( 55 | x = runif(20), 56 | y = runif(20), 57 | time = runif(20), 58 | duration = runif(20, max = 0.1) 59 | ) 60 | from_left <- function(x) { 61 | x$x <- -0.5 62 | x 63 | } 64 | to_right <- function(x) { 65 | x$x <- 1.5 66 | x 67 | } 68 | 69 | gen <- gen_events(d, 'cubic-in-out', start = time, end = time + duration, 70 | enter = from_left, exit = to_right, enter_length = 0.1, 71 | exit_length = 0.05) 72 | 73 | get_frame(gen, 0.65) 74 | 75 | } 76 | \seealso{ 77 | Other Other generators: 78 | \code{\link{gen_along}()}, 79 | \code{\link{gen_at}()}, 80 | \code{\link{gen_components}()}, 81 | \code{\link{gen_keyframe}()} 82 | } 83 | \concept{Other generators} 84 | -------------------------------------------------------------------------------- /man/gen_internal.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/aaa.R, R/gen.R, R/gen_keyframe.R 3 | \docType{data} 4 | \name{col_classes} 5 | \alias{col_classes} 6 | \alias{gen_internal} 7 | \alias{PHASE_LEVELS} 8 | \alias{is_generator} 9 | \alias{generator_settings} 10 | \alias{generator_settings<-} 11 | \alias{ease_type} 12 | \alias{ease_type<-} 13 | \alias{col_types} 14 | \alias{col_types<-} 15 | \alias{gen_data} 16 | \alias{gen_data<-} 17 | \alias{gen_to_data_frame} 18 | \alias{data_frame_to_gen} 19 | \alias{keyframes} 20 | \alias{keyframes<-} 21 | \alias{frame_times} 22 | \alias{frame_times<-} 23 | \title{Generator internals} 24 | \format{ 25 | An object of class \code{character} of length 5. 26 | } 27 | \usage{ 28 | col_classes(data) 29 | 30 | PHASE_LEVELS 31 | 32 | is_generator(x) 33 | 34 | generator_settings(x) 35 | 36 | generator_settings(x) <- value 37 | 38 | ease_type(x) 39 | 40 | ease_type(x) <- value 41 | 42 | col_types(x) 43 | 44 | col_types(x) <- value 45 | 46 | gen_data(x) 47 | 48 | gen_data(x) <- value 49 | 50 | gen_to_data_frame(...) 51 | 52 | data_frame_to_gen(x) 53 | 54 | keyframes(x) 55 | 56 | keyframes(x) <- value 57 | 58 | frame_times(x) 59 | 60 | frame_times(x) <- value 61 | } 62 | \arguments{ 63 | \item{x}{A generator object} 64 | } 65 | \value{ 66 | Various data 67 | } 68 | \description{ 69 | Generator internals 70 | } 71 | \keyword{datasets} 72 | \keyword{internal} 73 | -------------------------------------------------------------------------------- /man/gen_keyframe.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gen_keyframe.R 3 | \name{gen_keyframe} 4 | \alias{gen_keyframe} 5 | \alias{add_pause} 6 | \alias{add_keyframe} 7 | \title{Generator for keyframe based tweening} 8 | \usage{ 9 | gen_keyframe(keyframe = NULL, pause = 0) 10 | 11 | add_pause(.data, pause = 0) 12 | 13 | add_keyframe( 14 | .data, 15 | keyframe, 16 | ease, 17 | length, 18 | id = NULL, 19 | enter = NULL, 20 | exit = NULL 21 | ) 22 | } 23 | \arguments{ 24 | \item{keyframe}{A data frame to use as a keyframe state} 25 | 26 | \item{pause}{The length of the pause at the current keyframe} 27 | 28 | \item{.data}{A data.frame to start from. If \code{.data} is the result of a prior 29 | tween, only the last frame will be used for the tween. The new tween will 30 | then be added to the prior tween} 31 | 32 | \item{ease}{The easing function to use. Either a single string or one for 33 | each column in the data set.} 34 | 35 | \item{length}{The length of the transition} 36 | 37 | \item{id}{The column to match observations on. If \code{NULL} observations will be 38 | matched by position. See the \emph{Match, Enter, and Exit} section for more 39 | information.} 40 | 41 | \item{enter, exit}{functions that calculate a start state for new observations 42 | that appear in \code{to} or an end state for observations that are not present in 43 | \code{to}. If \code{NULL} the new/old observations will not be part of the tween. The 44 | function gets a data.frame with either the start state of the exiting 45 | observations, or the end state of the entering observations and must return 46 | a modified version of that data.frame. See the \emph{Match, Enter, and Exit} 47 | section for more information.} 48 | } 49 | \value{ 50 | A \code{keyframe_generator} object 51 | } 52 | \description{ 53 | This is a generator version of \code{\link[=tween_state]{tween_state()}} and its utility functions. It 54 | returns a generator that can be used with \code{\link[=get_frame]{get_frame()}} and 55 | \code{\link[=get_raw_frames]{get_raw_frames()}} to extract frames for a specific time point scaled between 56 | 0 and 1. 57 | } 58 | \examples{ 59 | df1 <- data.frame( 60 | country = c('Denmark', 'Sweden', 'Norway'), 61 | population = c(5e6, 10e6, 3.5e6) 62 | ) 63 | df2 <- data.frame( 64 | country = c('Denmark', 'Sweden', 'Norway', 'Finland'), 65 | population = c(6e6, 10.5e6, 4e6, 3e6) 66 | ) 67 | df3 <- data.frame( 68 | country = c('Denmark', 'Norway'), 69 | population = c(10e6, 6e6) 70 | ) 71 | to_zero <- function(x) { 72 | x$population <- 0 73 | x 74 | } 75 | gen <- gen_keyframe(df1, 10) \%>\% 76 | add_keyframe(df2, 'cubic-in-out', 35, id = country, enter = to_zero) \%>\% 77 | add_pause(10) \%>\% 78 | add_keyframe(df3, 'cubic-in-out', 35, id = country, enter = to_zero, 79 | exit = to_zero) \%>\% 80 | add_pause(10) 81 | 82 | get_frame(gen, 0.25) 83 | } 84 | \seealso{ 85 | Other Other generators: 86 | \code{\link{gen_along}()}, 87 | \code{\link{gen_at}()}, 88 | \code{\link{gen_components}()}, 89 | \code{\link{gen_events}()} 90 | } 91 | \concept{Other generators} 92 | -------------------------------------------------------------------------------- /man/get_frame.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/get_frame.R 3 | \name{get_frame} 4 | \alias{get_frame} 5 | \alias{get_raw_frames} 6 | \title{Extract a frame from a generator} 7 | \usage{ 8 | get_frame(generator, at, ...) 9 | 10 | get_raw_frames(generator, at, before = 0, after = 0, ...) 11 | } 12 | \arguments{ 13 | \item{generator}{A \code{frame_generator} object} 14 | 15 | \item{at}{A scalar numeric between 0 and 1} 16 | 17 | \item{...}{Arguments passed on to methods} 18 | 19 | \item{before, after}{Scalar numerics that define the time before and after 20 | \code{at} to search for raw data} 21 | } 22 | \description{ 23 | Using the generators in tweenr you can avoid calculating all needed frames up 24 | front, which can be prohibitive in memory. With a generator you can use 25 | \code{get_frame()} to extract any frame at a fractional location between 0 and 1 26 | one by one as you need them. You can further get all raw data before and/or 27 | after a given point in time using \code{get_raw_frames()}. 28 | } 29 | \examples{ 30 | data <- data.frame( 31 | x = c(1, 2, 2, 1, 2, 2), 32 | y = c(1, 2, 2, 2, 1, 1), 33 | time = c(1, 4, 8, 4, 8, 10), 34 | id = c(1, 1, 1, 2, 2, 2) 35 | ) 36 | 37 | gen <- gen_components(data, 'cubic-in-out', time = time, id = id) 38 | 39 | get_frame(gen, 0.3) 40 | 41 | get_raw_frames(gen, 0.5, before = 0.5, after = 0.2) 42 | } 43 | -------------------------------------------------------------------------------- /man/interpolate_custom_at.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gen_keyframe.R 3 | \name{interpolate_custom_at} 4 | \alias{interpolate_custom_at} 5 | \title{Fallback for keyframe vector support} 6 | \usage{ 7 | interpolate_custom_at(from, to, at, ease) 8 | } 9 | \arguments{ 10 | \item{from, to}{vectors to interpolate between} 11 | 12 | \item{at}{value between 0 and 1 defining the point} 13 | 14 | \item{ease}{the easing function to use} 15 | } 16 | \description{ 17 | Fallback for keyframe vector support 18 | } 19 | \keyword{internal} 20 | -------------------------------------------------------------------------------- /man/prepare_keyframes.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/gen_keyframe.R 3 | \name{prepare_keyframes} 4 | \alias{prepare_keyframes} 5 | \title{Prepare keyframes for generator} 6 | \usage{ 7 | prepare_keyframes(.data, keyframe) 8 | } 9 | \arguments{ 10 | \item{.data}{A keyframe generator} 11 | 12 | \item{keyframe}{A keyframe to add} 13 | } 14 | \value{ 15 | A valid keyframe generator 16 | } 17 | \description{ 18 | Prepare keyframes for generator 19 | } 20 | \keyword{internal} 21 | -------------------------------------------------------------------------------- /man/reexports.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/aaa.R 3 | \docType{import} 4 | \name{reexports} 5 | \alias{reexports} 6 | \alias{\%>\%} 7 | \title{Objects exported from other packages} 8 | \keyword{internal} 9 | \description{ 10 | These objects are imported from other packages. Follow the links 11 | below to see their documentation. 12 | 13 | \describe{ 14 | \item{magrittr}{\code{\link[magrittr:pipe]{\%>\%}}} 15 | }} 16 | 17 | -------------------------------------------------------------------------------- /man/tween.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tween.R, R/tween_colour.R, R/tween_constant.R, 3 | % R/tween_date.R, R/tween_datetime.R, R/tween_numeric.R 4 | \name{tween} 5 | \alias{tween} 6 | \alias{tween_t} 7 | \alias{tween_colour} 8 | \alias{tween_color} 9 | \alias{tween_colour_t} 10 | \alias{tween_color_t} 11 | \alias{tween_constant} 12 | \alias{tween_constant_t} 13 | \alias{tween_date} 14 | \alias{tween_date_t} 15 | \alias{tween_datetime} 16 | \alias{tween_datetime_t} 17 | \alias{tween_numeric} 18 | \alias{tween_numeric_t} 19 | \title{Create simple tweens} 20 | \usage{ 21 | tween(data, n, ease = "linear") 22 | 23 | tween_t(data, n, ease = "linear") 24 | 25 | tween_colour(data, n, ease = "linear") 26 | 27 | tween_color(data, n, ease = "linear") 28 | 29 | tween_colour_t(data, n, ease = "linear") 30 | 31 | tween_color_t(data, n, ease = "linear") 32 | 33 | tween_constant(data, n, ease = "linear") 34 | 35 | tween_constant_t(data, n, ease = "linear") 36 | 37 | tween_date(data, n, ease = "linear") 38 | 39 | tween_date_t(data, n, ease = "linear") 40 | 41 | tween_datetime(data, n, ease = "linear") 42 | 43 | tween_datetime_t(data, n, ease = "linear") 44 | 45 | tween_numeric(data, n, ease = "linear") 46 | 47 | tween_numeric_t(data, n, ease = "linear") 48 | } 49 | \arguments{ 50 | \item{data}{A list of vectors or a single vector. In the standard functions 51 | each element in the list must be of equal length; for the *_t functions 52 | lengths can differ. If a single vector is used it will be eqivalent to using 53 | \code{as.list(data)} for the standard functions and \code{list(data)} for the 54 | *_t functions.} 55 | 56 | \item{n}{The number of elements per transition or tween. See details} 57 | 58 | \item{ease}{The easing function to use for each transition or tween. See 59 | details. Defaults to \code{'linear'}} 60 | } 61 | \value{ 62 | A list with an element for each tween. That means that the length of 63 | the return is equal to the length of the elements in \code{data} for the 64 | standard functions and equal to the length of \code{data} for the *_t 65 | functions. 66 | } 67 | \description{ 68 | This set of functions can be used to interpolate between single data types, 69 | i.e. data not part of data.frames but stored in vectors. All functions come 70 | in two flavours: the standard and a *_t version. The standard reads the data 71 | as a list of states, each tween matched element-wise from state to state. The 72 | *_t version uses the transposed representation where each element is a vector 73 | of states. The standard approach can be used when each tween has the same 74 | number of states and you want to control the number of point in each state 75 | transition. The latter is useful when each tween consists of different 76 | numbers of states and/or you want to specify the total number of points for 77 | each tween. 78 | } 79 | \details{ 80 | \code{tween} and \code{tween_t} are wrappers around the other functions that tries to guess 81 | the type of input data and choose the appropriate tween function. Unless you 82 | have data that could be understood as a colour but is in fact a character 83 | vector it should be safe to use these wrappers. It is probably safer and more 84 | verbose to use the explicit functions within package code as they circumvent 85 | the type inference and checks whether the input data matches the tween 86 | function. 87 | 88 | \code{tween_numeric} will provide a linear interpolation between the points based on 89 | the sequence returned by the easing function. \code{tween_date} and \code{tween_datetime} 90 | converts to numeric, produces the tweening, and converts back again. 91 | \code{tween_colour} converts colours into Lab and does the interpolation there, 92 | converting back to sRGB after the tweening is done. \code{tween_constant} is a 93 | catchall that converts the input into character and interpolates by switching 94 | between states halfway through the transition. 95 | 96 | The meaning of the \code{n} and \code{ease} arguments differs somewhat 97 | between the standard and *_t versions of the functions. In the standard 98 | function \code{n} and \code{ease} refers to the length and easing function of 99 | each transition, being recycled if necessary to \code{length(data) - 1}. In 100 | the *_t functions \code{n} and \code{ease} refers to the total length of each 101 | tween and the easing function to be applied to all transition for each tween. 102 | The will both be recycled to \code{length(data)}. 103 | } 104 | \section{Difference Between \code{tween_numeric} and \code{approx()}}{ 105 | 106 | \code{tween_numeric} (and \code{tween_numeric_t}) is superficially equivalent to 107 | \code{\link[stats:approxfun]{stats::approx()}}, but there are differences. 108 | \code{\link[stats:approxfun]{stats::approx()}} will create evenly spaced points, at the expense 109 | of not including the actual points in the input, while the reverse is true 110 | for \code{tween_numeric}. Apart from that \code{tween_numeric} of course supports easing 111 | functions and is vectorized. 112 | } 113 | 114 | \examples{ 115 | tween_numeric(list(1:3, 10:8, c(20, 60, 30)), 10) 116 | 117 | tween_colour_t(list(colours()[1:4], colours()[1:2], colours()[25:100]), 100) 118 | 119 | } 120 | -------------------------------------------------------------------------------- /man/tween_along.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tween_along.R 3 | \name{tween_along} 4 | \alias{tween_along} 5 | \title{Interpolate data along a given dimension} 6 | \usage{ 7 | tween_along( 8 | .data, 9 | ease, 10 | nframes, 11 | along, 12 | id = NULL, 13 | range = NULL, 14 | history = TRUE, 15 | keep_last = FALSE 16 | ) 17 | } 18 | \arguments{ 19 | \item{.data}{A data.frame with components at different stages} 20 | 21 | \item{ease}{The easing function to use. Either a single string or one for 22 | each column in the data set.} 23 | 24 | \item{nframes}{The number of frames to calculate for the tween} 25 | 26 | \item{along}{The "time" point for each row} 27 | 28 | \item{id}{An unquoted expression giving the component id for each row. Will 29 | be evaluated in the context of \code{.data} so can refer to a column from that} 30 | 31 | \item{range}{The range of time points to include in the tween. If \code{NULL} it 32 | will use the range of \code{time}} 33 | 34 | \item{history}{Should earlier datapoints be kept in subsequent frames} 35 | 36 | \item{keep_last}{Should the last point of each id be kept beyond its time} 37 | } 38 | \value{ 39 | A data.frame with the same columns as \code{.data} along with \code{.id} giving 40 | the component id, \code{.phase} giving the state of each component in each frame, 41 | and \code{.frame} giving the frame membership of each row. 42 | } 43 | \description{ 44 | This tween takes groups of rows along with the time for each row and 45 | calculates the exact value at each at each frame. Further it allows for 46 | keeping the subsequent raw data from previous frame as well as letting the 47 | final row linger beyond its time. It especially useful for data that should 48 | be visualised as lines that are drawn along the x-axis, but can of course 49 | also be used for other dimensions as well (even dimensions not corresponding 50 | to any axis). 51 | } 52 | \seealso{ 53 | Other data.frame tween: 54 | \code{\link{tween_appear}()}, 55 | \code{\link{tween_components}()}, 56 | \code{\link{tween_elements}()}, 57 | \code{\link{tween_events}()}, 58 | \code{\link{tween_states}()} 59 | } 60 | \concept{data.frame tween} 61 | -------------------------------------------------------------------------------- /man/tween_appear.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tween_appear.R 3 | \name{tween_appear} 4 | \alias{tween_appear} 5 | \title{Tween a data.frame of appearances} 6 | \usage{ 7 | tween_appear(data, time, timerange, nframes) 8 | } 9 | \arguments{ 10 | \item{data}{A data.frame to tween} 11 | 12 | \item{time}{The name of the column that holds the time dimension. This does 13 | not need to hold time data in the strictest sence - any numerical type will 14 | do} 15 | 16 | \item{timerange}{The range of time to create the tween for. If missing it 17 | will defaults to the range of the time column} 18 | 19 | \item{nframes}{The number of frames to create for the tween. If missing it 20 | will create a frame for each full unit in \code{timerange} (e.g. 21 | \code{timerange = c(1, 10)} will give \code{nframes = 10})} 22 | } 23 | \value{ 24 | A data.frame as \code{data} but repeated \code{nframes} times and 25 | with the additional columns \code{.age} and \code{.frame} 26 | } 27 | \description{ 28 | This function is intended for use when you have a data.frame of events at 29 | different time points. This could be the appearance of an observation for 30 | example. This function replicates your data \code{nframes} times and 31 | calculates the duration of each frame. At each frame each row is 32 | assigned an age based on the progression of frames and the entry point of in 33 | time for that row. A negative age means that the row has not appeared yet. 34 | } 35 | \examples{ 36 | data <- data.frame( 37 | x = rnorm(100), 38 | y = rnorm(100), 39 | time = sample(50, 100, replace = TRUE) 40 | ) 41 | 42 | data <- tween_appear(data, 'time', nframes = 200) 43 | 44 | } 45 | \seealso{ 46 | Other data.frame tween: 47 | \code{\link{tween_along}()}, 48 | \code{\link{tween_components}()}, 49 | \code{\link{tween_elements}()}, 50 | \code{\link{tween_events}()}, 51 | \code{\link{tween_states}()} 52 | } 53 | \concept{data.frame tween} 54 | -------------------------------------------------------------------------------- /man/tween_at.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tween_at.R 3 | \name{tween_at} 4 | \alias{tween_at} 5 | \title{Get a specific position between two states} 6 | \usage{ 7 | tween_at(from, to, at, ease) 8 | } 9 | \arguments{ 10 | \item{from, to}{A data.frame or vector of the same type. If either is of 11 | length/nrow 1 it will get repeated to match the length of the other} 12 | 13 | \item{at}{A numeric between 0 and 1 recycled to match the nrow/length of 14 | \code{from}} 15 | 16 | \item{ease}{A character vector giving valid easing functions. Recycled to 17 | match the ncol of \code{from}} 18 | } 19 | \value{ 20 | If \code{from}/\code{to} is a data.frame then a data.frame with the same 21 | columns. If \code{from}/\code{to} is a vector then a vector. 22 | } 23 | \description{ 24 | This tween allows you to query a specific postion between two states rather 25 | than generate evenly spaced states. It can work with either data.frames or 26 | single vectors and each row/element can have its own position and easing. 27 | } 28 | \examples{ 29 | tween_at(mtcars[1:6, ], mtcars[6:1, ], runif(6), 'cubic-in-out') 30 | 31 | } 32 | -------------------------------------------------------------------------------- /man/tween_at_t.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tween_at.R 3 | \name{tween_at_t} 4 | \alias{tween_at_t} 5 | \title{Get several specific position between two states} 6 | \usage{ 7 | tween_at_t(from, to, at, ease) 8 | } 9 | \arguments{ 10 | \item{from, to}{A data.frame or vector of the same type. If either is of 11 | length/nrow 1 it will get repeated to match the length of the other} 12 | 13 | \item{at}{A numeric vector with values between 0 and 1.} 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 is a variation of \code{\link[=tween_at]{tween_at()}}. Instead of having \code{at} refer to 24 | the tweening position of each row, each \code{at} will interpolate the full data 25 | at that position. 26 | } 27 | \examples{ 28 | tween_at_t(mtcars[1:6, ], mtcars[6:1, ], runif(3), 'cubic-in-out') 29 | 30 | } 31 | -------------------------------------------------------------------------------- /man/tween_components.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tween_components.R 3 | \name{tween_components} 4 | \alias{tween_components} 5 | \title{Interpolate individual component} 6 | \usage{ 7 | tween_components( 8 | .data, 9 | ease, 10 | nframes, 11 | time, 12 | id = NULL, 13 | range = NULL, 14 | enter = NULL, 15 | exit = NULL, 16 | enter_length = 0, 17 | exit_length = 0 18 | ) 19 | } 20 | \arguments{ 21 | \item{.data}{A data.frame with components at different stages} 22 | 23 | \item{ease}{The easing function to use. Either a single string or one for 24 | each column in the data set.} 25 | 26 | \item{nframes}{The number of frames to calculate for the tween} 27 | 28 | \item{time}{An unquoted expression giving the timepoint for the different 29 | stages of the components. Will be evaluated in the context of \code{.data} so can 30 | refer to a column from that} 31 | 32 | \item{id}{An unquoted expression giving the component id for each row. Will 33 | be evaluated in the context of \code{.data} so can refer to a column from that} 34 | 35 | \item{range}{The range of time points to include in the tween. If \code{NULL} it 36 | will use the range of \code{time}} 37 | 38 | \item{enter, exit}{functions that calculate a start state for new observations 39 | that appear in \code{to} or an end state for observations that are not present in 40 | \code{to}. If \code{NULL} the new/old observations will not be part of the tween. The 41 | function gets a data.frame with either the start state of the exiting 42 | observations, or the end state of the entering observations and must return 43 | a modified version of that data.frame. See the \emph{Match, Enter, and Exit} 44 | section for more information.} 45 | 46 | \item{enter_length, exit_length}{The lenght of the opening and closing 47 | transitions if \code{enter} and/or \code{exit} is given. Measured in the same units as 48 | \code{time}} 49 | } 50 | \value{ 51 | A data.frame with the same columns as \code{.data} along with \code{.id} giving 52 | the component id, \code{.phase} giving the state of each component in each frame, 53 | and \code{.frame} giving the frame membership of each row. 54 | } 55 | \description{ 56 | This function is much like \code{\link[=tween_elements]{tween_elements()}} but with a slightly different 57 | syntax and support for many of the newer features such as enter/exits and 58 | tween phase identification. Furthermore it uses tidy evaluation for time and 59 | id, making it easier to change these on the fly. The biggest change in terms 60 | of functionality compared to \code{tween_elements()} is that the easing function 61 | is now given per column and not per row. If different easing functions are 62 | needed for each transition then \code{tween_elements()} is needed. 63 | } 64 | \examples{ 65 | 66 | from_zero <- function(x) {x$x <- 0; x} 67 | 68 | data <- data.frame( 69 | x = c(1, 2, 2, 1, 2, 2), 70 | y = c(1, 2, 2, 2, 1, 1), 71 | time = c(1, 4, 10, 4, 8, 10), 72 | id = c(1, 1, 1, 2, 2, 2) 73 | ) 74 | 75 | data <- tween_components(data, 'cubic-in-out', nframes = 100, time = time, 76 | id = id, enter = from_zero, enter_length = 4) 77 | 78 | } 79 | \seealso{ 80 | Other data.frame tween: 81 | \code{\link{tween_along}()}, 82 | \code{\link{tween_appear}()}, 83 | \code{\link{tween_elements}()}, 84 | \code{\link{tween_events}()}, 85 | \code{\link{tween_states}()} 86 | } 87 | \concept{data.frame tween} 88 | -------------------------------------------------------------------------------- /man/tween_elements.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tween_elements.R 3 | \name{tween_elements} 4 | \alias{tween_elements} 5 | \title{Create frames based on individual element states} 6 | \usage{ 7 | tween_elements(data, time, group, ease, timerange, nframes) 8 | } 9 | \arguments{ 10 | \item{data}{A data.frame consisting at least of a column giving the 11 | observation id, a column giving timepoints for each state and a column giving 12 | the easing to apply when transitioning away from the state.} 13 | 14 | \item{time}{The name of the column holding timepoints} 15 | 16 | \item{group}{The name of the column holding the observation id} 17 | 18 | \item{ease}{The name of the column holding the easing function name} 19 | 20 | \item{timerange}{The range of time to span. If missing it will default to 21 | \code{range(data[[time]])}} 22 | 23 | \item{nframes}{The number of frames to generate. If missing it will default 24 | to \code{ceiling(diff(timerange) + 1)} (At least one frame for each 25 | individual timepoint)} 26 | } 27 | \value{ 28 | A data.frame with the same columns as \code{data} except for the 29 | group and ease columns, but replicated \code{nframes} times. Two additional 30 | columns called \code{.frame} and \code{.group} will be added giving the frame 31 | number and observation id for each row. 32 | } 33 | \description{ 34 | This function creates tweens for each observation individually, in cases 35 | where the data doesn't pass through collective states but consists of fully 36 | independent transitions. Each observation is identified by an id and each 37 | state must have a time associated with it. 38 | } 39 | \examples{ 40 | data <- data.frame( 41 | x = c(1, 2, 2, 1, 2, 2), 42 | y = c(1, 2, 2, 2, 1, 1), 43 | time = c(1, 4, 10, 4, 8, 10), 44 | group = c(1, 1, 1, 2, 2, 2), 45 | ease = rep('cubic-in-out', 6) 46 | ) 47 | 48 | data <- tween_elements(data, 'time', 'group', 'ease', nframes = 100) 49 | 50 | } 51 | \seealso{ 52 | Other data.frame tween: 53 | \code{\link{tween_along}()}, 54 | \code{\link{tween_appear}()}, 55 | \code{\link{tween_components}()}, 56 | \code{\link{tween_events}()}, 57 | \code{\link{tween_states}()} 58 | } 59 | \concept{data.frame tween} 60 | -------------------------------------------------------------------------------- /man/tween_events.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tween_events.R 3 | \name{tween_events} 4 | \alias{tween_events} 5 | \title{Transition in and out of events} 6 | \usage{ 7 | tween_events( 8 | .data, 9 | ease, 10 | nframes, 11 | start, 12 | end = NULL, 13 | range = NULL, 14 | enter = NULL, 15 | exit = NULL, 16 | enter_length = 0, 17 | exit_length = 0 18 | ) 19 | } 20 | \arguments{ 21 | \item{.data}{A data.frame with components at different stages} 22 | 23 | \item{ease}{The easing function to use. Either a single string or one for 24 | each column in the data set.} 25 | 26 | \item{nframes}{The number of frames to calculate for the tween} 27 | 28 | \item{start, end}{The start (and potential end) of the event encoded in the 29 | row, as unquoted expressions. Will be evaluated in the context of \code{.data} so 30 | can refer to columns in it. If \code{end = NULL} the event will be without extend 31 | and only visible in a single frame, unless \code{enter} and/or \code{exit} is given.} 32 | 33 | \item{range}{The range of time points to include in the tween. If \code{NULL} it 34 | will use the range of \code{time}} 35 | 36 | \item{enter, exit}{functions that calculate a start state for new observations 37 | that appear in \code{to} or an end state for observations that are not present in 38 | \code{to}. If \code{NULL} the new/old observations will not be part of the tween. The 39 | function gets a data.frame with either the start state of the exiting 40 | observations, or the end state of the entering observations and must return 41 | a modified version of that data.frame. See the \emph{Match, Enter, and Exit} 42 | section for more information.} 43 | 44 | \item{enter_length, exit_length}{The lenght of the opening and closing 45 | transitions if \code{enter} and/or \code{exit} is given. Measured in the same units as 46 | \code{time}} 47 | } 48 | \value{ 49 | A data.frame with the same columns as \code{.data} along with \code{.id} giving 50 | the component id, \code{.phase} giving the state of each component in each frame, 51 | and \code{.frame} giving the frame membership of each row. 52 | } 53 | \description{ 54 | This tweening function is a more powerful version of \code{\link[=tween_appear]{tween_appear()}}, with 55 | support for newer features such as enter/exits and tween phase 56 | identification. The tweener treats each row in the data as unique events in 57 | time, and creates frames with the correct events present at any given time. 58 | } 59 | \examples{ 60 | d <- data.frame( 61 | x = runif(20), 62 | y = runif(20), 63 | time = runif(20), 64 | duration = runif(20, max = 0.1) 65 | ) 66 | from_left <- function(x) { 67 | x$x <- -0.5 68 | x 69 | } 70 | to_right <- function(x) { 71 | x$x <- 1.5 72 | x 73 | } 74 | 75 | tween_events(d, 'cubic-in-out', 50, start = time, end = time + duration, 76 | enter = from_left, exit = to_right, enter_length = 0.1, 77 | exit_length = 0.05) 78 | 79 | } 80 | \seealso{ 81 | Other data.frame tween: 82 | \code{\link{tween_along}()}, 83 | \code{\link{tween_appear}()}, 84 | \code{\link{tween_components}()}, 85 | \code{\link{tween_elements}()}, 86 | \code{\link{tween_states}()} 87 | } 88 | \concept{data.frame tween} 89 | -------------------------------------------------------------------------------- /man/tween_fill.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tween_fill.R 3 | \name{tween_fill} 4 | \alias{tween_fill} 5 | \title{Fill out missing values by interpolation} 6 | \usage{ 7 | tween_fill(data, ease) 8 | } 9 | \arguments{ 10 | \item{data}{A data.frame or vector.} 11 | 12 | \item{ease}{A character vector giving valid easing functions. Recycled to 13 | match the ncol of \code{data}} 14 | } 15 | \value{ 16 | If \code{data} is a data.frame then a data.frame with the same 17 | columns. If \code{data} is a vector then a vector. 18 | } 19 | \description{ 20 | This tween fills out \code{NA} elements (or \code{NULL} elements if \code{data} is a list) 21 | by interpolating between the prior and next non-missing values. 22 | } 23 | \examples{ 24 | # Single vector 25 | tween_fill(c(1, NA, NA, NA, NA, NA, 2, 6, NA, NA, NA, -2), 'cubic-in-out') 26 | 27 | # Data frame 28 | tween_fill(mtcars[c(1, NA, NA, NA, NA, 4, NA, NA, NA, 10), ], 'cubic-in') 29 | 30 | } 31 | -------------------------------------------------------------------------------- /man/tween_state.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tween_state.R 3 | \name{tween_state} 4 | \alias{tween_state} 5 | \alias{keep_state} 6 | \alias{open_state} 7 | \alias{close_state} 8 | \title{Compose tweening between states} 9 | \usage{ 10 | tween_state(.data, to, ease, nframes, id = NULL, enter = NULL, 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 simple 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 | } 134 | -------------------------------------------------------------------------------- /man/tween_states.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tween_states.R 3 | \name{tween_states} 4 | \alias{tween_states} 5 | \title{Tween a list of data.frames representing states} 6 | \usage{ 7 | tween_states(data, tweenlength, statelength, ease, nframes) 8 | } 9 | \arguments{ 10 | \item{data}{A list of data.frames. Each data.frame must contain the same 11 | number of rows, but only the first data.frame needs to contain all columns. 12 | Subsequent data.frames need only contain the columns that shows change.} 13 | 14 | \item{tweenlength}{The lengths of the transitions between each state.} 15 | 16 | \item{statelength}{The length of the pause at each state.} 17 | 18 | \item{ease}{The easing functions to use for the transitions. See details.} 19 | 20 | \item{nframes}{The number of frames to generate. The actual number of frames 21 | might end up being higher depending on the regularity of \code{tweenlength} 22 | and \code{statelength}.} 23 | } 24 | \value{ 25 | A data.frame with the same columns as the first data.frame in 26 | \code{data}, but replicated \code{nframes} times. An additional column called 27 | \code{.frame} will be added giving the frame number. 28 | } 29 | \description{ 30 | This function is intended to create smooth transitions between states of 31 | data. States are defined as full data.frames or data.frames containing only 32 | the columns with change. Each state can have a defined period of pause, the 33 | transition length between each states can be defined as well as the easing 34 | function. 35 | } 36 | \examples{ 37 | data1 <- data.frame( 38 | x = 1:20, 39 | y = 0, 40 | colour = 'forestgreen', 41 | stringsAsFactors = FALSE 42 | ) 43 | data2 <- data1 44 | data2$x <- 20:1 45 | data2$y <- 1 46 | 47 | data <- tween_states(list(data1, data2), 3, 1, 'cubic-in-out', 100) 48 | 49 | } 50 | \seealso{ 51 | Other data.frame tween: 52 | \code{\link{tween_along}()}, 53 | \code{\link{tween_appear}()}, 54 | \code{\link{tween_components}()}, 55 | \code{\link{tween_elements}()}, 56 | \code{\link{tween_events}()} 57 | } 58 | \concept{data.frame tween} 59 | -------------------------------------------------------------------------------- /man/tweenr-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tweenr_package.R 3 | \docType{package} 4 | \name{tweenr-package} 5 | \alias{tweenr} 6 | \alias{tweenr-package} 7 | \title{tweenr: Interpolate Data for Smooth Animations} 8 | \description{ 9 | \if{html}{\figure{logo.png}{options: style='float: right' alt='logo' width='120'}} 10 | 11 | In order to create smooth animation between states of data, tweening is necessary. This package provides a range of functions for creating tweened data that can be used as basis for animation. Furthermore it adds a number of vectorized interpolaters for common R data types such as numeric, date and colour. 12 | } 13 | \details{ 14 | tweenr is a small collection of functions to help you in creating 15 | intermediary representations of your data, i.e. interpolating states of data. 16 | As such it's a great match for packages such as animate and gganimate, since 17 | it can work directly with data.frames of data, but it also provide fast and 18 | efficient interpolaters for numeric, date, datetime and colour that are 19 | vectorized and thus more efficient to use than the build in interpolation 20 | functions (mainly \code{\link[stats:approxfun]{stats::approx()}} and 21 | \code{\link[grDevices:colorRamp]{grDevices::colorRamp()}}). 22 | 23 | The main functions for data.frames are \code{\link[=tween_states]{tween_states()}}, 24 | \code{\link[=tween_elements]{tween_elements()}} and \code{\link[=tween_appear]{tween_appear()}}, while the 25 | standard interpolaters can be found at \code{\link[=tween]{tween()}} 26 | } 27 | \seealso{ 28 | Useful links: 29 | \itemize{ 30 | \item \url{https://github.com/thomasp85/tweenr} 31 | \item Report bugs at \url{https://github.com/thomasp85/tweenr/issues} 32 | } 33 | 34 | } 35 | \author{ 36 | \strong{Maintainer}: Thomas Lin Pedersen \email{thomasp85@gmail.com} (\href{https://orcid.org/0000-0002-5147-4711}{ORCID}) 37 | 38 | } 39 | -------------------------------------------------------------------------------- /man/vec_tween_class.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/aaa.R 3 | \name{vec_tween_class} 4 | \alias{vec_tween_class} 5 | \title{Get the nominal class of a vector} 6 | \usage{ 7 | vec_tween_class(x) 8 | } 9 | \arguments{ 10 | \item{x}{a vector} 11 | } 12 | \description{ 13 | Get the nominal class of a vector 14 | } 15 | \keyword{internal} 16 | -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-120x120.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/tweenr/5f4ceb8a0d090142ec8da76b4c14e49d3573737e/pkgdown/favicon/apple-touch-icon-120x120.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-152x152.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/tweenr/5f4ceb8a0d090142ec8da76b4c14e49d3573737e/pkgdown/favicon/apple-touch-icon-152x152.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-180x180.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/tweenr/5f4ceb8a0d090142ec8da76b4c14e49d3573737e/pkgdown/favicon/apple-touch-icon-180x180.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-60x60.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/tweenr/5f4ceb8a0d090142ec8da76b4c14e49d3573737e/pkgdown/favicon/apple-touch-icon-60x60.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon-76x76.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/tweenr/5f4ceb8a0d090142ec8da76b4c14e49d3573737e/pkgdown/favicon/apple-touch-icon-76x76.png -------------------------------------------------------------------------------- /pkgdown/favicon/apple-touch-icon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/tweenr/5f4ceb8a0d090142ec8da76b4c14e49d3573737e/pkgdown/favicon/apple-touch-icon.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-16x16.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/tweenr/5f4ceb8a0d090142ec8da76b4c14e49d3573737e/pkgdown/favicon/favicon-16x16.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon-32x32.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/tweenr/5f4ceb8a0d090142ec8da76b4c14e49d3573737e/pkgdown/favicon/favicon-32x32.png -------------------------------------------------------------------------------- /pkgdown/favicon/favicon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/thomasp85/tweenr/5f4ceb8a0d090142ec8da76b4c14e49d3573737e/pkgdown/favicon/favicon.ico -------------------------------------------------------------------------------- /revdep/README.md: -------------------------------------------------------------------------------- 1 | # Revdeps 2 | 3 | -------------------------------------------------------------------------------- /revdep/cran.md: -------------------------------------------------------------------------------- 1 | ## revdepcheck results 2 | 3 | We checked 4 reverse dependencies, comparing R CMD check results across CRAN and dev versions of this package. 4 | 5 | * We saw 0 new problems 6 | * We failed to check 0 packages 7 | 8 | -------------------------------------------------------------------------------- /revdep/failures.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /revdep/problems.md: -------------------------------------------------------------------------------- 1 | *Wow, no problems at all. :)* -------------------------------------------------------------------------------- /src/.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.so 3 | *.dll 4 | -------------------------------------------------------------------------------- /src/at.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | 8 | #include "utils.h" 9 | 10 | [[cpp11::register]] 11 | cpp11::doubles numeric_at_interpolator(cpp11::doubles from, cpp11::doubles to, 12 | cpp11::doubles at, cpp11::strings ease) { 13 | R_xlen_t n = from.size(); 14 | std::string easer = ease[0]; 15 | cpp11::writable::doubles res(n); 16 | 17 | for (R_xlen_t i = 0; i < n; ++i) { 18 | double pos = ease_pos(at[i], easer); 19 | res[i] = from[i] + (to[i] - from[i]) * pos; 20 | } 21 | 22 | return res; 23 | } 24 | [[cpp11::register]] 25 | cpp11::doubles_matrix<> colour_at_interpolator(cpp11::doubles_matrix<> from, cpp11::doubles_matrix<> to, 26 | cpp11::doubles at, cpp11::strings ease) { 27 | R_xlen_t n = from.nrow(), m = from.ncol(); 28 | std::string easer = ease[0]; 29 | cpp11::writable::doubles_matrix<> res(n, m); 30 | 31 | for (R_xlen_t i = 0; i < n; ++i) { 32 | double pos = ease_pos(at[i], easer); 33 | for (R_xlen_t j = 0; j < m; ++j) { 34 | res(i, j) = from(i, j) + (to(i, j) - from(i, j)) * pos; 35 | } 36 | } 37 | 38 | return res; 39 | } 40 | [[cpp11::register]] 41 | cpp11::strings constant_at_interpolator(cpp11::strings from, cpp11::strings to, 42 | cpp11::doubles at, cpp11::strings ease) { 43 | R_xlen_t n = from.size(); 44 | std::string easer = ease[0]; 45 | cpp11::writable::strings res(n); 46 | 47 | for (R_xlen_t i = 0; i < n; ++i) { 48 | double pos = ease_pos(at[i], easer); 49 | res[i] = pos < 0.5 ? from[i] : to[i]; 50 | } 51 | 52 | return res; 53 | } 54 | [[cpp11::register]] 55 | cpp11::list list_at_interpolator(cpp11::list from, cpp11::list to, 56 | cpp11::doubles at, cpp11::strings ease) { 57 | R_xlen_t n = from.size(); 58 | std::string easer = ease[0]; 59 | cpp11::writable::list res(n); 60 | 61 | for (R_xlen_t i = 0; i < n; ++i) { 62 | double pos = ease_pos(at[i], easer); 63 | res[i] = pos < 0.5 ? from[i] : to[i]; 64 | } 65 | 66 | return res; 67 | } 68 | [[cpp11::register]] 69 | cpp11::list numlist_at_interpolator(cpp11::list_of from, cpp11::list_of to, 70 | cpp11::doubles at, cpp11::strings ease) { 71 | R_xlen_t n = from.size(); 72 | std::string easer = ease[0]; 73 | cpp11::writable::list res(n); 74 | 75 | for (R_xlen_t i = 0; i < n; ++i) { 76 | cpp11::doubles state_from_vec = from[i]; 77 | cpp11::doubles state_to_vec = to[i]; 78 | state_from_vec = align_num_elem(state_from_vec, state_to_vec); 79 | state_to_vec = align_num_elem(state_to_vec, state_from_vec); 80 | double pos = ease_pos(at[i], easer); 81 | cpp11::writable::doubles state_vec(state_from_vec.size()); 82 | for (R_xlen_t i = 0; i < state_from_vec.size(); ++i) { 83 | state_vec[i] = state_from_vec[i] + pos * (state_to_vec[i] - state_from_vec[i]); 84 | } 85 | res[i] = state_vec; 86 | } 87 | 88 | return res; 89 | } 90 | 91 | [[cpp11::register]] 92 | cpp11::doubles numeric_at_t_interpolator(cpp11::doubles from, cpp11::doubles to, 93 | cpp11::doubles at, cpp11::strings ease) { 94 | R_xlen_t n = from.size(); 95 | R_xlen_t m = at.size(); 96 | std::string easer = ease[0]; 97 | cpp11::writable::doubles res; 98 | 99 | for (R_xlen_t j = 0; j < m; ++j) { 100 | double pos = ease_pos(at[j], easer); 101 | for (R_xlen_t i = 0; i < n; ++i) { 102 | res.push_back(from[i] + (to[i] - from[i]) * pos); 103 | } 104 | } 105 | 106 | return res; 107 | } 108 | [[cpp11::register]] 109 | cpp11::doubles_matrix<> colour_at_t_interpolator(cpp11::doubles_matrix<> from, cpp11::doubles_matrix<> to, 110 | cpp11::doubles at, cpp11::strings ease) { 111 | R_xlen_t n = from.nrow(), nn = from.ncol(); 112 | R_xlen_t m = at.size(); 113 | std::string easer = ease[0]; 114 | cpp11::writable::doubles_matrix<> res(n*m, nn); 115 | 116 | for (R_xlen_t j = 0; j < m; ++j) { 117 | double pos = ease_pos(at[j], easer); 118 | for (R_xlen_t i = 0; i < n; ++i) { 119 | for (R_xlen_t k = 0; k < nn; ++k) { 120 | res(i, k) = from(i, k) + (to(i, k) - from(i, k)) * pos; 121 | } 122 | } 123 | } 124 | 125 | return res; 126 | } 127 | [[cpp11::register]] 128 | cpp11::strings constant_at_t_interpolator(cpp11::strings from, cpp11::strings to, 129 | cpp11::doubles at, cpp11::strings ease) { 130 | R_xlen_t n = from.size(); 131 | R_xlen_t m = at.size(); 132 | std::string easer = ease[0]; 133 | cpp11::writable::strings res; 134 | 135 | for (R_xlen_t j = 0; j < m; ++j) { 136 | double pos = ease_pos(at[j], easer); 137 | for (R_xlen_t i = 0; i < n; ++i) { 138 | res.push_back(pos < 0.5 ? from[i] : to[i]); 139 | } 140 | } 141 | 142 | return res; 143 | } 144 | [[cpp11::register]] 145 | cpp11::list list_at_t_interpolator(cpp11::list from, cpp11::list to, 146 | cpp11::doubles at, cpp11::strings ease) { 147 | R_xlen_t n = from.size(); 148 | R_xlen_t m = at.size(); 149 | std::string easer = ease[0]; 150 | cpp11::writable::list res; 151 | 152 | for (R_xlen_t j = 0; j < m; ++j) { 153 | double pos = ease_pos(at[j], easer); 154 | for (R_xlen_t i = 0; i < n; ++i) { 155 | res.push_back(pos < 0.5 ? from[i] : to[i]); 156 | } 157 | } 158 | 159 | return res; 160 | } 161 | [[cpp11::register]] 162 | cpp11::list numlist_at_t_interpolator(cpp11::list_of from, cpp11::list_of to, 163 | cpp11::doubles at, cpp11::strings ease) { 164 | R_xlen_t n = from.size(); 165 | R_xlen_t m = at.size(); 166 | std::string easer = ease[0]; 167 | cpp11::writable::list res; 168 | 169 | std::vector aligned_from, aligned_to; 170 | 171 | for (R_xlen_t i = 0; i < n; ++i) { 172 | aligned_from.push_back(align_num_elem(from[i], to[i])); 173 | aligned_to.push_back(align_num_elem(to[i], aligned_from.back())); 174 | } 175 | 176 | for (R_xlen_t j = 0; j < m; ++j) { 177 | double pos = ease_pos(at[j], easer); 178 | for (R_xlen_t i = 0; i < n; ++i) { 179 | cpp11::writable::doubles state_vec(aligned_from[i].size()); 180 | for (R_xlen_t k = 0; k < aligned_from[i].size(); ++k) { 181 | state_vec[k] = aligned_from[i][k] + pos * (aligned_to[i][k] - aligned_from[i][k]); 182 | } 183 | res.push_back(state_vec); 184 | } 185 | } 186 | 187 | return res; 188 | } 189 | -------------------------------------------------------------------------------- /src/easing.c: -------------------------------------------------------------------------------- 1 | // 2 | // easing.c 3 | // 4 | // Copyright (c) 2011, Auerhaus Development, LLC 5 | // 6 | // This program is free software. It comes without any warranty, to 7 | // the extent permitted by applicable law. You can redistribute it 8 | // and/or modify it under the terms of the Do What The Fuck You Want 9 | // To Public License, Version 2, as published by Sam Hocevar. See 10 | // http://sam.zoy.org/wtfpl/COPYING for more details. 11 | // 12 | 13 | #define _USE_MATH_DEFINES 14 | #include 15 | #include "easing.h" 16 | 17 | // Modeled after the line y = x 18 | AHFloat LinearInterpolation(AHFloat p) 19 | { 20 | return p; 21 | } 22 | 23 | // Modeled after the parabola y = x^2 24 | AHFloat QuadraticEaseIn(AHFloat p) 25 | { 26 | return p * p; 27 | } 28 | 29 | // Modeled after the parabola y = -x^2 + 2x 30 | AHFloat QuadraticEaseOut(AHFloat p) 31 | { 32 | return -(p * (p - 2)); 33 | } 34 | 35 | // Modeled after the piecewise quadratic 36 | // y = (1/2)((2x)^2) ; [0, 0.5) 37 | // y = -(1/2)((2x-1)*(2x-3) - 1) ; [0.5, 1] 38 | AHFloat QuadraticEaseInOut(AHFloat p) 39 | { 40 | if(p < 0.5) 41 | { 42 | return 2 * p * p; 43 | } 44 | else 45 | { 46 | return (-2 * p * p) + (4 * p) - 1; 47 | } 48 | } 49 | 50 | // Modeled after the cubic y = x^3 51 | AHFloat CubicEaseIn(AHFloat p) 52 | { 53 | return p * p * p; 54 | } 55 | 56 | // Modeled after the cubic y = (x - 1)^3 + 1 57 | AHFloat CubicEaseOut(AHFloat p) 58 | { 59 | AHFloat f = (p - 1); 60 | return f * f * f + 1; 61 | } 62 | 63 | // Modeled after the piecewise cubic 64 | // y = (1/2)((2x)^3) ; [0, 0.5) 65 | // y = (1/2)((2x-2)^3 + 2) ; [0.5, 1] 66 | AHFloat CubicEaseInOut(AHFloat p) 67 | { 68 | if(p < 0.5) 69 | { 70 | return 4 * p * p * p; 71 | } 72 | else 73 | { 74 | AHFloat f = ((2 * p) - 2); 75 | return 0.5 * f * f * f + 1; 76 | } 77 | } 78 | 79 | // Modeled after the quartic x^4 80 | AHFloat QuarticEaseIn(AHFloat p) 81 | { 82 | return p * p * p * p; 83 | } 84 | 85 | // Modeled after the quartic y = 1 - (x - 1)^4 86 | AHFloat QuarticEaseOut(AHFloat p) 87 | { 88 | AHFloat f = (p - 1); 89 | return f * f * f * (1 - p) + 1; 90 | } 91 | 92 | // Modeled after the piecewise quartic 93 | // y = (1/2)((2x)^4) ; [0, 0.5) 94 | // y = -(1/2)((2x-2)^4 - 2) ; [0.5, 1] 95 | AHFloat QuarticEaseInOut(AHFloat p) 96 | { 97 | if(p < 0.5) 98 | { 99 | return 8 * p * p * p * p; 100 | } 101 | else 102 | { 103 | AHFloat f = (p - 1); 104 | return -8 * f * f * f * f + 1; 105 | } 106 | } 107 | 108 | // Modeled after the quintic y = x^5 109 | AHFloat QuinticEaseIn(AHFloat p) 110 | { 111 | return p * p * p * p * p; 112 | } 113 | 114 | // Modeled after the quintic y = (x - 1)^5 + 1 115 | AHFloat QuinticEaseOut(AHFloat p) 116 | { 117 | AHFloat f = (p - 1); 118 | return f * f * f * f * f + 1; 119 | } 120 | 121 | // Modeled after the piecewise quintic 122 | // y = (1/2)((2x)^5) ; [0, 0.5) 123 | // y = (1/2)((2x-2)^5 + 2) ; [0.5, 1] 124 | AHFloat QuinticEaseInOut(AHFloat p) 125 | { 126 | if(p < 0.5) 127 | { 128 | return 16 * p * p * p * p * p; 129 | } 130 | else 131 | { 132 | AHFloat f = ((2 * p) - 2); 133 | return 0.5 * f * f * f * f * f + 1; 134 | } 135 | } 136 | 137 | // Modeled after quarter-cycle of sine wave 138 | AHFloat SineEaseIn(AHFloat p) 139 | { 140 | return sin((p - 1) * M_PI_2) + 1; 141 | } 142 | 143 | // Modeled after quarter-cycle of sine wave (different phase) 144 | AHFloat SineEaseOut(AHFloat p) 145 | { 146 | return sin(p * M_PI_2); 147 | } 148 | 149 | // Modeled after half sine wave 150 | AHFloat SineEaseInOut(AHFloat p) 151 | { 152 | return 0.5 * (1 - cos(p * M_PI)); 153 | } 154 | 155 | // Modeled after shifted quadrant IV of unit circle 156 | AHFloat CircularEaseIn(AHFloat p) 157 | { 158 | return 1 - sqrt(1 - (p * p)); 159 | } 160 | 161 | // Modeled after shifted quadrant II of unit circle 162 | AHFloat CircularEaseOut(AHFloat p) 163 | { 164 | return sqrt((2 - p) * p); 165 | } 166 | 167 | // Modeled after the piecewise circular function 168 | // y = (1/2)(1 - sqrt(1 - 4x^2)) ; [0, 0.5) 169 | // y = (1/2)(sqrt(-(2x - 3)*(2x - 1)) + 1) ; [0.5, 1] 170 | AHFloat CircularEaseInOut(AHFloat p) 171 | { 172 | if(p < 0.5) 173 | { 174 | return 0.5 * (1 - sqrt(1 - 4 * (p * p))); 175 | } 176 | else 177 | { 178 | return 0.5 * (sqrt(-((2 * p) - 3) * ((2 * p) - 1)) + 1); 179 | } 180 | } 181 | 182 | // Modeled after the exponential function y = 2^(10(x - 1)) 183 | AHFloat ExponentialEaseIn(AHFloat p) 184 | { 185 | return (p == 0.0) ? p : pow(2, 10 * (p - 1)); 186 | } 187 | 188 | // Modeled after the exponential function y = -2^(-10x) + 1 189 | AHFloat ExponentialEaseOut(AHFloat p) 190 | { 191 | return (p == 1.0) ? p : 1 - pow(2, -10 * p); 192 | } 193 | 194 | // Modeled after the piecewise exponential 195 | // y = (1/2)2^(10(2x - 1)) ; [0,0.5) 196 | // y = -(1/2)*2^(-10(2x - 1))) + 1 ; [0.5,1] 197 | AHFloat ExponentialEaseInOut(AHFloat p) 198 | { 199 | if(p == 0.0 || p == 1.0) return p; 200 | 201 | if(p < 0.5) 202 | { 203 | return 0.5 * pow(2, (20 * p) - 10); 204 | } 205 | else 206 | { 207 | return -0.5 * pow(2, (-20 * p) + 10) + 1; 208 | } 209 | } 210 | 211 | // Modeled after the damped sine wave y = sin(13pi/2*x)*pow(2, 10 * (x - 1)) 212 | AHFloat ElasticEaseIn(AHFloat p) 213 | { 214 | return sin(13 * M_PI_2 * p) * pow(2, 10 * (p - 1)); 215 | } 216 | 217 | // Modeled after the damped sine wave y = sin(-13pi/2*(x + 1))*pow(2, -10x) + 1 218 | AHFloat ElasticEaseOut(AHFloat p) 219 | { 220 | return sin(-13 * M_PI_2 * (p + 1)) * pow(2, -10 * p) + 1; 221 | } 222 | 223 | // Modeled after the piecewise exponentially-damped sine wave: 224 | // y = (1/2)*sin(13pi/2*(2*x))*pow(2, 10 * ((2*x) - 1)) ; [0,0.5) 225 | // y = (1/2)*(sin(-13pi/2*((2x-1)+1))*pow(2,-10(2*x-1)) + 2) ; [0.5, 1] 226 | AHFloat ElasticEaseInOut(AHFloat p) 227 | { 228 | if(p < 0.5) 229 | { 230 | return 0.5 * sin(13 * M_PI_2 * (2 * p)) * pow(2, 10 * ((2 * p) - 1)); 231 | } 232 | else 233 | { 234 | return 0.5 * (sin(-13 * M_PI_2 * ((2 * p - 1) + 1)) * pow(2, -10 * (2 * p - 1)) + 2); 235 | } 236 | } 237 | 238 | // Modeled after the overshooting cubic y = x^3-x*sin(x*pi) 239 | AHFloat BackEaseIn(AHFloat p) 240 | { 241 | return p * p * p - p * sin(p * M_PI); 242 | } 243 | 244 | // Modeled after overshooting cubic y = 1-((1-x)^3-(1-x)*sin((1-x)*pi)) 245 | AHFloat BackEaseOut(AHFloat p) 246 | { 247 | AHFloat f = (1 - p); 248 | return 1 - (f * f * f - f * sin(f * M_PI)); 249 | } 250 | 251 | // Modeled after the piecewise overshooting cubic function: 252 | // y = (1/2)*((2x)^3-(2x)*sin(2*x*pi)) ; [0, 0.5) 253 | // y = (1/2)*(1-((1-x)^3-(1-x)*sin((1-x)*pi))+1) ; [0.5, 1] 254 | AHFloat BackEaseInOut(AHFloat p) 255 | { 256 | if(p < 0.5) 257 | { 258 | AHFloat f = 2 * p; 259 | return 0.5 * (f * f * f - f * sin(f * M_PI)); 260 | } 261 | else 262 | { 263 | AHFloat f = (1 - (2*p - 1)); 264 | return 0.5 * (1 - (f * f * f - f * sin(f * M_PI))) + 0.5; 265 | } 266 | } 267 | 268 | AHFloat BounceEaseIn(AHFloat p) 269 | { 270 | return 1 - BounceEaseOut(1 - p); 271 | } 272 | 273 | AHFloat BounceEaseOut(AHFloat p) 274 | { 275 | if(p < 4/11.0) 276 | { 277 | return (121 * p * p)/16.0; 278 | } 279 | else if(p < 8/11.0) 280 | { 281 | return (363/40.0 * p * p) - (99/10.0 * p) + 17/5.0; 282 | } 283 | else if(p < 9/10.0) 284 | { 285 | return (4356/361.0 * p * p) - (35442/1805.0 * p) + 16061/1805.0; 286 | } 287 | else 288 | { 289 | return (54/5.0 * p * p) - (513/25.0 * p) + 268/25.0; 290 | } 291 | } 292 | 293 | AHFloat BounceEaseInOut(AHFloat p) 294 | { 295 | if(p < 0.5) 296 | { 297 | return 0.5 * BounceEaseIn(p*2); 298 | } 299 | else 300 | { 301 | return 0.5 * BounceEaseOut(p * 2 - 1) + 0.5; 302 | } 303 | } 304 | -------------------------------------------------------------------------------- /src/easing.h: -------------------------------------------------------------------------------- 1 | // 2 | // easing.h 3 | // 4 | // Copyright (c) 2011, Auerhaus Development, LLC 5 | // 6 | // This program is free software. It comes without any warranty, to 7 | // the extent permitted by applicable law. You can redistribute it 8 | // and/or modify it under the terms of the Do What The Fuck You Want 9 | // To Public License, Version 2, as published by Sam Hocevar. See 10 | // http://sam.zoy.org/wtfpl/COPYING for more details. 11 | // 12 | 13 | #ifndef AH_EASING_H 14 | #define AH_EASING_H 15 | 16 | #if defined(__LP64__) && !defined(AH_EASING_USE_DBL_PRECIS) 17 | #define AH_EASING_USE_DBL_PRECIS 18 | #endif 19 | 20 | #ifdef AH_EASING_USE_DBL_PRECIS 21 | #define AHFloat double 22 | #else 23 | #define AHFloat float 24 | #endif 25 | 26 | #if defined __cplusplus 27 | extern "C" { 28 | #endif 29 | 30 | typedef AHFloat (*AHEasingFunction)(AHFloat); 31 | 32 | // Linear interpolation (no easing) 33 | AHFloat LinearInterpolation(AHFloat p); 34 | 35 | // Quadratic easing; p^2 36 | AHFloat QuadraticEaseIn(AHFloat p); 37 | AHFloat QuadraticEaseOut(AHFloat p); 38 | AHFloat QuadraticEaseInOut(AHFloat p); 39 | 40 | // Cubic easing; p^3 41 | AHFloat CubicEaseIn(AHFloat p); 42 | AHFloat CubicEaseOut(AHFloat p); 43 | AHFloat CubicEaseInOut(AHFloat p); 44 | 45 | // Quartic easing; p^4 46 | AHFloat QuarticEaseIn(AHFloat p); 47 | AHFloat QuarticEaseOut(AHFloat p); 48 | AHFloat QuarticEaseInOut(AHFloat p); 49 | 50 | // Quintic easing; p^5 51 | AHFloat QuinticEaseIn(AHFloat p); 52 | AHFloat QuinticEaseOut(AHFloat p); 53 | AHFloat QuinticEaseInOut(AHFloat p); 54 | 55 | // Sine wave easing; sin(p * PI/2) 56 | AHFloat SineEaseIn(AHFloat p); 57 | AHFloat SineEaseOut(AHFloat p); 58 | AHFloat SineEaseInOut(AHFloat p); 59 | 60 | // Circular easing; sqrt(1 - p^2) 61 | AHFloat CircularEaseIn(AHFloat p); 62 | AHFloat CircularEaseOut(AHFloat p); 63 | AHFloat CircularEaseInOut(AHFloat p); 64 | 65 | // Exponential easing, base 2 66 | AHFloat ExponentialEaseIn(AHFloat p); 67 | AHFloat ExponentialEaseOut(AHFloat p); 68 | AHFloat ExponentialEaseInOut(AHFloat p); 69 | 70 | // Exponentially-damped sine wave easing 71 | AHFloat ElasticEaseIn(AHFloat p); 72 | AHFloat ElasticEaseOut(AHFloat p); 73 | AHFloat ElasticEaseInOut(AHFloat p); 74 | 75 | // Overshooting cubic easing; 76 | AHFloat BackEaseIn(AHFloat p); 77 | AHFloat BackEaseOut(AHFloat p); 78 | AHFloat BackEaseInOut(AHFloat p); 79 | 80 | // Exponentially-decaying bounce easing 81 | AHFloat BounceEaseIn(AHFloat p); 82 | AHFloat BounceEaseOut(AHFloat p); 83 | AHFloat BounceEaseInOut(AHFloat p); 84 | 85 | #ifdef __cplusplus 86 | } 87 | #endif 88 | 89 | #endif 90 | -------------------------------------------------------------------------------- /src/element_at.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | 9 | #include "utils.h" 10 | 11 | using namespace cpp11::literals; 12 | 13 | [[cpp11::register]] 14 | cpp11::writable::doubles numeric_element_at_interpolator(cpp11::doubles data, cpp11::integers group, cpp11::doubles time, double at, cpp11::strings ease) { 15 | cpp11::writable::doubles tweendata; 16 | 17 | for (R_xlen_t i = 1; i < data.size(); ++i) { 18 | if ((group[i - 1] == group[i] && time[i - 1] < at && time[i] >= at) || 19 | ((i == 1 || group[i - 2] != group[i - 1]) && time[i - 1] == at)) { 20 | double p = ease_pos((at - time[i - 1]) / (time[i] - time[i - 1]), ease[i - 1]); 21 | tweendata.push_back(data[i - 1] + p * (data[i] - data[i - 1])); 22 | } 23 | } 24 | 25 | return tweendata; 26 | } 27 | 28 | [[cpp11::register]] 29 | cpp11::writable::data_frame colour_element_at_interpolator(cpp11::doubles_matrix<> data, cpp11::integers group, cpp11::doubles time, double at, cpp11::strings ease) { 30 | cpp11::writable::doubles tweendata1; 31 | cpp11::writable::doubles tweendata2; 32 | cpp11::writable::doubles tweendata3; 33 | cpp11::writable::doubles tweendata4; 34 | 35 | for (R_xlen_t i = 1; i < data.nrow(); ++i) { 36 | if ((group[i - 1] == group[i] && time[i - 1] < at && time[i] >= at) || 37 | ((i == 1 || group[i - 2] != group[i - 1]) && time[i - 1] == at)) { 38 | double p = ease_pos((at - time[i - 1]) / (time[i] - time[i - 1]), ease[i - 1]); 39 | tweendata1.push_back(data(i - 1, 0) + p * (data(i, 0) - data(i - 1, 0))); 40 | tweendata2.push_back(data(i - 1, 1) + p * (data(i, 1) - data(i - 1, 1))); 41 | tweendata3.push_back(data(i - 1, 2) + p * (data(i, 2) - data(i - 1, 2))); 42 | tweendata4.push_back(data(i - 1, 3) + p * (data(i, 3) - data(i - 1, 3))); 43 | 44 | } 45 | } 46 | 47 | return cpp11::writable::data_frame({ 48 | "L"_nm = tweendata1, 49 | "a"_nm = tweendata2, 50 | "b"_nm = tweendata3, 51 | "alpha"_nm = tweendata4 52 | }); 53 | } 54 | 55 | [[cpp11::register]] 56 | cpp11::writable::strings constant_element_at_interpolator(cpp11::strings data, cpp11::integers group, cpp11::doubles time, double at, cpp11::strings ease) { 57 | cpp11::writable::strings tweendata; 58 | 59 | for (R_xlen_t i = 1; i < data.size(); ++i) { 60 | if ((group[i - 1] == group[i] && time[i - 1] < at && time[i] >= at) || 61 | ((i == 1 || group[i - 2] != group[i - 1]) && time[i - 1] == at)) { 62 | double p = ease_pos((at - time[i - 1]) / (time[i] - time[i - 1]), ease[i - 1]); 63 | tweendata.push_back(p < 0.5 ? data[i - 1] : data[i]); 64 | } 65 | } 66 | 67 | return tweendata; 68 | } 69 | 70 | [[cpp11::register]] 71 | cpp11::writable::list list_element_at_interpolator(cpp11::list data, cpp11::integers group, cpp11::doubles time, double at, cpp11::strings ease) { 72 | cpp11::writable::list tweendata; 73 | 74 | for (R_xlen_t i = 1; i < data.size(); ++i) { 75 | if ((group[i - 1] == group[i] && time[i - 1] < at && time[i] >= at) || 76 | ((i == 1 || group[i - 2] != group[i - 1]) && time[i - 1] == at)) { 77 | double p = ease_pos((at - time[i - 1]) / (time[i] - time[i - 1]), ease[i - 1]); 78 | tweendata.push_back(p < 0.5 ? data[i - 1] : data[i]); 79 | } 80 | } 81 | 82 | return tweendata; 83 | } 84 | 85 | [[cpp11::register]] 86 | cpp11::writable::list numlist_element_at_interpolator(cpp11::list_of data, cpp11::integers group, cpp11::doubles time, double at, cpp11::strings ease) { 87 | cpp11::writable::list tweendata; 88 | 89 | for (R_xlen_t i = 1; i < data.size(); ++i) { 90 | if ((group[i - 1] == group[i] && time[i - 1] < at && time[i] >= at) || 91 | ((i == 1 || group[i - 2] != group[i - 1]) && time[i - 1] == at)) { 92 | double p = ease_pos((at - time[i - 1]) / (time[i] - time[i - 1]), ease[i - 1]); 93 | cpp11::doubles state_from_vec = data[i - 1]; 94 | cpp11::doubles state_to_vec = data[i]; 95 | state_from_vec = align_num_elem(state_from_vec, state_to_vec); 96 | state_to_vec = align_num_elem(state_to_vec, state_from_vec); 97 | cpp11::writable::doubles state_vec(state_from_vec.size()); 98 | for (R_xlen_t i = 0; i < state_from_vec.size(); ++i) { 99 | state_vec[i] = state_from_vec[i] + p * (state_to_vec[i] - state_from_vec[i]); 100 | } 101 | tweendata.push_back(state_vec); 102 | } 103 | } 104 | 105 | return tweendata; 106 | } 107 | 108 | [[cpp11::register]] 109 | cpp11::writable::strings phase_element_at_interpolator(cpp11::strings data, cpp11::integers group, cpp11::doubles time, double at, cpp11::strings ease) { 110 | cpp11::writable::strings tweendata; 111 | 112 | for (R_xlen_t i = 1; i < data.size(); ++i) { 113 | if ((group[i - 1] == group[i] && time[i - 1] < at && time[i] >= at) || 114 | ((i == 1 || group[i - 2] != group[i - 1]) && time[i - 1] == at)) { 115 | if ((at == time[i - 2] && !(data[i - 1] == "enter")) || (at == time[i] && !(data[i] == "exit"))) { 116 | tweendata.push_back("raw"); 117 | } else{ 118 | tweendata.push_back(data[i - 1] == "enter" ? "enter" : data[i] == "exit" ? "exit" : data[i - 1] == "static" ? "static" : "transition"); 119 | } 120 | } 121 | } 122 | 123 | return tweendata; 124 | } 125 | -------------------------------------------------------------------------------- /src/fill.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | 8 | #include "utils.h" 9 | 10 | [[cpp11::register]] 11 | cpp11::doubles numeric_fill_interpolator(cpp11::doubles data, cpp11::strings ease) { 12 | cpp11::writable::doubles res(data.size()); 13 | std::fill(res.begin(), res.end(), R_NaReal); 14 | int last = -1; 15 | std::string easer = ease[0]; 16 | 17 | for (R_xlen_t i = 0; i < data.size(); ++i) { 18 | if (cpp11::is_na(data[i])) continue; 19 | if (last != -1) { 20 | std::vector easepos = ease_seq(easer, i - last); 21 | for (size_t j = 1; j < easepos.size(); ++j) { 22 | res[last + j] = data[last] + easepos[j] * (data[i] - data[last]); 23 | } 24 | } 25 | res[i] = data[i]; 26 | last = i; 27 | } 28 | 29 | return res; 30 | } 31 | [[cpp11::register]] 32 | cpp11::doubles_matrix<> colour_fill_interpolator(cpp11::doubles_matrix<> data, cpp11::strings ease) { 33 | cpp11::writable::doubles_matrix<> res(data.nrow(), data.ncol()); 34 | for (int i = 0; i < res.nrow(); ++i) { 35 | for (int j = 0; j < res.ncol(); ++j) { 36 | res(i, j) = R_NaReal; 37 | } 38 | } 39 | int last = -1; 40 | std::string easer = ease[0]; 41 | 42 | for (R_xlen_t i = 0; i < data.nrow(); ++i) { 43 | if (cpp11::is_na(data(i, 0))) continue; 44 | if (last != -1) { 45 | std::vector easepos = ease_seq(easer, i - last); 46 | for (size_t j = 1; j < easepos.size(); ++j) { 47 | for (R_xlen_t k = 0; k < data.ncol(); ++k) { 48 | res(last + j, k) = data(last, k) + easepos[j] * (data(i, k) - data(last, k)); 49 | } 50 | } 51 | } 52 | for (R_xlen_t k = 0; k < data.ncol(); ++k) { 53 | res(i, k) = data(i, k); 54 | } 55 | last = i; 56 | } 57 | 58 | return res; 59 | } 60 | [[cpp11::register]] 61 | cpp11::strings constant_fill_interpolator(cpp11::strings data, cpp11::strings ease) { 62 | cpp11::writable::strings res(data.size()); 63 | std::fill(res.begin(), res.end(), R_NaString); 64 | int last = -1; 65 | std::string easer = ease[0]; 66 | 67 | for (R_xlen_t i = 0; i < data.size(); ++i) { 68 | if (cpp11::is_na(data[i])) continue; 69 | if (last != -1) { 70 | std::vector easepos = ease_seq(easer, i - last); 71 | for (size_t j = 1; j < easepos.size(); ++j) { 72 | res[last + j] = easepos[j] < 0.5 ? data[last] : data[i]; 73 | } 74 | } 75 | res[i] = data[i]; 76 | last = i; 77 | } 78 | 79 | return res; 80 | } 81 | [[cpp11::register]] 82 | cpp11::list list_fill_interpolator(cpp11::list data, cpp11::strings ease) { 83 | cpp11::writable::list res(data.size()); 84 | std::fill(res.begin(), res.end(), R_NilValue); 85 | int last = -1; 86 | std::string easer = ease[0]; 87 | 88 | for (R_xlen_t i = 0; i < data.size(); ++i) { 89 | if (data[i] == R_NilValue) continue; 90 | if (last != -1) { 91 | std::vector easepos = ease_seq(easer, i - last); 92 | for (size_t j = 1; j < easepos.size(); ++j) { 93 | res[last + j] = easepos[j] < 0.5 ? data[last] : data[i]; 94 | } 95 | } 96 | res[i] = data[i]; 97 | last = i; 98 | } 99 | return res; 100 | } 101 | [[cpp11::register]] 102 | cpp11::list numlist_fill_interpolator(cpp11::list_of data, cpp11::strings ease) { 103 | cpp11::writable::list res(data.size()); 104 | std::fill(res.begin(), res.end(), R_NilValue); 105 | int last = -1; 106 | std::string easer = ease[0]; 107 | 108 | for (R_xlen_t i = 0; i < data.size(); ++i) { 109 | if (data[i] == R_NilValue) continue; 110 | if (last != -1) { 111 | std::vector easepos = ease_seq(easer, i - last); 112 | cpp11::doubles state_from_vec = data[last]; 113 | cpp11::doubles state_to_vec = data[i]; 114 | state_from_vec = align_num_elem(state_from_vec, state_to_vec); 115 | state_to_vec = align_num_elem(state_to_vec, state_from_vec); 116 | res[last] = data[last]; 117 | for (size_t j = 1; j < easepos.size(); ++j) { 118 | cpp11::writable::doubles state_vec(state_from_vec.size()); 119 | for (R_xlen_t k = 0; k < state_from_vec.size(); ++k) { 120 | state_vec[k] = state_from_vec[k] + easepos[j] * (state_to_vec[k] - state_from_vec[k]); 121 | } 122 | res[last + j] = state_vec; 123 | } 124 | } 125 | res[i] = data[i]; 126 | last = i; 127 | } 128 | return res; 129 | } 130 | -------------------------------------------------------------------------------- /src/utils.h: -------------------------------------------------------------------------------- 1 | #pragma once 2 | 3 | #include 4 | #include 5 | #include "cpp11/doubles.hpp" 6 | #include "easing.h" 7 | 8 | enum Easer { 9 | linear, 10 | quadratic_in, 11 | quadratic_out, 12 | quadratic_in_out, 13 | cubic_in, 14 | cubic_out, 15 | cubic_in_out, 16 | quartic_in, 17 | quartic_out, 18 | quartic_in_out, 19 | quintic_in, 20 | quintic_out, 21 | quintic_in_out, 22 | sine_in, 23 | sine_out, 24 | sine_in_out, 25 | circular_in, 26 | circular_out, 27 | circular_in_out, 28 | exponential_in, 29 | exponential_out, 30 | exponential_in_out, 31 | elastic_in, 32 | elastic_out, 33 | elastic_in_out, 34 | back_in, 35 | back_out, 36 | back_in_out, 37 | bounce_in, 38 | bounce_out, 39 | bounce_in_out, 40 | UNKNOWN 41 | }; 42 | static inline Easer get_easer(std::string ease) { 43 | if (ease == "linear") return linear; 44 | if (ease == "quadratic-in") return quadratic_in; 45 | if (ease == "quadratic-out") return quadratic_out; 46 | if (ease == "quadratic-in-out") return quadratic_in_out; 47 | if (ease == "cubic-in") return cubic_in; 48 | if (ease == "cubic-out") return cubic_out; 49 | if (ease == "cubic-in-out") return cubic_in_out; 50 | if (ease == "quartic-in") return quartic_in; 51 | if (ease == "quartic-out") return quartic_out; 52 | if (ease == "quartic-in-out") return quartic_in_out; 53 | if (ease == "quintic-in") return quintic_in; 54 | if (ease == "quintic-out") return quintic_out; 55 | if (ease == "quintic-in-out") return quintic_in_out; 56 | if (ease == "sine-in") return sine_in; 57 | if (ease == "sine-out") return sine_out; 58 | if (ease == "sine-in-out") return sine_in_out; 59 | if (ease == "circular-in") return circular_in; 60 | if (ease == "circular-out") return circular_out; 61 | if (ease == "circular-in-out") return circular_in_out; 62 | if (ease == "exponential-in") return exponential_in; 63 | if (ease == "exponential-out") return exponential_out; 64 | if (ease == "exponential-in-out") return exponential_in_out; 65 | if (ease == "elastic-in") return elastic_in; 66 | if (ease == "elastic-out") return elastic_out; 67 | if (ease == "elastic-in-out") return elastic_in_out; 68 | if (ease == "back-in") return back_in; 69 | if (ease == "back-out") return back_out; 70 | if (ease == "back-in-out") return back_in_out; 71 | if (ease == "bounce-in") return bounce_in; 72 | if (ease == "bounce-out") return bounce_out; 73 | if (ease == "bounce-in-out") return bounce_in_out; 74 | return UNKNOWN; 75 | } 76 | 77 | static inline std::vector ease_seq(std::string easer, int length) { 78 | std::vector res(length); 79 | double p; 80 | // Just linear for now 81 | for(int i = 0; i < length; ++i) { 82 | p = double(i) / length; 83 | switch (get_easer(easer)) { 84 | case linear: 85 | res[i] = LinearInterpolation(p); 86 | break; 87 | case quadratic_in: 88 | res[i] = QuadraticEaseIn(p); 89 | break; 90 | case quadratic_out: 91 | res[i] = QuadraticEaseOut(p); 92 | break; 93 | case quadratic_in_out: 94 | res[i] = QuadraticEaseInOut(p); 95 | break; 96 | case cubic_in: 97 | res[i] = CubicEaseIn(p); 98 | break; 99 | case cubic_out: 100 | res[i] = CubicEaseOut(p); 101 | break; 102 | case cubic_in_out: 103 | res[i] = CubicEaseInOut(p); 104 | break; 105 | case quartic_in: 106 | res[i] = QuarticEaseIn(p); 107 | break; 108 | case quartic_out: 109 | res[i] = QuarticEaseOut(p); 110 | break; 111 | case quartic_in_out: 112 | res[i] = QuarticEaseInOut(p); 113 | break; 114 | case quintic_in: 115 | res[i] = QuinticEaseIn(p); 116 | break; 117 | case quintic_out: 118 | res[i] = QuinticEaseOut(p); 119 | break; 120 | case quintic_in_out: 121 | res[i] = QuinticEaseInOut(p); 122 | break; 123 | case sine_in: 124 | res[i] = SineEaseIn(p); 125 | break; 126 | case sine_out: 127 | res[i] = SineEaseOut(p); 128 | break; 129 | case sine_in_out: 130 | res[i] = SineEaseInOut(p); 131 | break; 132 | case circular_in: 133 | res[i] = CircularEaseIn(p); 134 | break; 135 | case circular_out: 136 | res[i] = CircularEaseOut(p); 137 | break; 138 | case circular_in_out: 139 | res[i] = CircularEaseInOut(p); 140 | break; 141 | case exponential_in: 142 | res[i] = ExponentialEaseIn(p); 143 | break; 144 | case exponential_out: 145 | res[i] = ExponentialEaseOut(p); 146 | break; 147 | case exponential_in_out: 148 | res[i] = ExponentialEaseInOut(p); 149 | break; 150 | case elastic_in: 151 | res[i] = ElasticEaseIn(p); 152 | break; 153 | case elastic_out: 154 | res[i] = ElasticEaseOut(p); 155 | break; 156 | case elastic_in_out: 157 | res[i] = ElasticEaseInOut(p); 158 | break; 159 | case back_in: 160 | res[i] = BackEaseIn(p); 161 | break; 162 | case back_out: 163 | res[i] = BackEaseOut(p); 164 | break; 165 | case back_in_out: 166 | res[i] = BackEaseInOut(p); 167 | break; 168 | case bounce_in: 169 | res[i] = BounceEaseIn(p); 170 | break; 171 | case bounce_out: 172 | res[i] = BounceEaseOut(p); 173 | break; 174 | case bounce_in_out: 175 | res[i] = BounceEaseInOut(p); 176 | break; 177 | case UNKNOWN: 178 | cpp11::stop("Unknown easing function"); 179 | } 180 | } 181 | return res; 182 | } 183 | static inline double ease_pos(double p, std::string easer) { 184 | double p_new = 0; 185 | switch (get_easer(easer)) { 186 | case linear: 187 | p_new = LinearInterpolation(p); 188 | break; 189 | case quadratic_in: 190 | p_new = QuadraticEaseIn(p); 191 | break; 192 | case quadratic_out: 193 | p_new = QuadraticEaseOut(p); 194 | break; 195 | case quadratic_in_out: 196 | p_new = QuadraticEaseInOut(p); 197 | break; 198 | case cubic_in: 199 | p_new = CubicEaseIn(p); 200 | break; 201 | case cubic_out: 202 | p_new = CubicEaseOut(p); 203 | break; 204 | case cubic_in_out: 205 | p_new = CubicEaseInOut(p); 206 | break; 207 | case quartic_in: 208 | p_new = QuarticEaseIn(p); 209 | break; 210 | case quartic_out: 211 | p_new = QuarticEaseOut(p); 212 | break; 213 | case quartic_in_out: 214 | p_new = QuarticEaseInOut(p); 215 | break; 216 | case quintic_in: 217 | p_new = QuinticEaseIn(p); 218 | break; 219 | case quintic_out: 220 | p_new = QuinticEaseOut(p); 221 | break; 222 | case quintic_in_out: 223 | p_new = QuinticEaseInOut(p); 224 | break; 225 | case sine_in: 226 | p_new = SineEaseIn(p); 227 | break; 228 | case sine_out: 229 | p_new = SineEaseOut(p); 230 | break; 231 | case sine_in_out: 232 | p_new = SineEaseInOut(p); 233 | break; 234 | case circular_in: 235 | p_new = CircularEaseIn(p); 236 | break; 237 | case circular_out: 238 | p_new = CircularEaseOut(p); 239 | break; 240 | case circular_in_out: 241 | p_new = CircularEaseInOut(p); 242 | break; 243 | case exponential_in: 244 | p_new = ExponentialEaseIn(p); 245 | break; 246 | case exponential_out: 247 | p_new = ExponentialEaseOut(p); 248 | break; 249 | case exponential_in_out: 250 | p_new = ExponentialEaseInOut(p); 251 | break; 252 | case elastic_in: 253 | p_new = ElasticEaseIn(p); 254 | break; 255 | case elastic_out: 256 | p_new = ElasticEaseOut(p); 257 | break; 258 | case elastic_in_out: 259 | p_new = ElasticEaseInOut(p); 260 | break; 261 | case back_in: 262 | p_new = BackEaseIn(p); 263 | break; 264 | case back_out: 265 | p_new = BackEaseOut(p); 266 | break; 267 | case back_in_out: 268 | p_new = BackEaseInOut(p); 269 | break; 270 | case bounce_in: 271 | p_new = BounceEaseIn(p); 272 | break; 273 | case bounce_out: 274 | p_new = BounceEaseOut(p); 275 | break; 276 | case bounce_in_out: 277 | p_new = BounceEaseInOut(p); 278 | break; 279 | case UNKNOWN: 280 | cpp11::stop("Unknown easing function"); 281 | } 282 | return p_new; 283 | } 284 | 285 | static inline cpp11::doubles align_num_elem(cpp11::doubles from, cpp11::doubles to) { 286 | if (from.size() < to.size()) { 287 | cpp11::writable::doubles res(to.size()); 288 | if (from.size() == 0) { 289 | double mean = std::accumulate(to.begin(), to.end(), 0.0) / to.size(); 290 | std::fill(res.begin(), res.end(), mean); 291 | return res; 292 | } 293 | for (int i = 0; i < res.size(); ++i) { 294 | res[i] = from[i % from.size()]; 295 | } 296 | return res; 297 | } 298 | return from; 299 | } 300 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(tweenr) 3 | 4 | test_check("tweenr") 5 | -------------------------------------------------------------------------------- /tests/testthat/test-along.R: -------------------------------------------------------------------------------- 1 | context("along") 2 | 3 | df <- data.frame( 4 | x = c(1, 5, 7, 10), 5 | y = c(4, 3, 7, -1), 6 | col = c('black', 'red', 'green', 'blue'), 7 | type = letters[1:4], 8 | stringsAsFactors = FALSE 9 | ) 10 | 11 | test_that("tween_along works", { 12 | tween <- tween_along(df, ease = 'linear', nframes = 10, along = x) 13 | expect_equal(nrow(tween), 30) 14 | expect_equal(tween$col[22], '#78B785') 15 | expect_equal(tween$y[8], 3.25) 16 | 17 | tween <- tween_along(df, ease = 'linear', nframes = 10, along = x, history = FALSE) 18 | expect_equal(nrow(tween), 9) 19 | expect_equal(tween$col[8], '#78B785') 20 | expect_equal(tween$y[2], 3.75) 21 | }) 22 | 23 | test_that("tween_along throws errors", { 24 | expect_error(tween_along(df, ease = 'linear', nframes = 10, along = 1)) 25 | expect_error(tween_along(df, ease = 'linear', nframes = 10, along = x, id = 1)) 26 | expect_error(tween_along(df, ease = 'linear', nframes = 10, along = x, range = c(0, 0))) 27 | expect_error(tween_along(df[1,], ease = 'linear', nframes = 10, along = x)) 28 | }) 29 | -------------------------------------------------------------------------------- /tests/testthat/test-at.R: -------------------------------------------------------------------------------- 1 | context("at") 2 | 3 | df1 <- data.frame(x = 1:2, y = 4:5, col = 'black', type = letters[1:2], stringsAsFactors = FALSE) 4 | df2 <- data.frame(x = 11:12, y = 14:15, col = 'white', type = letters[1], stringsAsFactors = FALSE) 5 | 6 | test_that("tween_at works", { 7 | tween <- tween_at(df1, df2, 0.5, 'linear') 8 | expect_equal(nrow(tween), 2) 9 | expect_named(tween, names(df1)) 10 | expect_equal(tween$x, c(6, 7)) 11 | expect_equal(tween$col[1], '#777777') 12 | }) 13 | 14 | test_that("tween_at handles weird input", { 15 | tween <- tween_at(df1, df2[1,], 0.5, 'linear') 16 | expect_equal(nrow(tween), 2) 17 | tween <- tween_at(df1[1,], df2, 0.5, 'linear') 18 | expect_equal(nrow(tween), 2) 19 | tween <- tween_at(df1, df2[integer(),], 0.5, 'linear') 20 | expect_equal(nrow(tween), 0) 21 | tween <- tween_at(df1[integer(),], df2, 0.5, 'linear') 22 | expect_equal(nrow(tween), 0) 23 | expect_error(tween_at(df1[c(1,2,1), ], df2, 0.5, 'linear')) 24 | expect_error(tween_at(df1, df2, numeric(), 'linear')) 25 | expect_error(tween_at(df1, df2, 0.5, character())) 26 | }) 27 | 28 | test_that('tween_at works with vectors', { 29 | tween <- tween_at(df1$x, df2$x, 0.5, 'linear') 30 | expect_is(tween, 'numeric') 31 | expect_equal(tween, c(6,7)) 32 | expect_error(tween_at(df1$x, df2$col)) 33 | }) 34 | -------------------------------------------------------------------------------- /tests/testthat/test-components.R: -------------------------------------------------------------------------------- 1 | context("components") 2 | 3 | df <- data.frame( 4 | x = c(1, 5, 7, 10), 5 | y = c(4, 3, 7, -1), 6 | col = c('black', 'red', 'green', 'blue'), 7 | type = letters[1:4], 8 | stringsAsFactors = FALSE 9 | ) 10 | 11 | test_that("tween_components works", { 12 | tween <- tween_components(df, 'linear', nframes = 10, time = c(1, 7, 13, 20)) 13 | expect_equal(nrow(tween), 10) 14 | expect_equal(tween$x[6], 19/3) 15 | expect_equal(tween$col[2], '#52170B') 16 | expect_equal(max(tween$.frame), 10) 17 | expect_true(all(tween$.phase[c(1,4,7,10)] == 'raw')) 18 | expect_true(all(tween$.phase[-c(1,4,7,10)] == 'transition')) 19 | 20 | tween <- tween_components(df, 'linear', nframes = 10, time = c(1, 7, 13, 20), rep(c(1,2), 2)) 21 | expect_equal(nrow(tween), 14) 22 | expect_equal(tween$x[12], 25/3) 23 | expect_equal(tween$col[2], '#162A10') 24 | expect_equal(max(tween$.frame), 10) 25 | expect_true(all(tween$.phase[c(1,5,10,14)] == 'raw')) 26 | expect_true(all(tween$.phase[-c(1,5,10,14)] == 'transition')) 27 | }) 28 | 29 | test_that("enter/exit works", { 30 | tween <- tween_components(df, 'linear', nframes = 20, time = c(1, 7, 13, 20), enter = function(df) { 31 | df$x <- 0 32 | df$col <- 'red' 33 | df 34 | }, enter_length = 3) 35 | expect_equal(nrow(tween), 20) 36 | expect_equal(tween$x[3], 2/3, tolerance = 1e-7) 37 | expect_equal(tween$col[2], '#A51B0B') 38 | expect_equal(max(tween$.frame), 20) 39 | expect_true(all(tween$.phase[1:3] == 'enter')) 40 | }) 41 | 42 | test_that("weird input gets caught", { 43 | tween <- tween_components(df, 'linear', nframes = 0, time = c(1, 7, 13, 20)) 44 | expect_equal(nrow(tween), 0) 45 | tween <- tween_components(df[integer(), ], 'linear', nframes = 10, time = numeric()) 46 | expect_equal(nrow(tween), 0) 47 | expect_error(tween_components(df, 'linear', nframes = 10, time = 1)) 48 | expect_error(tween_components(df, 'linear', nframes = 0, time = c(1, 7, 13, 20), id = 1)) 49 | }) 50 | -------------------------------------------------------------------------------- /tests/testthat/test-events.R: -------------------------------------------------------------------------------- 1 | context("events") 2 | 3 | df <- data.frame( 4 | x = c(1, 5, 7, 10), 5 | y = c(4, 3, 7, -1), 6 | col = c('black', 'red', 'green', 'blue'), 7 | type = letters[1:4], 8 | stringsAsFactors = FALSE 9 | ) 10 | 11 | test_that("tween_events works", { 12 | tween <- tween_events(df, 'linear', 20, x, x + 2) 13 | expect_equal(nrow(tween), 17) 14 | expect_equal(max(tween$.frame), 20) 15 | expect_true(all(tween$.phase[c(4, 8, 13, 17)] == 'raw')) 16 | expect_true(all(tween$.phase[-c(4, 8, 13, 17)] == 'static')) 17 | 18 | 19 | tween <- tween_events(df, 'linear', 20, x, enter = function(df) { 20 | df$x <- 0 21 | df$col <- 'red' 22 | df 23 | }, enter_length = 3) 24 | 25 | 26 | expect_equal(nrow(tween), 23) 27 | expect_equal(max(tween$.frame), 20) 28 | expect_true(all(tween$.phase[c(6, 13, 17, 23)] == 'raw')) 29 | expect_true(all(tween$.phase[-c(6, 13, 17, 23)] == 'enter')) 30 | expect_equal(tween$x[2], 0.2) 31 | expect_equal(tween$col[3], '#931B0B') 32 | }) 33 | 34 | test_that("weird input gets handled", { 35 | expect_error(tween_events(df, 'linear', 20)) 36 | tween <- tween_events(df, 'linear', 0, x) 37 | expect_equal(nrow(tween), 0) 38 | tween <- tween_events(df[integer(), ], 'linear', 10, x) 39 | expect_equal(nrow(tween), 0) 40 | }) 41 | -------------------------------------------------------------------------------- /tests/testthat/test-fill.R: -------------------------------------------------------------------------------- 1 | context("fill") 2 | 3 | df <- data.frame( 4 | x = c(1, NA, NA, NA, 6, 4, NA, NA, NA, NA, 20), 5 | type = c('a', NA, NA, NA, 'b', 'c', NA, NA, NA, NA, 'd'), 6 | col = c('red', NA, NA, NA, 'blue', 'green', NA, NA, NA, NA, 'black'), 7 | stringsAsFactors = FALSE 8 | ) 9 | test_that("tween_fill works", { 10 | tween <- tween_fill(df, 'linear') 11 | expect_equal(dim(df), dim(tween)) 12 | expect_equal(tween$x[3], 3.5) 13 | expect_equal(tween$col[10], '#183112') 14 | 15 | expect_equal(tween_fill(df$col, 'linear'), tween$col) 16 | 17 | tween <- tween_fill(df[-c(1, 11), 1], 'linear') 18 | expect_equal(tween, df$x[-c(1, 11)]) 19 | }) 20 | -------------------------------------------------------------------------------- /tests/testthat/test-state.R: -------------------------------------------------------------------------------- 1 | context("state") 2 | 3 | df1 <- data.frame(x = 1:2, y = 4:5, col = 'black', type = letters[1:2], stringsAsFactors = FALSE) 4 | df2 <- data.frame(x = 11:12, y = 14:15, col = 'white', type = letters[1], stringsAsFactors = FALSE) 5 | 6 | test_that("tween_state works", { 7 | tween <- tween_state(df1, df2, ease = 'linear', nframes = 5) 8 | expect_equal(max(tween$.frame), 5) 9 | expect_true(all(tween$.phase[c(1:2, 9:10)] == 'raw')) 10 | expect_true(all(tween$.phase[c(3:8)] == 'transition')) 11 | expect_true(all(tween$.id == rep(1:2, 5))) 12 | expect_equal(tween$col[5], '#777777') 13 | expect_equal(tween$x[7], 8.5) 14 | expect_equal(tween$type[4:5], c('b', 'a')) 15 | }) 16 | 17 | test_that("keep_state works", { 18 | expect_warning( 19 | keep <- keep_state(df1, 5), 20 | NA 21 | ) 22 | expect_equal(max(keep$.frame), 5) 23 | expect_true(all(keep$.phase[c(9:10)] == 'raw')) 24 | expect_true(all(keep$.phase[c(1:8)] == 'static')) 25 | }) 26 | 27 | test_that("enter/exit works", { 28 | tween <- tween_state(df1, df2[1,, drop = FALSE], 'linear', 5, exit = function(df) { 29 | df$x <- 0 30 | df$col <- 'red' 31 | df 32 | }) 33 | expect_equal(nrow(tween), 9) 34 | expect_true(all(tween$.phase[c(4,6,8)] == 'exit')) 35 | expect_equal(tween$col[8], '#BB1909') 36 | expect_equal(tween$x[8], 0.5) 37 | }) 38 | --------------------------------------------------------------------------------