Το παρόν Case Study εξετάζει την κερδοφορία αεροπορικών δρομολογίων από το Ντουμπάι (DXB). Το σύνολο δεδομένων περιλαμβάνει πάνω από 7.500 πτήσεις.
Για τις ανάγκες της Λογιστικής Παλινδρόμησης, δημιουργούμε μια νέα εξαρτημένη μεταβλητή με όνομα Is_Profitable. Η μεταβλητή αυτή παίρνει την τιμή 1 αν το Profit_Margin είναι θετικό (κερδοφόρα πτήση) και 0 αν είναι αρνητικό (ζημιογόνα πτήση).
# Φόρτωση δεδομένων
data <- read.csv("airline_route_train.csv")
# Δημιουργία εξαρτημένης μεταβλητής (δυαδική)
data$Is_Profitable <- ifelse(data$Profit_Margin > 0, 1, 0)
# Επιλογή των σημαντικότερων μεταβλητών για το μοντέλο
data_subset <- data %>%
select(Is_Profitable, Load_Factor, Flight_Hours, Total_Cost, Total_Revenue, Passengers)
str(data_subset)## 'data.frame': 6379 obs. of 6 variables:
## $ Is_Profitable: num 0 1 1 1 0 1 1 0 1 1 ...
## $ Load_Factor : num 0.779 0.791 0.85 0.775 0.79 ...
## $ Flight_Hours : num 14.5 4.2 7.5 3.5 2.2 2 5 1.5 2 5 ...
## $ Total_Cost : num 506422 123324 282266 113919 46581 ...
## $ Total_Revenue: num 464217 163585 681565 144028 36523 ...
## $ Passengers : int 308 234 251 229 142 171 281 148 171 281 ...
Χρησιμοποιούμε τη βιβλιοθήκη caTools για να χωρίσουμε τα δεδομένα μας.
Training Set: 65% των δεδομένων.
Testing Set: 35% των δεδομένων.
Seed: Ορίζουμε το seed 960.
set.seed(960) # Παράδειγμα seed 900 + 26
split <- sample.split(data_subset$Is_Profitable, SplitRatio = 0.65)
train <- subset(data_subset, split == TRUE)
test <- subset(data_subset, split == FALSE)
# Καταγραφή πλήθους εγγραφών
cat("Εγγραφές στο Training Set (train):", nrow(train), "\n")## Εγγραφές στο Training Set (train): 4146
## Εγγραφές στο Testing Set (test): 2233
Εκπαιδεύουμε το μοντέλο ProfitLog χρησιμοποιώντας όλες τις ανεξάρτητες μεταβλητές.
# Αφαιρούμε τις μεταβλητές που ορίζουν απευθείας το κέρδος
ProfitLog <- glm(Is_Profitable ~ Load_Factor + Flight_Hours + Passengers,
data = train, family = binomial)
summary(ProfitLog)##
## Call:
## glm(formula = Is_Profitable ~ Load_Factor + Flight_Hours + Passengers,
## family = binomial, data = train)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -5.9030483 0.3498570 -16.873 < 2e-16 ***
## Load_Factor 6.3459305 0.4637658 13.683 < 2e-16 ***
## Flight_Hours -0.0413768 0.0096253 -4.299 1.72e-05 ***
## Passengers 0.0074309 0.0006321 11.756 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 5309.3 on 4145 degrees of freedom
## Residual deviance: 4658.7 on 4142 degrees of freedom
## AIC: 4666.7
##
## Number of Fisher Scoring iterations: 4
Αποφασίσαμε να εξαιρέσουμε τις μεταβλητές Total_Revenue και Total_Cost από το τελικό μοντέλο, καθώς η άμεση μαθηματική τους σχέση με το κέρδος προκαλούσε προβλήματα στη στατιστική ανάλυση (Perfect Separation). Έτσι, εστιάζουμε στην επίδραση των λειτουργικών μεταβλητών.
Η εντολή predict με την παράμετρο type=“response” μας επιστρέφει τις πιθανότητες (από 0 έως 1) να ανήκει μια πτήση στην κατηγορία “Κερδοφόρα” (1). Δεν μας δίνει απευθείας 0 ή 1, αλλά την πιθανότητα εμφάνισης του γεγονότος.
## 3 6 9 11 16 21
## 0.7402157 0.7881007 0.7881007 0.6789833 0.6683288 0.8557809
Ορίζουμε ως κατώφλι το 0.5. Αν η πιθανότητα είναι > 0.5, προβλέπουμε κέρδος.
##
## FALSE TRUE
## 0 279 478
## 1 177 1299
# Υπολογισμός Μετρικών
TN <- conf_matrix[1,1]
FP <- conf_matrix[1,2]
FN <- conf_matrix[2,1]
TP <- conf_matrix[2,2]
accuracy <- (TP + TN) / nrow(test)
sensitivity <- TP / (TP + FN)
specificity <- TN / (TN + FP)
# Baseline Model Accuracy
baseline_acc <- max(table(test$Is_Profitable)) / nrow(test)
cat("Accuracy:", accuracy, "\n")## Accuracy: 0.7066726
## Sensitivity: 0.8800813
## Specificity: 0.3685601
## Baseline Accuracy: 0.6609942
Παρατηρούμε ότι το μοντέλο έχει πολύ υψηλή ακρίβεια, ξεπερνώντας σημαντικά το baseline model (το οποίο προβλέπει πάντα το πιο συχνό αποτέλεσμα). Η υψηλή ευαισθησία (Sensitivity) δείχνει ότι το μοντέλο εντοπίζει με επιτυχία τις κερδοφόρες πτήσεις.
Δημιουργούμε νέα σύνολα δεδομένων αφαιρώντας εγγραφές με κενά πεδία για τη δημιουργία της καμπύλης ROC.
## Εγγραφές στο train2: 4146
## Εγγραφές στο test2: 2233
Χρησιμοποιούμε τη βιβλιοθήκη ROCR για την οπτικοποίηση της απόδοσης.
ROCRpred <- prediction(predictTest2, test2$Is_Profitable)
ROCRperf <- performance(ROCRpred, "tpr", "fpr")
# Σχεδίαση καμπύλης με color-coding
plot(ROCRperf, colorize = TRUE, main = "ROC Curve (Profitability Prediction)", print.cutoffs.at=seq(0,1,0.1))# Υπολογισμός AUC
auc_value <- as.numeric(performance(ROCRpred, "auc")@y.values)
cat("Η τιμή του δείκτη AUC είναι:", auc_value, "\n")## Η τιμή του δείκτη AUC είναι: 0.7247573
Η λογιστική παλινδρόμηση έδειξε ότι μπορούμε να προβλέψουμε με μεγάλη ακρίβεια αν μια πτήση θα είναι κερδοφόρα. Η τιμή του AUC (r round(auc_value, 3)) η οποία είναι κοντά στο 1, επιβεβαιώνει ότι το μοντέλο μας έχει εξαιρετική ικανότητα διαχωρισμού μεταξύ κερδοφόρων και ζημιογόνων δρομολογίων. Οι σημαντικότεροι παράγοντες παραμένουν τα έσοδα και η πληρότητα.