Closed spsanderson closed 11 months ago
See if you can update the ts_growth_rate_vec() to maintain ts attributes
ts_growth_rate_vec()
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"
See if you can update the
ts_growth_rate_vec()
to maintain ts attributesFunction:
Example: