Group Members

  1. LEE JIE YENG (S2168543) - LEADER
  2. TSU HIAO PING (22106817)
  3. FARAH AMIRAH BINTI MOHAMAD RAFI (17067242)
  4. VICKNESWARY PERUMAL (S2150313)
  5. NUR SHAFIQAH BINTI MUHAMAD BAHARUM (S2151950)

Introduction

The objective of this project is to analyze and predict flight cancellations and delays using the Air Flight Dataset, which contains comprehensive flight information, including cancellations and delays by airline, from 2018 to 2022.

Research Questions

  1. Classification Research Question: What are the most significant factors that contribute to a flight being delayed by 15 minutes or more, and how accurately can we predict such delays using these factors?

This research question focuses on developing a regression model with the target variable ArrDelay to estimate the delay time for flights.

  1. Regression Research Question: What are the key factors influencing the exact delay time of a flight, and how accurately can we predict the arrival delay time (in minutes) using these factors?

This research question aims to identify the key factors that influence whether a flight will be delayed by 15 minutes or more. By developing a classification model using the target variable ArrDel15, the study seeks to understand and predict delays based on various attributes.

To achieve these objectives, the project will first involve data cleaning and preprocessing to handle null values and ensure the dataset is suitable for analysis. This step will use the Combined_Flights_2018.csv to Combined_Flights_2022.csv, which have already filtered out columns with mostly null values. Exploratory Data Analysis (EDA) will then be performed to uncover initial insights, detect patterns, and visualize the data distributions. This will guide the feature selection and engineering processes necessary for building robust predictive models.

Data Preprocessing

Step 1: Installing, Loading Packages and Combining 5-year Data Set

library(data.table)
library(magrittr)
setwd("C:/Users/Tsu/Desktop/WQD 7004/7004 - Flight dataset/only_csv/file")

# List the CSV files in the directory
csv_files <- paste0("Combined_Flights_", 2018:2022, ".csv")

# Combine the CSV files into a single dataset using fread and rbindlist
combined_data <- rbindlist(lapply(csv_files, fread))

Step 2: Set Sample Size of 25% and Perform Ramdom Sampling

# Set the seed for reproducibility
set.seed(123)

# Calculate the sample size of 25%
sample_size <- nrow(combined_data) * 0.25

# Perform random sampling
sampled_data <- dplyr::sample_n(combined_data, sample_size, replace = FALSE)

Dimension and Structure of the Dataset

# Dimension of the dataset
dim(sampled_data)
## [1] 7298445      61
# Structure of the dataset (column names, data types)
str(sampled_data)
## Classes 'data.table' and 'data.frame':   7298445 obs. of  61 variables:
##  $ FlightDate                             : IDate, format: "2022-05-07" "2019-05-31" ...
##  $ Airline                                : chr  "Delta Air Lines Inc." "Air Wisconsin Airlines Corp" "SkyWest Airlines Inc." "Southwest Airlines Co." ...
##  $ Origin                                 : chr  "AUS" "DAY" "CHS" "ELP" ...
##  $ Dest                                   : chr  "ATL" "ORD" "DTW" "HOU" ...
##  $ Cancelled                              : logi  FALSE FALSE FALSE FALSE FALSE TRUE ...
##  $ Diverted                               : logi  FALSE FALSE FALSE FALSE FALSE FALSE ...
##  $ CRSDepTime                             : int  805 1733 900 705 1959 1230 1817 1600 1240 700 ...
##  $ DepTime                                : num  805 1742 857 703 1952 ...
##  $ DepDelayMinutes                        : num  0 9 0 0 0 NA 18 57 0 0 ...
##  $ DepDelay                               : num  0 9 -3 -2 -7 NA 18 57 -8 -3 ...
##  $ ArrTime                                : num  1104 1755 1051 948 2140 ...
##  $ ArrDelayMinutes                        : num  0 0 0 0 0 NA 0 43 0 2 ...
##  $ AirTime                                : num  106 42 96 91 88 NA 172 45 92 114 ...
##  $ CRSElapsedTime                         : num  132 92 120 110 104 145 210 70 121 141 ...
##  $ ActualElapsedTime                      : num  119 73 114 105 108 NA 191 56 112 146 ...
##  $ Distance                               : num  813 240 667 677 587 ...
##  $ Year                                   : int  2022 2019 2019 2021 2021 2020 2021 2019 2020 2022 ...
##  $ Quarter                                : int  2 2 4 2 4 2 4 2 1 1 ...
##  $ Month                                  : int  5 5 11 4 12 5 10 4 1 3 ...
##  $ DayofMonth                             : int  7 31 23 19 2 2 13 14 4 23 ...
##  $ DayOfWeek                              : int  6 5 6 1 4 6 3 7 6 3 ...
##  $ Marketing_Airline_Network              : chr  "DL" "UA" "DL" "WN" ...
##  $ Operated_or_Branded_Code_Share_Partners: chr  "DL" "UA_CODESHARE" "DL_CODESHARE" "WN" ...
##  $ DOT_ID_Marketing_Airline               : int  19790 19977 19790 19393 19790 19393 19977 19393 19790 20409 ...
##  $ IATA_Code_Marketing_Airline            : chr  "DL" "UA" "DL" "WN" ...
##  $ Flight_Number_Marketing_Airline        : int  2234 3937 4010 729 1412 3278 1011 39 3781 841 ...
##  $ Operating_Airline                      : chr  "DL" "ZW" "OO" "WN" ...
##  $ DOT_ID_Operating_Airline               : int  19790 20046 20304 19393 19790 19393 19977 19393 20304 20409 ...
##  $ IATA_Code_Operating_Airline            : chr  "DL" "ZW" "OO" "WN" ...
##  $ Tail_Number                            : chr  "N127DN" "N411ZW" "N548CA" "N7729A" ...
##  $ Flight_Number_Operating_Airline        : int  2234 3937 4010 729 1412 3278 1011 39 3781 841 ...
##  $ OriginAirportID                        : int  10423 11267 10994 11540 15304 11278 12266 11259 10257 12478 ...
##  $ OriginAirportSeqID                     : int  1042302 1126702 1099402 1154005 1530402 1127805 1226603 1125904 1025702 1247805 ...
##  $ OriginCityMarketID                     : int  30423 31267 30994 30615 33195 30852 31453 30194 30257 31703 ...
##  $ OriginCityName                         : chr  "Austin, TX" "Dayton, OH" "Charleston, SC" "El Paso, TX" ...
##  $ OriginState                            : chr  "TX" "OH" "SC" "TX" ...
##  $ OriginStateFips                        : int  48 39 45 48 12 51 48 48 36 36 ...
##  $ OriginStateName                        : chr  "Texas" "Ohio" "South Carolina" "Texas" ...
##  $ OriginWac                              : int  74 44 37 74 33 38 74 74 22 22 ...
##  $ DestAirportID                          : int  10397 13930 11433 12191 14492 15304 12953 12191 11433 14685 ...
##  $ DestAirportSeqID                       : int  1039707 1393007 1143302 1219102 1449202 1530402 1295304 1219102 1143302 1468502 ...
##  $ DestCityMarketID                       : int  30397 30977 31295 31453 34492 33195 31703 31453 31295 34685 ...
##  $ DestCityName                           : chr  "Atlanta, GA" "Chicago, IL" "Detroit, MI" "Houston, TX" ...
##  $ DestState                              : chr  "GA" "IL" "MI" "TX" ...
##  $ DestStateFips                          : int  13 17 26 48 37 12 36 48 26 13 ...
##  $ DestStateName                          : chr  "Georgia" "Illinois" "Michigan" "Texas" ...
##  $ DestWac                                : int  34 41 43 74 36 33 22 74 43 34 ...
##  $ DepDel15                               : num  0 0 0 0 0 NA 1 1 0 0 ...
##  $ DepartureDelayGroups                   : num  0 0 -1 -1 -1 NA 1 3 -1 -1 ...
##  $ DepTimeBlk                             : chr  "0800-0859" "1700-1759" "0900-0959" "0700-0759" ...
##  $ TaxiOut                                : num  9 18 12 9 13 NA 14 8 12 25 ...
##  $ WheelsOff                              : num  814 1800 909 712 2005 ...
##  $ WheelsOn                               : num  1100 1742 1045 943 2133 ...
##  $ TaxiIn                                 : num  4 13 6 5 7 NA 5 3 8 7 ...
##  $ CRSArrTime                             : int  1117 1805 1100 955 2143 1455 2247 1710 1441 921 ...
##  $ ArrDelay                               : num  -13 -10 -9 -7 -3 NA -1 43 -17 2 ...
##  $ ArrDel15                               : num  0 0 0 0 0 NA 0 1 0 0 ...
##  $ ArrivalDelayGroups                     : num  -1 -1 -1 -1 -1 NA -1 2 -2 0 ...
##  $ ArrTimeBlk                             : chr  "1100-1159" "1800-1859" "1100-1159" "0900-0959" ...
##  $ DistanceGroup                          : int  4 1 3 3 3 4 6 1 2 3 ...
##  $ DivAirportLandings                     : num  0 0 0 0 0 0 0 0 0 0 ...
##  - attr(*, ".internal.selfref")=<externalptr>

Summary of the Raw Data

