Περιγραφή του Datasheet

Το σύνολο δεδομένων που επιλέξαμε αφορά τον κλάδο του Supply Chain/Logistics και αποτελεί μια προσομοίωση 5.000 διεθνών δρομολογίων, αντικατοπτρίζοντας την έντονη αστάθεια που επηρεάζει τις παγκόσμιες μεταφορές. Περιλαμβάνει δεδομένα που καλύπτουν τρεις βασικούς άξονες:

  • Δεδομένα Logistics: Λεπτομέρειες για τη διαδρομή (Origin/Destination), το μέσο μεταφοράς (Θάλασσα, Αέρας, Σιδηρόδρομος, Οδικό δίκτυο), το βάρος του φορτίου και την απόσταση.
  • Περιβαλλοντικοί & Οικονομικοί Παράγοντες: Καταγραφή καιρικών συνθηκών και ιστορικοί δείκτες τιμών καυσίμων.
  • Μετρικές Ρίσκου: Ένα «σκορ γεωπολιτικού κινδύνου» (0-10) και το ποσοστό αξιοπιστίας του εκάστοτε μεταφορέα (Carrier Reliability).

Το dataset διαθέτει δύο μεταβλητές-στόχους (Target Variables):

  1. Lead_Time_Days: (Για παλινδρόμηση) Οι ημέρες που απαιτούνται από την ημέρα της παραγγελίας έως την παράδοση.
  2. Disruption_Occurred: (Για ταξινόμηση) Μια δυαδική τιμή (0 ή 1) που δείχνει αν η αποστολή διακόπηκε ή απέτυχε.

Γιατί επιλέξαμε αυτό το Dataset;

Η επιλογή έγινε επειδή η περίοδος 2024-2026 χαρακτηρίζεται από έντονες γεωπολιτικές συγκρούσεις, την κλιματική αλλαγή που επηρεάζει άμεσα τις θαλάσσιες οδούς και τη συνεχή οικονομική αβεβαιότητα.

Σκοπός και τι προσπαθούμε να βρούμε

Ο κεντρικός στόχος της ανάλυσης είναι να βελτιώσουμε την εφοδιαστική αλυσίδα καθιστώντας την προληπτική (proactive), ώστε να δρούμε προτού συμβεί η διακοπή του δρομολογίου. Προσπαθούμε να απαντήσουμε στα εξής:

1. Πρόβλεψη Πιθανότητας Διαταραχής (Disruption Risk)

Χρησιμοποιώντας τη Λογιστική Παλινδρόμηση, θέλουμε να υπολογίσουμε την πιθανότητα (0-100%) να αποτύχει μια αποστολή πριν καν ξεκινήσει, βάσει των τρεχόντων γεωπολιτικών ρίσκων και των καιρικών συνθηκών. Αυτό μας επιτρέπει να εξετάσουμε εγκαίρως εναλλακτικούς προμηθευτές και διαδρομές, ώστε να διασφαλίσουμε την αδιάλειπτη ροή της αλυσίδας.

2. Υποστήριξη Αποφάσεων

Στόχος είναι η δημιουργία ενός μοντέλου που θα παρέχει πολύτιμη πληροφορία στον διαχειριστή logistics, όπως: «Αυτή η διαδρομή έχει 80% πιθανότητα διαταραχής. Προτείνεται άμεση αλλαγή μέσου ή δρομολογίου».

Προεπισκόπηση Δεδομένων

Ακολουθούν οι πρώτες γραμμές του dataset για μια αρχική εικόνα των δεδομένων:

kable(head(data, 5), caption = "Πρώτες 5 γραμμές του Dataset")
Πρώτες 5 γραμμές του Dataset
Shipment_ID Date Origin_Port Destination_Port Transport_Mode Product_Category Distance_km Weight_MT Fuel_Price_Index Geopolitical_Risk_Score Weather_Condition Carrier_Reliability_Score Lead_Time_Days Disruption_Occurred
SC-10000 2025-10-16 Singapore Los Angeles Rail Textiles 5930.83 197.42 2.43 5.0 Hurricane 0.865 41.39 1
SC-10001 2024-04-24 Singapore Shanghai Rail Automotive 14285.36 237.24 2.30 7.5 Storm 0.592 40.92 1
SC-10002 2024-01-26 Rotterdam Los Angeles Rail Perishables 11113.91 427.42 1.78 5.6 Rain 0.673 11.54 0
SC-10003 2024-10-08 Busan Hamburg Rail Electronics 9180.55 170.66 3.20 0.8 Hurricane 0.832 53.13 1
SC-10004 2024-09-07 Busan Singapore Air Perishables 2762.27 434.96 2.77 1.9 Fog 0.741 0.50 1




