Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Experiment with ts_growth_rate_vec() to preserve ts attributes #480

Closed
spsanderson opened this issue Oct 16, 2023 · 0 comments
Closed

Experiment with ts_growth_rate_vec() to preserve ts attributes #480

spsanderson opened this issue Oct 16, 2023 · 0 comments
Assignees
Labels
enhancement New feature or request

Comments

@spsanderson
Copy link
Owner

spsanderson commented Oct 16, 2023

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"
@spsanderson spsanderson added the enhancement New feature or request label Oct 16, 2023
@spsanderson spsanderson added this to the healthyR.ts 0.3 milestone Oct 16, 2023
@spsanderson spsanderson self-assigned this Oct 16, 2023
@spsanderson spsanderson removed this from the healthyR.ts 0.3 milestone Oct 16, 2023
@spsanderson spsanderson changed the title Experiment with ts_growth_rate_vec() to preservce ts attributes Experiment with ts_growth_rate_vec() to preserve ts attributes Oct 18, 2023
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
enhancement New feature or request
Development

No branches or pull requests

1 participant