# Use the summary() function to get summary statistics for each column
summary(sampled_data)
##    FlightDate           Airline             Origin              Dest          
##  Min.   :2018-01-01   Length:7298445     Length:7298445     Length:7298445    
##  1st Qu.:2019-03-18   Class :character   Class :character   Class :character  
##  Median :2020-02-08   Mode  :character   Mode  :character   Mode  :character  
##  Mean   :2020-04-23                                                           
##  3rd Qu.:2021-07-17                                                           
##  Max.   :2022-07-31                                                           
##                                                                               
##  Cancelled        Diverted         CRSDepTime      DepTime      
##  Mode :logical   Mode :logical   Min.   :   1   Min.   :   1    
##  FALSE:7104311   FALSE:7281434   1st Qu.: 918   1st Qu.: 920    
##  TRUE :194134    TRUE :17011     Median :1320   Median :1323    
##                                  Mean   :1326   Mean   :1329    
##                                  3rd Qu.:1730   3rd Qu.:1736    
##                                  Max.   :2359   Max.   :2400    
##                                                 NA's   :190348  
##  DepDelayMinutes     DepDelay          ArrTime       ArrDelayMinutes  
##  Min.   :   0.0   Min.   :-611.00   Min.   :   1     Min.   :   0.00  
##  1st Qu.:   0.0   1st Qu.:  -6.00   1st Qu.:1055     1st Qu.:   0.00  
##  Median :   0.0   Median :  -3.00   Median :1505     Median :   0.00  
##  Mean   :  12.8   Mean   :   9.33   Mean   :1468     Mean   :  12.83  
##  3rd Qu.:   5.0   3rd Qu.:   5.00   3rd Qu.:1910     3rd Qu.:   6.00  
##  Max.   :3072.0   Max.   :3072.00   Max.   :2400     Max.   :3069.00  
##  NA's   :190714   NA's   :190714    NA's   :196419   NA's   :211289   
##     AirTime       CRSElapsedTime   ActualElapsedTime    Distance     
##  Min.   :  7.0    Min.   :-112.0   Min.   :  4.0     Min.   :  16.0  
##  1st Qu.: 59.0    1st Qu.:  88.0   1st Qu.: 82.0     1st Qu.: 354.0  
##  Median : 91.0    Median : 121.0   Median :116.0     Median : 627.0  
##  Mean   :109.1    Mean   : 138.8   Mean   :133.3     Mean   : 780.2  
##  3rd Qu.:139.0    3rd Qu.: 169.0   3rd Qu.:164.0     3rd Qu.:1014.0  
##  Max.   :696.0    Max.   :1629.0   Max.   :794.0     Max.   :5812.0  
##  NA's   :212903   NA's   :11       NA's   :211153                    
##       Year         Quarter          Month          DayofMonth   
##  Min.   :2018   Min.   :1.000   Min.   : 1.000   Min.   : 1.00  
##  1st Qu.:2019   1st Qu.:1.000   1st Qu.: 3.000   1st Qu.: 8.00  
##  Median :2020   Median :2.000   Median : 6.000   Median :16.00  
##  Mean   :2020   Mean   :2.448   Mean   : 6.326   Mean   :15.75  
##  3rd Qu.:2021   3rd Qu.:3.000   3rd Qu.: 9.000   3rd Qu.:23.00  
##  Max.   :2022   Max.   :4.000   Max.   :12.000   Max.   :31.00  
##                                                                 
##    DayOfWeek     Marketing_Airline_Network
##  Min.   :1.000   Length:7298445           
##  1st Qu.:2.000   Class :character         
##  Median :4.000   Mode  :character         
##  Mean   :3.975                            
##  3rd Qu.:6.000                            
##  Max.   :7.000                            
##                                           
##  Operated_or_Branded_Code_Share_Partners DOT_ID_Marketing_Airline
##  Length:7298445                          Min.   :19393           
##  Class :character                        1st Qu.:19790           
##  Mode  :character                        Median :19805           
##                                          Mean   :19828           
##                                          3rd Qu.:19977           
##                                          Max.   :21171           
##                                                                  
##  IATA_Code_Marketing_Airline Flight_Number_Marketing_Airline Operating_Airline 
##  Length:7298445              Min.   :   1                    Length:7298445    
##  Class :character            1st Qu.:1098                    Class :character  
##  Mode  :character            Median :2292                    Mode  :character  
##                              Mean   :2690                                      
##                              3rd Qu.:4255                                      
##                              Max.   :9888                                      
##                                                                                
##  DOT_ID_Operating_Airline IATA_Code_Operating_Airline Tail_Number       
##  Min.   :19393            Length:7298445              Length:7298445    
##  1st Qu.:19790            Class :character            Class :character  
##  Median :19977            Mode  :character            Mode  :character  
##  Mean   :20002                                                          
##  3rd Qu.:20378                                                          
##  Max.   :21171                                                          
##                                                                         
##  Flight_Number_Operating_Airline OriginAirportID OriginAirportSeqID
##  Min.   :   1                    Min.   :10135   Min.   :1013505   
##  1st Qu.:1098                    1st Qu.:11292   1st Qu.:1129202   
##  Median :2292                    Median :12889   Median :1288903   
##  Mean   :2690                    Mean   :12677   Mean   :1267747   
##  3rd Qu.:4255                    3rd Qu.:14057   3rd Qu.:1405702   
##  Max.   :9888                    Max.   :16869   Max.   :1686901   
##                                                                    
##  OriginCityMarketID OriginCityName     OriginState        OriginStateFips
##  Min.   :30070      Length:7298445     Length:7298445     Min.   : 1.00  
##  1st Qu.:30693      Class :character   Class :character   1st Qu.:12.00  
##  Median :31453      Mode  :character   Mode  :character   Median :26.00  
##  Mean   :31761                                            Mean   :27.29  
##  3rd Qu.:32575                                            3rd Qu.:42.00  
##  Max.   :36133                                            Max.   :78.00  
##                                                                          
##  OriginStateName      OriginWac     DestAirportID   DestAirportSeqID 
##  Length:7298445     Min.   : 1.00   Min.   :10135   Min.   :1013505  
##  Class :character   1st Qu.:34.00   1st Qu.:11292   1st Qu.:1129202  
##  Mode  :character   Median :45.00   Median :12889   Median :1288903  
##                     Mean   :54.78   Mean   :12677   Mean   :1267662  
##                     3rd Qu.:82.00   3rd Qu.:14057   3rd Qu.:1405702  
##                     Max.   :93.00   Max.   :16869   Max.   :1686901  
##                                                                      
##  DestCityMarketID DestCityName        DestState         DestStateFips  
##  Min.   :30070    Length:7298445     Length:7298445     Min.   : 1.00  
##  1st Qu.:30693    Class :character   Class :character   1st Qu.:12.00  
##  Median :31453    Mode  :character   Mode  :character   Median :26.00  
##  Mean   :31762                                          Mean   :27.29  
##  3rd Qu.:32575                                          3rd Qu.:42.00  
##  Max.   :36133                                          Max.   :78.00  
##                                                                        
##  DestStateName         DestWac         DepDel15      DepartureDelayGroups
##  Length:7298445     Min.   : 1.00   Min.   :0.00     Min.   :-2.00       
##  Class :character   1st Qu.:34.00   1st Qu.:0.00     1st Qu.:-1.00       
##  Mode  :character   Median :45.00   Median :0.00     Median :-1.00       
##                     Mean   :54.79   Mean   :0.17     Mean   :-0.01       
##                     3rd Qu.:82.00   3rd Qu.:0.00     3rd Qu.: 0.00       
##                     Max.   :93.00   Max.   :1.00     Max.   :12.00       
##                                     NA's   :190714   NA's   :190714      
##   DepTimeBlk           TaxiOut         WheelsOff         WheelsOn     
##  Length:7298445     Min.   :  0.00   Min.   :   1     Min.   :   1    
##  Class :character   1st Qu.: 11.00   1st Qu.: 935     1st Qu.:1052    
##  Mode  :character   Median : 14.00   Median :1336     Median :1501    
##                     Mean   : 16.71   Mean   :1353     Mean   :1464    
##                     3rd Qu.: 19.00   3rd Qu.:1750     3rd Qu.:1905    
##                     Max.   :215.00   Max.   :2400     Max.   :2400    
##                     NA's   :195006   NA's   :195002   NA's   :198176  
##      TaxiIn         CRSArrTime      ArrDelay          ArrDel15     
##  Min.   :  0.00   Min.   :   1   Min.   :-475.00   Min.   :0.00    
##  1st Qu.:  4.00   1st Qu.:1108   1st Qu.: -16.00   1st Qu.:0.00    
##  Median :  6.00   Median :1515   Median :  -7.00   Median :0.00    
##  Mean   :  7.53   Mean   :1489   Mean   :   3.63   Mean   :0.18    
##  3rd Qu.:  9.00   3rd Qu.:1915   3rd Qu.:   6.00   3rd Qu.:0.00    
##  Max.   :316.00   Max.   :2400   Max.   :3069.00   Max.   :1.00    
##  NA's   :198179                  NA's   :211289    NA's   :211289  
##  ArrivalDelayGroups  ArrTimeBlk        DistanceGroup    DivAirportLandings
##  Min.   :-2.00      Length:7298445     Min.   : 1.000   Min.   :0.000000  
##  1st Qu.:-2.00      Class :character   1st Qu.: 2.000   1st Qu.:0.000000  
##  Median :-1.00      Mode  :character   Median : 3.000   Median :0.000000  
##  Mean   :-0.29                         Mean   : 3.595   Mean   :0.003457  
##  3rd Qu.: 0.00                         3rd Qu.: 5.000   3rd Qu.:0.000000  
##  Max.   :12.00                         Max.   :11.000   Max.   :9.000000  
##  NA's   :211289                                         NA's   :21

Step 3: Handling Missing Values

Calculate Missing Proportion

At first, We plan to omit the factors that are not useful and have very large missing values

# Use the colMeans function to calculate the proportion of missing values for each column in sampled_data and then filter the columns where the proportion exceeds 5%: 
# Calculate the proportion of missing values for each column 
missing_proportion <- colMeans(is.na(sampled_data)) 
# Find columns with missing values exceeding 5% 
cols_with_missing <- names(missing_proportion[missing_proportion > 0.05]) 
# Display the columns 
cols_with_missing 
## character(0)

The output has shown that we cannot delete variables with high missing values since all NA values shown are less than 5%.

# Count missing values for each column 
missing_counts <- colSums(is.na(sampled_data)) 
# List variables with missing values and their corresponding missing counts 
vars_with_missing <- names(missing_counts[missing_counts > 0]) 
# Display the list of variables with missing values and their missing counts 
for (var_name in vars_with_missing) { 
  cat("Variable:", var_name, "\tMissing Count:", missing_counts[var_name], "\n") 
} 
## Variable: DepTime    Missing Count: 190348 
## Variable: DepDelayMinutes    Missing Count: 190714 
## Variable: DepDelay   Missing Count: 190714 
## Variable: ArrTime    Missing Count: 196419 
## Variable: ArrDelayMinutes    Missing Count: 211289 
## Variable: AirTime    Missing Count: 212903 
## Variable: CRSElapsedTime     Missing Count: 11 
## Variable: ActualElapsedTime  Missing Count: 211153 
## Variable: DepDel15   Missing Count: 190714 
## Variable: DepartureDelayGroups   Missing Count: 190714 
## Variable: TaxiOut    Missing Count: 195006 
## Variable: WheelsOff  Missing Count: 195002 
## Variable: WheelsOn   Missing Count: 198176 
## Variable: TaxiIn     Missing Count: 198179 
## Variable: ArrDelay   Missing Count: 211289 
## Variable: ArrDel15   Missing Count: 211289 
## Variable: ArrivalDelayGroups     Missing Count: 211289 
## Variable: DivAirportLandings     Missing Count: 21

Replacing missing values for numeric variables (In our dataset, categorical variables do not have missing values)

Min-Max Imputation: This method replaces missing values with random values drawn from the range of observed non-missing values in the variable. Min-max imputation preserves the distribution of the variable and can handle outliers better than mean imputation.

However, it may introduce some bias, especially if the distribution of the variable is skewed. In general, if our data has outliers or if we want to preserve the distribution of the variable, min-max imputation may be a better choice. However, if the variable is normally distributed and is not concerned about outliers, mean imputation may be more appropriate.

Replacing missing values for numeric variables

# Replace missing values in DepTime 
sampled_data$DepTime[is.na(sampled_data$DepTime)] <- runif( 
  
  n = sum(is.na(sampled_data$DepTime)), 
  
  min = min(sampled_data$DepTime, na.rm = TRUE), 
  
  max = max(sampled_data$DepTime, na.rm = TRUE) 
  
) 
# Replace missing values in DepDelay 
sampled_data$DepDelay[is.na(sampled_data$DepDelay)] <- runif( 
  
  n = sum(is.na(sampled_data$DepDelay)), 
  
  min = min(sampled_data$DepDelay, na.rm = TRUE), 
  
  max = max(sampled_data$DepDelay, na.rm = TRUE) 
  
) 

# Replace missing values in ArrTime 
sampled_data$ArrTime[is.na(sampled_data$ArrTime)] <- runif( 
  
  n = sum(is.na(sampled_data$ArrTime)), 
  
  min = min(sampled_data$ArrTime, na.rm = TRUE), 
  
  max = max(sampled_data$ArrTime, na.rm = TRUE) 
  
) 

# Replace missing values in ArrDelayMinutes 
sampled_data$ArrDelayMinutes[is.na(sampled_data$ArrDelayMinutes)] <- runif( 
  
  n = sum(is.na(sampled_data$ArrDelayMinutes)), 
  
  min = min(sampled_data$ArrDelayMinutes, na.rm = TRUE), 
  
  max = max(sampled_data$ArrDelayMinutes, na.rm = TRUE) 
  
) 

# Replace missing values in AirTime 
sampled_data$AirTime[is.na(sampled_data$AirTime)] <- runif( 
  
  n = sum(is.na(sampled_data$AirTime)), 
  
  min = min(sampled_data$AirTime, na.rm = TRUE), 
  
  max = max(sampled_data$AirTime, na.rm = TRUE) 
  
) 

# Replace missing values in CRSElapsedTime 
sampled_data$CRSElapsedTime[is.na(sampled_data$CRSElapsedTime)] <- runif( 
  
  n = sum(is.na(sampled_data$CRSElapsedTime)), 
  
  min = min(sampled_data$CRSElapsedTime, na.rm = TRUE), 
  
  max = max(sampled_data$CRSElapsedTime, na.rm = TRUE) 
  
) 

# Replace missing values in ActualElapsedTime 
sampled_data$ActualElapsedTime[is.na(sampled_data$ActualElapsedTime)] <- runif( 
  
  n = sum(is.na(sampled_data$ActualElapsedTime)), 
  
  min = min(sampled_data$ActualElapsedTime, na.rm = TRUE), 
  
  max = max(sampled_data$ActualElapsedTime, na.rm = TRUE) 
  
) 

# Replace missing values in DepDel15 
sampled_data$DepDel15[is.na(sampled_data$DepDel15)] <- runif( 
  
  n = sum(is.na(sampled_data$DepDel15)), 
  
  min = min(sampled_data$DepDel15, na.rm = TRUE), 
  
  max = max(sampled_data$DepDel15, na.rm = TRUE) 
  
) 

# Replace missing values in DepartureDelayGroups 
sampled_data$DepartureDelayGroups[is.na(sampled_data$DepartureDelayGroups)] <- runif( 
  
  n = sum(is.na(sampled_data$DepartureDelayGroups)), 
  
  min = min(sampled_data$DepartureDelayGroups, na.rm = TRUE), 
  
  max = max(sampled_data$DepartureDelayGroups, na.rm = TRUE) 
  
) 

# Replace missing values in TaxiOut 
sampled_data$TaxiOut[is.na(sampled_data$TaxiOut)] <- runif( 
  
  n = sum(is.na(sampled_data$TaxiOut)), 
  
  min = min(sampled_data$TaxiOut, na.rm = TRUE), 
  
  max = max(sampled_data$TaxiOut, na.rm = TRUE) 
  
) 

# Replace missing values in WheelsOff 
sampled_data$WheelsOff[is.na(sampled_data$WheelsOff)] <- runif( 
  
  n = sum(is.na(sampled_data$WheelsOff)), 
  
  min = min(sampled_data$WheelsOff, na.rm = TRUE), 
  
  max = max(sampled_data$WheelsOff, na.rm = TRUE) 
  
) 

# Replace missing values in WheelsOn 
sampled_data$WheelsOn[is.na(sampled_data$WheelsOn)] <- runif( 
  
  n = sum(is.na(sampled_data$WheelsOn)), 
  
  min = min(sampled_data$WheelsOn, na.rm = TRUE), 
  
  max = max(sampled_data$WheelsOn, na.rm = TRUE) 
  
) 

# Replace missing values in TaxiIn 
sampled_data$TaxiIn[is.na(sampled_data$TaxiIn)] <- runif( 
  
  n = sum(is.na(sampled_data$TaxiIn)), 
  
  min = min(sampled_data$TaxiIn, na.rm = TRUE), 
  
  max = max(sampled_data$TaxiIn, na.rm = TRUE) 
  
) 

# Replace missing values in ArrDelay 
sampled_data$ArrDelay[is.na(sampled_data$ArrDelay)] <- runif( 
  
  n = sum(is.na(sampled_data$ArrDelay)), 
  
  min = min(sampled_data$ArrDelay, na.rm = TRUE), 
  
  max = max(sampled_data$ArrDelay, na.rm = TRUE) 
  
) 

# Replace missing values in ArrDel15 
sampled_data$ArrDel15[is.na(sampled_data$ArrDel15)] <- runif( 
  
  n = sum(is.na(sampled_data$ArrDel15)), 
  
  min = min(sampled_data$ArrDel15, na.rm = TRUE), 
  
  max = max(sampled_data$ArrDel15, na.rm = TRUE) 
  
) 

# Replace missing values in ArrivalDelayGroups 
sampled_data$ArrivalDelayGroups[is.na(sampled_data$ArrivalDelayGroups)] <- runif( 
  
  n = sum(is.na(sampled_data$ArrivalDelayGroups)), 
  
  min = min(sampled_data$ArrivalDelayGroups, na.rm = TRUE), 
  
  max = max(sampled_data$ArrivalDelayGroups, na.rm = TRUE) 
  
) 

# Replace missing values in DivAirportLandings 
sampled_data$DivAirportLandings[is.na(sampled_data$DivAirportLandings)] <- runif( 
  
  n = sum(is.na(sampled_data$DivAirportLandings)), 
  
  min = min(sampled_data$DivAirportLandings, na.rm = TRUE), 
  
  max = max(sampled_data$DivAirportLandings, na.rm = TRUE) 
  
) 

Step 4: To encode Date format

The Output is ‘False’, which indicates that the format for all the dates is the same.

any(!grepl("^\\d{4}-\\d{2}-\\d{2}$", sampled_data$FlightDate)) 
## [1] FALSE
#To convert it to ordered factor with levels and labels
sampled_data$DayOfWeek <- factor(sampled_data$DayOfWeek, levels = 1:7, 
                                 labels = c("Mon", "Tues", "Wed", "Thur", "Fri", "Sat", "Sun"), 
                                 ordered = TRUE)

