An open API service indexing awesome lists of open source software.

https://github.com/coolbutuseless/displease

Non-linear numeric interpolation
https://github.com/coolbutuseless/displease

Last synced: 4 months ago
JSON representation

Non-linear numeric interpolation

Awesome Lists containing this project

README

        

---
output: github_document
---

```{r, include = FALSE}
knitr::opts_chunk$set(
collapse = TRUE,
comment = "#>",
fig.path = "man/figures/README-",
out.width = "100%"
)

library(displease)
```

# displease

![](https://img.shields.io/badge/cool-useless-green.svg)
[![R-CMD-check](https://github.com/coolbutuseless/displease/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/coolbutuseless/displease/actions/workflows/R-CMD-check.yaml)
[![CRAN status](https://www.r-pkg.org/badges/version/displease)](https://CRAN.R-project.org/package=displease)

The `displease` package provides non-linear interpolation between numeric values.

It is a replacement for `seq()` for when you want a sequence between two values which is **not** equally spaced.

Easing can look much better than strict linear interpolation when applied to
objects moving spatially.

`displease` = **displ** + **ease**. The results are often used for
animating visual **displacement**, and the non-linear interpolation is
performed by applying an **easing** function.

## Installation

This package can be installed from CRAN

``` r
install.packages('displease')
```

You can install the latest development version from
[GitHub](https://github.com/coolbutuseless/displease) with:

``` r
# install.package('remotes')
remotes::install_github('coolbutuseless/displease')
```

Pre-built source/binary versions can also be installed from
[R-universe](https://r-universe.dev)

``` r
install.packages('displease', repos = c('https://coolbutuseless.r-universe.dev', 'https://cloud.r-project.org'))
```

## What's in the box?

* `seq_ease(x1, x2, n, type, direction)` - create a sequence of length `n`
between `x1` and `x2`. Apply the easing function given by `type`.
* `type` is one of: `sine`, `quad`, `cubic`, `quart`, `quint`, `exp`,
`circle`, `back`, `elastic`
* `direction` is one of: `in`, `out`, `in-out`
* `seq_color(col1, col2, ...)` non-linear interpolation between two colors.

The following graph shows the `seq_ease()` output for `n = 100` for
all the different easing functions with given extents of `x1 = 0` and `x2 = 1`

## Displacement Easing

```{r example}
library(displease)

# normal linear interpolation using seq()
(y_linear <- seq(1, 10, length.out = 10))

# Non-linear interpolation using {displease}
(y_cubic_in <- seq_ease(1, 10, n=10, type = 'cubic', direction = 'in'))
(y_cubic_in_out <- seq_ease(1, 10, n=10, type = 'cubic', direction = 'in-out'))

plot(1:10, y_linear , type = 'b')
plot(1:10, y_cubic_in , type = 'b')
plot(1:10, y_cubic_in_out, type = 'b')
```

### Illustration of supported easings

```{r echo=FALSE, fig.height = 10}
suppressPackageStartupMessages({
library(dplyr)
library(ggplot2)
library(purrr)
})

type <- c('sine', 'quad', 'cubic', 'quart', 'quint', 'exp', 'circle', 'back', 'elastic')
direction <- c('in', 'out', 'in-out')

df <- as_tibble(expand.grid(type = type, direction = direction))

df <- purrr::map2_dfr(df$type, df$direction,
~tibble(
type = .x,
direction = .y,
x = 1:100,
y = seq_ease(type = .x, direction = .y)))

ggplot(df) +
geom_line(aes(x, y)) +
facet_grid(type ~ direction) +
theme_bw() +
scale_y_continuous(name = NULL, breaks = c(0, 1)) +
scale_x_continuous(name = NULL, breaks = c(0, 100)) +
theme(axis.title = element_blank(), axis.text.x = element_blank()) +
coord_fixed(50)

```

## Easing between two colors

When easing between two colors, the `colorspace` where the interpolation takes
place will have a large effect on the final result.

The examples below show the interpolation from 'red' to 'blue'. The only difference
between the examples is the colorspace where the interpolation occurs.

```{r fig.height = 1}
n <- 100
cols <- seq_color('red', 'blue', n = n, direction = 'in-out', type = 'cubic',
colorspace = 'hcl')
head(cols)
grid::grid.rect(x = seq(0, 0.95, length.out = n), width = 0.1,
gp = grid::gpar(fill = cols, col = NA))
```

```{r fig.height = 1}
n <- 100
cols <- seq_color('red', 'blue', n = n, direction = 'in-out', type = 'cubic',
colorspace = 'lab')
head(cols)
grid::grid.rect(x = seq(0, 0.95, length.out = n), width = 0.1,
gp = grid::gpar(fill = cols, col = NA))
```

## Animated example

This animation shows each of the easing types.

```{r eval = FALSE, echo = FALSE}
library(dplyr)
library(ggplot2)

N <- 50
linear = seq(0, 1, length.out = N)
sine = seq_ease(0, 1, n=N, type = 'sine' , direction = 'in-out')
quad = seq_ease(0, 1, n=N, type = 'quad' , direction = 'in-out')
cubic = seq_ease(0, 1, n=N, type = 'cubic' , direction = 'in-out')
quart = seq_ease(0, 1, n=N, type = 'quart' , direction = 'in-out')
quint = seq_ease(0, 1, n=N, type = 'quint' , direction = 'in-out')
exp = seq_ease(0, 1, n=N, type = 'exp' , direction = 'in-out')
circle = seq_ease(0, 1, n=N, type = 'circle' , direction = 'in-out')
back = seq_ease(0, 1, n=N, type = 'back' , direction = 'in-out')
elastic = seq_ease(0, 1, n=N, type = 'elastic', direction = 'in-out')

df <- data.frame(
idx = seq_len(N * 2),
linear = c(linear , rev(linear )),
sine = c(sine , rev(sine )),
quad = c(quad , rev(quad )),
cubic = c(cubic , rev(cubic )),
quart = c(quart , rev(quart )),
quint = c(quint , rev(quint )),
exp = c(exp , rev(exp )),
circle = c(circle , rev(circle )),
back = c(back , rev(back )),
elastic = c(elastic, rev(elastic))
)

mdf <- tidyr::gather(df, type, value, -idx)

dir.create('man/figures/anim/', showWarnings = FALSE)
zz <- list.files('man/figures/anim/', full.names = TRUE)
unlink(zz)

alpha <- c(
'0' = 1,
'1' = 0.15,
'2' = 0.1,
'3' = 0.07,
'4' = 0.03,
'5' = 0.02,
'6' = 0.01
)

create_plot <- function(this_idx) {
plot_df <- mdf %>%
filter(idx <= this_idx, this_idx - idx <= 5) %>%
mutate(lag = as.character(this_idx - idx))
p <- ggplot(plot_df) +
geom_point(aes(value, type, alpha = lag), size = 3, stroke = NA) +
theme_void() +
xlim(-0.2, 1.2) +
theme(
axis.text.y = element_text(),
legend.position = 'none'
) +
scale_alpha_manual(values = alpha)

filename <- sprintf("man/figures/anim/%03i.png", this_idx)
ggsave(filename, p, width = 6, height = 5)
p
}

seq_len(N*2) %>% purrr::walk(create_plot)

# system.time({ system("convert man/figures/anim/*.png man/figures/anim.gif") })
# system.time({ system("gifski --fast --fps 10 man/figures/anim/*.png --output man/figures/anim2.gif")})
system.time({ system("gifski --fps 10 man/figures/anim/*.png --output man/figures/anim2.gif")})
system("gifsicle -k 16 -O99 man/figures/anim2.gif -o man/figures/anim3.gif")
```