使用寓言包，预测风扇不会在实际行的末尾开始

Question

I have constructed the following fanplot using the fable package in R. I'm wondering whether anyone has advice as to why my forecast fan's point of origin is not from the actual line (the outer points at the beginning are quite far from the actual line)? Is that a modelling error or is it a data issue that I cannot avoid?

Here is a reproductible of my dataset

structure(list(Date = structure(c(12418, 12509, 12600, 12692, 
12784, 12874, 12965, 13057, 13149, 13239, 13330, 13422, 13514, 
13604, 13695, 13787, 13879, 13970, 14061, 14153, 14245, 14335, 
14426, 14518, 14610, 14700, 14791, 14883, 14975, 15065, 15156, 
15248, 15340, 15431, 15522, 15614, 15706, 15796, 15887, 15979, 
16071, 16161, 16252, 16344, 16436, 16526, 16617, 16709, 16801, 
16892, 16983, 17075, 17167, 17257, 17348, 17440, 17532, 17622, 
17713, 17805), fiscal_start = 1, class = c("yearquarter", "vctrs_vctr"
)), Index = c(99.9820253708305, 100.194245830908, 100.464139353185, 
100.509664967831, 100.0275008635, 100.372695892486, 100.468066533557, 
100.576244163805, 100.623717628381, 100.780442246863, 100.65264776914, 
100.69366042058, 100.909079987983, 101.018619794549, 100.959015810121, 
101.04835942569, 100.681089538573, 100.663660573108, 100.522268447626, 
100.22783149065, 99.4643787364223, 99.4331456182866, 99.5626187912313, 
100.039081681562, 100.418818090577, 100.4652077117, 100.544938523663, 
100.643407515773, 100.44741458842, 100.502455228311, 100.695097023592, 
100.716907300461, 100.555884307168, 100.503742436422, 100.432566888692, 
100.553320081068, 100.32442656222, 100.456727368091, 100.350509427919, 
100.677833560057, 100.362403841025, 100.827860652847, 100.499496900756, 
100.418652455482, 100.234221207155, 100.25208930362, 100.159571677823, 
100.229735300634, 100.369332695161, 100.169972399177, 100.17207717391, 
100.35130514679, 99.9317959389533, 99.8704136030018, 100.052802025981, 
100.176345514426, 100.355049154025, 100.544145324359, 100.549886876118, 
100.5559420697)), row.names = c(NA, -60L), key = structure(list(
    .rows = structure(list(1:60), ptype = integer(0), class = c("vctrs_list_of", 
    "vctrs_vctr", "list"))), row.names = c(NA, -1L), class = c("tbl_df", 
"tbl", "data.frame")), index = structure("Date", ordered = TRUE), index2 = "Date", interval = structure(list(
    year = 0, quarter = 1, month = 0, week = 0, day = 0, hour = 0, 
    minute = 0, second = 0, millisecond = 0, microsecond = 0, 
    nanosecond = 0, unit = 0), .regular = TRUE, class = c("interval", 
"vctrs_rcrd", "vctrs_vctr")), class = c("tbl_ts", "tbl_df", "tbl", 
"data.frame"))

and my code

fit <- afsi %>%
  model(arima = ARIMA(log(Index)))

p <- fit %>%
  forecast(h="2 year") %>%
  autoplot(bind_rows(afsi %>% slice(tail(row_number(), 12)), select(slice(., 1), Date, Index = .mean)), level=seq(10,90,by=10), show_gap = TRUE) +
  geom_line(aes(Date,Index), col = '#75002B', size=1.2) +
  theme_bw() +
  labs(y='Log (AFSI)', title = 'Fanchart - Aggregate Financial Stability Index',
       subtitle = '8 period forecast (2019Q1-2020Q4)') 

  

p$layers[[1]]$aes_params$fill <- "#75002B"

p + theme(legend.position = 'none')

EDIT: I am looking for a solution whereby the outer bands in my evolution of uncertainty (the forecast fan) are more narrow at the beginning and they fan out over time, similarly to the Bank of England plot that I've attached below

Answer 1

The show_gap option for autoplot(<fable>) requires the historical data to be provided via autoplot(<fable>, <tsibble>, show_gap = FALSE) .

library(fable)
library(dplyr)
library(ggplot2)
fit <- afsi %>%
  model(arima = ARIMA(log(Index)))

fit %>%
  forecast(h="2 year") %>%
  autoplot(tail(afsi, 12), level=seq(10,90,by=10), show_gap = FALSE) +
  theme_bw() +
  labs(y='Log (AFSI)', title = 'Fanchart - Aggregate Financial Stability Index',
       subtitle = '8 period forecast (2019Q1-2020Q4)') +
  theme(legend.position = 'none')

^{Created on 2020-09-23 by the reprex package (v0.3.0)}

If you need to produce a more custom graphic, I suggest not using autoplot() and writing your own plot with ggplot2.

To graphically join the forecasts to the data, you can add another row to your fable which is the last observation of data:

fc <- fit %>% 
  forecast(h = "2 years")

fc_no_gap <- afsi %>% 
  tail(1) %>% 
  # Match structure of fable to combine with
  mutate(.model = "arima", Index = distributional::dist_degenerate(Index), .mean = mean(Index)) %>% 
  as_fable(distribution = Index, response = "Index") %>% 
  bind_rows(fc)
#> Warning: The dimnames of the fable's distribution are missing and have been set
#> to match the response variables.

^{Created on 2020-09-23 by the reprex package (v0.3.0)}

From there you can use the {ggdist} package to visualise the distributions, and geom_line() to add the historical data.