Αρχικά φτιάχνουμε ένα correlation plot για να δούμε ποιές μεταβλητές φαίνεται να έχουν υψηλή συσχέτιση με το “Disruption Risk”

corr_matrix <- cor(numeric_only, use = "complete.obs")
corrplot(corr_matrix, method = "color", addCoef.col = "black", number.cex = 0.7)


3. Data Splitting & Scaling

Σε αυτό το στάδιο χωρίσαμε τα δεδομένα σε δεδομένα εκπαίδευσης και τέστ (αξιολόγησης).Ο λόγος που κάναμε scaling είναι πως κάποιοι αριθμητικοί δείκτες όπως το “Distance_km” έχουν πολύ μεγάλες τιμές (8.000-10.000km) με αποτέλεσμα να μπερδευόταν το μοντέλο για τις μικρές αριθμητικές τιμές όπως Lead_Time_Days και θα έδινε περισσότερη βαρύτητα στις μεγάλες τιμές. Με την συνάρτηση scale τα φέραμε στην ίδια κλίμακα.

set.seed(909) # Seed based on institutional email suffix
split <- sample.split(model_data$Disruption_Occurred, SplitRatio = 0.65)

train_set <- subset(model_data, split == TRUE)
test_set  <- subset(model_data, split == FALSE)

# Scaling numerical predictors
num_cols <- c("Geopolitical_Risk_Score", "Carrier_Reliability_Score", 
              "Lead_Time_Days", "Fuel_Price_Index", "Distance_km", "Weight_MT")

train_set[num_cols] <- scale(train_set[num_cols])
test_set[num_cols]  <- scale(test_set[num_cols])

———————————————-

model_scaled <- glm(Disruption_Occurred ~ Geopolitical_Risk_Score + Weight_MT + Fuel_Price_Index + Carrier_Reliability_Score + Lead_Time_Days + Distance_km, 
                    data = train_set, 
                    family = "binomial")

# 7. Results
summary(model_scaled)
## 
## Call:
## glm(formula = Disruption_Occurred ~ Geopolitical_Risk_Score + 
##     Weight_MT + Fuel_Price_Index + Carrier_Reliability_Score + 
##     Lead_Time_Days + Distance_km, family = "binomial", data = train_set)
## 
## Coefficients:
##                            Estimate Std. Error z value Pr(>|z|)    
## (Intercept)                0.733118   0.048324  15.171  < 2e-16 ***
## Geopolitical_Risk_Score    0.458032   0.040144  11.410  < 2e-16 ***
## Weight_MT                  0.048734   0.039073   1.247    0.212    
## Fuel_Price_Index          -0.002004   0.039088  -0.051    0.959    
## Carrier_Reliability_Score -0.193081   0.039289  -4.914 8.91e-07 ***
## Lead_Time_Days             1.471830   0.104354  14.104  < 2e-16 ***
## Distance_km               -0.291312   0.041802  -6.969 3.20e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 4339.2  on 3249  degrees of freedom
## Residual deviance: 3772.6  on 3243  degrees of freedom
## AIC: 3786.6
## 
## Number of Fisher Scoring iterations: 6

Παρατηρούμε πως κάποιες μεταβλητές είναι στατιστικά ασήμαντες, ενώ οι μεταβλητές με *** έχουν επίδραση στο μοντέλο.

3. Model Evaluation - Threshold 0.50

# Predict probabilities on the test set
predictions <- predict(model_scaled, newdata = test_set, type = "response")
prediction_class <- ifelse(predictions > 0.5, 1, 0)

# Create a Confusion Matrix to see accuracy
confusion_matrix <- table(Predicted = prediction_class, Actual = test_set$Disruption_Occurred)
print(confusion_matrix)
##          Actual
## Predicted   0   1
##         0 329 220
##         1 349 852
# Υπολογισμοί
accuracy <- sum(diag(confusion_matrix)) / sum(confusion_matrix)
sensitivity <- confusion_matrix[2,2] / sum(confusion_matrix[2,]) # True Positive Rate
specificity <- confusion_matrix[1,1] / sum(confusion_matrix[1,]) # True Negative Rate
cat("The Metrics for Threshold 0.50:","\n")
## The Metrics for Threshold 0.50:
cat("Accuracy:", accuracy, "\n")
## Accuracy: 0.6748571
cat("Sensitivity:", sensitivity, "\n")
## Sensitivity: 0.7094088
cat("Specificity:", specificity, "\n")
## Specificity: 0.5992714
## 
##    0    1 
##  678 1072
## Baseline Accuracy: 0.6125714

