BUA 345

Time Series and Forecasting Practice Questions

Author

Penelope Pooler Eisenbies

Published

April 16, 2025

Setup

Run the following chunk of R code to install and load the packages needed for this assignment.
Click green triangle in the upper right corner of the setup chunk to run the setup code.
Note that this may be slow if there are packages that have not been installed yet.

Import and Examine Data

Code

```{r}
#| label: import data
#| code-fold: true

# data source: https://www.transtats.bts.gov/Data_Elements.aspx?Data=1

united <- read_csv("data/united_passengers_2025_04_16.csv",
                   show_col_types = F, skip=1)|>
  filter(Month != "TOTAL") |>
  mutate(date_som = ym(paste(Year, Month)),
         Date = ceiling_date(date_som, "month")-1,
         Total = (TOTAL/1000000) |> round(2)) |>
  select(Date, Total) |>
  glimpse(width=60)

united_pp <- united |>          # post_pandemic data 
  filter(Date >= "2021-06-01") |>
  glimpse(width=60)
```

Rows: 268
Columns: 2
$ Date  <date> 2002-10-31, 2002-11-30, 2002-12-31, 2003-01…
$ Total <dbl> 5.62, 5.06, 5.85, 5.10, 4.71, 5.53, 5.05, 5.…
Rows: 44
Columns: 2
$ Date  <date> 2021-06-30, 2021-07-31, 2021-08-31, 2021-09…
$ Total <dbl> 6.43, 8.05, 7.69, 6.78, 7.80, 7.92, 8.35, 6.…

Interactive Time Series Plot

Full and Truncated Data Plots

Plot of Full Time Series

Seasonal pattern was disrupted by the pandemic when air travel was considered dangerous.

Plot of Truncated Time Series

Once vaccines became readily available, air travel began to resume it’s traditional pattern:

Peaks occur at the end of July
Low points occur at the end of Jnauary
Pattern is not straightforward to discern because post-pandemic data are fairly limited.
Data for February and March of 2024 are not available yet.

Forecast Modeling

Create Time Series (`ts`)

Code

```{r}
#| label: create time series
#| code-fold: true

united_ts <- ts(united_pp$Total, freq=12, start=c(2021,6)) # create time series

united_ts # display time series
```

       Jan   Feb   Mar   Apr   May   Jun   Jul   Aug   Sep   Oct   Nov   Dec
2021                                6.43  8.05  7.69  6.78  7.80  7.92  8.35
2022  6.25  6.71  8.99  9.18  9.86 10.24 10.83 10.27  9.50 10.45  9.72 10.53
2023  9.63  9.03 11.07 10.72 11.55 11.73 12.73 12.44 11.25 11.86 10.75 11.23
2024  9.95 10.07 12.10 11.31 12.20 12.53 12.96 12.56 11.33 12.12 11.16 12.27
2025 10.76

Model 1

Code

```{r}
#| label: Model 1
#| code-fold: true

united_model1 <- united_ts |> auto.arima(ic="aic", seasonal=F)

united_forecast1 <- united_model1 |> forecast(h=12)

(united_fcp1 <- autoplot(united_forecast1) + 
    labs(y = "Number of Passenger (Mill.)") + 
    theme_classic())

united_forecast1

checkresiduals(united_forecast1, test=F)

(acr1 <- accuracy(united_forecast1)) 
```

         Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
Feb 2025       11.19411 9.967203 12.42101 9.317720 13.07049
Mar 2025       11.19411 9.734303 12.65391 8.961529 13.42668
Apr 2025       11.19411 9.533757 12.85446 8.654820 13.73339
May 2025       11.19411 9.354950 13.03326 8.381359 14.00685
Jun 2025       11.19411 9.192050 13.19616 8.132225 14.25599
Jul 2025       11.19411 9.041441 13.34677 7.901889 14.48632
Aug 2025       11.19411 8.900703 13.48751 7.686648 14.70157
Sep 2025       11.19411 8.768115 13.62010 7.483872 14.90434
Oct 2025       11.19411 8.642407 13.74581 7.291619 15.09659
Nov 2025       11.19411 8.522608 13.86561 7.108401 15.27981
Dec 2025       11.19411 8.407955 13.98026 6.933055 15.45516
Jan 2026       11.19411 8.297837 14.09038 6.764645 15.62357
                   ME      RMSE       MAE      MPE     MAPE      MASE
