Author

Penelope Pooler Eisenbies

Published

April 30, 2025

Import and Examine Data

Code 
```{r}
#| label: import data

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

alaska <- read_csv("data/alaska_airlines_4_30_2025.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)

alaska_pp <- alaska |>          # 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> 1.05, 1.06, 1.26, 1.05, 1.02, 1.19, 1.16, 1.…
Rows: 44
Columns: 2
$ Date  <date> 2021-06-30, 2021-07-31, 2021-08-31, 2021-09…
$ Total <dbl> 2.39, 2.55, 2.43, 2.05, 2.26, 2.29, 2.32, 1.…

Interactive Time Series Plot

Code 
```{r}
#| label: create dygraph

# create interactive plot
alaska_xts <- xts(x=alaska[,2], order.by=alaska$Date)

(alaska_dg <- dygraph(alaska_xts[,1], 
                      main="Alaska Airlines - 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.

Code 
```{r}
#| label: Full Time Series
#| warning: false
#| message: false

(full_plot <- alaska |>
  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-01-31"))) +
  scale_y_continuous(breaks=seq(0,4,.5), limits=c(0,4)) +
  labs(title="Alaska 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/alaska_full_plot_2025_04_30.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.

Code 
```{r}
#| label: Truncated Time Series
#| warning: false
#| message: false

(short_plot <- alaska_pp |>
  ggplot() +
  geom_line(aes(x=Date, y=Total), linewidth=1, color="blue") +
  theme_classic() +
  scale_x_date(date_breaks = "2 months",  
               date_labels = "%b", 
               limits=c(ymd("2021-05-31"), ymd("2025-1-31")))+
  scale_y_continuous(limits=c(1.5, 4)) +
  labs(title="Alaska 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/alaska_trnc_plot_2024_04_21.png", width=6, height=4, unit="in")
```

Forecast Modeling

Create Time Series (ts)

Code 
```{r}
#| label: create time series

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

alaska_ts # display time series
```
      Jan  Feb  Mar  Apr  May  Jun  Jul  Aug  Sep  Oct  Nov  Dec
2021                          2.39 2.55 2.43 2.05 2.26 2.29 2.32
2022 1.81 2.02 2.70 2.71 2.78 2.79 3.01 2.94 2.69 2.80 2.67 2.73
2023 2.53 2.38 2.89 2.90 3.05 3.24 3.47 3.30 2.87 2.88 2.80 2.86
2024 2.18 2.42 2.91 2.80 3.06 3.30 3.60 3.41 2.94 2.96 2.82 3.12
2025 2.61

Model 1

Code 
```{r}
#| label: Model 1

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

alaska_forecast1 <- alaska_model1 |> forecast(h=12)

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

alaska_forecast1

checkresiduals(alaska_forecast1, test=F)

(acr1 <- accuracy(alaska_forecast1)) 
```
         Point Forecast    Lo 80    Hi 80     Lo 95    Hi 95
Feb 2025           2.61 2.248419 2.971581 2.0570095 3.162991
Mar 2025           2.61 2.098647 3.121353 1.8279533 3.392047
Apr 2025           2.61 1.983723 3.236277 1.6521923 3.567808
May 2025           2.61 1.886838 3.333162 1.5040190 3.715981
Jun 2025           2.61 1.801480 3.418520 1.3734756 3.846524
Jul 2025           2.61 1.724311 3.495689 1.2554554 3.964545
Aug 2025           2.61 1.653346 3.566654 1.1469246 4.073075
Sep 2025           2.61 1.587294 3.632706 1.0459067 4.174093
Oct 2025           2.61 1.525257 3.694743 0.9510285 4.268972
Nov 2025           2.61 1.466580 3.753420 0.8612905 4.358710
Dec 2025           2.61 1.410771 3.809229 0.7759380 4.444062
Jan 2026           2.61 1.357446 3.862554 0.6943847 4.525615
                      ME      RMSE       MAE        MPE     MAPE      MASE
Training set 0.005054318 0.2789186 0.2136907 -0.3874883 8.093345 0.8007145
                    ACF1
Training set -0.06757475

Model 2

Code 
```{r}
#| label: Model 2

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

alaska_forecast2 <- alaska_model2 |> forecast(h=12)

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

alaska_forecast2

checkresiduals(alaska_forecast2, test=F)

(acr2 <- accuracy(alaska_forecast2)) 
```
         Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
Feb 2025       2.620887 2.442494 2.799280 2.348058 2.893716
Mar 2025       3.122636 2.870350 3.374923 2.736798 3.508475
Apr 2025       3.083133 2.774147 3.392119 2.610579 3.555686
May 2025       3.278511 2.921725 3.635298 2.732853 3.824169
Jun 2025       3.489138 3.090238 3.888037 2.879074 4.099202
Jul 2025       3.748015 3.311043 4.184987 3.079723 4.416306
Aug 2025       3.569764 3.097780 4.041748 2.847927 4.291602
Sep 2025       3.123263 2.618691 3.627835 2.351587 3.894940
Oct 2025       3.137388 2.602209 3.672568 2.318902 3.955875
Nov 2025       3.032636 2.468508 3.596765 2.169876 3.895397
Dec 2025       3.191644 2.599981 3.783307 2.286773 4.096515
Jan 2026       2.581774 1.963802 3.199746 1.636667 3.526881
                       ME      RMSE        MAE        MPE     MAPE      MASE
Training set -0.009642139 0.1149414 0.08026623 -0.4727818 2.901428 0.3007634
                    ACF1
Training set -0.08774973