spsanderson / healthyR.ts

A time-series companion package to healthyR
https://www.spsanderson.com/healthyR.ts/
Other
18 stars 3 forks source link

Experiment with `ts_growth_rate_vec()` to preserve ts attributes #480

Closed spsanderson closed 11 months ago

spsanderson commented 11 months ago

See if you can update the ts_growth_rate_vec() to maintain ts attributes

Function:

ts_growth_rate_vec <- function(.x, .scale = 100, .power = 1, .log_diff = FALSE,
                               .lags = 1){

  # Catch attributes of incoming vector
  atb <- attributes(.x)

  # Variables
  x <- as.vector(as.numeric(.x))
  s <- as.numeric(.scale)
  p <- as.numeric(.power)
  l <- as.numeric(.lags)
  ld <- as.logical(.log_diff)

  # Checks
  if (!is.vector(x) | !is.numeric(x)){
    rlang::abort(
      message = ".x must be a numeric vector",
      use_cli_format = TRUE
    )
  }

  if (!is.numeric(s) | !is.numeric(p) | !is.numeric(l)){
    rlang::abort(
      message = ".scale, .power and .lags must all be numeric",
      use_cli_format = TRUE
    )
  }

  if (!is.logical(ld)){
    rlang::abort(
      message = ".log_diff must be either TRUE or FALSE",
      use_cli_format = TRUE
    )
  }

  if (l == 0){
    rlang::abort(
      message = ".lags must be an integer that is either greater than or less than 0",
      use_cli_format = TRUE
    )
  }

  # Calculation
  if (l < 0){
    if (ld) {
      x <- (log(x / dplyr::lead(x, -l)) * s)
    } else {
      x <- (((x / dplyr::lead(x, -l))^p - 1) * s)
    }
  } else if (ld){
    x <- (log(x/dplyr::lag(x, l)) * s)
  } else {
    x <- (((x / dplyr::lag(x, l))^p - 1) * s)
  }

  # Attributes
  attr(x, "vector_attributes") <- atb
  attr(x, "name") <- deparse(substitute(.x))

  # Return
  return(x)
}

Example:

> ts_growth_rate_vec(AirPassengers)
  [1]          NA   5.3571429  11.8644068  -2.2727273  -6.2015504  11.5702479   9.6296296
  [8]   0.0000000  -8.1081081 -12.5000000 -12.6050420  13.4615385  -2.5423729   9.5652174
 [15]  11.9047619  -4.2553191  -7.4074074  19.2000000  14.0939597   0.0000000  -7.0588235
 [22] -15.8227848 -14.2857143  22.8070175   3.5714286   3.4482759  18.6666667  -8.4269663
 [29]   5.5214724   3.4883721  11.7977528   0.0000000  -7.5376884 -11.9565217  -9.8765432
 [36]  13.6986301   3.0120482   5.2631579   7.2222222  -6.2176166   1.1049724  19.1256831
 [43]   5.5045872   5.2173913 -13.6363636  -8.6124402  -9.9476440  12.7906977   1.0309278
 [50]   0.0000000  20.4081633  -0.4237288  -2.5531915   6.1135371   8.6419753   3.0303030
 [57] -12.8676471 -10.9704641 -14.6919431  11.6666667   1.4925373  -7.8431373  25.0000000
 [64]  -3.4042553   3.0837004  12.8205128  14.3939394  -2.9801325 -11.6040956 -11.5830116
 [71] -11.3537118  12.8078818   5.6768559  -3.7190083  14.5922747   0.7490637   0.3717472
 [78]  16.6666667  15.5555556  -4.6703297 -10.0864553 -12.1794872 -13.5036496  17.2995781
 [85]   2.1582734  -2.4647887  14.4404332  -1.2618297   1.5974441  17.6100629  10.4278075
 [92]  -1.9370460 -12.3456790 -13.8028169 -11.4379085  12.9151292   2.9411765  -4.4444444
 [99]  18.2724252  -2.2471910   2.0114943  18.8732394  10.1895735   0.4301075 -13.4903640
[106] -14.1089109 -12.1037464  10.1639344   1.1904762  -6.4705882  13.8364780  -3.8674033
[113]   4.3103448  19.8347107  12.8735632   2.8513238 -20.0000000 -11.1386139 -13.6490251
[120]   8.7096774   6.8249258  -5.0000000  18.7134503  -2.4630542   6.0606061  12.3809524
[127]  16.1016949   2.0072993 -17.1735242 -12.0950324 -11.0565111  11.8784530   2.9629630
[134]  -6.2350120   7.1611253  10.0238663   2.3861171  13.3474576  16.2616822  -2.5723473
[141] -16.1716172  -9.2519685 -15.4013015  10.7692308
attr(,"vector_attributes")
attr(,"vector_attributes")$tsp
[1] 1949.000 1960.917   12.000

attr(,"vector_attributes")$class
[1] "ts"

attr(,"name")
[1] "AirPassengers"