# Convert Month to factor with custom levels and labels 
sampled_data$Month <- factor(sampled_data$Month, levels = 1:12, labels = c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")) 
# Convert DayofMonth to factor with custom levels and labels 
sampled_data$DayofMonth <- factor(sampled_data$DayofMonth, levels = 1:31, labels = paste0("Day", 1:31)) 

Step 5: Change integer variables (which are descriptive in nature) into character variables

  • DOT_ID_Marketing_Airline
  • Flight_Number_Marketing_Airline
  • DOT_ID_Operating_Airline
  • Flight_Number_Operating_Airline
  • OriginAirportID
  • OriginAirportSeqID
  • OriginCityMarketID
  • OriginStateFips
  • OriginWac
  • DestAirportID
  • DestAirportSeqID
  • DestCityMarketID
  • DestStateFips
  • DestWac
# Convert selected variables to character 
sampled_data$DOT_ID_Marketing_Airline <- as.character(sampled_data$DOT_ID_Marketing_Airline) 
sampled_data$Flight_Number_Marketing_Airline <- as.character(sampled_data$Flight_Number_Marketing_Airline) 
sampled_data$DOT_ID_Operating_Airline <- as.character(sampled_data$DOT_ID_Operating_Airline) 
sampled_data$Flight_Number_Operating_Airline <- as.character(sampled_data$Flight_Number_Operating_Airline) 
sampled_data$OriginAirportID <- as.character(sampled_data$OriginAirportID) 
sampled_data$OriginAirportSeqID <- as.character(sampled_data$OriginAirportSeqID) 
sampled_data$OriginCityMarketID <- as.character(sampled_data$OriginCityMarketID) 
sampled_data$OriginStateFips <- as.character(sampled_data$OriginStateFips) 
sampled_data$OriginWac <- as.character(sampled_data$OriginWac) 
sampled_data$DestAirportID <- as.character(sampled_data$DestAirportID) 
sampled_data$DestAirportSeqID <- as.character(sampled_data$DestAirportSeqID) 
sampled_data$DestCityMarketID <- as.character(sampled_data$DestCityMarketID) 
sampled_data$DestStateFips <- as.character(sampled_data$DestStateFips) 
sampled_data$DestWac <- as.character(sampled_data$DestWac) 

Step 6: Replacing Outliers with Interquartile Range Method

# Define the cap_outliers function
cap_outliers <- function(x) {
  quantiles <- quantile(x, c(0.05, 0.25, 0.75, 0.95), na.rm = TRUE)
  x[x < quantiles[2] - 1.5 * IQR(x, na.rm = TRUE)] <- quantiles[1]
  x[x > quantiles[3] + 1.5 * IQR(x, na.rm = TRUE)] <- quantiles[4]
  return(x)
}

# Apply the function to the desired columns
sampled_data$DepDelayMinutes <- cap_outliers(sampled_data$DepDelayMinutes)
sampled_data$DepDelay <- cap_outliers(sampled_data$DepDelay)
sampled_data$ArrDelayMinutes <- cap_outliers(sampled_data$ArrDelayMinutes)
sampled_data$AirTime <- cap_outliers(sampled_data$AirTime)
sampled_data$CRSElapsedTime <- cap_outliers(sampled_data$CRSElapsedTime)
sampled_data$ActualElapsedTime <- cap_outliers(sampled_data$ActualElapsedTime)
sampled_data$DepDel15 <- cap_outliers(sampled_data$DepDel15)
sampled_data$DepartureDelayGroups <- cap_outliers(sampled_data$DepartureDelayGroups)
sampled_data$TaxiOut <- cap_outliers(sampled_data$TaxiOut)
sampled_data$TaxiIn <- cap_outliers(sampled_data$TaxiIn)
sampled_data$ArrDelay <- cap_outliers(sampled_data$ArrDelay)
sampled_data$ArrDel15 <- cap_outliers(sampled_data$ArrDel15)
sampled_data$ArrivalDelayGroups <- cap_outliers(sampled_data$ArrivalDelayGroups)
sampled_data$Distance <- cap_outliers(sampled_data$Distance)
sampled_data$DistanceGroup <- cap_outliers(sampled_data$DistanceGroup)
sampled_data$DivAirportLandings <- cap_outliers(sampled_data$DivAirportLandings)

Library & Loading Cleaned Data

#library & loading cleaned data

file_path <- "C:/Users/Tsu/Desktop/WQD 7004/7004 - Flight dataset/only_csv/file/cleaned_flight_data.csv"
data3 <- read.csv(file_path)
head(data3)
##   FlightDate                     Airline Origin Dest Cancelled Diverted
## 1 2022-05-07        Delta Air Lines Inc.    AUS  ATL     FALSE    FALSE
## 2 2019-05-31 Air Wisconsin Airlines Corp    DAY  ORD     FALSE    FALSE
## 3 2019-11-23       SkyWest Airlines Inc.    CHS  DTW     FALSE    FALSE
## 4 2021-04-19      Southwest Airlines Co.    ELP  HOU     FALSE    FALSE
## 5 2021-12-02        Delta Air Lines Inc.    TPA  RDU     FALSE    FALSE
## 6 2020-05-02      Southwest Airlines Co.    DCA  TPA      TRUE    FALSE
##   CRSDepTime  DepTime DepDelayMinutes DepDelay   ArrTime ArrDelayMinutes
## 1        805  805.000               0        0 1104.0000               0
## 2       1733 1742.000               9        9 1755.0000               0
## 3        900  857.000               0       -3 1051.0000               0
## 4        705  703.000               0       -2  948.0000               0
## 5       1959 1952.000               0       -7 2140.0000               0
## 6       1230 1486.824             114      103  104.3003             121
##   AirTime CRSElapsedTime ActualElapsedTime Distance Year Quarter Month
## 1     106            132               119      813 2022       2   May
## 2      42             92                73      240 2019       2   May
## 3      96            120               114      667 2019       4   Nov
## 4      91            110               105      677 2021       2   Apr
## 5      88            104               108      587 2021       4   Dec
## 6     286            145               313      814 2020       2   May
##   DayofMonth DayOfWeek Marketing_Airline_Network
## 1       Day7       Sat                        DL
## 2      Day31       Fri                        UA
## 3      Day23       Sat                        DL
## 4      Day19       Mon                        WN
## 5       Day2      Thur                        DL
## 6       Day2       Sat                        WN
##   Operated_or_Branded_Code_Share_Partners DOT_ID_Marketing_Airline
## 1                                      DL                    19790
## 2                            UA_CODESHARE                    19977
## 3                            DL_CODESHARE                    19790
## 4                                      WN                    19393
## 5                                      DL                    19790
## 6                                      WN                    19393
##   IATA_Code_Marketing_Airline Flight_Number_Marketing_Airline Operating_Airline
## 1                          DL                            2234                DL
## 2                          UA                            3937                ZW
## 3                          DL                            4010                OO
## 4                          WN                             729                WN
## 5                          DL                            1412                DL
## 6                          WN                            3278                WN
##   DOT_ID_Operating_Airline IATA_Code_Operating_Airline Tail_Number
## 1                    19790                          DL      N127DN
## 2                    20046                          ZW      N411ZW
## 3                    20304                          OO      N548CA
## 4                    19393                          WN      N7729A
## 5                    19790                          DL      N344NB
## 6                    19393                          WN            
##   Flight_Number_Operating_Airline OriginAirportID OriginAirportSeqID
## 1                            2234           10423            1042302
## 2                            3937           11267            1126702
## 3                            4010           10994            1099402
## 4                             729           11540            1154005
## 5                            1412           15304            1530402
## 6                            3278           11278            1127805
##   OriginCityMarketID OriginCityName OriginState OriginStateFips OriginStateName
## 1              30423     Austin, TX          TX              48           Texas
## 2              31267     Dayton, OH          OH              39            Ohio
## 3              30994 Charleston, SC          SC              45  South Carolina
## 4              30615    El Paso, TX          TX              48           Texas
## 5              33195      Tampa, FL          FL              12         Florida
## 6              30852 Washington, DC          VA              51        Virginia
##   OriginWac DestAirportID DestAirportSeqID DestCityMarketID       DestCityName
## 1        74         10397          1039707            30397        Atlanta, GA
## 2        44         13930          1393007            30977        Chicago, IL
## 3        37         11433          1143302            31295        Detroit, MI
## 4        74         12191          1219102            31453        Houston, TX
## 5        33         14492          1449202            34492 Raleigh/Durham, NC
## 6        38         15304          1530402            33195          Tampa, FL
##   DestState DestStateFips  DestStateName DestWac DepDel15 DepartureDelayGroups
## 1        GA            13        Georgia      34        0                    0
## 2        IL            17       Illinois      41        0                    0
## 3        MI            26       Michigan      43        0                   -1
## 4        TX            48          Texas      74        0                   -1
## 5        NC            37 North Carolina      36        0                   -1
## 6        FL            12        Florida      33        1                    5
##   DepTimeBlk TaxiOut WheelsOff WheelsOn TaxiIn CRSArrTime ArrDelay ArrDel15
## 1  0800-0859       9  814.0000 1100.000      4       1117      -13        0
## 2  1700-1759      18 1800.0000 1742.000     13       1805      -10        0
## 3  0900-0959      12  909.0000 1045.000      6       1100       -9        0
## 4  0700-0759       9  712.0000  943.000      5        955       -7        0
## 5  1900-1959      13 2005.0000 2133.000      7       2143       -3        0
## 6  1200-1259      39  101.1498 1385.682     23       1455      110        1
##   ArrivalDelayGroups ArrTimeBlk DistanceGroup DivAirportLandings
## 1         -1.0000000  1100-1159             4                  0
## 2         -1.0000000  1800-1859             1                  0
## 3         -1.0000000  1100-1159             3                  0
## 4         -1.0000000  0900-0959             3                  0
## 5         -1.0000000  2100-2159             3                  0
## 6          0.1885885  1400-1459             4                  0
##    ArrDelayInterval
## 1           [0,100]
## 2           [0,100]
## 3           [0,100]
## 4           [0,100]
## 5           [0,100]
## 6 (1.1e+03,1.2e+03]
options(repos = "https://cloud.r-project.org")

install.packages("glmnet")
## Installing package into 'C:/Users/Tsu/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'glmnet' successfully unpacked and MD5 sums checked
## 
## The downloaded binary packages are in
##  C:\Users\Tsu\AppData\Local\Temp\RtmpEnZaXb\downloaded_packages
install.packages("pacman")
## Installing package into 'C:/Users/Tsu/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'pacman' successfully unpacked and MD5 sums checked
## 
## The downloaded binary packages are in
##  C:\Users\Tsu\AppData\Local\Temp\RtmpEnZaXb\downloaded_packages
install.packages("rpart")
## Installing package into 'C:/Users/Tsu/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'rpart' successfully unpacked and MD5 sums checked
## 
## The downloaded binary packages are in
##  C:\Users\Tsu\AppData\Local\Temp\RtmpEnZaXb\downloaded_packages
install.packages("rpart.plot")
## Installing package into 'C:/Users/Tsu/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'rpart.plot' successfully unpacked and MD5 sums checked
## 
## The downloaded binary packages are in
##  C:\Users\Tsu\AppData\Local\Temp\RtmpEnZaXb\downloaded_packages
install.packages("Metrics")
## Installing package into 'C:/Users/Tsu/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'Metrics' successfully unpacked and MD5 sums checked
## 
## The downloaded binary packages are in
##  C:\Users\Tsu\AppData\Local\Temp\RtmpEnZaXb\downloaded_packages
install.packages("lightgbm")
## Installing package into 'C:/Users/Tsu/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'lightgbm' successfully unpacked and MD5 sums checked
## 
## The downloaded binary packages are in
##  C:\Users\Tsu\AppData\Local\Temp\RtmpEnZaXb\downloaded_packages
install.packages("caret")
## Installing package into 'C:/Users/Tsu/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'caret' successfully unpacked and MD5 sums checked
## 
## The downloaded binary packages are in
##  C:\Users\Tsu\AppData\Local\Temp\RtmpEnZaXb\downloaded_packages
install.packages("dplyr")
## Installing package into 'C:/Users/Tsu/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'dplyr' successfully unpacked and MD5 sums checked
## Warning: cannot remove prior installation of package 'dplyr'
## Warning in file.copy(savedcopy, lib, recursive = TRUE): problem copying
## C:\Users\Tsu\AppData\Local\R\win-library\4.3\00LOCK\dplyr\libs\x64\dplyr.dll to
## C:\Users\Tsu\AppData\Local\R\win-library\4.3\dplyr\libs\x64\dplyr.dll:
## Permission denied
## Warning: restored 'dplyr'
## 
## The downloaded binary packages are in
##  C:\Users\Tsu\AppData\Local\Temp\RtmpEnZaXb\downloaded_packages
install.packages("pROC")
## Installing package into 'C:/Users/Tsu/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'pROC' successfully unpacked and MD5 sums checked
## 
## The downloaded binary packages are in
##  C:\Users\Tsu\AppData\Local\Temp\RtmpEnZaXb\downloaded_packages
install.packages("e1071")
## Installing package into 'C:/Users/Tsu/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'e1071' successfully unpacked and MD5 sums checked
## 
## The downloaded binary packages are in
##  C:\Users\Tsu\AppData\Local\Temp\RtmpEnZaXb\downloaded_packages
install.packages("caret")
## Installing package into 'C:/Users/Tsu/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'caret' successfully unpacked and MD5 sums checked
## 
## The downloaded binary packages are in
##  C:\Users\Tsu\AppData\Local\Temp\RtmpEnZaXb\downloaded_packages
install.packages("dplyr")
## Installing package into 'C:/Users/Tsu/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'dplyr' successfully unpacked and MD5 sums checked
## Warning: cannot remove prior installation of package 'dplyr'
## Warning in file.copy(savedcopy, lib, recursive = TRUE): problem copying
## C:\Users\Tsu\AppData\Local\R\win-library\4.3\00LOCK\dplyr\libs\x64\dplyr.dll to
## C:\Users\Tsu\AppData\Local\R\win-library\4.3\dplyr\libs\x64\dplyr.dll:
## Permission denied
## Warning: restored 'dplyr'
## 
## The downloaded binary packages are in
##  C:\Users\Tsu\AppData\Local\Temp\RtmpEnZaXb\downloaded_packages
install.packages("data.table")
## Warning: package 'data.table' is in use and will not be installed
install.packages("LiblineaR")
## Installing package into 'C:/Users/Tsu/AppData/Local/R/win-library/4.3'
## (as 'lib' is unspecified)
## package 'LiblineaR' successfully unpacked and MD5 sums checked
## 
## The downloaded binary packages are in
##  C:\Users\Tsu\AppData\Local\Temp\RtmpEnZaXb\downloaded_packages
library(pacman)
library(caret)
## Loading required package: ggplot2
## Loading required package: lattice
library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:data.table':
## 
##     between, first, last
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(stringr)
library(fastDummies)
## Thank you for using fastDummies!
## To acknowledge our work, please cite the package:
## Kaplan, J. & Schlegel, B. (2023). fastDummies: Fast Creation of Dummy (Binary) Columns and Rows from Categorical Variables. Version 1.7.1. URL: https://github.com/jacobkap/fastDummies, https://jacobkap.github.io/fastDummies/.
library(ggplot2)
library(corrplot)
## corrplot 0.92 loaded
library(forecast) #For ARIMA
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
library(xgboost) #For XGBoost
## 
## Attaching package: 'xgboost'
## The following object is masked from 'package:dplyr':
## 
##     slice
library(glmnet)#For log regression
## Loading required package: Matrix
## Loaded glmnet 4.1-8
library(Matrix)
library(Metrics) #For Evaluation Metrics
## 
## Attaching package: 'Metrics'
## The following object is masked from 'package:forecast':
## 
##     accuracy
## The following objects are masked from 'package:caret':
## 
##     precision, recall
library(rpart)
library(rpart.plot)
library(lightgbm)
## 
## Attaching package: 'lightgbm'
## The following object is masked from 'package:xgboost':
## 
##     slice
## The following object is masked from 'package:dplyr':
## 
##     slice
library(e1071)
library(pROC)  # For ROC curve
## Type 'citation("pROC")' for a citation.
## 
## Attaching package: 'pROC'
## The following object is masked from 'package:Metrics':
## 
##     auc
## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var
library(data.table)
library(reshape2)
## 
## Attaching package: 'reshape2'
## The following objects are masked from 'package:data.table':
## 
##     dcast, melt
library(LiblineaR)
library(GGally)
## Registered S3 method overwritten by 'GGally':
##   method from   
##   +.gg   ggplot2
library(ggcorrplot)
library(gridExtra)
## 
## Attaching package: 'gridExtra'
## The following object is masked from 'package:dplyr':
## 
##     combine

Exploratory Data Analysis

# Take a sample of 12.5%
data33 <- data3 %>% sample_frac(0.125)

data4 <- data33 %>%
  select(-FlightDate, -Origin, -Dest, -Cancelled, -CRSDepTime, -CRSElapsedTime, -ActualElapsedTime, -DayofMonth, -DayOfWeek, -Marketing_Airline_Network, -Operated_or_Branded_Code_Share_Partners, -DOT_ID_Marketing_Airline, -IATA_Code_Marketing_Airline, -Flight_Number_Marketing_Airline, -Operating_Airline, -DOT_ID_Operating_Airline, -IATA_Code_Operating_Airline, -Tail_Number, -Flight_Number_Operating_Airline, -OriginAirportID, -OriginAirportSeqID, -OriginCityMarketID, -OriginCityName, -OriginState, -OriginStateFips, -OriginWac, -DestAirportID, -DestAirportSeqID, -DestCityMarketID, -DestCityName, -DestState, -DestStateFips, -DestWac, -DepartureDelayGroups, -DepTimeBlk, -WheelsOff, -WheelsOn, -ArrivalDelayGroups, -ArrTimeBlk, -DistanceGroup, -ArrDelayInterval, -DepDelayMinutes, -ArrDelayMinutes, -CRSArrTime)

head(data4)
##                  Airline Diverted DepTime DepDelay ArrTime AirTime Distance
## 1  United Air Lines Inc.    FALSE    2312      103     847     286     2086
## 2  United Air Lines Inc.    FALSE     951       -4    1251      91      689
## 3            Comair Inc.    FALSE     712       -6    1021      78      577
## 4          Allegiant Air    FALSE    2035      -10    2159      65      477
## 5            Horizon Air    FALSE    1025        0    1136      53      224
## 6 American Airlines Inc.    FALSE    1521        6    1922     286     2086
##   Year Quarter Month OriginStateName  DestStateName DepDel15 TaxiOut TaxiIn
## 1 2019       1   Jan          Hawaii       Colorado        1      25      7
## 2 2021       4   Oct           Texas        Georgia        0      18     11
## 3 2018       4   Dec     Mississippi North Carolina        0      26     23
## 4 2018       1   Jan            Utah        Arizona        0      12      7
## 5 2021       4   Oct      Washington     Washington        0      10      8
## 6 2019       3   Aug     Puerto Rico       Illinois        0      14     14
##   ArrDelay ArrDel15 DivAirportLandings
## 1      110        1                  0
## 2       -8        0                  0
## 3        7        0                  0
## 4      -19        0                  0
## 5       -5        0                  0
## 6      -12        0                  0
# Create dummy variables for "Month"
month_dummies <- dummy_cols(data4$Month, remove_first_dummy = TRUE)

# Define a function to encode regions
encode_region <- function(city) {
  ifelse(city %in% c("Colorado", "California", "Washington", "Oregon", "Montana", "Idaho", "Wyoming", "Utah", "Nevada", "Alaska", "Hawaii"), "Region_west",
         ifelse(city %in% c("Texas", "Tennessee", "Alabama", "Nebraska", "Virginia", "Florida", "Louisiana", "New Mexico", "New York", "Oklahoma", "New Jersey", "Missouri", "Kentucky", "Rhode Island", "North Carolina", "Pennsylvania", "Illinois", "Ohio", "Maine", "Arkansas", "Wisconsin", "Vermont", "Michigan", "South Carolina", "Minnesota", "Iowa", "Indiana", "Kansas", "North Dakota", "Mississippi", "Georgia", "Connecticut", "Massachusetts", "Maryland", "New Hampshire", "West Virginia", "Delaware"), "Region_east",
                "Territories_and_Possessions"))
}

# Apply the encode_region function to create the 'Region' column
data4$Region_ori <- sapply(data4$OriginStateName, encode_region)

# Remove the original 'OriginStateName' column
data4 <- subset(data4, select = -OriginStateName)

# Apply the encode_region function to create the 'Region' column
data4$Region_dest <- sapply(data4$DestStateName, encode_region)

# Remove the original 'DestStateName' column
data4 <- subset(data4, select = -DestStateName)

# Check if Region_ori is equal to Region_dest and label accordingly
data4$Region_comparison <- ifelse(data4$Region_ori == data4$Region_dest, "within same region", "across region")

# Pad DepTime and ArrTime columns with leading zeros to ensure a consistent format
data4$DepTime <- str_pad(data4$DepTime, width = 4, pad = "0")
data4$ArrTime <- str_pad(data4$ArrTime, width = 4, pad = "0")

# Filter out rows with invalid time formats in DepTime
invalid_timesdep_format <- grep("[^0-9]", data4$DepTime, value = TRUE)
data4 <- data4[!data4$DepTime %in% invalid_timesdep_format, ]

# Filter out rows with invalid time formats in ArrTime
invalid_timesarr_format <- grep("[^0-9]", data4$ArrTime, value = TRUE)
data4 <- data4[!data4$ArrTime %in% invalid_timesarr_format, ]

head(data4)
##                  Airline Diverted DepTime DepDelay ArrTime AirTime Distance
## 1  United Air Lines Inc.    FALSE    2312      103    0847     286     2086
## 2  United Air Lines Inc.    FALSE    0951       -4    1251      91      689
## 3            Comair Inc.    FALSE    0712       -6    1021      78      577
## 4          Allegiant Air    FALSE    2035      -10    2159      65      477
## 5            Horizon Air    FALSE    1025        0    1136      53      224
## 6 American Airlines Inc.    FALSE    1521        6    1922     286     2086
##   Year Quarter Month DepDel15 TaxiOut TaxiIn ArrDelay ArrDel15
## 1 2019       1   Jan        1      25      7      110        1
## 2 2021       4   Oct        0      18     11       -8        0
## 3 2018       4   Dec        0      26     23        7        0
## 4 2018       1   Jan        0      12      7      -19        0
## 5 2021       4   Oct        0      10      8       -5        0
## 6 2019       3   Aug        0      14     14      -12        0
##   DivAirportLandings                  Region_ori                 Region_dest
## 1                  0                 Region_west                 Region_west
## 2                  0                 Region_east                 Region_east
## 3                  0                 Region_east                 Region_east
## 4                  0                 Region_west Territories_and_Possessions
## 5                  0                 Region_west                 Region_west
## 6                  0 Territories_and_Possessions                 Region_east
##    Region_comparison
## 1 within same region
## 2 within same region
## 3 within same region
## 4      across region
## 5 within same region
## 6      across region
# Check summary statistics
summary(data4)
##    Airline           Diverted         DepTime             DepDelay     
##  Length:887807      Mode :logical   Length:887807      Min.   :-25.00  
##  Class :character   FALSE:885957    Class :character   1st Qu.: -6.00  
##  Mode  :character   TRUE :1850      Mode  :character   Median : -3.00  
##                                                        Mean   : 10.93  
##                                                        3rd Qu.:  5.00  
##                                                        Max.   :103.00  
##    ArrTime             AirTime           Distance           Year     
##  Length:887807      Min.   :  7.224   Min.   :  16.0   Min.   :2018  
##  Class :character   1st Qu.: 59.000   1st Qu.: 356.0   1st Qu.:2019  
##  Mode  :character   Median : 92.000   Median : 628.0   Median :2020  
##                     Mean   :108.347   Mean   : 763.7   Mean   :2020  
##                     3rd Qu.:139.000   3rd Qu.:1020.0   3rd Qu.:2021  
##                     Max.   :286.000   Max.   :2086.0   Max.   :2022  
##     Quarter         Month              DepDel15         TaxiOut     
##  Min.   :1.000   Length:887807      Min.   :0.0000   Min.   : 0.00  
##  1st Qu.:1.000   Class :character   1st Qu.:0.0000   1st Qu.:11.00  
##  Median :2.000   Mode  :character   Median :0.0000   Median :14.00  
##  Mean   :2.459                      Mean   :0.1727   Mean   :16.37  
##  3rd Qu.:3.000                      3rd Qu.:0.0000   3rd Qu.:19.00  
##  Max.   :4.000                      Max.   :1.0000   Max.   :39.00  
##      TaxiIn          ArrDelay          ArrDel15      DivAirportLandings
##  Min.   : 0.000   Min.   :-52.000   Min.   :0.0000   Min.   :0         
##  1st Qu.: 4.000   1st Qu.:-16.000   1st Qu.:0.0000   1st Qu.:0         
##  Median : 6.000   Median : -7.000   Median :0.0000   Median :0         
##  Mean   : 7.396   Mean   :  3.231   Mean   :0.1784   Mean   :0         
##  3rd Qu.: 9.000   3rd Qu.:  6.000   3rd Qu.:0.0000   3rd Qu.:0         
##  Max.   :23.000   Max.   :110.000   Max.   :1.0000   Max.   :0         
##   Region_ori        Region_dest        Region_comparison 
##  Length:887807      Length:887807      Length:887807     
##  Class :character   Class :character   Class :character  
##  Mode  :character   Mode  :character   Mode  :character  
##                                                          
##                                                          
## 
# Exclude 'Year', 'Quarter', and 'DivAirportLandings' from the numeric columns
numeric_columns <- sapply(data4, is.numeric)
numeric_data <- data4[, numeric_columns]

# Specify columns to exclude
exclude_columns <- c("Year", "Quarter", "DivAirportLandings", "DepDel15", "ArrDel15")

# Filter out the excluded columns
numeric_data <- numeric_data[, !(colnames(numeric_data) %in% exclude_columns)]

# Function to create histograms
plot_histogram <- function(data, col) {
  ggplot(data, aes_string(x = col)) +
    geom_histogram(binwidth = 30, fill = "blue", color = "black") +
    ggtitle(paste("Histogram of", col)) +
    xlab(col)
}

# Create a list of histogram plots
histogram_list <- lapply(colnames(numeric_data), function(col) {
  plot_histogram(numeric_data, col)
})
## Warning: `aes_string()` was deprecated in ggplot2 3.0.0.
## ℹ Please use tidy evaluation idioms with `aes()`.
## ℹ See also `vignette("ggplot2-in-packages")` for more information.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
# Arrange histograms in a grid
do.call(grid.arrange, c(histogram_list, ncol = 2))

The histogram reveals a significant frequency of flights without departure delays while the arrival pattern suggests that arrivals may likely be punctual or possibly even early. Moreover, the data shows a similar trend between distance and airtime, indicating that a majority of flights cover shorter distances and have shorter airtime durations.

Between the duration of TaxiIn and TaxiOut, we noticed aircraft often take more time taking off.

Encode List of Columns to include in Bar Plots

# Create a list of columns to include in bar plots (numeric treated as categorical)
barplot_columns <- c("Year", "Quarter", "DivAirportLandings", "DepDel15", "ArrDel15")

# Plot bar plots for specified variables
par(mfrow = c(2, 2))
for (col in barplot_columns) {
  if (col %in% names(data4)) {
    bar_plot <- ggplot(data4, aes_string(x = col)) +
      geom_bar(fill = "blue", color = "black") +
      ggtitle(paste("Bar Plot of", col)) +
      xlab(col) +
      theme_minimal()
    
    print(bar_plot)
  } else {
    warning(paste("Column", col, "not found in the dataset. Skipping plot."))
  }
}

The dataset spans from 2018 to 2022, with the highest number of flights recorded in 2019. However, there was a significant decline in 2020, likely attributed to the onset of the Covid pandemic, before a gradual recovery was observed in 2021.

Both the 15-minute delay in departure and arrival exhibit a similar trend, with the majority of flights experiencing no delays. Only a small fraction encountered minimal delays in both departure and arrival times.

Correlation Matrix

# Compute the correlation matrix
cor_matrix <- cor(numeric_data)

# Define a color palette
col_palette <- c("blue", "white", "red")

# Plot the correlation heatmap
ggcorrplot(cor_matrix, method = "square", type = "upper", 
           lab = TRUE, lab_size = 3, colors = col_palette,
           outline.col = "white", ggtheme = ggplot2::theme_minimal())

Many variables exhibited minimal interaction with each other, although, as anticipated, there is a noticeable relationship between arrival delay and departure delay, as well as between airtime and distance.

Since the dataset is quite large, we opt to run barplot instead of scatterplot to ensure faster and efficient runs.

Calculate Mean Arrival Delay

mean_delay <- data4 %>% 
  group_by(Airline) %>% 
  summarise(mean_ArrDelay = mean(ArrDelay, na.rm = TRUE)) %>%
  arrange(desc(mean_ArrDelay)) %>%  # Arrange in descending order of mean arrival delay
  head(10)  # Select the top 10 airlines with the highest mean arrival delays

# Plot bar plot for top 10 airlines with highest mean arrival delays
ggplot(mean_delay, aes(x = reorder(Airline, mean_ArrDelay), y = mean_ArrDelay)) +
  geom_bar(stat = "identity", fill = "blue") +
  labs(title = "Top 10 Airlines with Highest Mean Arrival Delays",
       x = "Airline", y = "Mean Arrival Delay") +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))  # Rotate x-axis labels if needed

