---
title: "Time Series Analysis Example"
vignette: >
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteIndexEntry{Time Series Analysis Example}
output:
  knitr:::html_vignette:
    toc: yes
---

```{r setup, include = FALSE}
options(digits = 3)
library(timetk)
library(forecast)
library(rsample)
library(purrr)
library(tidyr)
library(sweep)
library(dplyr)
library(ggplot2)
library(zoo)
```

"[Demo Week: Tidy Forecasting with `sweep`](http://www.business-science.io/code-tools/2017/10/25/demo_week_sweep.html)" is an excellent article that uses tidy methods with time series. This article uses their analysis with `rsample` to get performance estimates for future observations using [rolling forecast origin resampling](https://robjhyndman.com/hyndsight/crossvalidation/). 

The data are sales of alcoholic beverages originally from [the Federal Reserve Bank of St. Louis website](https://fred.stlouisfed.org/series/S4248SM144NCEN).

```{r read-data}
library(tidymodels)
data("drinks")
str(drinks, give.att = FALSE)
```

Each row is a month of sales (in millions of US dollars). 

Suppose that predictions for one year ahead were needed and the model should use the most recent data from the last 20 years. To setup this resampling scheme:

```{r rof}
roll_rs <- rolling_origin(
  drinks, 
  initial = 12 * 20, 
  assess = 12,
  cumulative = FALSE
  )
nrow(roll_rs)
roll_rs
```

Each `split` element contains the information about that resample:

```{r split}
roll_rs$splits[[1]]
```

For plotting, let's index each split by the first day of the assessment set:

```{r labels}
get_date <- function(x) 
  min(assessment(x)$date)

start_date <- map(roll_rs$splits, get_date)
roll_rs$start_date <- do.call("c", start_date)
head(roll_rs$start_date)
```

This resampling scheme has `r nrow(roll_rs)` splits of the data so that there will be `r nrow(roll_rs)` ARIMA models that are fit. To create the models, the `auto.arima` function from the `forecast` package is used. The functions `analysis` and `assessment` return the data frame, so another step converts the data in to a `ts` object called `mod_dat` using a function in the `timetk` package.

```{r model-fun}
library(forecast)  # for `auto.arima`
library(timetk)    # for `tk_ts`
library(zoo)       # for `as.yearmon`

fit_model <- function(x, ...) {
  # suggested by Matt Dancho:
  x %>%
    analysis() %>%
    # Since the first day changes over resamples, adjust it
    # based on the first date value in the data frame 
    tk_ts(start = .$date[[1]] %>% as.yearmon(), 
          freq = 12, 
          silent = TRUE) %>%
    auto.arima(...)
}
```

Each model is saved in a new column:

```{r model-fit, warning = FALSE, message = FALSE}
roll_rs$arima <- map(roll_rs$splits, fit_model)

# For example:
roll_rs$arima[[1]]
```

(There are some warnings produced by these first regarding extra columns in the data that can be ignored)

Using the model fits, performance will be measured in two ways:

 * _interpolation_ error will measure how well the model fits to the data that were used to create the model. This is most likely optimistic since no holdout method is used. 
 * _extrapolation_ or _forecast_ error evaluates the efficacy of the model on the data from the following year (that were not used in the model fit).
 
In each case, the mean absolute percent error (MAPE) is the statistic used to characterize the model fits. The interpolation error can be computed from the `Arima` object. to make things easy, the `sweep` package's `sw_glance` function is used:

```{r interp}
library(sweep)

roll_rs$interpolation <- map_dbl(
  roll_rs$arima,
  function(x) 
    sw_glance(x)[["MAPE"]]
  )
summary(roll_rs$interpolation)
```

For the extrapolation error, the model and split objects are required. Using these:

```{r extrap}
get_extrap <- function(split, mod) {
  n <- nrow(assessment(split))
  # Get assessment data
  pred_dat <- assessment(split) %>%
    mutate(
      pred = as.vector(forecast(mod, h = n)$mean),
      pct_error = ( S4248SM144NCEN - pred ) / S4248SM144NCEN * 100
    )
  mean(abs(pred_dat$pct_error))
}

roll_rs$extrapolation <- 
  map2_dbl(roll_rs$splits, roll_rs$arima, get_extrap)

summary(roll_rs$extrapolation)
```

What do these error estimates look like over time?

```{r plot}
roll_rs %>%
  select(interpolation, extrapolation, start_date) %>%
  as.data.frame %>%
  gather(error, MAPE, -start_date) %>%
  ggplot(aes(x = start_date, y = MAPE, col = error)) + 
  geom_point() + 
  geom_line() + 
  theme_bw() + 
  theme(legend.position = "top")
```

It is likely that the interpolation error is an underestimate to some degree. 

It is also worth noting that `rolling_origin()` can be used over calendar periods, rather than just over a fixed window size. This is especially useful for irregular series where a fixed window size might not make sense because of missing data points, or because of calendar features like different months having a different number of days.

The example below demonstrates this idea by splitting `drinks` into a nested set
of 26 years, and rolling over years rather than months. Note that the end result
accomplishes a different task than the original example, in this case, each slice
moves forward an entire year, rather than just one month.

```{r rof-annual}
# The idea is to nest by the period to roll over,
# which in this case is the year.
roll_rs_annual <- drinks %>%
  mutate(year = as.POSIXlt(date)$year + 1900) %>%
  nest(-year) %>%
  rolling_origin(
    initial = 20, 
    assess = 1, 
    cumulative = FALSE
  )

analysis(roll_rs_annual$splits[[1]])
```

The workflow to access these calendar slices is to use `bind_rows()` to join
each analysis set together.

```{r}
mutate(
  roll_rs_annual,
  extracted_slice = map(splits, ~ bind_rows(analysis(.x)$data))
)
```