Training set 0.163666 0.9353466 0.7763282 1.205517 7.902057 0.5245461
                    ACF1
Training set -0.03439602

Model 2

Code

```{r}
#| label: Model 2
#| code-fold: true

united_model2 <- united_ts |> auto.arima(ic="aic", seasonal=T) 

united_forecast2 <- united_model2 |> forecast(h=12)

(united_fcp2 <- autoplot(united_forecast2) + 
    labs(y = "Number of Passenger (Mill.)") + 
    theme_classic())

united_forecast2

checkresiduals(united_forecast2, test=F)

(acr2 <- accuracy(united_forecast2)) 
```

         Point Forecast     Lo 80    Hi 80     Lo 95    Hi 95
Feb 2025       10.54717  9.973302 11.12104  9.669514 11.42483
Mar 2025       12.58179 11.770221 13.39337 11.340600 13.82299
Apr 2025       11.99519 11.001219 12.98916 10.475044 13.51533
May 2025       12.85745 11.709716 14.00519 11.102141 14.61277
Jun 2025       13.11811 11.834905 14.40132 11.155615 15.08061
Jul 2025       13.81160 12.405918 15.21729 11.661793 15.96141
Aug 2025       13.46245 11.944139 14.98077 11.140392 15.78451
Sep 2025       12.25094 10.627798 13.87409  9.768556 14.73333
Oct 2025       12.95774 11.236130 14.67934 10.324767 15.59070
Nov 2025       11.92840 10.113664 13.74313  9.153003 14.70379
Dec 2025       12.74717 10.843864 14.65048  9.836314 15.65803
Jan 2026       11.34349  9.355552 13.33143  8.303200 14.38378
                      ME      RMSE       MAE        MPE     MAPE      MASE
Training set -0.09886363 0.3697521 0.2333483 -0.9172191 2.194578 0.1576678
                   ACF1
Training set -0.1198428