Peninsula Airways Inc has the highest average arrival delay among the airlines, surpassing all others.

Plot box plot for delay by region

# Plot box plot for delay by region
ggplot(data4, aes(x = Region_ori, y = ArrDelay, fill = Region_ori)) +
  geom_boxplot() +
  labs(title = "Delay by Region", x = "Region", y = "Arrival Delay") +
  theme_minimal()

The origin of departure does not seem to have a significant impact on the delay, as there is a roughly similar distribution observed across all regions.

Calculate mean arrival delay for each distance and region comparison

# Calculate mean arrival delay for each distance and region comparison
mean_delay_distance_region <- data4 %>%
  group_by(Distance, Region_comparison) %>%
  summarise(mean_ArrDelay = mean(ArrDelay, na.rm = TRUE))
## `summarise()` has grouped output by 'Distance'. You can override using the
## `.groups` argument.
# Plot aggregated bar plot for delay by distance and region comparison
ggplot(mean_delay_distance_region, aes(x = Distance, y = mean_ArrDelay, fill = Region_comparison)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Mean Arrival Delay by Distance and Region Comparison",
       x = "Distance", y = "Mean Arrival Delay") +
  theme_minimal()

# Plot line plot for delay by year
ggplot(data4, aes(x = Year, y = ArrDelay, group = 1)) +
  geom_line() +
  labs(title = "Delay by Year", x = "Year", y = "Arrival Delay") +
  theme_minimal()

