## ----echo = FALSE, message = FALSE, warning = FALSE---------------------------
knitr::opts_chunk$set(
    # message = FALSE,
    # warning = FALSE,
    fig.width = 8, 
    fig.height = 4.5,
    fig.align = 'center',
    out.width='95%', 
    dpi = 200
)

# devtools::load_all() # Travis CI fails on load_all()

## ----message = F--------------------------------------------------------------
library(tidyr)
library(dplyr)
library(purrr)
library(lubridate)
library(ggplot2)
library(tidyquant)
library(timetk)
library(sweep)
library(forecast)

## -----------------------------------------------------------------------------
sales_monthly_raw <- bike_sales %>%
    dplyr::mutate(date = lubridate::floor_date(order.date, unit = "month")) %>%
    dplyr::group_by(date) %>%
    dplyr::summarise(price = sum(price.ext), .groups = "drop") %>%
    dplyr::mutate(price = dplyr::if_else(dplyr::row_number() %in% c(7L, 19L, 38L), NA_real_, price))
sales_monthly_raw

## -----------------------------------------------------------------------------
summary(sales_monthly_raw$price)

## -----------------------------------------------------------------------------
sales_monthly <- sales_monthly_raw %>%
    fill(price, .direction = "down") %>%
    fill(price, .direction = "up")

## -----------------------------------------------------------------------------
sales_monthly %>%
    ggplot(aes(x = date, y = price)) +
    geom_line(color = palette_light()[[1]]) +
    labs(title = "Bike Sales Revenue, Monthly", x = "", y = "Revenue") +
    scale_y_continuous(labels = scales::label_dollar(scale = 1 / 1000000, suffix = "M")) +
    theme_tq()

## -----------------------------------------------------------------------------
sales_quarterly <- sales_monthly %>%
    tq_transmute(mutate_fun = to.period, period = "quarters") 
sales_quarterly

## -----------------------------------------------------------------------------
sales_quarterly %>%
    ggplot(aes(x = date, y = price)) +
    geom_line(color = palette_light()[[1]], linewidth = 1) +
    labs(title = "Bike Sales Revenue, Quarterly", x = "", y = "Revenue") +
    scale_y_continuous(labels = scales::label_dollar(scale = 1 / 1000000, suffix = "M")) +
    scale_x_date(date_breaks = "5 years", date_labels = "%Y") +
    theme_tq()

## -----------------------------------------------------------------------------
df <- tibble(
  f = c("runif", "rpois", "rnorm"),
  params = list(
    list(n = 10),
    list(n = 5, lambda = 10),
    list(n = 10, mean = -3, sd = 10)
  )
)
df

## -----------------------------------------------------------------------------
df$params

## -----------------------------------------------------------------------------
# FIXME invoke_map is deprecated
df_out <- df %>% 
    mutate(out = invoke_map(f, params))
df_out

## -----------------------------------------------------------------------------
df_out$out

## -----------------------------------------------------------------------------
sales_quarterly_ts <- sales_quarterly %>% 
    tk_ts(select = -date, start = c(2011, 1), freq = 4)
sales_quarterly_ts

## -----------------------------------------------------------------------------
models_list <- list(
    auto.arima = list(
        y = sales_quarterly_ts
        ),
    ets = list(
        y = sales_quarterly_ts,
        damped = TRUE
    ),
    bats = list(
        y = sales_quarterly_ts
    )
)

## -----------------------------------------------------------------------------
models_tbl <- tibble::enframe(models_list, name = "f", value = "params")
models_tbl

## -----------------------------------------------------------------------------
models_tbl_fit <- models_tbl %>%
    mutate(fit = purrr::invoke_map(f, params))
models_tbl_fit

## -----------------------------------------------------------------------------
models_tbl_fit %>%
    mutate(tidy = map(fit, sw_tidy)) %>%
    unnest(tidy) %>%
    spread(key = f, value = estimate)

## -----------------------------------------------------------------------------
models_tbl_fit %>%
    mutate(glance = map(fit, sw_glance)) %>%
    unnest(glance, .drop = TRUE)

## ----warning=F, fig.height=8--------------------------------------------------
models_tbl_fit %>%
    mutate(augment = map(fit, sw_augment, rename_index = "date")) %>%
    unnest(augment) %>%
    ggplot(aes(x = date, y = .resid, group = f)) +
    geom_line(color = palette_light()[[2]]) +
    geom_point(color = palette_light()[[1]]) +
    geom_smooth(method = "loess") +
    facet_wrap(~ f, nrow = 3) +
    labs(title = "Residuals Plot") +
    theme_tq()

## -----------------------------------------------------------------------------
models_tbl_fcast <- models_tbl_fit %>%
    mutate(fcast = map(fit, forecast, h = 6))
models_tbl_fcast

## -----------------------------------------------------------------------------
models_tbl_fcast_tidy <- models_tbl_fcast %>%
    mutate(sweep = map(fcast, sw_sweep, fitted = FALSE, timetk_idx = TRUE, rename_index = "date"))
models_tbl_fcast_tidy

## -----------------------------------------------------------------------------
models_tbl_fcast_tidy %>%
    unnest(sweep)

## ----fig.height=8-------------------------------------------------------------
models_tbl_fcast_tidy %>%
    unnest(sweep) %>%
    ggplot(aes(x = date, y = price, color = key, group = f)) +
    geom_ribbon(aes(ymin = lo.95, ymax = hi.95), 
                fill = "#D5DBFF", color = NA, linewidth = 0) +
    geom_ribbon(aes(ymin = lo.80, ymax = hi.80, fill = key), 
                fill = "#596DD5", color = NA, linewidth = 0, alpha = 0.8) +
    geom_line(linewidth = 1) +
    facet_wrap(~f, nrow = 3) +
    labs(title = "Bike Sales Revenue Forecasts",
         subtitle = "Forecasting multiple models with sweep: ARIMA, BATS, ETS",
         x = "", y = "Revenue") +
    scale_y_continuous(labels = scales::label_dollar(scale = 1 / 1000000, suffix = "M")) +
    scale_x_date(date_breaks = "5 years", date_labels = "%Y") +
    theme_tq() +
    scale_color_tq()