library(tidyverse)
library(fpp3)
url <- c(
"https://www.eia.gov/electricity/wholesale/xls/archive/ice_electric-2021final.xlsx",
"https://www.eia.gov/electricity/wholesale/xls/archive/ice_electric-2020final.xlsx",
"https://www.eia.gov/electricity/wholesale/xls/archive/ice_electric-2019final.xlsx",
"https://www.eia.gov/electricity/wholesale/xls/archive/ice_electric-2018final.xlsx"
)
# Download the files to the directory
file_paths <- map(url, ~ {
file_name <- basename(.x)
file_path <- file.path(here::here("data", file_name))
download.file(.x, destfile = file_path, mode = "wb")
file_path
})
data_frames <- map(file_paths, ~ readxl::read_xlsx(.x))
# Combine the data frames into one
combined_data <- bind_rows(data_frames) |>
janitor::clean_names()Assignment 1
Read data
Gather URLs, create temp file directory in data folder, then download files and bind together single data frame
Create tsibble
Since data observations are not unique, calculate weekly average
energy_prices <- combined_data |>
group_by(week = lubridate::floor_date(trade_date, "week")) |>
mutate(week = yearweek(week)) |>
summarise(mean_weekly_avg = mean(wtd_avg_price_m_wh)) |>
as_tsibble(index = week)Plot
combined_data |>
group_by(price_hub, week = lubridate::floor_date(trade_date, "week")) |>
summarise(mean_price = mean(wtd_avg_price_m_wh)) |>
filter(price_hub != "ERCOT North 345KV Peak") |>
ggplot(aes(week, mean_price, color = "value")) +
geom_line(linewidth = 1.25, show.legend = FALSE) +
facet_wrap(~price_hub) +
ggthemes::theme_fivethirtyeight() +
labs(
title = "Weekly average energy prices by hub",
subtitle = "2018-2022"
)
Create models
Create training set
train <- energy_prices |>
filter_index("2018-01-03" ~ "2020-12-31")NAIVE, Drift, SNAIVE, ETS
energy_fit <- train |>
model(
ets = ETS(mean_weekly_avg ~ error("M") + trend("M")),
naive = NAIVE(mean_weekly_avg),
snaive = SNAIVE(mean_weekly_avg),
drift = RW(mean_weekly_avg ~ drift())
)1-year ahead forecast
energy_fc <- energy_fit |>
forecast(h = 52)Performance metrics:
Surprisingly, naive had both the lowest RMSE, as well as MAE and MAPE.
energy_fc |>
accuracy(energy_prices) |>
arrange(RMSE)# A tibble: 4 × 10
.model .type ME RMSE MAE MPE MAPE MASE RMSSE
<chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 naive Test 2.63e 1 37.9 2.67e 1 3.58e 1 3.74e 1 1.70e 0 1.29
2 drift Test 2.79e 1 39.2 2.82e 1 3.87e 1 3.98e 1 1.79e 0 1.34
3 snaive Test 2.32e 1 45.0 3.13e 1 3.39e 1 5.10e 1 1.99e 0 1.53
4 ets Test -1.83e183 Inf 1.83e183 -2.67e183 2.67e183 1.16e182 Inf
# ℹ 1 more variable: ACF1 <dbl>energy_fc |>
autoplot(
energy_prices |>
filter(as.Date(week) < "2021-01-01"),
level = c(90, 95)
) +
scale_y_continuous(
breaks = scales::breaks_width(50),
labels = scales::label_dollar(),
limits = c(0, 300)
) +
labs(
title = "Forecasted weekly average energy prices",
subtitle = "Shaded area is 90th and 95th percent confidence interval"
) +
ggthemes::theme_fivethirtyeight()
Compare results with cross-validation
Start with 4 weeks, move 1 ahead
energy_prices_cv <- train |>
stretch_tsibble(.init = 4, .step = 1)By performing cross-validation, we drastically improved the forecasts overall, and snaive had the best RMSE and MAPE.
energy_fit_cv <- energy_prices_cv |>
model(
ets = ETS(mean_weekly_avg),
naive = NAIVE(mean_weekly_avg),
snaive = SNAIVE(mean_weekly_avg),
drift = RW(mean_weekly_avg ~ drift())
) |>
forecast(h = 52)
energy_fit_cv |>
accuracy(train) |>
arrange(RMSE)# A tibble: 4 × 10
.model .type ME RMSE MAE MPE MAPE MASE RMSSE ACF1
<chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
1 snaive Test -5.10 28.8 15.3 -30.4 42.9 1.00 1.00 0.532
2 naive Test -0.631 30.8 17.4 -19.6 47.7 1.14 1.07 0.721
3 ets Test -1.18 42.2 19.3 -21.3 53.4 1.26 1.47 0.824
4 drift Test 1.45 43.7 24.9 -15.0 68.4 1.63 1.52 0.854Residual checks
Since snaive performed the best in the cross-validation model, lets check the residuals. There’s one significant lag.
energy_fit_cv |>
filter(.model == "snaive", .id == 154) |>
gg_tsdisplay()