uçuş
Rabia
2024-12-08
# Kütüphane kontrolü
if (!require(nycflights13)) {
install.packages("nycflights13")
library(nycflights13)
} else {
library(nycflights13)
}#“BIA 505 Final Ödevi: Uçuş Gecikmelerinin Yapay Zeka ile Tahmin Edilmesi ## BIA 505 R ile Yapay Zeka Final Ödevi
Havacılıkta gecikme konusu çok ciddi bir sorundur. Gecikmelerin çok farklı nedenleri olabilir. Hava koşulları, havayolu firmasının kötü yönetimi, havalimanının yoğunluğu.
Final ödeviniz kalkış esnasında oluşabilecek gecikme durumunun tahmin edilmesidir. Havacılıkta verilen kalkış saatinden 15 dk ve üzerindeki geçikmeler havayolu istatistiklerinde “gecikme” olarak kaydedilmektedir.
nycflights13 kütüphanesinde 2013 yılında newyorktaki havalimanlarından yapılan uçuşlara ilişkin veriler vardır.
Buna göre bir havayolu firmasının uzmanı rolü ile uçuşlardaki gecikmeleri tahminlemeye çalışacağımız bir çalışma yapmanız gerekmektedir.
# Veriyi hazırlayalım.
library(nycflights13) # uçuş verisi için
library(dplyr)
library(lubridate)
library(caret)
library(randomForest)
library(e1071)
library(xgboost)
library(gbm)
library(rpart)
library(nnet)
#nycflights13 verisinde "flights" ve "weather" verilerini birleştirelim
flight_data <-
flights %>%
mutate(
# Convert the dept delay to a factor
dep_delay = ifelse(dep_delay >= 15, "late", "on_time"),
dep_delay = factor(dep_delay),
# You'll use the date (not date-time) for the recipe that you'll create
date = lubridate::as_date(time_hour)
) %>%
# Include weather data
inner_join(weather, by = c("origin", "time_hour"))Veride hangi havayolu şirketleri var? Bunun için aşağıdaki komutu kullanın.
head(flight_data)## # A tibble: 6 × 33
## year.x month.x day.x dep_time sched_dep_time dep_delay arr_time sched_arr_time
## <int> <int> <int> <int> <int> <fct> <int> <int>
## 1 2013 1 1 517 515 on_time 830 819
## 2 2013 1 1 533 529 on_time 850 830
## 3 2013 1 1 542 540 on_time 923 850
## 4 2013 1 1 544 545 on_time 1004 1022
## 5 2013 1 1 554 600 on_time 812 837
## 6 2013 1 1 554 558 on_time 740 728
## # ℹ 25 more variables: arr_delay <dbl>, carrier <chr>, flight <int>,
## # tailnum <chr>, origin <chr>, dest <chr>, air_time <dbl>, distance <dbl>,
## # hour.x <dbl>, minute <dbl>, time_hour <dttm>, date <date>, year.y <int>,
## # month.y <int>, day.y <int>, hour.y <int>, temp <dbl>, dewp <dbl>,
## # humid <dbl>, wind_dir <dbl>, wind_speed <dbl>, wind_gust <dbl>,
## # precip <dbl>, pressure <dbl>, visib <dbl>table(flight_data$carrier)##
## 9E AA AS B6 DL EV F9 FL HA MQ OO UA US
## 18390 32601 709 54299 47916 53925 683 3247 340 26293 32 58361 20470
## VX WN YV
## 5136 12220 598library(lubridate)
#day sütununu ekledik.
flight_data <- flight_data %>% mutate(day = weekdays(as.Date(date)),
month = month(date, label = TRUE, abbr = FALSE))Soru 1
- Verinizi sadece sizin uçuşlarınızı içerecek şekilde filtreleyin.
print(flight_data)## # A tibble: 335,220 × 35
## year.x month.x day.x dep_time sched_dep_time dep_delay arr_time
## <int> <int> <int> <int> <int> <fct> <int>
## 1 2013 1 1 517 515 on_time 830
## 2 2013 1 1 533 529 on_time 850
## 3 2013 1 1 542 540 on_time 923
## 4 2013 1 1 544 545 on_time 1004
## 5 2013 1 1 554 600 on_time 812
## 6 2013 1 1 554 558 on_time 740
## 7 2013 1 1 555 600 on_time 913
## 8 2013 1 1 557 600 on_time 709
## 9 2013 1 1 557 600 on_time 838
## 10 2013 1 1 558 600 on_time 753
## # ℹ 335,210 more rows
## # ℹ 28 more variables: sched_arr_time <int>, arr_delay <dbl>, carrier <chr>,
## # flight <int>, tailnum <chr>, origin <chr>, dest <chr>, air_time <dbl>,
## # distance <dbl>, hour.x <dbl>, minute <dbl>, time_hour <dttm>, date <date>,
## # year.y <int>, month.y <int>, day.y <int>, hour.y <int>, temp <dbl>,
## # dewp <dbl>, humid <dbl>, wind_dir <dbl>, wind_speed <dbl>, wind_gust <dbl>,
## # precip <dbl>, pressure <dbl>, visib <dbl>, day <chr>, month <ord># DL kodlu firmanın uçuşlarını filtrelemek için subset fonksiyonunu kullandık.
filtered_DL <- subset(flight_data, carrier == "DL")
# Filtrelenmiş veriyi görmek için;
print(filtered_DL)## # A tibble: 47,916 × 35
## year.x month.x day.x dep_time sched_dep_time dep_delay arr_time
## <int> <int> <int> <int> <int> <fct> <int>
## 1 2013 1 1 554 600 on_time 812
## 2 2013 1 1 602 610 on_time 812
## 3 2013 1 1 606 610 on_time 837
## 4 2013 1 1 615 615 on_time 833
## 5 2013 1 1 653 700 on_time 936
## 6 2013 1 1 655 655 on_time 1021
## 7 2013 1 1 655 700 on_time 1037
## 8 2013 1 1 655 700 on_time 1002
## 9 2013 1 1 657 700 on_time 959
## 10 2013 1 1 658 700 on_time 944
## # ℹ 47,906 more rows
## # ℹ 28 more variables: sched_arr_time <int>, arr_delay <dbl>, carrier <chr>,
## # flight <int>, tailnum <chr>, origin <chr>, dest <chr>, air_time <dbl>,
## # distance <dbl>, hour.x <dbl>, minute <dbl>, time_hour <dttm>, date <date>,
## # year.y <int>, month.y <int>, day.y <int>, hour.y <int>, temp <dbl>,
## # dewp <dbl>, humid <dbl>, wind_dir <dbl>, wind_speed <dbl>, wind_gust <dbl>,
## # precip <dbl>, pressure <dbl>, visib <dbl>, day <chr>, month <ord>1.a Kaç tane geç kalmış uçuşunuz var?
## Geç kalan uçuşları filtreledik.
late_flights_DL <- filtered_DL %>%
filter(carrier == "DL" & dep_delay == "late")
# Filtrelenmiş verileri görmek için;
print(late_flights_DL)## # A tibble: 8,045 × 35
## year.x month.x day.x dep_time sched_dep_time dep_delay arr_time
## <int> <int> <int> <int> <int> <fct> <int>
## 1 2013 1 1 921 900 late 1237
## 2 2013 1 1 1323 1300 late 1651
## 3 2013 1 1 1610 1555 late 1852
## 4 2013 1 1 1621 1548 late 1904
## 5 2013 1 1 1740 1630 late 2102
## 6 2013 1 1 1925 1900 late 2259
## 7 2013 1 1 1930 1745 late 2233
## 8 2013 1 1 1959 1930 late 2331
## 9 2013 1 2 819 800 late 1127
## 10 2013 1 2 1021 1000 late 1251
## # ℹ 8,035 more rows
## # ℹ 28 more variables: sched_arr_time <int>, arr_delay <dbl>, carrier <chr>,
## # flight <int>, tailnum <chr>, origin <chr>, dest <chr>, air_time <dbl>,
## # distance <dbl>, hour.x <dbl>, minute <dbl>, time_hour <dttm>, date <date>,
## # year.y <int>, month.y <int>, day.y <int>, hour.y <int>, temp <dbl>,
## # dewp <dbl>, humid <dbl>, wind_dir <dbl>, wind_speed <dbl>, wind_gust <dbl>,
## # precip <dbl>, pressure <dbl>, visib <dbl>, day <chr>, month <ord># Geç kalan uçuşların sayısını aldık.
num_late_flights <- nrow(late_flights_DL)
# Geç kalan uçuşların sayısını yazdırdık.
print(num_late_flights)## [1] 80451.b Geç kalma sayılarını haftanın günlerine ve aylara göre ayrı ayrı görselleştirin.
# Haftanın günlerine göre gecikmeleri görselleştirdik.
ggplot(late_flights_DL, aes(x = day, fill = day)) +
geom_bar() +
labs(title = "Haftanın Günlerine Göre DL Firmasının Geç Kalan Uçuşları",
x = "Haftanın Günü", y = "Geç Kalan Uçuş Sayısı") +
theme_minimal() +
scale_fill_brewer(palette = "Set3")
# Haftanın günlerine göre geç kalma sayılarını bulduk.
weekday_delay <- late_flights_DL %>%
filter(dep_delay == "late") %>%
count(day)
print(weekday_delay)## # A tibble: 7 × 2
## day n
## <chr> <int>
## 1 Friday 1269
## 2 Monday 1316
## 3 Saturday 797
## 4 Sunday 1121
## 5 Thursday 1362
## 6 Tuesday 1055
## 7 Wednesday 1125# Aylara göre gecikmeleri görselleştirdik.
ggplot(late_flights_DL, aes(x = month, fill = month)) +
geom_bar() +
labs(title = "Aylara Göre DL Firmasının Geç Kalan Uçuşları",
x = "Ay", y = "Geç Kalan Uçuş Sayısı") +
theme_minimal() +
scale_fill_brewer(palette = "Set3")
1.c Aynı şeyi “origin” yani kalkış yapılan havalimanına göre yapın.
# Kalkış havalimanına göre gecikmeleri görselleştirdik.
ggplot(late_flights_DL, aes(x = origin, fill = origin)) +
geom_bar() +
labs(title = "Kalkış Havalimanına Göre DL Firmasının Geç Kalan Uçuşları",
x = "Kalkış Havalimanı", y = "Geç Kalan Uçuş Sayısı") +
theme_minimal() +
scale_fill_brewer(palette = "Set3") +
theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1))
late_flights_by_origin <- late_flights_DL %>%
group_by(origin) %>%
summarise(delay_count = n()) %>%
arrange(desc(delay_count))
print(late_flights_by_origin)## # A tibble: 3 × 2
## origin delay_count
## <chr> <int>
## 1 LGA 3867
## 2 JFK 3412
## 3 EWR 766Sizce bunlar gecikmede etkili faktörler mi?
Evet, tüm bu faktörler gecikmelerde etkili gibi duruyor. Haftanın günlerine göre uçuş gecikmelerinin analizini yaparken, gecikmelerin en fazla Perşembe günü yaşandığı, bunu takiben Pazartesi ve Cuma günlerinin geldiği görülmektedir. İş seyahati yapanlar, hafta sonu tatili öncesinde işlerini tamamlamak için Perşembe günü seyahat edebilirler. Ayrıca, Perşembe günü haftanın ortasında bir dönemeç noktasıdır ve birikmiş operasyonel sorunlar (örneğin, teknik problemler, hava koşulları) bu günde doruğa ulaşabilir.
Perşembe gününü takiben pazartesi ve cuma günlerinde de gecikmelerin fazla olduğunu görüyoruz. İş seyahatleri genellikle haftanın başında yoğun olur. İş insanları ve çalışanlar, Pazartesi sabahı genellikle hafta içi programlarına başlamak için seyahat ederler. Bu yoğunluk, havaalanlarında ve havayolu operasyonlarında ek baskı oluşturabilir, bu da gecikmelere neden olabilir.
Hafta sonu tatiline çıkmak isteyen kişilerin seyahat planları nedeniyle Cuma günü uçuş trafiği artar. Tatil ve turizm amaçlı seyahatlerin yoğunluğunun, Cuma günü uçuş gecikmelerini artırabileceğini düşünüyoruz.
Aylık takvimde gecikmelerin en fazla Haziran ve Temmuz aylarında yaşandığını görüyoruz. Haziran ve Temmuz ayları, Kuzey Yarımküre’de yaz aylarıdır ve bu dönemde okullar tatil olur. Aileler, çocuklarıyla birlikte tatile çıkmak için bu dönemi tercih ederler. Bu nedenle, bu aylarda genel olarak hava trafiği yoğunlaşır. Özellikle Perşembe günleri, tatil için hafta sonuna hazırlık olarak sıklıkla tercih edilen bir seyahat günü olabilir. İnsanlar hafta sonu tatili için Perşembe günü seyahate başlayabilirler.
Yaz aylarında artan yolcu talebi, havayolu şirketlerinin daha fazla uçuş düzenlemesine neden olur. Bu yoğunluk, operasyonel zorlukları ve dolayısıyla gecikmeleri artırabilir.
Soru 2
Gecikmeler uçuşların gerçekleştiği aylar ve haftanın günleri ile ilgili olabilir.
2.a Buna göre veriye “month.x” sütunundaki aylara göre mevsimleri ifade eden yeni “season” adında yeni bir sütun ekleyin. “month.x” değeri 2’e eşit ve daha küçük ise ya da 10’a eşit veya büyükse “winter” diğer durumda”summer” yazın.
#Aylara göre mevsimleri ifade eden yeni sütun ekledik.
late_flights_DL <- late_flights_DL %>%
mutate(season = ifelse(month(time_hour) <= 2 | month(time_hour) >= 10, "winter", "summer"))
print(late_flights_DL)## # A tibble: 8,045 × 36
## year.x month.x day.x dep_time sched_dep_time dep_delay arr_time
## <int> <int> <int> <int> <int> <fct> <int>
## 1 2013 1 1 921 900 late 1237
## 2 2013 1 1 1323 1300 late 1651
## 3 2013 1 1 1610 1555 late 1852
## 4 2013 1 1 1621 1548 late 1904
## 5 2013 1 1 1740 1630 late 2102
## 6 2013 1 1 1925 1900 late 2259
## 7 2013 1 1 1930 1745 late 2233
## 8 2013 1 1 1959 1930 late 2331
## 9 2013 1 2 819 800 late 1127
## 10 2013 1 2 1021 1000 late 1251
## # ℹ 8,035 more rows
## # ℹ 29 more variables: sched_arr_time <int>, arr_delay <dbl>, carrier <chr>,
## # flight <int>, tailnum <chr>, origin <chr>, dest <chr>, air_time <dbl>,
## # distance <dbl>, hour.x <dbl>, minute <dbl>, time_hour <dttm>, date <date>,
## # year.y <int>, month.y <int>, day.y <int>, hour.y <int>, temp <dbl>,
## # dewp <dbl>, humid <dbl>, wind_dir <dbl>, wind_speed <dbl>, wind_gust <dbl>,
## # precip <dbl>, pressure <dbl>, visib <dbl>, day <chr>, month <ord>, …# Mevsimlere göre geç kalma sayılarını bulduk.
season_delay <- late_flights_DL %>%
filter(dep_delay == "late") %>%
count(season)
print(season_delay)## # A tibble: 2 × 2
## season n
## <chr> <int>
## 1 summer 5578
## 2 winter 2467# Mevsimlere Göre Geç Kalma Sayıları görselleştirdik.
ggplot(season_delay, aes(x = season, y = n, fill = season)) +
geom_bar(stat = "identity") +
labs(title = "Mevsimlere Göre Geç Kalma Sayıları",
x = "Mevsim", y = "Geç Kalma Sayısı") +
theme_minimal() +
scale_fill_brewer(palette = "Dark2")
2.b “date” sütunundaki tarihlerin hangi günlere ait olduğunu aşağıdaki komutla bulun.
“weekdays(as.Date(flight_data$date))”
#çalışmanın en başında bu komutu kullanmıştık. Veri setimize day sütununu eklenmiş ve date sütununundaki tarihin haftanın hangi gününe denk geldiği görülmektedir.
print(late_flights_DL)## # A tibble: 8,045 × 36
## year.x month.x day.x dep_time sched_dep_time dep_delay arr_time
## <int> <int> <int> <int> <int> <fct> <int>
## 1 2013 1 1 921 900 late 1237
## 2 2013 1 1 1323 1300 late 1651
## 3 2013 1 1 1610 1555 late 1852
## 4 2013 1 1 1621 1548 late 1904
## 5 2013 1 1 1740 1630 late 2102
## 6 2013 1 1 1925 1900 late 2259
## 7 2013 1 1 1930 1745 late 2233
## 8 2013 1 1 1959 1930 late 2331
## 9 2013 1 2 819 800 late 1127
## 10 2013 1 2 1021 1000 late 1251
## # ℹ 8,035 more rows
## # ℹ 29 more variables: sched_arr_time <int>, arr_delay <dbl>, carrier <chr>,
## # flight <int>, tailnum <chr>, origin <chr>, dest <chr>, air_time <dbl>,
## # distance <dbl>, hour.x <dbl>, minute <dbl>, time_hour <dttm>, date <date>,
## # year.y <int>, month.y <int>, day.y <int>, hour.y <int>, temp <dbl>,
## # dewp <dbl>, humid <dbl>, wind_dir <dbl>, wind_speed <dbl>, wind_gust <dbl>,
## # precip <dbl>, pressure <dbl>, visib <dbl>, day <chr>, month <ord>, …Bu veriyi “day” adlı yeni bir sütun olarak “flight_data” verisine ekleyin. Yukarıda eklemiştik. Aşağıdaki komutla da “day” sütununu görebiliyoruz.
print(names(flight_data))## [1] "year.x" "month.x" "day.x" "dep_time"
## [5] "sched_dep_time" "dep_delay" "arr_time" "sched_arr_time"
## [9] "arr_delay" "carrier" "flight" "tailnum"
## [13] "origin" "dest" "air_time" "distance"
## [17] "hour.x" "minute" "time_hour" "date"
## [21] "year.y" "month.y" "day.y" "hour.y"
## [25] "temp" "dewp" "humid" "wind_dir"
## [29] "wind_speed" "wind_gust" "precip" "pressure"
## [33] "visib" "day" "month"2.c Veriden aşağıdaki sütunları seçerek yeni bir veri seti oluşturun. ÖNEMLİ: Sadece sizin havayolunuza ait verileri alın.
“sched_dep_time, origin, dest, distance, carrier, hour.y, temp, wind_speed, visib, day, season, dep_delay”
#Aylara göre mevsimleri ifade eden yeni sütunu filtered_DL veri setine de ekliyoruz.
filtered_DL <- filtered_DL %>%
mutate(season = ifelse(month(time_hour) <= 2 | month(time_hour) >= 10, "winter", "summer"))
print(filtered_DL)## # A tibble: 47,916 × 36
## year.x month.x day.x dep_time sched_dep_time dep_delay arr_time
## <int> <int> <int> <int> <int> <fct> <int>
## 1 2013 1 1 554 600 on_time 812
## 2 2013 1 1 602 610 on_time 812
## 3 2013 1 1 606 610 on_time 837
## 4 2013 1 1 615 615 on_time 833
## 5 2013 1 1 653 700 on_time 936
## 6 2013 1 1 655 655 on_time 1021
## 7 2013 1 1 655 700 on_time 1037
## 8 2013 1 1 655 700 on_time 1002
## 9 2013 1 1 657 700 on_time 959
## 10 2013 1 1 658 700 on_time 944
## # ℹ 47,906 more rows
## # ℹ 29 more variables: sched_arr_time <int>, arr_delay <dbl>, carrier <chr>,
## # flight <int>, tailnum <chr>, origin <chr>, dest <chr>, air_time <dbl>,
## # distance <dbl>, hour.x <dbl>, minute <dbl>, time_hour <dttm>, date <date>,
## # year.y <int>, month.y <int>, day.y <int>, hour.y <int>, temp <dbl>,
## # dewp <dbl>, humid <dbl>, wind_dir <dbl>, wind_speed <dbl>, wind_gust <dbl>,
## # precip <dbl>, pressure <dbl>, visib <dbl>, day <chr>, month <ord>, …# Belirtilen sütunları çekerek yeni veri seti oluşturduk.
new_DL <- filtered_DL %>%
select(sched_dep_time, origin, dest, distance, carrier, hour.y, temp, wind_speed, visib, day, season, dep_delay)
# Yeni veri setini kontrol ettik.
print(new_DL)## # A tibble: 47,916 × 12
## sched_dep_time origin dest distance carrier hour.y temp wind_speed visib
## <int> <chr> <chr> <dbl> <chr> <int> <dbl> <dbl> <dbl>
## 1 600 LGA ATL 762 DL 6 39.9 16.1 10
## 2 610 LGA MSP 1020 DL 6 39.9 16.1 10
## 3 610 JFK ATL 760 DL 6 37.9 13.8 10
## 4 615 EWR ATL 746 DL 6 37.9 11.5 10
## 5 700 LGA PBI 1035 DL 7 39.9 15.0 10
## 6 655 JFK SLC 1990 DL 6 37.9 13.8 10
## 7 700 JFK SFO 2586 DL 7 39.0 13.8 10
## 8 700 LGA MIA 1096 DL 7 39.9 15.0 10
## 9 700 LGA FLL 1076 DL 7 39.9 15.0 10
## 10 700 LGA ATL 762 DL 7 39.9 15.0 10
## # ℹ 47,906 more rows
## # ℹ 3 more variables: day <chr>, season <chr>, dep_delay <fct># Belirtilen sütunları çekerek yeni veri seti oluşturduk.
new_DL <- filtered_DL %>%
select(sched_dep_time, origin, dest, distance, carrier, hour.y, temp, wind_speed, visib, day, season, dep_delay)
# Yeni veri setini kontrol ettik.
print(new_DL)## # A tibble: 47,916 × 12
## sched_dep_time origin dest distance carrier hour.y temp wind_speed visib
## <int> <chr> <chr> <dbl> <chr> <int> <dbl> <dbl> <dbl>
## 1 600 LGA ATL 762 DL 6 39.9 16.1 10
## 2 610 LGA MSP 1020 DL 6 39.9 16.1 10
## 3 610 JFK ATL 760 DL 6 37.9 13.8 10
## 4 615 EWR ATL 746 DL 6 37.9 11.5 10
## 5 700 LGA PBI 1035 DL 7 39.9 15.0 10
## 6 655 JFK SLC 1990 DL 6 37.9 13.8 10
## 7 700 JFK SFO 2586 DL 7 39.0 13.8 10
## 8 700 LGA MIA 1096 DL 7 39.9 15.0 10
## 9 700 LGA FLL 1076 DL 7 39.9 15.0 10
## 10 700 LGA ATL 762 DL 7 39.9 15.0 10
## # ℹ 47,906 more rows
## # ℹ 3 more variables: day <chr>, season <chr>, dep_delay <fct>print(names(new_DL))## [1] "sched_dep_time" "origin" "dest" "distance"
## [5] "carrier" "hour.y" "temp" "wind_speed"
## [9] "visib" "day" "season" "dep_delay"Soru 3
Veriyi eğitim ve test verisi olarak iki parçaya ayırın ve aşağıdakileri ayrı ayrı uygulayın. Gecikme durumunu bir sınıflandırma problemi olarak ele alın ve tahmin etmeye çalışın.
#Carrier sütunu makine öğrenmesi sırasında hata vermesin diye veri setinden çıkarıyoruz
new_DL_2 <- new_DL %>%
select(sched_dep_time, origin, dest, distance, hour.y, temp, wind_speed, visib, day, season, dep_delay)print(new_DL_2)## # A tibble: 47,916 × 11
## sched_dep_time origin dest distance hour.y temp wind_speed visib day
## <int> <chr> <chr> <dbl> <int> <dbl> <dbl> <dbl> <chr>
## 1 600 LGA ATL 762 6 39.9 16.1 10 Tuesday
## 2 610 LGA MSP 1020 6 39.9 16.1 10 Tuesday
## 3 610 JFK ATL 760 6 37.9 13.8 10 Tuesday
## 4 615 EWR ATL 746 6 37.9 11.5 10 Tuesday
## 5 700 LGA PBI 1035 7 39.9 15.0 10 Tuesday
## 6 655 JFK SLC 1990 6 37.9 13.8 10 Tuesday
## 7 700 JFK SFO 2586 7 39.0 13.8 10 Tuesday
## 8 700 LGA MIA 1096 7 39.9 15.0 10 Tuesday
## 9 700 LGA FLL 1076 7 39.9 15.0 10 Tuesday
## 10 700 LGA ATL 762 7 39.9 15.0 10 Tuesday
## # ℹ 47,906 more rows
## # ℹ 2 more variables: season <chr>, dep_delay <fct># Eksik değerleri kontrol ediyoruz
colSums(is.na(new_DL_2))## sched_dep_time origin dest distance hour.y
## 0 0 0 0 0
## temp wind_speed visib day season
## 1 9 0 0 0
## dep_delay
## 348# Eksik değerleri barındıran satırları kaldırıyoruz
new_DL_2 <- na.omit(new_DL_2)colSums(is.na(new_DL_2))## sched_dep_time origin dest distance hour.y
## 0 0 0 0 0
## temp wind_speed visib day season
## 0 0 0 0 0
## dep_delay
## 0# Kategorik değişkenleri faktör olarak ayarlıyoruz.
new_DL_2$origin <- factor(new_DL_2$origin)
new_DL_2$dest <- factor(new_DL_2$dest)
new_DL_2$season <- factor(new_DL_2$season)
new_DL_2$day <- factor(new_DL_2$day)new_DL_2$dep_delay <- factor(new_DL_2$dep_delay, levels = c("on_time", "late"))
# Sınıfların dağılımını kontrol et
table(new_DL_2$dep_delay)##
## on_time late
## 39514 80443.a. Eğitim ve Test Verisine Ayırma
Eğitim verisi üzerinde makine öğrenmesi modellerini eğiteceğiz ve test verisi üzerinde tahminleri değerlendireceğiz.
library(caret)
set.seed(123) # Tekrar edilebilirlik için
trainIndex <- createDataPartition(new_DL_2$dep_delay, p = 0.5, list = FALSE)
# Eğitim ve test verilerini ayıralım
trainData <- new_DL_2[trainIndex,]
testData <- new_DL_2[-trainIndex,]
# Eğitim ve test seti büyüklüklerini kontrol et
dim(trainData)## [1] 23779 11dim(testData)## [1] 23779 11Karar Ağacı (Decision Tree) - Basit bir model, ancak genellikle aşırı uyum yapabilir (overfitting). Rastgele Orman (Random Forest) - Ensemble Learning algoritması, çoklu karar ağaçları kullanarak genellikle daha iyi sonuçlar verir. Gradient Boosting - Bir başka Ensemble Learning algoritması, veriyi iyileştirmek için zayıf modelleri aşama aşama optimize eder. Destek Vektör Makinesi (SVM) - Sınıflandırma problemleri için güçlü bir algoritmadır. Lojistik Regresyon (Logistic Regression) - Basit ancak etkili bir sınıflandırma algoritması.
library(caret)
library(randomForest)
library(e1071)
library(gbm)
library(parallel)
# 1. Karar Ağacı (Decision Tree) - Basit ayar
tree_model <- train(dep_delay ~ ., data = trainData, method = "rpart", trControl = trainControl(method = "cv", number = 5, allowParallel = TRUE))
tree_pred <- predict(tree_model, testData)
tree_conf <- confusionMatrix(tree_pred, testData$dep_delay)
cat("Karar Ağacı (Decision Tree) Hata Matrisi:\n")## Karar Ağacı (Decision Tree) Hata Matrisi:print(tree_conf)## Confusion Matrix and Statistics
##
## Reference
## Prediction on_time late
## on_time 19565 3722
## late 192 300
##
## Accuracy : 0.8354
## 95% CI : (0.8306, 0.8401)
## No Information Rate : 0.8309
## P-Value [Acc > NIR] : 0.03113
##
## Kappa : 0.0997
##
## Mcnemar's Test P-Value : < 2e-16
##
## Sensitivity : 0.99028
## Specificity : 0.07459
## Pos Pred Value : 0.84017
## Neg Pred Value : 0.60976
## Prevalence : 0.83086
## Detection Rate : 0.82278
## Detection Prevalence : 0.97931
## Balanced Accuracy : 0.53244
##
## 'Positive' Class : on_time
## # 2. Rastgele Orman (Random Forest) - `ntree` sayısını düşürerek hızlandırma
rf_model <- train(dep_delay ~ ., data = trainData, method = "rf", ntree = 30, trControl = trainControl(method = "cv", number = 5, allowParallel = TRUE))
rf_pred <- predict(rf_model, testData)
rf_conf <- confusionMatrix(rf_pred, testData$dep_delay)
cat("Rastgele Orman (Random Forest) Hata Matrisi:\n")## Rastgele Orman (Random Forest) Hata Matrisi:print(rf_conf)## Confusion Matrix and Statistics
##
## Reference
## Prediction on_time late
## on_time 18907 3114
## late 850 908
##
## Accuracy : 0.8333
## 95% CI : (0.8285, 0.838)
## No Information Rate : 0.8309
## P-Value [Acc > NIR] : 0.1599
##
## Kappa : 0.2355
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.9570
## Specificity : 0.2258
## Pos Pred Value : 0.8586
## Neg Pred Value : 0.5165
## Prevalence : 0.8309
## Detection Rate : 0.7951
## Detection Prevalence : 0.9261
## Balanced Accuracy : 0.5914
##
## 'Positive' Class : on_time
## # 3. Gradient Boosting (GBM) - `verbose = FALSE` ve sınırlı parametre
gbm_model <- train(dep_delay ~ ., data = trainData, method = "gbm", verbose = FALSE, trControl = trainControl(method = "cv", number = 5, allowParallel = TRUE))
gbm_pred <- predict(gbm_model, testData)
gbm_conf <- confusionMatrix(gbm_pred, testData$dep_delay)
cat("Gradient Boosting Hata Matrisi:\n")## Gradient Boosting Hata Matrisi:print(gbm_conf)## Confusion Matrix and Statistics
##
## Reference
## Prediction on_time late
## on_time 19485 3572
## late 272 450
##
## Accuracy : 0.8383
## 95% CI : (0.8336, 0.843)
## No Information Rate : 0.8309
## P-Value [Acc > NIR] : 0.001011
##
## Kappa : 0.1457
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 0.9862
## Specificity : 0.1119
## Pos Pred Value : 0.8451
## Neg Pred Value : 0.6233
## Prevalence : 0.8309
## Detection Rate : 0.8194
## Detection Prevalence : 0.9696
## Balanced Accuracy : 0.5491
##
## 'Positive' Class : on_time
## # 4. Destek Vektör Makinesi (SVM) - Az sayıda parametre ayarı
svm_model <- train(dep_delay ~ ., data = trainData, method = "svmRadial", preProcess = "scale", tuneLength = 3, trControl = trainControl(method = "cv", number = 5, allowParallel = TRUE))
svm_pred <- predict(svm_model, testData)
svm_conf <- confusionMatrix(svm_pred, testData$dep_delay)
cat("Destek Vektör Makinesi (SVM) Hata Matrisi:\n")## Destek Vektör Makinesi (SVM) Hata Matrisi:print(svm_conf)## Confusion Matrix and Statistics
##
## Reference
## Prediction on_time late
## on_time 19723 3944
## late 34 78
##
## Accuracy : 0.8327
## 95% CI : (0.8279, 0.8374)
## No Information Rate : 0.8309
## P-Value [Acc > NIR] : 0.2261
##
## Kappa : 0.0288
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.99828
## Specificity : 0.01939
## Pos Pred Value : 0.83335
## Neg Pred Value : 0.69643
## Prevalence : 0.83086
## Detection Rate : 0.82943
## Detection Prevalence : 0.99529
## Balanced Accuracy : 0.50884
##
## 'Positive' Class : on_time
## # 5. Lojistik Regresyon (Logistic Regression) - Basit ayar
log_model <- train(dep_delay ~ ., data = trainData, method = "glm", family = binomial, trControl = trainControl(method = "cv", number = 5, allowParallel = TRUE))
log_pred <- predict(log_model, testData)
log_conf <- confusionMatrix(log_pred, testData$dep_delay)
cat("Lojistik Regresyon (Logistic Regression) Hata Matrisi:\n")## Lojistik Regresyon (Logistic Regression) Hata Matrisi:print(log_conf)## Confusion Matrix and Statistics
##
## Reference
## Prediction on_time late
## on_time 19651 3837
## late 106 185
##
## Accuracy : 0.8342
## 95% CI : (0.8294, 0.8389)
## No Information Rate : 0.8309
## P-Value [Acc > NIR] : 0.08698
##
## Kappa : 0.0644
##
## Mcnemar's Test P-Value : < 2e-16
##
## Sensitivity : 0.9946
## Specificity : 0.0460
## Pos Pred Value : 0.8366
## Neg Pred Value : 0.6357
## Prevalence : 0.8309
## Detection Rate : 0.8264
## Detection Prevalence : 0.9878
## Balanced Accuracy : 0.5203
##
## 'Positive' Class : on_time
## cat("Logistic Regression Confusion Matrix:\n")## Logistic Regression Confusion Matrix:print(log_conf)## Confusion Matrix and Statistics
##
## Reference
## Prediction on_time late
## on_time 19651 3837
## late 106 185
##
## Accuracy : 0.8342
## 95% CI : (0.8294, 0.8389)
## No Information Rate : 0.8309
## P-Value [Acc > NIR] : 0.08698
##
## Kappa : 0.0644
##
## Mcnemar's Test P-Value : < 2e-16
##
## Sensitivity : 0.9946
## Specificity : 0.0460
## Pos Pred Value : 0.8366
## Neg Pred Value : 0.6357
## Prevalence : 0.8309
## Detection Rate : 0.8264
## Detection Prevalence : 0.9878
## Balanced Accuracy : 0.5203
##
## 'Positive' Class : on_time
## cat("\nDecision Tree Confusion Matrix:\n")##
## Decision Tree Confusion Matrix:print(tree_conf)## Confusion Matrix and Statistics
##
## Reference
## Prediction on_time late
## on_time 19565 3722
## late 192 300
##
## Accuracy : 0.8354
## 95% CI : (0.8306, 0.8401)
## No Information Rate : 0.8309
## P-Value [Acc > NIR] : 0.03113
##
## Kappa : 0.0997
##
## Mcnemar's Test P-Value : < 2e-16
##
## Sensitivity : 0.99028
## Specificity : 0.07459
## Pos Pred Value : 0.84017
## Neg Pred Value : 0.60976
## Prevalence : 0.83086
## Detection Rate : 0.82278
## Detection Prevalence : 0.97931
## Balanced Accuracy : 0.53244
##
## 'Positive' Class : on_time
## cat("\nRandom Forest Confusion Matrix:\n")##
## Random Forest Confusion Matrix:print(rf_conf)## Confusion Matrix and Statistics
##
## Reference
## Prediction on_time late
## on_time 18907 3114
## late 850 908
##
## Accuracy : 0.8333
## 95% CI : (0.8285, 0.838)
## No Information Rate : 0.8309
## P-Value [Acc > NIR] : 0.1599
##
## Kappa : 0.2355
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.9570
## Specificity : 0.2258
## Pos Pred Value : 0.8586
## Neg Pred Value : 0.5165
## Prevalence : 0.8309
## Detection Rate : 0.7951
## Detection Prevalence : 0.9261
## Balanced Accuracy : 0.5914
##
## 'Positive' Class : on_time
## cat("\nGradient Boosting Confusion Matrix:\n")##
## Gradient Boosting Confusion Matrix:print(gbm_conf)## Confusion Matrix and Statistics
##
## Reference
## Prediction on_time late
## on_time 19485 3572
## late 272 450
##
## Accuracy : 0.8383
## 95% CI : (0.8336, 0.843)
## No Information Rate : 0.8309
## P-Value [Acc > NIR] : 0.001011
##
## Kappa : 0.1457
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 0.9862
## Specificity : 0.1119
## Pos Pred Value : 0.8451
## Neg Pred Value : 0.6233
## Prevalence : 0.8309
## Detection Rate : 0.8194
## Detection Prevalence : 0.9696
## Balanced Accuracy : 0.5491
##
## 'Positive' Class : on_time
## cat("\nSupport Vector Machine (SVM) Confusion Matrix:\n")##
## Support Vector Machine (SVM) Confusion Matrix:print(svm_conf)## Confusion Matrix and Statistics
##
## Reference
## Prediction on_time late
## on_time 19723 3944
## late 34 78
##
## Accuracy : 0.8327
## 95% CI : (0.8279, 0.8374)
## No Information Rate : 0.8309
## P-Value [Acc > NIR] : 0.2261
##
## Kappa : 0.0288
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.99828
## Specificity : 0.01939
## Pos Pred Value : 0.83335
## Neg Pred Value : 0.69643
## Prevalence : 0.83086
## Detection Rate : 0.82943
## Detection Prevalence : 0.99529
## Balanced Accuracy : 0.50884
##
## 'Positive' Class : on_time
##