@@ -89,45 +89,88 @@ invert_bc_transform <- function(b, lambda, gamma) {
8989 return (z - gamma )
9090}
9191
92- # ' Do first-order seasonal differencing (go from original time series values to
93- # ' seasonally differenced time series values ).
92+ # ' Do first-order and seasonal differencing (go from original time series
93+ # ' to differenced time series).
9494# '
9595# ' @param y a univariate time series or numeric vector.
96- # ' @param ts_frequency frequency of time series. Must be provided if y is not
97- # ' of class "ts". See the help for stats::ts for more.
96+ # ' @param d order of first differencing
97+ # ' @param D order of seasonal differencing
98+ # ' @param frequency frequency of time series. Must be provided if y is not
99+ # ' of class "ts" and D > 0. See the help for stats::ts for more.
98100# '
99- # ' @return a seasonally differenced time series object (of class 'ts'),
101+ # ' @return a differenced time series object (of class 'ts'),
100102# ' padded with leading NAs.
101103# '
102104# ' @export
103- do_seasonal_difference <- function (y , ts_frequency ) {
104- differenced_y <- ts(c(rep(NA , ts_frequency ),
105- y [seq(from = ts_frequency + 1 , to = length(y ))] -
106- y [seq(from = 1 , to = length(y ) - ts_frequency )]),
107- frequency = ts_frequency )
108- return (differenced_y )
105+ do_difference <- function (y , d = 0 , D = 0 , frequency = 1 ) {
106+ # first differencing
107+ for (i in seq_len(d )) {
108+ y <- ts(
109+ c(NA ,
110+ y [seq(from = 1 + 1 , to = length(y ))] -
111+ y [seq(from = 1 , to = length(y ) - 1 )]),
112+ frequency = frequency )
113+ }
114+
115+ # seasonal differencing
116+ if (D > 0 && frequency < 2 ) {
117+ stop(" It doesn't make sense to do seasonal differencing with a time series frequency of 1."
118+ }
119+ for (i in seq_len(D )) {
120+ y <- ts(
121+ c(rep(NA , frequency ),
122+ y [seq(from = frequency + 1 , to = length(y ))] -
123+ y [seq(from = 1 , to = length(y ) - frequency )]),
124+ frequency = frequency )
125+ }
126+
127+ return (y )
109128}
110129
111- # ' Invert first-order seasonal differencing (go from seasonally differenced time
112- # ' series values to original time series values ).
130+ # ' Invert first-order and seasonal differencing (go from seasonally differenced
131+ # ' time series to original time series).
113132# '
114- # ' @param dy a first-order seasonally differenced univariate time series with
115- # ' values like y_{t} - y_{t - ts_frequency}
133+ # ' @param dy a first-order and/or seasonally differenced univariate time series
134+ # ' with values like y_{t} - y_{t - ts_frequency}
116135# ' @param y a univariate time series or numeric vector with values like
117136# ' y_{t - ts_frequency}.
118- # ' @param ts_frequency frequency of time series. Must be provided if y is not
119- # ' of class "ts". See the help for stats::ts for more.
137+ # ' @param d order of first differencing
138+ # ' @param D order of seasonal differencing
139+ # ' @param frequency frequency of time series. Must be provided if y is not
140+ # ' of class "ts" and D > 0. See the help for stats::ts for more.
120141# '
121142# ' @details y may have longer length than dy. It is assumed that dy "starts"
122- # ' one time index after y "ends": that is, if y is of length T then
123- # ' dy[1] = y[T + 1] - y[T + 1 - ts_frequency]
143+ # ' one time index after y "ends": that is, if y is of length T, d = 0, and
144+ # ' D = 1 then dy[1] = y[T + 1] - y[T + 1 - ts_frequency]
124145# '
125146# ' @return a time series object (of class 'ts')
126147# '
127148# ' @export
128- invert_seasonal_difference <- function (dy , y , ts_frequency ) {
129- return (ts(dy + y [length(y ) + seq_along(dy ) - ts_frequency ],
130- freq = ts_frequency ))
149+ invert_difference <- function (dy , y , d , D , frequency ) {
150+ for (i in seq_len(d )) {
151+ y_dm1 <- do_difference(y , d = d - i , D = D , frequency = frequency )
152+ dy_full <- c(y_dm1 , dy )
153+ for (t in seq_len(length(dy ))) {
154+ dy_full [length(y_dm1 ) + t ] <- dy_full [length(y_dm1 ) + t - 1 ] + dy_full [length(y_dm1 ) + t ]
155+ }
156+ dy <- dy_full [length(y_dm1 ) + seq_along(dy )]
157+ }
158+
159+ for (i in seq_len(D )) {
160+ y_dm1 <- do_difference(y , d = 0 , D = D - i , frequency = frequency )
161+ dy_full <- c(y_dm1 , dy )
162+ for (t in seq_len(length(dy ))) {
163+ dy_full [length(y_dm1 ) + t ] <- dy_full [length(y_dm1 ) + t - frequency ] + dy_full [length(y_dm1 ) + t ]
164+ }
165+ dy <- dy_full [length(y_dm1 ) + seq_along(dy )]
166+ }
167+
168+ # for(i in seq_len(D)) {
169+ # y_dm1 <- do_difference(y, d = 0, D = D-i, frequency = frequency)
170+ # dy <- dy + y_dm1[length(y_dm1) + seq_along(dy) - frequency]
171+ # }
172+
173+ return (ts(dy , frequency = frequency ))
131174}
132175
133176# ' Remove leading values that are infinite or missing, and replace all internal
0 commit comments