library(fpp3)
## Warning: package 'fpp3' was built under R version 4.5.3
## ── Attaching packages ──────────────────────────────────────────── fpp3 1.0.3 ──
## ✔ tibble 3.3.1 ✔ tsibble 1.2.0
## ✔ dplyr 1.1.4 ✔ tsibbledata 0.4.1
## ✔ tidyr 1.3.2 ✔ ggtime 0.2.0
## ✔ lubridate 1.9.4 ✔ feasts 0.5.0
## ✔ ggplot2 4.0.2 ✔ fable 0.5.0
## Warning: package 'tibble' was built under R version 4.5.2
## Warning: package 'tidyr' was built under R version 4.5.2
## Warning: package 'ggplot2' was built under R version 4.5.2
## Warning: package 'tsibble' was built under R version 4.5.3
## Warning: package 'tsibbledata' was built under R version 4.5.3
## Warning: package 'ggtime' was built under R version 4.5.3
## Warning: package 'feasts' was built under R version 4.5.3
## Warning: package 'fabletools' was built under R version 4.5.3
## Warning: package 'fable' was built under R version 4.5.3
## ── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
## ✖ lubridate::date() masks base::date()
## ✖ dplyr::filter() masks stats::filter()
## ✖ tsibble::intersect() masks base::intersect()
## ✖ tsibble::interval() masks lubridate::interval()
## ✖ dplyr::lag() masks stats::lag()
## ✖ tsibble::setdiff() masks base::setdiff()
## ✖ tsibble::union() masks base::union()
library(readr)
## Warning: package 'readr' was built under R version 4.5.2
electricity_raw <- read_csv("APU000072610.csv")
## Rows: 571 Columns: 2
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): observation_date
## dbl (1): Price of Kw/pHR
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
electricity <- electricity_raw %>%
mutate(
Month = yearmonth(observation_date)
) %>%
select(Month, Price = `Price of Kw/pHR`) %>%
filter(Month >= yearmonth("2016 Jan")) %>%
as_tsibble(index = Month)
electricity %>%
autoplot(Price) +
labs(
title = "Average U.S. Electricity Price",
x = "Year",
y = "Price per kWh"
)
electricity %>%
gg_season(Price)
electricity %>%
gg_subseries(Price)
electricity %>%
model(STL(Price)) %>%
components() %>%
autoplot()
n <- nrow(electricity)
train_data <- electricity %>%
slice(1:floor(0.8 * n))
test_data <- electricity %>%
slice((floor(0.8 * n) + 1):n)
models <- train_data %>%
model(
ETS = ETS(Price),
NAIVE = NAIVE(Price),
SNAIVE = SNAIVE(Price)
)
fc <- models %>%
forecast(h = nrow(test_data))
fc %>%
autoplot(train_data, level = NULL) +
autolayer(test_data, Price)
report(models)
## Warning in report.mdl_df(models): Model reporting is only supported for
## individual models, so a glance will be shown. To see the report for a specific
## model, use `select()` and `filter()` to identify a single model.
## # A tibble: 3 × 9
## .model sigma2 log_lik AIC AICc BIC MSE AMSE MAE
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 ETS 0.000191 393. -780. -780. -772. 0.00000395 0.0000107 0.00943
## 2 NAIVE 0.00000387 NA NA NA NA NA NA NA
## 3 SNAIVE 0.0000515 NA NA NA NA NA NA NA
accuracy(fc, test_data)
## # A tibble: 3 × 10
## .model .type ME RMSE MAE MPE MAPE MASE RMSSE ACF1
## <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 ETS Test 0.0111 0.0128 0.0111 5.90 5.90 NaN NaN 0.827
## 2 NAIVE Test 0.0111 0.0128 0.0111 5.90 5.90 NaN NaN 0.827
## 3 SNAIVE Test 0.0140 0.0155 0.0140 7.48 7.48 NaN NaN 0.749
ensemble_model <- train_data %>%
model(
ENSEMBLE = (ETS(Price) + NAIVE(Price) + SNAIVE(Price)) / 3
)
ensemble_fc <- ensemble_model %>%
forecast(h = nrow(test_data))
ensemble_fc %>%
autoplot(train_data, level = NULL) +
autolayer(test_data, Price) +
labs(
title = "Ensemble Forecast Compared to Actual Electricity Prices",
subtitle = "Ensemble averages ETS, NAIVE, and SNAIVE forecasts",
x = "Year",
y = "Price per kWh"
)
ensemble_accuracy <- ensemble_fc %>%
accuracy(test_data)
model_accuracy <- fc %>%
accuracy(test_data)
final_accuracy <- bind_rows(
model_accuracy,
ensemble_accuracy
)
final_accuracy
## # 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 ETS Test 0.0111 0.0128 0.0111 5.90 5.90 NaN NaN 0.827
## 2 NAIVE Test 0.0111 0.0128 0.0111 5.90 5.90 NaN NaN 0.827
## 3 SNAIVE Test 0.0140 0.0155 0.0140 7.48 7.48 NaN NaN 0.749
## 4 ENSEMBLE Test 0.0120 0.0136 0.0120 6.43 6.43 NaN NaN 0.823
models %>%
select(ETS) %>%
gg_tsresiduals()
models %>%
select(NAIVE) %>%
gg_tsresiduals()
## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_line()`).
## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_point()`).
## Warning: Removed 1 row containing non-finite outside the scale range
## (`stat_bin()`).
## Warning: Removed 1 row containing missing values or values outside the scale range
## (`geom_rug()`).
models %>%
select(SNAIVE) %>%
gg_tsresiduals()
## Warning: Removed 12 rows containing missing values or values outside the scale range
## (`geom_line()`).
## Warning: Removed 12 rows containing missing values or values outside the scale range
## (`geom_point()`).
## Warning: Removed 12 rows containing non-finite outside the scale range
## (`stat_bin()`).
## Warning: Removed 12 rows containing missing values or values outside the scale range
## (`geom_rug()`).
