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

jetblue <- read_csv("data/jetblue_airways_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)

jetblue_pp <- jetblue |>          # 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> 0.55, 0.54, 0.64, 0.64, 0.60, 0.75, 0.74, 0.…
Rows: 44
Columns: 2
$ Date  <date> 2021-06-30, 2021-07-31, 2021-08-31, 2021-09…
$ Total <dbl> 3.07, 3.42, 3.21, 2.49, 2.81, 2.80, 3.03, 2.…

Interactive Time Series Plot

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

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

(jetblue_dg <- dygraph(jetblue_xts[,1], 
                      main="Jet Blue Airways - 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 <- jetblue |>
  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="Jet Blue Airways: 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/jetblue_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 <- jetblue_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(2,4)) +
  labs(title="Jet Blue Airways: 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/jetblue_trnc_plot_2024_04_21.png", width=6, height=4, unit="in")
```

Forecast Modeling

Create Time Series (ts)

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

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

jetblue_ts # display time series
```
      Jan  Feb  Mar  Apr  May  Jun  Jul  Aug  Sep  Oct  Nov  Dec
2021                          3.07 3.42 3.21 2.49 2.81 2.80 3.03
2022 2.30 2.55 3.36 3.48 3.50 3.39 3.70 3.68 3.17 3.42 3.45 3.63
2023 3.26 3.09 3.88 3.77 3.82 3.72 3.91 3.94 3.18 3.41 3.38 3.45
2024 3.03 2.98 3.61 3.35 3.52 3.54 3.88 3.80 2.96 3.19 3.18 3.59
2025 3.01

Model 1

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

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

jetblue_forecast1 <- jetblue_model1 |> forecast(h=12)

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

jetblue_forecast1

checkresiduals(jetblue_forecast1, test=F)

(acr1 <- accuracy(jetblue_forecast1)) 
```
         Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
Feb 2025           2.96 2.751176 3.168824 2.640631 3.279369
Mar 2025           3.59 3.294678 3.885322 3.138344 4.041656
Apr 2025           3.33 2.968306 3.691694 2.776837 3.883163
May 2025           3.50 3.082352 3.917648 2.861262 4.138738
Jun 2025           3.52 3.053055 3.986945 2.805870 4.234130
Jul 2025           3.86 3.348488 4.371512 3.077709 4.642291
Aug 2025           3.78 3.227503 4.332497 2.935029 4.624971
Sep 2025           2.94 2.349356 3.530644 2.036688 3.843312
Oct 2025           3.17 2.543528 3.796472 2.211893 4.128107
Nov 2025           3.16 2.499640 3.820360 2.150067 4.169933
Dec 2025           3.57 2.877409 4.262591 2.510773 4.629227
Jan 2026           2.99 2.266612 3.713388 1.883674 4.096326
                       ME      RMSE        MAE        MPE    MAPE     MASE
Training set -0.007866597 0.1367726 0.08809806 -0.2669487 2.59706 0.287961
                   ACF1
Training set -0.2372708

Model 2

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

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

jetblue_forecast2 <- jetblue_model2 |> forecast(h=12)

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

jetblue_forecast2

checkresiduals(jetblue_forecast2, test=F)

(acr2 <- accuracy(jetblue_forecast2)) 
```
         Point Forecast    Lo 80    Hi 80    Lo 95    Hi 95
Feb 2025       3.083444 2.692177 3.474710 2.485054 3.681833
Mar 2025       3.090663 2.605688 3.575639 2.348958 3.832369
Apr 2025       3.413831 2.847043 3.980620 2.547003 4.280660
May 2025       3.266046 2.699139 3.832952 2.399037 4.133055
Jun 2025       3.266046 2.684909 3.847183 2.377273 4.154819
Jul 2025       3.266046 2.671018 3.861074 2.356029 4.176063
Aug 2025       3.266046 2.657444 3.874648 2.335270 4.196822
Sep 2025       3.266046 2.644167 3.887925 2.314964 4.217128
Oct 2025       3.266046 2.631167 3.900925 2.295083 4.237009
Nov 2025       3.266046 2.618428 3.913664 2.275600 4.256492
Dec 2025       3.266046 2.605935 3.926157 2.256493 4.275599
Jan 2026       3.266046 2.593674 3.938418 2.237742 4.294350
                   ME      RMSE       MAE       MPE     MAPE      MASE
Training set 0.016989 0.2869492 0.2120094 -0.098135 6.592307 0.6929827
                     ACF1
Training set 0.0006400605