data 624 hw 6
IZZA KHAN
library(fpp3)## Warning: package 'fpp3' was built under R version 4.4.3## Registered S3 methods overwritten by 'ggtime':
## method from
## +.gg_tsensemble feasts
## autolayer.fbl_ts fabletools
## autolayer.tbl_ts fabletools
## autoplot.dcmp_ts fabletools
## autoplot.fbl_ts fabletools
## autoplot.tbl_cf feasts
## autoplot.tbl_ts fabletools
## chooseOpsMethod.gg_tsensemble feasts
## fortify.fbl_ts fabletools
## grid.draw.gg_tsensemble feasts
## print.gg_tsensemble feasts
## scale_type.cf_lag feasts## Warning: replacing previous import 'feasts::scale_x_cf_lag' by
## 'ggtime::scale_x_cf_lag' when loading 'fpp3'## Warning: replacing previous import 'feasts::gg_season' by 'ggtime::gg_season'
## when loading 'fpp3'## Warning: replacing previous import 'feasts::gg_tsresiduals' by
## 'ggtime::gg_tsresiduals' when loading 'fpp3'## Warning: replacing previous import 'feasts::gg_irf' by 'ggtime::gg_irf' when
## loading 'fpp3'## Warning: replacing previous import 'feasts::gg_arma' by 'ggtime::gg_arma' when
## loading 'fpp3'## Warning: replacing previous import 'feasts::gg_tsdisplay' by
## 'ggtime::gg_tsdisplay' when loading 'fpp3'## Warning: replacing previous import 'feasts::gg_subseries' by
## 'ggtime::gg_subseries' when loading 'fpp3'## Warning: replacing previous import 'feasts::gg_lag' by 'ggtime::gg_lag' when
## loading 'fpp3'## ── Attaching packages ──────────────────────────────────────────── fpp3 1.0.3 ──## ✔ tibble 3.3.1 ✔ tsibble 1.2.0
## ✔ dplyr 1.2.0 ✔ tsibbledata 0.4.1
## ✔ tidyr 1.3.2 ✔ ggtime 0.2.0
## ✔ lubridate 1.9.5 ✔ feasts 0.4.2
## ✔ ggplot2 4.0.2 ✔ fable 0.5.0## ── Conflicts ───────────────────────────────────────────────── fpp3_conflicts ──
## ✖ lubridate::date() masks base::date()
## ✖ dplyr::filter() masks stats::filter()
## ✖ feasts::gg_arma() masks ggtime::gg_arma()
## ✖ feasts::gg_irf() masks ggtime::gg_irf()
## ✖ feasts::gg_lag() masks ggtime::gg_lag()
## ✖ feasts::gg_season() masks ggtime::gg_season()
## ✖ feasts::gg_subseries() masks ggtime::gg_subseries()
## ✖ feasts::gg_tsdisplay() masks ggtime::gg_tsdisplay()
## ✖ feasts::gg_tsresiduals() masks ggtime::gg_tsresiduals()
## ✖ tsibble::intersect() masks base::intersect()
## ✖ tsibble::interval() masks lubridate::interval()
## ✖ dplyr::lag() masks stats::lag()
## ✖ feasts::scale_x_cf_lag() masks ggtime::scale_x_cf_lag()
## ✖ tsibble::setdiff() masks base::setdiff()
## ✖ tsibble::union() masks base::union()data("aus_livestock")
data("global_economy")pigs <- aus_livestock
pigs |>
autoplot(Count) +
labs(title="Livestock Data", y="Count")
fit <- pigs |>
model(ETS(Count ~ error("A") + trend("N") + season("N")))
report(fit)## Warning in report.mdl_df(fit): 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: 54 × 11
## Animal State .model sigma2 log_lik AIC AICc BIC MSE AMSE MAE
## <fct> <fct> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Bulls,… Aust… "ETS(… 1.52e5 -4632. 9270. 9270. 9283. 1.52e5 2.09e5 1.69e2
## 2 Bulls,… New … "ETS(… 8.40e7 -6242. 12489. 12489. 12502. 8.37e7 9.86e7 7.11e3
## 3 Bulls,… Nort… "ETS(… 2.99e6 -5125. 10257. 10257. 10269. 2.98e6 8.37e6 8.46e2
## 4 Bulls,… Quee… "ETS(… 8.77e8 -6840. 13686. 13686. 13698. 8.74e8 1.48e9 2.27e4
## 5 Bulls,… Sout… "ETS(… 1.11e7 -5726. 11459. 11459. 11472. 1.11e7 1.56e7 2.61e3
## 6 Bulls,… Tasm… "ETS(… 1.91e6 -5277. 10559. 10559. 10572. 1.90e6 3.01e6 1.08e3
## 7 Bulls,… Vict… "ETS(… 5.79e7 -6147. 12299. 12300. 12312. 5.77e7 8.18e7 6.03e3
## 8 Bulls,… West… "ETS(… 1.09e7 -5721. 11448. 11448. 11461. 1.09e7 1.86e7 2.46e3
## 9 Calves Aust… "ETS(… 6.88e3 -4229. 8464. 8464. 8477. 6.86e3 8.64e3 4.12e1
## 10 Calves New … "ETS(… 1.54e7 -6380. 12766. 12766. 12779. 1.53e7 1.84e7 2.94e3
## # ℹ 44 more rowsThe ETS(A,N,N) model represents simple exponential smoothing with additive errors and no trend or seasonality.
fc <- fit |> forecast(h = 4)
fc |> autoplot(pigs)
res <- augment(fit)
s <- sd(res$.resid, na.rm=TRUE)
s## [1] 24377.61forecast_value <- fc$.mean[1]
lower <- forecast_value - 1.96*s
upper <- forecast_value + 1.96*s
lower## [1] -47780.12upper## [1] 47780.12ses_function <- function(y, alpha, level){
for(i in 2:length(y)){
level <- alpha*y[i] + (1-alpha)*level
}
return(level)
}ses_function(pigs$Count, 0.5, pigs$Count[1])## [1] 133224.9sse_function <- function(params, y){
alpha <- params[1]
level <- params[2]
sse <- 0
for(i in 2:length(y)){
forecast <- level
error <- y[i] - forecast
sse <- sse + error^2
level <- alpha*y[i] + (1-alpha)*level
}
return(sse)
}
optim(c(0.5, pigs$Count[1]), sse_function, y=pigs$Count)## $par
## [1] 0.9294777 2295.2930737
##
## $value
## [1] 2.10811e+13
##
## $counts
## function gradient
## 67 NA
##
## $convergence
## [1] 0
##
## $message
## NULLchina <- global_economy |>
filter(Country == "China")china |>
autoplot(Exports) +
labs(title="Exports of China", y="% of GDP")
fit1 <- china |>
model(ETS(Exports ~ error("A") + trend("N") + season("N")))
fc1 <- fit1 |> forecast(h=5)
fc1 |> autoplot(china)
accuracy(fit1)## # A tibble: 1 × 11
## Country .model .type ME RMSE MAE MPE MAPE MASE RMSSE ACF1
## <fct> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 China "ETS(Exports ~ … Trai… 0.266 1.90 1.26 1.84 9.34 0.983 0.991 0.288fit2 <- china |>
model(ETS(Exports ~ error("A") + trend("A") + season("N")))
accuracy(fit2)## # A tibble: 1 × 11
## Country .model .type ME RMSE MAE MPE MAPE MASE RMSSE ACF1
## <fct> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 China "ETS(Exports… Trai… -0.0854 1.91 1.25 -0.169 9.57 0.973 0.995 0.232china |>
autoplot(GDP)
gdp_fit <- china |>
model(ETS(GDP))
gdp_fc <- gdp_fit |> forecast(h=20)
gdp_fc |> autoplot(china)