/
tidiers_arima.R
152 lines (128 loc) · 4.08 KB
/
tidiers_arima.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
#' Tidying methods for ARIMA modeling of time series
#'
#' These methods tidy the coefficients of ARIMA models of univariate time
#' series.
#'
#' @param x An object of class "Arima"
#' @param data Used with `sw_augment` only.
#' `NULL` by default which simply returns augmented columns only.
#' User can supply the original data, which returns the data + augmented columns.
#' @param rename_index Used with `sw_augment` only.
#' A string representing the name of the index generated.
#' @param timetk_idx Used with `sw_augment` only.
#' Uses a irregular timetk index if present.
#'
#'
#' @seealso [arima()], [Arima()]
#'
#' @examples
#' library(dplyr)
#' library(forecast)
#'
#' fit_arima <- WWWusage %>%
#' auto.arima()
#'
#' sw_tidy(fit_arima)
#' sw_glance(fit_arima)
#' sw_augment(fit_arima)
#'
#'
#' @name tidiers_arima
NULL
#' @rdname tidiers_arima
#'
#' @param ... Additional parameters (not used)
#'
#' @return
#' __`sw_tidy()`__ returns one row for each coefficient in the model,
#' with five columns:
#' * `term`: The term in the nonlinear model being estimated and tested
#' * `estimate`: The estimated coefficient
#'
#' @export
sw_tidy.Arima <- function(x, ...) {
coefs <- stats::coef(x)
if (length(coefs > 0)) {
ret <- tibble::tibble(
term = names(coefs),
estimate = coefs
)
} else {
ret <- tibble::tibble(
term = NA,
estimate = NA
)
}
return(ret)
}
#' @rdname tidiers_arima
#'
#' @return
#' __`sw_glance()`__ returns one row with the columns
#' * `model.desc`: A description of the model including the
#' three integer components (p, d, q) are the AR order,
#' the degree of differencing, and the MA order.
#' * `sigma`: The square root of the estimated residual variance
#' * `logLik`: The data's log-likelihood under the model
#' * `AIC`: The Akaike Information Criterion
#' * `BIC`: The Bayesian Information Criterion
#' * `ME`: Mean error
#' * `RMSE`: Root mean squared error
#' * `MAE`: Mean absolute error
#' * `MPE`: Mean percentage error
#' * `MAPE`: Mean absolute percentage error
#' * `MASE`: Mean absolute scaled error
#' * `ACF1`: Autocorrelation of errors at lag 1
#'
#' @export
sw_glance.Arima <- function(x, ...) {
# Model description
ret_1 <- tibble::tibble(model.desc = arima_string(x))
# Summary statistics
ret_2 <- tibble::tibble(sigma = sqrt(x$sigma2))
ret_2 <- finish_glance(ret_2, x) %>%
tibble::as_tibble()
# forecast accuracy
ret_3 <- tibble::as_tibble(forecast::accuracy(x))
ret <- dplyr::bind_cols(ret_1, ret_2, ret_3)
return(ret)
}
#' @rdname tidiers_arima
#'
#' @return
#' __`sw_augment()`__ returns a tibble with the following time series attributes:
#' * `index`: An index is either attempted to be extracted from the model or
#' a sequential index is created for plotting purposes
#' * `.actual`: The original time series
#' * `.fitted`: The fitted values from the model
#' * `.resid`: The residual values from the model
#'
#' @export
sw_augment.Arima <- function(x, data = NULL, rename_index = "index", timetk_idx = FALSE, ...) {
# Check timetk_idx
if (timetk_idx) {
if (!has_timetk_idx(x)) {
warning("Object has no timetk index. Using default index.")
timetk_idx = FALSE
}
}
# Convert model to tibble
if ("fitted" %in% names(x)) {
# forecast::Arima
ret <- tk_tbl(cbind(.actual = x$x, .fitted = x$fitted, .resid = x$residuals),
rename_index = rename_index, silent = TRUE)
} else {
# stats::Arima
warning("No `.actual` or `.fitted` within stats::arima() models. Use forecast::Arima() if more information is needed.")
ret <- tk_tbl(x$residuals, rename_index = rename_index, silent = TRUE) %>%
dplyr::rename(.resid = value)
}
# Apply timetk index if selected
if (timetk_idx) {
idx <- tk_index(x, timetk_idx = TRUE)
ret[, rename_index] <- idx
}
# Augment columns if necessary
ret <- sw_augment_columns(ret, data, rename_index, timetk_idx)
return(ret)
}