Στη συνέχεια βρήκαμε πως το Baseline μοντέλο έχει 61% σωστή κατηγοριοποίηση, δηλαδή εάν μαρκάραμε όλα τα δείγματα στην κλάση πλειοψηφίας, το 61% των περιπτώσεων θα το βρίσκαμε σωστά, ενώ με το κατώφλι (threshold) του 0.50 πετυχαίνουμε 67% ακρίβεια οπότε είμαστε σε καλό δρόμο

** Μας ενδιαφέρει να εντοπίζουμε τα φορτία που θα διακοπούν και μας πειράζει λιγότερο εάν ελέγξουμε ένα φορτίο που εν τέλη δεν θα διακοπεί, οπότε θα δώσουμε μεγαλύτερη ακρίβεια στο Sensitivity δηλαδή να εντοπίζουμε σωστά όσο περισσότερο γίνεται να φορτία που θα διακοπούν. **

Ας αλλάξουμε το κατώφλι για να ανεβάσουμε το Sensitivity.

##          Actual
## Predicted   0   1
##         0 472 393
##         1 206 679
## The Metrics for Threshold 0.61:
## Accuracy: 0.6577143
## Sensitivity: 0.7672316
## Specificity: 0.5456647


Παρατηρούμε πως αυξήθηκε το sensitivity αλλά μειώνεται το Specificity, δηλαδή απο όλα τα δρομολόγια που ήταν όντως ασφαλή (No Disruption), πόσα κατάφερε το μοντέλο να προβλέψει σωστά ως ασφαλή;

5. Καμπύλη ROC-AUC

# Δημιουργία των νέων σετ

cat("Γραμμές στο train 2: ", nrow(train2), "Γραμμές στο test 2: ", nrow(test2))
## Γραμμές στο train 2:  3250 Γραμμές στο test 2:  1750
model2 <- glm(Disruption_Occurred ~ ., data = train2, family = "binomial")
predictTest2 <- predict(model2, newdata = test2, type = "response")
# Δημιουργία του αντικειμένου πρόβλεψης για το ROCR
ROCRpred <- prediction(predictTest2, test2$Disruption_Occurred)

# Υπολογισμός απόδοσης (True Positive Rate vs False Positive Rate)
ROCRperf <- performance(ROCRpred, "tpr", "fpr")

# Σχεδίαση καμπύλης ROC με χρώματα
plot(ROCRperf, 
     colorize = TRUE, 
     print.cutoffs.at = seq(0, 1, by = 0.1), 
     text.adj = c(-0.2, 1.7),
     main = "ROC Curve with Color-Coding")

# Υπολογισμός της τιμής AUC
auc_value <- performance(ROCRpred, measure = "auc")
auc_value <- auc_value@y.values[[1]]

cat("Η τιμή AUC είναι:", auc_value)
## Η τιμή AUC είναι: 0.7267355

Συμπεράσματα & Επιχειρηματική Λήψη Αποφάσεων

Το μοντέλο είναι ικανό να διακρίνει τα επικίνδυνα δρομολόγια με μεγαλύτερη ακρίβεια από μια τυχαία πρόβλεψη (Baseline πρόβλεψη).

Προτεραιότητα στο Sensitivity: Στην εφοδιαστική αλυσίδα, το κόστος μιας μη προγνωσμένης διαταραχής (False Negative) είναι συνήθως πολύ μεγαλύτερο από το κόστος ενός επιπλέον ελέγχου (False Positive). Επομένως, προτείνεται η χρήση ενός χαμηλότερου Threshold (π.χ. 0.4 ή 0.3) ώστε να αυξήσουμε το Sensitivity και να “πιάσουμε” όσο το δυνατόν περισσότερες διαταραχές. Οι υπεύθυνοι Logistics πρέπει να δίνουν προσοχή στο Lead Time και στο Geopolitical Score, καθώς αυτά αποτελούν τους ισχυρούς δείκτες μιας επερχόμενης κρίσης.