Module 4 Discussion

R Markdown

##https://rpubs.com/Farrell/1348295
library(fpp3)

## Registered S3 method overwritten by 'tsibble':
##   method               from 
##   as_tibble.grouped_df dplyr

## ── Attaching packages ──────────────────────────────────────────── fpp3 1.0.2 ──

## ✔ tibble      3.3.0     ✔ tsibble     1.1.6
## ✔ dplyr       1.1.4     ✔ tsibbledata 0.4.1
## ✔ tidyr       1.3.1     ✔ feasts      0.4.2
## ✔ lubridate   1.9.4     ✔ fable       0.4.1
## ✔ ggplot2     3.5.2

## ── 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(fredr)
library(tidyverse)

## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ forcats 1.0.0     ✔ readr   2.1.5
## ✔ purrr   1.1.0     ✔ stringr 1.5.1

## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter()     masks stats::filter()
## ✖ tsibble::interval() masks lubridate::interval()
## ✖ dplyr::lag()        masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(patchwork)
library(knitr)
library(kableExtra)

## 
## Attaching package: 'kableExtra'
## 
## The following object is masked from 'package:dplyr':
## 
##     group_rows

library(writexl)
library(dplyr)
library(feasts)
fredr_set_key("430508d0ad1df25ecddc34d5581dafc8")

cpi <- fredr("CPIAUCSL",
              observation_start = as.Date("2000-01-01"),
              observation_end   = as.Date("2025-08-01")
              ) |>
  mutate(Month = yearmonth(date), value) |>
  as_tsibble(index = Month) 

#Setting up the data to have a test and train sample with 80%/20% 
split_index <- floor(0.8 * nrow(cpi))  

train <- cpi[1:split_index, ]
test  <- cpi[(split_index + 1):nrow(cpi), ]

# Fit five benchmark forecasting models 
library(fable)

models <- train %>% model( NAIVE  = NAIVE(formula = value),) 

report(models%>% select(NAIVE))

## Series: value 
## Model: NAIVE 
## 
## sigma^2: 0.405

library(ggplot2)

# forecasts on the test data 
fc <- models %>%
  forecast(h = nrow(test)
  ) # h = 12 if you want to forecast the next 12 months

# Plot all forecasts with the training data
fc %>% autoplot(train) + 
  labs( title = "Naive",
        y = "Value",
        x = "Month" 
        ) + facet_wrap(~ .model,
                       ncol = 2
                       ) 

# Calc the accuracy metrics and print
acc <- accuracy(object = fc, 
                data = test
                ) |>
  select(.model, ME, MPE, RMSE, MAE, MAPE #, MASE, RMSSE
         )

# Print with knitr::kable
kable(acc, caption = "Forecast Accuracy Metrics") |>
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)

Forecast Accuracy Metrics

.model	ME	MPE	RMSE	MAE	MAPE
NAIVE	38.30085	12.53529	43.39963	38.30085	12.53529

library(ggplot2)

cpi |> autoplot() +
labs(y = "CPI Autoplot")

## Plot variable not specified, automatically selected `.vars = value`

cpi |>  autoplot(sqrt(value)) +
labs(y = "Square root CPI Value")

##The sqrt transformation made little change to the plot. 

cpi |> autoplot(log(value)) +
labs(y = "Log Value")

#Log also made little movement

cpi |> autoplot(-1 /value) +
labs(y = "Inverse Value")

#Inverse also made little movement

#BOX COX
library(feasts)
cpi |>
features(value, features = guerrero)

## # A tibble: 1 × 1
##   lambda_guerrero
##             <dbl>
## 1          -0.900

-0.8999268

## [1] -0.8999268

cpi |> autoplot(box_cox(value, -0.8999268)) +
labs(y = "Box-Cox transformed Value")

#there a pretty big lambda, plot looks relatively unchanged.