Between 2018 and 2019, there was a significant amount of time attributed to delays. However, from 2019 to 2021, delays decreased to the point of falling below 0, indicating early arrivals. This trend reversed in 2022, with delays rising again, although they remained relatively lower compared to the levels observed in 2018.

Convert Month to a factor with correct order

# Convert Month to a factor with correct order
data4$Month <- factor(data4$Month, levels = c("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"))

# Plot line plot for delay by month with sorted order
ggplot(data4, aes(x = Month, y = ArrDelay, group = 1)) +
  geom_line() +
  labs(title = "Delay by Month", x = "Month", y = "Arrival Delay") +
  theme_minimal()

# Plot line plot for delay by quarter
ggplot(data4, aes(x = Quarter, y = ArrDelay, group = 1)) +
  geom_line() +
  labs(title = "Delay by Quarter", x = "Quarter", y = "Arrival Delay") +
  theme_minimal()

Between 2018 and 2019, there was a significant amount of time attributed to delays. However, from 2019 to 2022, delays decreased to the point of falling below 0, indicating early arrivals.

Closer examination at the monthly level, January show high level of delays but it’s getting lower in February however, we noticed sudden hike in arrival delays, particularly in March to April, August to September and slight increase from November to December. These fluctuations are likely attributed to seasonal trends in air travel, such as increased demand during summer vacation periods and holidays.

