From 1b113c055e1686098800fdeb780698b52f02910b Mon Sep 17 00:00:00 2001 From: Juan Pablo Date: Fri, 6 Dec 2024 17:09:51 -0500 Subject: [PATCH] didn't knit readme file --- .Rhistory | 512 ++++++++++++++++++++++++++++++++++++++++++++++++ NAMESPACE | 2 + R/seq_color.R | 0 R/seq_data_nl.R | 277 ++++++++++++++++++++++++++ R/seq_nl.R | 9 +- R/utils.R | 16 ++ README.md | 2 +- man/seq_data.Rd | 74 +++++++ 8 files changed, 887 insertions(+), 5 deletions(-) create mode 100644 .Rhistory delete mode 100644 R/seq_color.R create mode 100644 R/seq_data_nl.R create mode 100644 man/seq_data.Rd diff --git a/.Rhistory b/.Rhistory new file mode 100644 index 0000000..c7dd740 --- /dev/null +++ b/.Rhistory @@ -0,0 +1,512 @@ +smooth_fashion, +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +# Notice how we use base '2' and exponentiate as +# polynomial increases by n. You can use any base you +# like, I chose 2 because that's what I've seen others +# do, and it's the standard as far as I know. +quad_in = t^2, +quad_out = 1-(1 - t)^2, +quad_in_out = ifelse(t < 0.5, +2*t^2, +1 - 0.5*(-2*t+2)^2), +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +cubic_in = t^3, +cubic_out = 1 - (1-t)^3, +cubic_in_out = ifelse(t < 0.5, +4*t^3, +1- 0.5*(-2*t+2)^3), +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +quart_in = t^4, +quart_out = 1 - (1-t)^4, +quart_in_out = ifelse(t < 0.5, +8*t^4, +1 - 0.5*(-2*t+2)^4), +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +quint_in = t^5, +quint_out = 1 - (1-t)^5, +quint_in_out = ifelse(t < 0.5, +16*t^5, +1 - 0.5*(-2*t+2)^5), +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +exp_in = 2^(10*t - 10), +exp_out = 1 - 2^(-10*t), +exp_in_out = ifelse(t == 0,0, +ifelse(t == 1,1, +ifelse(t < 0.5, +2^(20*t-10)/2, +(2 - 2^(-20*t+10))/2 +))), +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +circle_in = 1 - sqrt(1-t^2), +circle_out = sqrt(1 - (t - 1)^2), +circle_in_out = ifelse(t < 0.5, +(1 - sqrt(1 - (2 * t)^2)) / 2, +0.5 * (sqrt(1 - (-2 * t + 2)^2) + 1)), +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +back_in = 2.70158*t^3 - 1.70158*t^2, +back_out = 1 + 2.70158* (t-1)^3 + 1.70158*(t-1)^2, +back_in_out = { +k <- 1.70158 +k2 <- k * 1.525 +ifelse(t < 0.5, +(2*t)^2 * ((k2 + 1) * 2 * t - k2) / 2, +((2*t-2)^2 * ((k2 + 1) * (t * 2 - 2) + k2) + 2) / 2 +) +}, +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +elastic_in = ifelse(t == 0,0, +ifelse(t == 1,1 +-(2^(10*t-10))*sin((t*10-10.75)*2*pi/3)) +), +elastic_out = ifelse(t == 0,0, +ifelse(t ==1,1, +2^(-10*t)*sin((t*10-0.75)*2*pi/3)+1) +), +elastic_in_out = ifelse( +t == 0, 0, +ifelse(t == 1, 1, +ifelse(t < 0.5, +-(2^( 20*t - 10) * sin((20 * t - 11.125) * 2 * pi/4.5)) / 2, +(2^(-20*t + 10) * sin((20 * t - 11.125) * 2 * pi/4.5)) / 2 + 1 +)) +), +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +sine_in = 1 - cos((t*pi)/2), +sine_out = sin((t*pi)/2), +sine_in_out = -(cos(t*pi)-1)/2, +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +bounce_in = 1 - ifelse((1 - t) < 0.3636, +7.5625 * (1 - t)^2, +ifelse((1 - t) < 0.7273, +7.5625 * ((1 - t) - 1.5 / 2.75)^2 + 0.75, +ifelse((1 - t) < 0.9091, +7.5625 * ((1 - t) - 2.25 / 2.75)^2 + 0.9375, +7.5625 * ((1 - t) - 2.625 / 2.75)^2 + 0.984375)) +), +bounce_out = ifelse(t < 0.3636, +7.5625 * t^2, +ifelse(t < 0.7273, +7.5625 * (t - 1.5 / 2.75)^2 + 0.75, +ifelse(t < 0.9091, +7.5625 * (t - 2.25 / 2.75)^2 + 0.9375, +7.5625 * (t - 2.625 / 2.75)^2 + 0.984375)) +) +, +bounce_in_out = ifelse(t < 0.5, +0.5 * ifelse(t * 2 < 0.3636, +7.5625 * (2 * t)^2, +ifelse(t * 2 < 0.7273, +7.5625 * ((2 * t) - 1.5 / 2.75)^2 + 0.75, +ifelse(t * 2 < 0.9091, +7.5625 * ((2 * t) - 2.25 / 2.75)^2 + 0.9375, +7.5625 * ((2 * t) - 2.625 / 2.75)^2 + 0.984375))), +0.5 * ifelse((2 * t - 1) < 0.3636, +7.5625 * (2 * t - 1)^2, +ifelse((2 * t - 1) < 0.7273, +7.5625 * ((2 * t - 1) - 1.5 / 2.75)^2 + 0.75, +ifelse((2 * t - 1) < 0.9091, +7.5625 * ((2 * t - 1) - 2.25 / 2.75)^2 + 0.9375, +7.5625 * ((2 * t - 1) - 2.625 / 2.75)^2 + 0.984375))) + 0.5 +) +) +smooth_seq <- from + smooth_fashion * (to-from) +return(smooth_seq) +} +seq_smooth(1,50,100, type = "elastic","in") +devtools::load_all() +seq_data(rnorm(100,0,1), type = "elastic",ease = "out") +seq_data(rnorm(100,0,1), type = "elastic",ease = "in") +devtools::load_all() +seq_data(rnorm(100,0,1), type = "elastic",ease = "in") +seq_ease <- function(x1 = 0, x2 = 1, n = 100, type = 'cubic', direction = 'in-out') { +loc <- seq(0, 1, length.out = n) +if (type == 'linear') { +return(loc) +} +stopifnot(direction %in% c('in', 'out', 'in-out')) +type <- paste0(type, '-', direction) +fac <- switch( +type, +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Sine +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +`sine-in` = 1 - cos((loc * pi) / 2), +`sine-out` = sin((loc * pi) / 2), +`sine-in-out` = -(cos(loc * pi) - 1) / 2, +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Quad +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +`quad-in` = loc^2, +`quad-out` = 1 - (1 - loc)^2, +`quad-in-out` = ifelse(loc < 0.5, +2 * loc^2, +1 - 0.5 * (-2 * loc + 2)^2), +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Cubic +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +`cubic-in` = loc^3, +`cubic-out` = 1 - (1 - loc)^3, +`cubic-in-out` = ifelse(loc < 0.5, +4 * loc^3, +1 - 0.5 * (-2 * loc + 2)^3), +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Quart +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +`quart-in` = loc^4, +`quart-out` = 1 - (1 - loc)^4, +`quart-in-out` = ifelse(loc < 0.5, +8 * loc^4, +1 - 0.5 * (-2 * loc + 2)^4), +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Quint +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +`quint-in` = loc^5, +`quint-out` = 1 - (1 - loc)^5, +`quint-in-out` = ifelse(loc < 0.5, +16 * loc^5, +1 - 0.5 * (-2 * loc + 2)^5), +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Exp +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +`exp-in` = 2^(10 * loc - 10), +`exp-out` = 1 - 2^(-10 * loc), +`exp-in-out` = ifelse(loc == 0, 0, +ifelse(loc == 1, 1, +ifelse(loc < 0.5, +2 ^ (20 * loc - 10)/2, +(2 - 2^(-20 * loc + 10)) / 2 +) +) +), +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Circle +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +`circle-in` = 1 - sqrt(1 - loc^2), +`circle-out` = sqrt(1 - (loc - 1)^2), +`circle-in-out` = suppressWarnings({ +ifelse(loc < 0.5, +(1 - sqrt(1 - (2 * loc)^2)) / 2, +0.5 * (sqrt(1 - (-2 * loc + 2)^2) + 1)) +}), +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Back +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +`back-in` = 2.70158 * loc^3 - 1.70158 * loc^2, +`back-out` = 1 + 2.70158 * (loc - 1)^3 + 1.70158 * (loc - 1)^2, +`back-in-out` = { +c1 <- 1.70158 +c2 <- c1 * 1.525 +ifelse(loc < 0.5, +(2*loc)^2 * ((c2 + 1) * 2 * loc - c2) / 2, +((2*loc-2)^2 * ((c2 + 1) * (loc * 2 - 2) + c2) + 2) / 2 +) +}, +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Elastic +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +`elastic-in` = ifelse( +loc == 0, 0, +ifelse(loc == 1, +1, +-(2 ^ (10*loc-10)) * sin((loc * 10 - 10.75) * 2 * pi / 3) +) +), +`elastic-out` = ifelse( +loc == 0, 0, +ifelse(loc == 1, +1, +2^(-10*loc) * sin((loc * 10 - 0.75) * 2 * pi / 3) + 1) +), +`elastic-in-out` = ifelse( +loc == 0, 0, +ifelse(loc == 1, 1, +ifelse(loc < 0.5, +-(2^( 20*loc - 10) * sin((20 * loc - 11.125) * 2 * pi/4.5)) / 2, +(2^(-20*loc + 10) * sin((20 * loc - 11.125) * 2 * pi/4.5)) / 2 + 1 +)) +), +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +# Ooops! +#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +stop("No such ease type: ", type) +) +x1 + fac * (x2 - x1) +} +seq_ease(1,50,100,type = "elastic",direction = "in") +all.equal(seq_smooth,seq_ease) +#' Generate Non-linear Smooth Sequences with Custom Easing +#' +#' The `seq_smooth` function generates a sequence of numbers between a specified range (`from` to `to`) using different smoothing techniques and easing types. It supports various interpolation methods such as linear, quadratic, cubic, and more. Additionally, easing options (`in`, `out`, and `in_out`) allow for customization of how the transition occurs across the range. +#' +#' @param from A numeric value specifying the starting value of the sequence. Default is 1. +#' @param to A numeric value specifying the ending value of the sequence. Default is 1. +#' @param n An integer specifying the number of points in the sequence. Default is 100. +#' @param type A character string indicating the type of smoothing to apply. Available options include `"linear"`, `"quad"`, `"cubic"`, `"quart"`, `"quint"`, `"exp"`, `"circle"`, `"back"`, `"elastic"`, `"sine"`, `"bounce"`, and `"step"`. Default is `"linear"`. +#' @param step_count An integer specifying the number of discrete steps for the `"step"` type. If `NULL`, defaults to 4.The number of steps cannot exceed 'n'. +#' @param ease A character string indicating the easing direction to apply. Available options are `"in"` (smooth transition at the start), `"out"` (smooth transition at the end), and `"in_out"` (smooth transition at both start and end). Required for non-linear types. Default is `NULL`. +#' +#' @details +#' The function calculates a sequence based on the specified `type` and applies the easing (`ease`) to modify how values progress. For `"linear"` types, no easing is applied, and the sequence is uniformly spaced. For other types, the function supports easing that modifies the progression curve. +#' +#' - **Linear**: A straight-line interpolation. +#' - **Quadratic to Quintic**: Higher-degree polynomial interpolations. +#' - **Exponential**: Exponential interpolation. +#' - **Elastic and Bounce**: Nonlinear interpolations with oscillations. +#' - **Step**: A step-wise progression with discrete levels. +#' +#' The `ease` parameter controls how values are distributed along the sequence: +#' - `"in"`: Starts slow and accelerates. +#' - `"out"`: Starts fast and decelerates. +#' - `"in_out"`: Combines both for a smooth start and end. +#' +#' For `"step"` type, `step_count` specifies the number of steps in the sequence. +#' +#' @return A numeric vector of length `n`, representing the non-linear, smoothed sequence. +#' +#' @examples +#' # Linear sequence from 0 to 10 +#' t <- seq(0,1,length.out = 100) +#' lin_seq <- seq_smooth(0, 10, n = 100, type = "linear") +#' plot.new() +#' plot.window(range(t),range(lin_seq)) +#' points(t,lin_seq,pch = 16, cex = .75,col = "red") +#' axis(1,tcl = 0.75,lwd = 0, family = "serif") +#' axis(2,lwd = 0, family = "serif", las = 1) +#' grid(2,3,col = "gray80",lty = "dotted", lwd = 0.50) +#' mtext("Linear Sequence",3,cex = 1.3, family = "serif") +#' +#' # Quadratic easing in sequence +#' quad_seq <- seq_smooth(0, 10, n = 100, type = "quad", ease = "in") +#' plot.new() +#' plot.window(range(t),range(quad_seq)) +#' points(t,quad_seq,pch = 16, cex = .75,col = "red") +#' axis(1,tcl = 0.75,lwd = 0, family = "serif") +#' axis(2,lwd = 0, family = "serif", las = 1) +#' grid(2,3,col = "gray80",lty = "dotted", lwd = 0.50) +#' mtext("Ease-in Quadratic Sequence",3,cex = 1.3, family = "serif") +#' +#' # Step sequence with 5 steps +#' step_seq <- seq_smooth(0, 10, n = 100, type = "step", step_count = 5) +#' plot.new() +#' plot.window(range(t),range(step_seq)) +#' lines(t,step_seq,pch = 16, cex = .75,col = "red") +#' axis(1,tcl = 0.75,lwd = 0, family = "serif") +#' axis(2,lwd = 0, family = "serif", las = 1) +#' grid(2,3,col = "gray80",lty = "dotted", lwd = 0.50) +#' mtext("Step Sequence",3,cex = 1.3, family = "serif") +#' +#' # Elastic easing out sequence +#' elastic_seq <- seq_smooth(0, 10, n = 100, type = "elastic", ease = "out") +#' plot.new() +#' plot.window(range(t),range(elastic_seq)) +#' points(t,elastic_seq,pch = 16, cex = .75,col = "red") +#' axis(1,tcl = 0.75,lwd = 0, family = "serif") +#' axis(2,lwd = 0, family = "serif", las = 1) +#' grid(2,3,col = "gray80",lty = "dotted", lwd = 0.50) +#' mtext("Ease-out Elastic Sequence",3,cex = 1.3, family = "serif") +#' +#' @export +seq_smooth <- function(from = 1, to = 1, +n = 100, +type = "linear", +step_count = NULL, +ease = NULL){ +stopifnot(is.character(type)) +if(!is.null(ease)) +if(!is.character(ease)) +stop("Ease must be a characer string of length 1") +type <- match.arg(type,c("linear","quad","cubic","quart", +"quint","exp","circle","back", +"elastic","sine","bounce","step")) +# Compute normalized time (t) as the y-component +# Time could be any range, but it complicates comparison if +# time range is not bounded. However, you can always +# normalize it to be bounded from [0,1] +t <- seq(0,1,length.out = n) +# Default sequence +if(type == "linear") { +seq <- from + t*(to-from) +return(seq) +} +# `in` curves it at the start +#`out` will curve the line at the end +#`in_out` will curve the line at both ends +# Keep in mind there are n - 1 critical points +# as polynomials of size n increases. +# Issue warning if 'ease' not set to NULL when type is linear +if (type != "linear" && type != "step") { +ease <- match.arg(ease, c("in", "out", "in_out")) +} +# Compute normalized time +t <- seq(0, 1, length.out = n) +# Linear sequence +if (type == "linear") { +seq <- from + t * (to - from) +return(seq) +} +# Step sequence +if (type == "step") { +# Handle null or invalid step_count +if (is.null(step_count)) { +warning("Step count is 'NULL'. Using default 'step_count' = 4.") +step_count <- 4 +} +# Check step_count limits +if (step_count < 1) { +stop("Invalid 'step_count': Minimum number of steps is 1. Provided: ", step_count) +} +if (step_count > n) { +stop("Invalid 'step_count': Number of steps (", step_count, +") cannot exceed the length of the numeric vector (n = ", n, ").") +} +# Warn if 'ease' is provided (not applicable for steps) +if (!is.null(ease) && !is.na(ease)) { +warning("'ease' has no effect on step functions. Step function is not continuous.") +} +# Compute step sequence +smooth_seq <- from + (to - from) * round(step_count * t) / step_count +return(smooth_seq) +} +# What type of sequence and direction to compute +smooth_fashion <- join_char(type,"_",ease) +smooth_fashion <- switch( +smooth_fashion, +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +# Notice how we use base '2' and exponentiate as +# polynomial increases by n. You can use any base you +# like, I chose 2 because that's what I've seen others +# do, and it's the standard as far as I know. +quad_in = t^2, +quad_out = 1-(1 - t)^2, +quad_in_out = ifelse(t < 0.5, +2*t^2, +1 - 0.5*(-2*t+2)^2), +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +cubic_in = t^3, +cubic_out = 1 - (1-t)^3, +cubic_in_out = ifelse(t < 0.5, +4*t^3, +1- 0.5*(-2*t+2)^3), +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +quart_in = t^4, +quart_out = 1 - (1-t)^4, +quart_in_out = ifelse(t < 0.5, +8*t^4, +1 - 0.5*(-2*t+2)^4), +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +quint_in = t^5, +quint_out = 1 - (1-t)^5, +quint_in_out = ifelse(t < 0.5, +16*t^5, +1 - 0.5*(-2*t+2)^5), +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +exp_in = 2^(10*t - 10), +exp_out = 1 - 2^(-10*t), +exp_in_out = ifelse(t == 0,0, +ifelse(t == 1,1, +ifelse(t < 0.5, +2^(20*t-10)/2, +(2 - 2^(-20*t+10))/2 +))), +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +circle_in = 1 - sqrt(1-t^2), +circle_out = sqrt(1 - (t - 1)^2), +circle_in_out = ifelse(t < 0.5, +(1 - sqrt(1 - (2 * t)^2)) / 2, +0.5 * (sqrt(1 - (-2 * t + 2)^2) + 1)), +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +back_in = 2.70158*t^3 - 1.70158*t^2, +back_out = 1 + 2.70158* (t-1)^3 + 1.70158*(t-1)^2, +back_in_out = { +k <- 1.70158 +k2 <- k * 1.525 +ifelse(t < 0.5, +(2*t)^2 * ((k2 + 1) * 2 * t - k2) / 2, +((2*t-2)^2 * ((k2 + 1) * (t * 2 - 2) + k2) + 2) / 2 +) +}, +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +elastic_in = ifelse(t == 0, 0, +ifelse(t == 1,1, +-(2 ^ (10 * t - 10)) * sin((t * 10 - 10.75) * 2 * pi / 3) +) +), +elastic_out = ifelse(t == 0,0, +ifelse(t ==1,1, +2^(-10*t)*sin((t*10-0.75)*2*pi/3)+1) +), +elastic_in_out = ifelse( +t == 0, 0, +ifelse(t == 1, 1, +ifelse(t < 0.5, +-(2^( 20*t - 10) * sin((20 * t - 11.125) * 2 * pi/4.5)) / 2, +(2^(-20*t + 10) * sin((20 * t - 11.125) * 2 * pi/4.5)) / 2 + 1 +)) +), +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +sine_in = 1 - cos((t*pi)/2), +sine_out = sin((t*pi)/2), +sine_in_out = -(cos(t*pi)-1)/2, +#---- --- ---- --- ---- --- ---- --- ----- --- ----# +bounce_in = 1 - ifelse((1 - t) < 0.3636, +7.5625 * (1 - t)^2, +ifelse((1 - t) < 0.7273, +7.5625 * ((1 - t) - 1.5 / 2.75)^2 + 0.75, +ifelse((1 - t) < 0.9091, +7.5625 * ((1 - t) - 2.25 / 2.75)^2 + 0.9375, +7.5625 * ((1 - t) - 2.625 / 2.75)^2 + 0.984375)) +), +bounce_out = ifelse(t < 0.3636, +7.5625 * t^2, +ifelse(t < 0.7273, +7.5625 * (t - 1.5 / 2.75)^2 + 0.75, +ifelse(t < 0.9091, +7.5625 * (t - 2.25 / 2.75)^2 + 0.9375, +7.5625 * (t - 2.625 / 2.75)^2 + 0.984375)) +) +, +bounce_in_out = ifelse(t < 0.5, +0.5 * ifelse(t * 2 < 0.3636, +7.5625 * (2 * t)^2, +ifelse(t * 2 < 0.7273, +7.5625 * ((2 * t) - 1.5 / 2.75)^2 + 0.75, +ifelse(t * 2 < 0.9091, +7.5625 * ((2 * t) - 2.25 / 2.75)^2 + 0.9375, +7.5625 * ((2 * t) - 2.625 / 2.75)^2 + 0.984375))), +0.5 * ifelse((2 * t - 1) < 0.3636, +7.5625 * (2 * t - 1)^2, +ifelse((2 * t - 1) < 0.7273, +7.5625 * ((2 * t - 1) - 1.5 / 2.75)^2 + 0.75, +ifelse((2 * t - 1) < 0.9091, +7.5625 * ((2 * t - 1) - 2.25 / 2.75)^2 + 0.9375, +7.5625 * ((2 * t - 1) - 2.625 / 2.75)^2 + 0.984375))) + 0.5 +) +) +smooth_seq <- from + smooth_fashion * (to-from) +return(smooth_seq) +} +seq_smooth(1,50,100,type = "elastic",dease = "in") +seq_smooth(1,50,100,type = "elastic",ease = "in") +devtools::load_all() +seq_data(1,50,100,type = "elastic",dease = "in") +seq_data(1,50,100,type = "elastic",ease = "in") +seq_data(1,50,type = "elastic",ease = "in") +seq_data(rnorm(100,23,12),type = "elastic",ease = "in") +plot(seq_data(rnorm(100,23,12),type = "elastic",ease = "in")) +plot(seq_data(rnorm(100,23,12),type = "elastic",ease = "out")) +plot(seq_data(rnorm(100,23,12),type = "elastic",ease = "in_out")) +plot(seq_data(rnorm(100,23,12),type = "exp",ease = "in_out")) +plot(seq_data(rnorm(100,23,12),type = "exp",ease = "out")) +plot(seq_data(rnorm(100,23,12),type = "exp",ease = "in")) +plot(seq_data(rnorm(100,23,12),type = "cubic",ease = "in")) +plot(seq_data(rnorm(100,23,12),type = "cubic",ease = "in_out")) +plot(seq_data(rnorm(100,23,12),type = "cubic",ease = "out")) +plot(seq_data(rnorm(100,23,12),type = "quint",ease = "out")) +plot(seq_data(rnorm(100,23,12),type = "quint",ease = "in_out")) +plot(seq_data(rnorm(100,23,12),type = "quart",ease = "in_out")) +plot(seq_data(rnorm(100,23,12),type = "step",ease = "in_out")) +?aprox +?approx +seq_data(rpois(100,3), type = "circle",ease = "in_out") +plot(seq_data(rpois(100,3), type = "circle",ease = "in_out")) +devtools::document() diff --git a/NAMESPACE b/NAMESPACE index 58ac716..17bbb39 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,3 +1,5 @@ # Generated by roxygen2: do not edit by hand +export(seq_data) export(seq_smooth) +importFrom(stats,approx) diff --git a/R/seq_color.R b/R/seq_color.R deleted file mode 100644 index e69de29..0000000 diff --git a/R/seq_data_nl.R b/R/seq_data_nl.R new file mode 100644 index 0000000..b05b5a7 --- /dev/null +++ b/R/seq_data_nl.R @@ -0,0 +1,277 @@ +#' Interpolate a sequence of values with Easing or Stepping Given Data Points +#' +#' This function generates a sequence of values based on a specified easing or stepping function. +#' It supports linear, polynomial, exponential, and other smooth transitions, as well as stepped transitions. +#' +#' @param data Numeric vector, matrix, data frame, or list. The input data to be used for generating the sequence. +#' @param type Character string specifying the type of sequence. Supported types include: +#' \itemize{ +#' \item `"linear"`: Linear interpolation. +#' \item `"quad"`: Quadratic easing. +#' \item `"cubic"`: Cubic easing. +#' \item `"quart"`: Quartic easing. +#' \item `"quint"`: Quintic easing. +#' \item `"exp"`: Exponential easing. +#' \item `"circle"`: Circular easing. +#' \item `"back"`: Back easing with overshoot. +#' \item `"elastic"`: Elastic easing with oscillation. +#' \item `"sine"`: Sine wave easing. +#' \item `"bounce"`: Bouncing easing. +#' \item `"step"`: Stepped transitions. +#' } +#' Defaults to `"linear"`. +#' @param step_count Integer specifying the number of steps for the `"step"` type. Must be between 1 and the length of `data`. Defaults to `NULL`. +#' @param ease Character string specifying the direction of easing. Supported values are: +#' \itemize{ +#' \item `"in"`: Easing starts slow and accelerates. +#' \item `"out"`: Easing starts fast and decelerates. +#' \item `"in_out"`: Easing combines both behaviors. +#' } +#' Applicable only for non-linear types. Defaults to `NULL`. +#' +#' @return A numeric vector containing the generated sequence. +#' \itemize{ +#' \item For `"linear"`, a smoothly interpolated sequence is returned. +#' \item For `"step"`, a sequence with distinct steps is generated. +#' \item For other easing types, the sequence follows the specified smooth transition curve. +#' } +#' +#' @details +#' The `seq_data` function calculates a sequence of values based on the specified `type` and `ease`. +#' The `data` input is used to determine the range (minimum and maximum) of the sequence to then be interpolated, and the resulting +#' sequence is normalized between 0 and 1 before applying the specified easing or stepping function. +#' +#' For `"step"` type, the number of steps can be controlled using `step_count`. The `ease` parameter has no effect +#' when `type` is `"linear"` or `"step"`. +#' +#' @examples +#' # Generate a linear sequence +#' seq_data(1:10, type = "linear") +#' +#' # Generate a quadratic easing sequence +#' seq_data(rnorm(100,14,5), type = "quad", ease = "in_out") +#' +#' # Generate a stepped sequence with 5 steps +#' seq_data(rpois(100,3), type = "step", step_count = 5) +#' +#' @note +#' This function supports various easing functions commonly used in animations and graphics, as well as +#' stepped sequences for discrete transitions. Invalid or unsupported inputs will result in informative +#' error messages or warnings. +#' +#' @importFrom stats approx +#' @export + +seq_data <- function(data, + type = "linear", + step_count = NULL, + ease = NULL){ + + stopifnot(is.character(type), + is.numeric(data) || is.matrix(data) || is.data.frame(data) || is.list(data)) + + if(!is.null(ease)) + if(!is.character(ease)) + stop("Ease must be a characer string of length 1") + + type <- match.arg(type,c("linear","quad","cubic","quart", + "quint","exp","circle","back", + "elastic","sine","bounce","step")) + + # Compute normalized time (t) as the y-component + # Time could be any range, but it complicates comparison if + # time range is not bounded. However, you can always + # normalize it to be bounded from [0,1] + if (is.numeric(data)) { + n <- length(data) + } else if (is.data.frame(data) || is.matrix(data)) { + n <- nrow(data) + } else if (is.list(data)) { + n <- unique(lengths(data)) + } else { + stop("Unsupported data type: data must be numeric, a data.frame, a matrix, or a list.") + } + + from <- min(data) + to <- max(data) + + t <- seq(0,1,length.out = n) + + # Default sequence + if(type == "linear") { + seq <- from + t*(to-from) + return(seq) + } + + # `in` curves it at the start + #`out` will curve the line at the end + #`in_out` will curve the line at both ends + # Keep in mind there are n - 1 critical points + # as polynomials of size n increases. + + # Issue warning if 'ease' not set to NULL when type is linear + if (type != "linear" && type != "step") { + ease <- match.arg(ease, c("in", "out", "in_out")) + } + + # Compute normalized time + t <- seq(0, 1, length.out = n) + + # Linear sequence + if (type == "linear") { + seq <- from + t * (to - from) + return(seq) + } + + # Step sequence + if (type == "step") { + + # Handle null or invalid step_count + if (is.null(step_count)) { + warning("Step count is 'NULL'. Using default 'step_count' = 4.") + step_count <- 4 + } + + # Check step_count limits + if (step_count < 1) { + stop("Invalid 'step_count': Minimum number of steps is 1. Provided: ", step_count) + } + if (step_count > n) { + stop("Invalid 'step_count': Number of steps (", step_count, + ") cannot exceed the length of the numeric vector (n = ", n, ").") + } + + # Warn if 'ease' is provided (not applicable for steps) + if (!is.null(ease) && !is.na(ease)) { + warning("'ease' has no effect on step functions. Step function is not continuous.") + } + + # Compute step sequence + smooth_seq <- from + (to - from) * round(step_count * t) / step_count + + return(smooth_seq) + } + + + # What type of sequence and direction to compute + smooth_fashion <- join_char(type,"_",ease) + + + smooth_fashion <- switch( + smooth_fashion, + #---- --- ---- --- ---- --- ---- --- ----- --- ----# + # Notice how we use base '2' and exponentiate as + # polynomial increases by n. You can use any base you + # like, I chose 2 because that's what I've seen others + # do, and it's the standard as far as I know. + quad_in = t^2, + quad_out = 1-(1 - t)^2, + quad_in_out = ifelse(t < 0.5, + 2*t^2, + 1 - 0.5*(-2*t+2)^2), + #---- --- ---- --- ---- --- ---- --- ----- --- ----# + cubic_in = t^3, + cubic_out = 1 - (1-t)^3, + cubic_in_out = ifelse(t < 0.5, + 4*t^3, + 1- 0.5*(-2*t+2)^3), + #---- --- ---- --- ---- --- ---- --- ----- --- ----# + quart_in = t^4, + quart_out = 1 - (1-t)^4, + quart_in_out = ifelse(t < 0.5, + 8*t^4, + 1 - 0.5*(-2*t+2)^4), + #---- --- ---- --- ---- --- ---- --- ----- --- ----# + quint_in = t^5, + quint_out = 1 - (1-t)^5, + quint_in_out = ifelse(t < 0.5, + 16*t^5, + 1 - 0.5*(-2*t+2)^5), + #---- --- ---- --- ---- --- ---- --- ----- --- ----# + exp_in = 2^(10*t - 10), + exp_out = 1 - 2^(-10*t), + exp_in_out = ifelse(t == 0,0, + ifelse(t == 1,1, + ifelse(t < 0.5, + 2^(20*t-10)/2, + (2 - 2^(-20*t+10))/2 + ))), + #---- --- ---- --- ---- --- ---- --- ----- --- ----# + circle_in = 1 - sqrt(1-t^2), + circle_out = sqrt(1 - (t - 1)^2), + circle_in_out = ifelse(t < 0.5, + (1 - sqrt(1 - (2 * t)^2)) / 2, + 0.5 * (sqrt(1 - (-2 * t + 2)^2) + 1)), + #---- --- ---- --- ---- --- ---- --- ----- --- ----# + back_in = 2.70158*t^3 - 1.70158*t^2, + back_out = 1 + 2.70158* (t-1)^3 + 1.70158*(t-1)^2, + back_in_out = { + k <- 1.70158 + k2 <- k * 1.525 + ifelse(t < 0.5, + (2*t)^2 * ((k2 + 1) * 2 * t - k2) / 2, + ((2*t-2)^2 * ((k2 + 1) * (t * 2 - 2) + k2) + 2) / 2 + ) + }, + #---- --- ---- --- ---- --- ---- --- ----- --- ----# + elastic_in = ifelse(t == 0, 0, + ifelse(t == 1,1, + -(2 ^ (10 * t - 10)) * sin((t * 10 - 10.75) * 2 * pi / 3) + ) + ), + elastic_out = ifelse(t == 0,0, + ifelse(t ==1,1, + 2^(-10*t)*sin((t*10-0.75)*2*pi/3)+1) + ), + elastic_in_out = ifelse( + t == 0, 0, + ifelse(t == 1, 1, + ifelse(t < 0.5, + -(2^( 20*t - 10) * sin((20 * t - 11.125) * 2 * pi/4.5)) / 2, + (2^(-20*t + 10) * sin((20 * t - 11.125) * 2 * pi/4.5)) / 2 + 1 + )) + ), + #---- --- ---- --- ---- --- ---- --- ----- --- ----# + sine_in = 1 - cos((t*pi)/2), + sine_out = sin((t*pi)/2), + sine_in_out = -(cos(t*pi)-1)/2, + #---- --- ---- --- ---- --- ---- --- ----- --- ----# + bounce_in = 1 - ifelse((1 - t) < 0.3636, + 7.5625 * (1 - t)^2, + ifelse((1 - t) < 0.7273, + 7.5625 * ((1 - t) - 1.5 / 2.75)^2 + 0.75, + ifelse((1 - t) < 0.9091, + 7.5625 * ((1 - t) - 2.25 / 2.75)^2 + 0.9375, + 7.5625 * ((1 - t) - 2.625 / 2.75)^2 + 0.984375)) + ), + bounce_out = ifelse(t < 0.3636, + 7.5625 * t^2, + ifelse(t < 0.7273, + 7.5625 * (t - 1.5 / 2.75)^2 + 0.75, + ifelse(t < 0.9091, + 7.5625 * (t - 2.25 / 2.75)^2 + 0.9375, + 7.5625 * (t - 2.625 / 2.75)^2 + 0.984375)) + ) + , + bounce_in_out = ifelse(t < 0.5, + 0.5 * ifelse(t * 2 < 0.3636, + 7.5625 * (2 * t)^2, + ifelse(t * 2 < 0.7273, + 7.5625 * ((2 * t) - 1.5 / 2.75)^2 + 0.75, + ifelse(t * 2 < 0.9091, + 7.5625 * ((2 * t) - 2.25 / 2.75)^2 + 0.9375, + 7.5625 * ((2 * t) - 2.625 / 2.75)^2 + 0.984375))), + 0.5 * ifelse((2 * t - 1) < 0.3636, + 7.5625 * (2 * t - 1)^2, + ifelse((2 * t - 1) < 0.7273, + 7.5625 * ((2 * t - 1) - 1.5 / 2.75)^2 + 0.75, + ifelse((2 * t - 1) < 0.9091, + 7.5625 * ((2 * t - 1) - 2.25 / 2.75)^2 + 0.9375, + 7.5625 * ((2 * t - 1) - 2.625 / 2.75)^2 + 0.984375))) + 0.5 + ) + ) + + smooth_seq <- from + smooth_fashion * (to-from) + + return(smooth_seq) +} diff --git a/R/seq_nl.R b/R/seq_nl.R index 789cf29..5564b56 100644 --- a/R/seq_nl.R +++ b/R/seq_nl.R @@ -211,10 +211,11 @@ stopifnot(is.character(type)) ) }, #---- --- ---- --- ---- --- ---- --- ----- --- ----# - elastic_in = ifelse(t == 0,0, - ifelse(t == 1,1 - -(2^(10*t-10))*sin((t*10-10.75)*2*pi/3)) - ), + elastic_in = ifelse(t == 0, 0, + ifelse(t == 1,1, + -(2 ^ (10 * t - 10)) * sin((t * 10 - 10.75) * 2 * pi / 3) + ) + ), elastic_out = ifelse(t == 0,0, ifelse(t ==1,1, 2^(-10*t)*sin((t*10-0.75)*2*pi/3)+1) diff --git a/R/utils.R b/R/utils.R index 98a50b0..4396571 100644 --- a/R/utils.R +++ b/R/utils.R @@ -25,3 +25,19 @@ join_char <- function(first, return(new_string) } + +get_mode <- function(.x) { + .x <- unique(.x) + x_not_na <- .x[which(!is.na(.x))] + if(length(x_not_na) > 0) { + tab <- tabulate(match(.x, x_not_na)) + candidates <- x_not_na[tab == max(tab)] + if (is.logical(.x)) { + any(candidates) # return TRUE if any true. max returns an integer + } else { + max(candidates) # return highest (ie max) value + } + } else { + .x[NA_integer_] + } +} diff --git a/README.md b/README.md index 38abd55..e4bc65e 100644 --- a/README.md +++ b/README.md @@ -9,7 +9,7 @@ status](https://www.r-pkg.org/badges/version/sequentially)](https://CRAN.R-project.org/package=sequentially) [![stability-wip](https://img.shields.io/badge/stability-wip-lightgrey.svg)](https://github.com/mkenney/software-guides/blob/master/STABILITY-BADGES.md#work-in-progress) [![Codecov test -coverage](https://codecov.io/gh/jpmonteagudo28/sequentially/graph/badge.svg)](https://app.codecov.io/gh/jpmonteagudo28/sequentially) +coverage](https://codecov.io/gh/jpmonteagudo28/sequentially/branch/main/graph/badge.svg)](https://app.codecov.io/gh/jpmonteagudo28/sequentially?branch=main) diff --git a/man/seq_data.Rd b/man/seq_data.Rd new file mode 100644 index 0000000..f909e63 --- /dev/null +++ b/man/seq_data.Rd @@ -0,0 +1,74 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/seq_data_nl.R +\name{seq_data} +\alias{seq_data} +\title{Interpolate a sequence of values with Easing or Stepping Given Data Points} +\usage{ +seq_data(data, type = "linear", step_count = NULL, ease = NULL) +} +\arguments{ +\item{data}{Numeric vector, matrix, data frame, or list. The input data to be used for generating the sequence.} + +\item{type}{Character string specifying the type of sequence. Supported types include: +\itemize{ +\item \code{"linear"}: Linear interpolation. +\item \code{"quad"}: Quadratic easing. +\item \code{"cubic"}: Cubic easing. +\item \code{"quart"}: Quartic easing. +\item \code{"quint"}: Quintic easing. +\item \code{"exp"}: Exponential easing. +\item \code{"circle"}: Circular easing. +\item \code{"back"}: Back easing with overshoot. +\item \code{"elastic"}: Elastic easing with oscillation. +\item \code{"sine"}: Sine wave easing. +\item \code{"bounce"}: Bouncing easing. +\item \code{"step"}: Stepped transitions. +} +Defaults to \code{"linear"}.} + +\item{step_count}{Integer specifying the number of steps for the \code{"step"} type. Must be between 1 and the length of \code{data}. Defaults to \code{NULL}.} + +\item{ease}{Character string specifying the direction of easing. Supported values are: +\itemize{ +\item \code{"in"}: Easing starts slow and accelerates. +\item \code{"out"}: Easing starts fast and decelerates. +\item \code{"in_out"}: Easing combines both behaviors. +} +Applicable only for non-linear types. Defaults to \code{NULL}.} +} +\value{ +A numeric vector containing the generated sequence. +\itemize{ +\item For \code{"linear"}, a smoothly interpolated sequence is returned. +\item For \code{"step"}, a sequence with distinct steps is generated. +\item For other easing types, the sequence follows the specified smooth transition curve. +} +} +\description{ +This function generates a sequence of values based on a specified easing or stepping function. +It supports linear, polynomial, exponential, and other smooth transitions, as well as stepped transitions. +} +\details{ +The \code{seq_data} function calculates a sequence of values based on the specified \code{type} and \code{ease}. +The \code{data} input is used to determine the range (minimum and maximum) of the sequence to then be interpolated, and the resulting +sequence is normalized between 0 and 1 before applying the specified easing or stepping function. + +For \code{"step"} type, the number of steps can be controlled using \code{step_count}. The \code{ease} parameter has no effect +when \code{type} is \code{"linear"} or \code{"step"}. +} +\note{ +This function supports various easing functions commonly used in animations and graphics, as well as +stepped sequences for discrete transitions. Invalid or unsupported inputs will result in informative +error messages or warnings. +} +\examples{ +# Generate a linear sequence +seq_data(1:10, type = "linear") + +# Generate a quadratic easing sequence +seq_data(rnorm(100,14,5), type = "quad", ease = "in_out") + +# Generate a stepped sequence with 5 steps +seq_data(rpois(100,3), type = "step", step_count = 5) + +}