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.
This research question focuses on developing a regression model with the target variable ArrDelay to estimate the delay time for flights.
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.
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))
# 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 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>
# 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
# We 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)
)
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))
# 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)
# 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
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\RtmpMxcvLC\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\RtmpMxcvLC\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\RtmpMxcvLC\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\RtmpMxcvLC\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\RtmpMxcvLC\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\RtmpMxcvLC\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\RtmpMxcvLC\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\RtmpMxcvLC\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\RtmpMxcvLC\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\RtmpMxcvLC\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\RtmpMxcvLC\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\RtmpMxcvLC\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\RtmpMxcvLC\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
# 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.
# 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.
# 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 for each airline
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
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
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()
# 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 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.
The first quarter exhibits a higher number of delays compared to the later quarters. Upon 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 May to June and July to August. These fluctuations are likely attributed to seasonal trends in air travel, such as increased demand during summer vacation periods and holidays.
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 2937534 156.9 5346762 285.6 5346762 285.6
## Vcells 2275452710 17360.4 3658388420 27911.3 3654928307 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, ]
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%).
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
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")
The most important variable for this model (according to variable importance) is the DepDel15.
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
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))
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.
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 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)
##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
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).
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
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%).
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.