Model Training

Step 1: Train-Test Split (Binary)

set.seed(123)  # For reproducibility
train_index <- createDataPartition(data4$ArrDel15, p = 0.6, list = FALSE) 
train_data <- data4[train_index, ]
test_data <- data4[-train_index, ]
gc()
##              used    (Mb) gc trigger    (Mb)   max used    (Mb)
## Ncells    2937606   156.9    5346097   285.6    5346097   285.6
## Vcells 2275452742 17360.4 3658389060 27911.3 3654928841 27884.9
glimpse(data4)
## Rows: 887,807
## Columns: 19
## $ Airline            <chr> "United Air Lines Inc.", "United Air Lines Inc.", "…
## $ Diverted           <lgl> FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FA…
## $ DepTime            <chr> "2312", "0951", "0712", "2035", "1025", "1521", "17…
## $ DepDelay           <dbl> 103, -4, -6, -10, 0, 6, -2, -9, -2, -6, -9, -5, -6,…
## $ ArrTime            <chr> "0847", "1251", "1021", "2159", "1136", "1922", "18…
## $ AirTime            <dbl> 286, 91, 78, 65, 53, 286, 82, 70, 48, 44, 52, 52, 6…
## $ Distance           <int> 2086, 689, 577, 477, 224, 2086, 550, 423, 304, 296,…
## $ Year               <int> 2019, 2021, 2018, 2018, 2021, 2019, 2021, 2018, 202…
## $ Quarter            <int> 1, 4, 4, 1, 4, 3, 3, 4, 2, 1, 2, 4, 1, 4, 4, 2, 3, …
## $ Month              <fct> Jan, Oct, Dec, Jan, Oct, Aug, Aug, Dec, May, Jan, M…
## $ DepDel15           <int> 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ TaxiOut            <dbl> 25, 18, 26, 12, 10, 14, 9, 9, 22, 7, 39, 12, 12, 7,…
## $ TaxiIn             <dbl> 7, 11, 23, 7, 8, 14, 4, 6, 5, 2, 5, 11, 7, 12, 8, 9…
## $ ArrDelay           <dbl> 110, -8, 7, -19, -5, -12, -12, -19, -5, -18, 3, -16…
## $ ArrDel15           <int> 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, …
## $ DivAirportLandings <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ Region_ori         <chr> "Region_west", "Region_east", "Region_east", "Regio…
## $ Region_dest        <chr> "Region_west", "Region_east", "Region_east", "Terri…
## $ Region_comparison  <chr> "within same region", "within same region", "within…

Step 1: Train-Test Split (Continuous)

set.seed(42)  # For reproducibility
train_index2 <- createDataPartition(data4$ArrDelay, p = 0.6, list = FALSE) 
train_data2 <- data4[train_index, ]
test_data2 <- data4[-train_index, ]

Step 2: Feature Selection

selected_features <- c("ArrDel15", "DepTime", "DepDel15", "AirTime", "Distance", "TaxiOut", "TaxiIn")
selected_features2 <- c("ArrDelay", "DepTime", "DepDelay", "AirTime", "Distance", "TaxiOut", "TaxiIn") 
train_data <- train_data %>% select(all_of(selected_features))
test_data <- test_data %>% select(all_of(selected_features))

train_data2 <- train_data2 %>% select(all_of(selected_features2))
test_data2 <- test_data2 %>% select(all_of(selected_features2))

To solve both regression and classication problems, we have selected 3 Regression Models (ARIMA, Decision Tree and SVM) and 3 classification models (XGBoost, Light GBM and Naive Bayes).

The model’s performance is then evaluated using Root Mean Square Error (RMSE), Mean Absolute Error (MAE), and Forecast Accuracy (FA%).

Regression Models

Support Vector Machine (SVM)

The LiblineaR function in the code trains the SVM model with the training data with a linear kernel and a specified cost parameter (cost = 1).

# Convert to data.table
train_data_svm <- as.data.table(train_data2)
test_data_svm <- as.data.table(test_data2)

# Ensure all relevant variables are numeric
train_data_svm[, ArrDelay := as.numeric(ArrDelay)]
test_data_svm[, ArrDelay := as.numeric(ArrDelay)]
test_data_svm[, DepTime := as.numeric(DepTime)]

# Prepare data for LiblineaR
train_matrix <- as.matrix(train_data_svm[, !c("ArrDelay"), with = FALSE])
train_labels <- train_data_svm$ArrDelay
test_matrix <- as.matrix(test_data_svm[, !c("ArrDelay"), with = FALSE])
test_labels <- test_data_svm$ArrDelay

# Train SVM Model for regression using LiblineaR with linear kernel
svm_model <- LiblineaR(data = train_matrix, target = train_labels, type = 11, cost = 1)
## Warning in LiblineaR(data = train_matrix, target = train_labels, type = 11, :
## No value provided for svr_eps. Using default of 0.1
# Make Predictions
predictions_svm <- predict(svm_model, test_matrix)$predictions

Decision Tree

The decision tree model is trained using the training data and is then visualized (Plot Decision Tree).

Predictions are made and Variable importance is calculated understand the influential features (Which is the DepDel15).

# Convert DepTime to factor
train_data2$DepTime <- as.factor(train_data2$DepTime)
test_data2$DepTime <- factor(test_data2$DepTime, levels = levels(train_data2$DepTime))

# Define threshold for binary classification
threshold <- 15  # Example threshold for delay classification

# Model Training with improved parameters
tree_control <- rpart.control(minsplit = 20, minbucket = 7, cp = 0.02)  # Increase cp and set minsplit and minbucket

tree_model <- rpart(ArrDelay ~ ., data = train_data2, method = "anova", control = tree_control)

# Plot the tree
rpart.plot(tree_model, main = "Decision Tree for ArrDelay")

# Make predictions on the test set
predictions_DT <- predict(tree_model, newdata = test_data2)

# Calculate variable importance
importance_DT <- tree_model$variable.importance

# Plot variable importance
barplot(importance_DT, main = "Decision Tree Variable Importance", xlab = "Variable", ylab = "Importance")