--- title: "BUA 345" subtitle: "Time Series and Forecasting Practice Questions" author: "Penelope Pooler Eisenbies" date: last-modified lightbox: true toc: true toc-depth: 3 toc-location: left toc-title: "Table of Contents" toc-expand: 1 format: html: code-line-numbers: true code-fold: true code-tools: true execute: echo: fenced --- ## Setup - Run the following chunk of R code to install and load the packages needed for this assignment. - Click green triangle in the upper right corner of the setup chunk to run the setup code. - Note that this may be slow if there are packages that have not been installed yet. ```{r} #| label: setup #| include: false # suppress scientific notation options(scipen=100) # install helper package that loads and installs other packages, if needed if (!require("pacman")) install.packages("pacman", repos = "http://lib.stat.cmu.edu/R/CRAN/") # install and load required packages # pacman should be first package in parentheses and then list others pacman::p_load(pacman,tidyverse, magrittr, knitr, gridExtra, forecast, tidyquant, lubridate, ggthemes, RColorBrewer, dygraphs) # verify packages #p_loaded() ``` ## Import and Examine Data ```{r} #| label: import data #| code-fold: true # data source: https://www.transtats.bts.gov/Data_Elements.aspx?Data=1 united <- read_csv("data/united_passengers_2025_04_16.csv", show_col_types = F, skip=1)|> filter(Month != "TOTAL") |> mutate(date_som = ym(paste(Year, Month)), Date = ceiling_date(date_som, "month")-1, Total = (TOTAL/1000000) |> round(2)) |> select(Date, Total) |> glimpse(width=60) united_pp <- united |> # post_pandemic data filter(Date >= "2021-06-01") |> glimpse(width=60) ``` ### Interactive Time Series Plot ```{r} #| label: create dygraph #| echo: false # create interactive plot united_xts <- xts(x=united[,2], order.by=united$Date) (united_dg <- dygraph(united_xts[,1], main="United - Total Passengers") |> dySeries("Total", label="Total (Mill.)", color= "blue") |> dyAxis("y", label = "", drawGrid = FALSE) |> dyAxis("x", label = "", drawGrid = FALSE) |> dyShading(from="2020-3-12", to="2021-6-14", color = "lightgrey") |> dyRangeSelector()) ``` ## Full and Truncated Data Plots ### Plot of Full Time Series Seasonal pattern was disrupted by the pandemic when air travel was considered dangerous. ```{r} #| label: Full Time Series #| echo: false #| warning: false #| message: false (full_plot <- united |> ggplot() + geom_line(aes(x=Date, y=Total), linewidth=1, color="blue") + theme_classic() + scale_x_date(date_breaks = "2 years", date_labels = "%Y", limits=c(ymd("2001-12-31"), ymd("2025-12-31"))) + scale_y_continuous(breaks=seq(0,12,2), limits=c(0,13)) + labs(title="United Airlines: October 2002 - January 2025", subtitle="Total Passengers (Domestic and International)", x="Date", y="Millions of Passengers", caption="Data Source: https://www.bts.gov/" ) + theme(plot.title = element_text(size = 15), plot.caption = element_text(size = 10), axis.title.x = element_text(size = 15), axis.title.y = element_text(size = 15), axis.text.x = element_text(size = 10), axis.text.y = element_text(size = 15))) ggsave("img/united_full_plot_2025_04_16.png", width=6, height=4, unit="in") ``` ### Plot of Truncated Time Series Once vaccines became readily available, air travel began to resume it's traditional pattern: - Peaks occur at the end of July - Low points occur at the end of Jnauary - Pattern is not straightforward to discern because post-pandemic data are fairly limited. - Data for February and March of 2024 are not available yet. ```{r} #| label: Truncated Time Series #| echo: false #| warning: false #| message: false (short_plot <- united_pp |> ggplot() + geom_line(aes(x=Date, y=Total), linewidth=1, color="blue") + theme_classic() + scale_x_date(date_breaks = "3 months", date_labels = "%b", limits=c(ymd("2021-05-31"), ymd("2025-1-31")))+ scale_y_continuous(breaks=seq(0,12,2), limits=c(0,13)) + labs(title="United Airlines: June 2021 - January 2025", subtitle="Total Passengers (Domestic and International)", x="Date", y="Millions of Passengers", caption="Data Source: https://www.bts.gov/" ) + theme(plot.title = element_text(size = 15), plot.caption = element_text(size = 10), axis.title.x = element_text(size = 15), axis.title.y = element_text(size = 15), axis.text.x = element_text(size = 10), axis.text.y = element_text(size = 15))) ggsave("img/united_trnc_plot_2025_04_16.png", width=6, height=4, unit="in") ``` ## Forecast Modeling ### Create Time Series (`ts`) ```{r} #| label: create time series #| code-fold: true united_ts <- ts(united_pp$Total, freq=12, start=c(2021,6)) # create time series united_ts # display time series ``` ### Model 1 ```{r} #| label: Model 1 #| code-fold: true united_model1 <- united_ts |> auto.arima(ic="aic", seasonal=F) united_forecast1 <- united_model1 |> forecast(h=12) (united_fcp1 <- autoplot(united_forecast1) + labs(y = "Number of Passenger (Mill.)") + theme_classic()) united_forecast1 checkresiduals(united_forecast1, test=F) (acr1 <- accuracy(united_forecast1)) ``` ### Model 2 ```{r} #| label: Model 2 #| code-fold: true united_model2 <- united_ts |> auto.arima(ic="aic", seasonal=T) united_forecast2 <- united_model2 |> forecast(h=12) (united_fcp2 <- autoplot(united_forecast2) + labs(y = "Number of Passenger (Mill.)") + theme_classic()) united_forecast2 checkresiduals(united_forecast2, test=F) (acr2 <- accuracy(united_forecast2)) ```

Setup

Import and Examine Data

Interactive Time Series Plot

Full and Truncated Data Plots

Plot of Full Time Series

Plot of Truncated Time Series

Forecast Modeling

Create Time Series (ts)

Model 1

Model 2

Create Time Series (`ts`)