Вычислить (и визуализировать) вклады AR и MA для модели Arima (1,1,1) - PullRequest
Новая
       18

Вычислить (и визуализировать) вклады AR и MA для модели Arima (1,1,1)

0 голосов
/ 24 мая 2018

Я хотел бы визуализировать и понять компоненты модели Arima (1,1,1) правильно.

Как бы я мог количественно оценить вклад, который AR и MA-Терминпредоставить для каждого установленного значения серии серии?

Я думаю, что я в основном смог сделать это для модели (1,0,1), см. пример ниже 

library(forecast)
library(tidyverse)
library(ggfortify)

arima_101 <- Arima(AirPassengers, c(1, 0, 1), include.mean = F)  # only works without mean
autoplot(arima_101)


# get coefficients
ar1_coef <- coef(arima_101)["ar1"]
ma1_coef <- coef(arima_101)["ma1"]

# try to compute contributions by components 
ar1_part <- AirPassengers %>% 
  as.numeric() %>% 
  dplyr::lag(1) %>% 
  `*`(ar1_coef)

ma1_part <- resid(arima_101) %>% 
  as.numeric() %>% 
  dplyr::lag(1) %>% 
  `*`(ma1_coef)

fitted_values <- fitted(arima_101) %>% as.numeric()


# inspect results
df <- tibble(idx = 1:144, ar1_part, ma1_part, fitted_values) %>% 
  mutate(sum_ar1_ma1 = ar1_part + ma1_part)

df %>% 
  gather("component", "contribution", -idx, -fitted_values, -sum_ar1_ma1) %>% 
  #  %>% 
  ggplot(aes(idx, contribution)) +
  geom_area(aes(fill = component)) +
  geom_line(aes(idx, value, linetype = result),
            alpha = 0.3,
            data = gather(df, "result", "value", -idx, -ar1_part, -ma1_part))
#> Warning: Removed 2 rows containing missing values (position_stack).
#> Warning: Removed 1 rows containing missing values (geom_path).


fitted_values == ar1_part + ma1_part
#>   [1]    NA FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
#>  [12] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE  TRUE  TRUE
#>  [23]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
#>  [34]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
#>  [45]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
#>  [56]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
#>  [67]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
#>  [78]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
#>  [89]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
#> [100]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
#> [111]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
#> [122]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
#> [133]  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE  TRUE
#> [144]  TRUE

1 Ответ

0 голосов
/ 26 мая 2018

На данный момент это мой лучший снимок для аримы (1,1,1) 

# ARIMA 111
library(forecast)
library(tidyverse)
#> ── Attaching packages ─────────────────────────────────────────────────────────────── tidyverse 1.2.1 ──
#> ✔ ggplot2 2.2.1     ✔ purrr   0.2.4
#> ✔ tibble  1.4.2     ✔ dplyr   0.7.4
#> ✔ tidyr   0.8.0     ✔ stringr 1.3.1
#> ✔ readr   1.1.1     ✔ forcats 0.2.0
#> ── Conflicts ────────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
#> ✖ dplyr::filter() masks stats::filter()
#> ✖ dplyr::lag()    masks stats::lag()
library(ggfortify)

arima_111 <- Arima(AirPassengers, c(1, 1, 1))  # possibly dissallow the mean
autoplot(arima_111)


diff_airpass <- diff(AirPassengers)
diff_arima101 <- Arima(diff_airpass, c(1,0,1), include.mean = F)

diff_baseline <- as.numeric(AirPassengers) - c(NA, diff_airpass)

autoplot(diff_arima101)


# get coefficients
ar1_coef <- coef(arima_111)["ar1"]
ma1_coef <- coef(arima_111)["ma1"]

# airpass_num <- as.numeric()
# plot(airpass_num, type = "b")

# try to compute contributions by components 
ar1_part <- diff_airpass %>% 
  # diff() %>% 
  as.numeric() %>% 
  dplyr::lag(1) %>% 
  `*`(ar1_coef) %>% 
  c(NA, .)  # add na for first value

ma1_part <- resid(diff_arima101) %>% 
  as.numeric() %>% 
  dplyr::lag(1) %>% 
  `*`(ma1_coef) %>% 
  c(NA, .)

fitted_values <- fitted(diff_arima101) %>%
  as.numeric() %>% 
  c(NA, .)


# inspect results
df <- tibble(idx = 1:144, ar1_part, ma1_part, z_baseline = diff_baseline, fitted_values) %>% 
  mutate(sum_ar1_ma1 = ar1_part + ma1_part)

df %>% 
  gather("component", "contribution", -idx, -fitted_values, -sum_ar1_ma1) %>% 
  ggplot(aes(idx, contribution)) +
  geom_area(aes(fill = component)) 
#> Warning: Removed 5 rows containing missing values (position_stack).

...