# Convert predictions to factors for evaluation
predicted_factor_DT <- as.factor(ifelse(predictions_DT > threshold, 1, 0))  # Delayed if ArrDelay > threshold
actual_factor_DT <- as.factor(ifelse(test_data2$ArrDelay > threshold, 1, 0))  # Delayed if ArrDelay > threshold

The most important variable for this model (according to variable importance) is the DepDel15.

ARIMA

This model forecasts future values for the test dataset and converts these forecasted values into binary classes.

The ARIMA model uses the auto.arima function to predict a binary outcome (ArrDel15).

# Train ARIMA Model
arimax_model <- auto.arima(train_data2$ArrDelay)

#Forecast
forecast_values_ARI <- forecast(arimax_model, h = nrow(test_data2))

Classification Models

XGBoost

The xgb.train function trains the model with 100 rounds. Predictions are then generated.

Variable importance is also calculated for XGBoost. The important variable is DepDel15.

#Convert DepTime to numeric
train_data$DepTime <- as.numeric(train_data$DepTime)
test_data$DepTime <- as.numeric(test_data$DepTime)
#Model Training with Regularization
train_matrix <- xgb.DMatrix(data = as.matrix(train_data[, -1]), label = train_data$ArrDel15)
test_matrix <- xgb.DMatrix(data = as.matrix(test_data[, -1]), label = test_data$ArrDel15)

# Set parameters
params <- list(
  objective = "binary:logistic",
  eval_metric = "error",
  max_depth = 6,
  eta = 0.1,
  nthread = 2
)

# Train the model
xgb_model <- xgb.train(
  params = params,
  data = train_matrix,
  nrounds = 100,
  watchlist = list(train = train_matrix, test = test_matrix),
  early_stopping_rounds = 10,
  verbose = 0
)

# Make predictions
preds <- predict(xgb_model, test_matrix)
predicted_classes_XGB <- ifelse(preds > 0.5, 1, 0)

# Calculate variable importance
importance_XGB <- xgb.importance(model = xgb_model)

# Plot variable importance
xgb.plot.importance(importance_matrix = importance_XGB)

The most important variable for this model (according to variable importance) is the DepDel15.

LightGBM Classification

The model is also trained with 100 rounds. Predictions are then generated.

Variable importance is also calculated for LightGBM. The important variable is DepDel15.

# Prepare Data for LightGBM
train_matrix <- lgb.Dataset(data = as.matrix(train_data %>% select(-ArrDel15)), label = train_data$ArrDel15)
test_matrix <- as.matrix(test_data %>% select(-ArrDel15))

# Set Parameters for LightGBM
params <- list(
  objective = "binary",
  metric = "binary_logloss",
  boosting_type = "gbdt",
  num_leaves = 31,
  learning_rate = 0.05,
  feature_fraction = 0.9
)

# Train LightGBM Model
lgb_model <- lgb.train(params, train_matrix, 100, verbose = 0)

# Make Predictions
predictions_lgb <- predict(lgb_model, test_matrix)

# Convert Predictions to Binary Classes (0 or 1) Based on a Threshold (e.g., 0.5)
predicted_classes_lgb <- ifelse(predictions_lgb > 0.5, 1, 0)
predicted_factor_lgb <- factor(predicted_classes_lgb, levels = 0:1)
actual_factor_lgb <- factor(test_data$ArrDel15, levels = 0:1)

# Calculate variable importance
importance_lgb <- lgb.importance(model = lgb_model)

# Plot variable importance
lgb.plot.importance(importance_lgb)

The most important variable for this model (according to variable importance) is the DepDel15.

Naive Bayes

Naive Bayes is a probabilistic classifier using Bayes’ theorem (independence between features).

Similarly, the model was trained using the train data.

# Train a Naive Bayes model
nb_model <- naiveBayes(ArrDel15 ~ ., data = train_data)

# Make predictions on the test set
predictions_NB <- predict(nb_model, newdata = test_data)

# Convert predictions_NB and test_data$ArrDel15 to factors
predictions_NB_factor <- factor(predictions_NB)
test_data$ArrDel15_factor <- factor(test_data$ArrDel15)

# Compute ROC curve
roc_curve <- roc(test_data$ArrDel15, as.numeric(predictions_NB))
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
# Plot ROC curve
plot(roc_curve, col = "blue", lwd = 2, main = "ROC Curve", cex.main = 1.2)

# Print AUC (Area Under the Curve)
print(auc(roc_curve))
## Area under the curve: 0.8792

Evaluate Models

Regression Model Comparison

#Evaluation Metrics Function for Regression Models
evaluate_regression <- function(true_values, predictions) {
  mae_val <- mean(abs(true_values - predictions))
  mape_val <- mean(abs((true_values - predictions) / true_values)) * 100
  mse_val <- mean((true_values - predictions)^2)
  rmse_val <- sqrt(mse_val)
  c(mae_val, mape_val, mse_val, rmse_val)
}

#Evaluate the Models
ARI_metrics <- evaluate_regression(test_data2$ArrDelay, forecast_values_ARI$mean)
DT_metrics <- evaluate_regression(as.numeric(actual_factor_DT), as.numeric(predicted_factor_DT))
SVM_metrics <- evaluate_regression(test_labels, predictions_svm)

#Compare the Models  
regression_results <- data.frame(
  Model = c("ARIMA", "Decision Tree", "SVM"),
  MAE = c(ARI_metrics[1], DT_metrics[1], SVM_metrics[1]),
  MAPE = c(ARI_metrics[2], DT_metrics[2], SVM_metrics[2]),
  MSE = c(ARI_metrics[3], DT_metrics[3], SVM_metrics[3]),
  RMSE = c(ARI_metrics[4], DT_metrics[4], SVM_metrics[4])
)

print(regression_results)
##           Model         MAE     MAPE          MSE       RMSE
## 1         ARIMA 22.86686811      Inf 1.235071e+03 35.1435808
## 2 Decision Tree  0.06487911 3.589471 6.487911e-02  0.2547138
## 3           SVM 12.87849312      Inf 3.775198e+02 19.4298687

Plot the Results

#Plot the Results
regression_melt <- melt(regression_results, id.vars = "Model")
regression_melt$value[regression_melt$variable == "Accuracy"] <- regression_melt$value[regression_melt$variable == "Accuracy"] / 100

ggplot(regression_melt, aes(x = Model, y = value, fill = variable)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Regression Model Comparison", y = "Metric Value", x = "Model") +
  theme_minimal() +
  scale_fill_brewer(palette = "Set1")

From the regression result, the best performing model predicting the delay in arrival is the Decision Tree as it has the lowest MAE (0.065), MAPE (3.61%), MSE (0.065), and RMSE (0.255).

Classification Models

Evaluation Metrics Function for Classification Models

evaluate_model <- function(true_labels, predictions) {
  confusion <- confusionMatrix(as.factor(predictions), as.factor(true_labels))
  recall <- confusion$byClass["Sensitivity"]
  precision <- confusion$byClass["Pos Pred Value"]
  specificity <- confusion$byClass["Specificity"]
  accuracy <- confusion$overall["Accuracy"]
  c(recall, precision, specificity, accuracy)
}

#Evaluate the Models
xgb_metrics <- evaluate_model(test_data$ArrDel15, predicted_classes_XGB)
lgb_metrics <- evaluate_model(test_data$ArrDel15, predicted_classes_lgb)
nb_metrics <- evaluate_model(test_data$ArrDel15, predictions_NB)

#Compare the Models 
classification_results <- data.frame(
  Model = c("XGBoost", "LightGBM", "Naive Bayes"),
  Recall = c(xgb_metrics[1], lgb_metrics[1], nb_metrics[1]),
  Precision = c(xgb_metrics[2], lgb_metrics[2], nb_metrics[2]),
  Specificity = c(xgb_metrics[3], lgb_metrics[3], nb_metrics[3]),
  Accuracy = c(xgb_metrics[4], lgb_metrics[4], nb_metrics[4])
)

print(classification_results)
##         Model    Recall Precision Specificity  Accuracy
## 1     XGBoost 0.9544724 0.9603335   0.8188578 0.9302324
## 2    LightGBM 0.9554496 0.9575640   0.8054510 0.9286386
## 3 Naive Bayes 0.9491646 0.9580902   0.8092320 0.9241528

Plot the Results

classification_melt <- melt(classification_results, id.vars = "Model")
ggplot(classification_melt, aes(x = Model, y = value, fill = variable)) +
  geom_bar(stat = "identity", position = "dodge") +
  labs(title = "Classification Model Comparison", y = "Metric Value", x = "Model") +
  theme_minimal() +
  scale_fill_brewer(palette = "Set1")

From the classification evaluation result, the best performing model to predict whether or not it will delay is XGBoost, as it has the highest accuracy (93.03%) and the best balance between recall (95.44%) and precision (96.05%).

Conclusion

In this report, we evaluated several models for predicting flight delays using the Air Flight Dataset. We compared regression models (ARIMA, Decision Tree, SVM) for predicting the delay time in arrival and classification models (XGBoost, LightGBM, Naive Bayes) for predicting whether a flight will be delayed or not.

For the regression models, the Decision Tree model performed the best. This indicates that the Decision Tree model is the most accurate in predicting the delay time in arrival compared to ARIMA and SVM.

For the classification models, XGBoost performed the best. This means that XGBoost is the most reliable model for predicting whether a flight will be delayed or not, compared to LightGBM and Naive Bayes.

In conclusion, based on our evaluation, the Decision Tree model is recommended for predicting the delay time in arrival, while XGBoost is recommended for predicting flight delays. These models can provide valuable insights to airlines and airport authorities in managing and mitigating the impact of flight delays.