Εργ6 - Λογιστική Παλινδρόμηση
Panagiotis Malousoudis (iis22056)
2025-05-07
1. Διερεύνηση του συνόλου δεδομένων (dataset)
Το σύνολο δεδομένων προέρχεται από μία διεθνής εταιρεία ηλεκτρονικού εμπορίου που επιδιώκει να ανακαλύψει βασικές πληροφορίες από τη βάση δεδομένων των πελατών της.
Σκοπεύει να χρησιμοποιήσει προηγμένες τεχνικές μηχανικής μάθησης για την ανάλυση των πελατών της. Συγκεκριμένα, η εταιρεία ειδικεύεται στην πώληση ηλεκτρονικών προϊόντων. Το dataset περιέχει 10.999 εγγραφές και 12 στήλες, οι οποίες σχετίζονται με την αποστολή προϊόντων, την ικανοποίηση των πελατών και επιχειρηματικές μετρήσεις.
Τίτλοι στηλών
ID: Αριθμός αναγνώρισης πελατών.
Warehouse block: Η εταιρεία διαθέτει μια μεγάλη αποθήκη που είναι χωρισμένη σε τμήματα, όπως A, B, C, D, E.
Mode of shipment: Η εταιρεία αποστέλλει τα προϊόντα με διάφορους τρόπους, όπως πλοίο, αεροπορική μεταφορά και οδική μεταφορά.
Customer care calls: Ο αριθμός των κλήσεων που έγιναν για ερωτήσεις σχετικά με την αποστολή.
Customer rating: Η εταιρεία λαμβάνει βαθμολογίες από κάθε πελάτη. Το 1 είναι η χαμηλότερη (χειρότερη) βαθμολογία, ενώ το 5 είναι η υψηλότερη (καλύτερη).
Cost of the product: Το κόστος του προϊόντος σε δολάρια ΗΠΑ.
Prior purchases: Ο αριθμός των προηγούμενων αγορών του πελάτη.
Product importance: Η εταιρεία έχει κατηγοριοποιήσει τα προϊόντα σε διάφορες κατηγορίες, όπως χαμηλή, μεσαία και υψηλή σημασία.
Gender: Φύλο (Άνδρας ή Γυναίκα).
Discount offered: Η έκπτωση που προσφέρεται για το συγκεκριμένο προϊόν.
Weight in gms: Το βάρος του προϊόντος σε γραμμάρια.
Reached on time: Αυτή είναι η μεταβλητή-στόχος, όπου το 1 υποδηλώνει ότι το προϊόν ΔΕΝ παραδόθηκε στην ώρα του, ενώ το 0 υποδηλώνει ότι παραδόθηκε στην ώρα του.
Για καλύτερη κατανόηση παρακάτω φαίνονται οι στήλες αναλυτικά για τις πρώτες 10 εγγραφές:
| ID | Warehouse_block | Mode_of_Shipment | Customer_care_calls | Customer_rating | Cost_of_the_Product | Prior_purchases | Product_importance | Gender | Discount_offered | Weight_in_gms | Reached.on.Time_Y.N |
|---|---|---|---|---|---|---|---|---|---|---|---|
| 1 | D | Flight | 4 | 2 | 177 | 3 | low | F | 44 | 1233 | 1 |
| 2 | F | Flight | 4 | 5 | 216 | 2 | low | M | 59 | 3088 | 1 |
| 3 | A | Flight | 2 | 2 | 183 | 4 | low | M | 48 | 3374 | 1 |
| 4 | B | Flight | 3 | 3 | 176 | 4 | medium | M | 10 | 1177 | 1 |
| 5 | C | Flight | 2 | 2 | 184 | 3 | medium | F | 46 | 2484 | 1 |
| 6 | F | Flight | 3 | 1 | 162 | 3 | medium | F | 12 | 1417 | 1 |
| 7 | D | Flight | 3 | 4 | 250 | 3 | low | F | 3 | 2371 | 1 |
| 8 | F | Flight | 4 | 1 | 233 | 2 | low | F | 48 | 2804 | 1 |
| 9 | A | Flight | 3 | 4 | 150 | 3 | low | F | 11 | 1861 | 1 |
| 10 | B | Flight | 3 | 2 | 164 | 3 | medium | F | 29 | 1187 | 1 |
Λογιστική Παλινδρόμηση
Στο σημείο αυτό θα εφαρμόσουμε λογιστική παλινδρόμηση για την μεταβλητή Reached.on.Time_Y.N.
##
## 0 1
## 4436 6563Παρατηρούμε ότι η πλειονότητα των εγγραφών αντιστοιχεί στην τιμή 1, γεγονός που υποδηλώνει ότι, στις περισσότερες περιπτώσεις, το δέμα φτάνει εγκαίρως στον προορισμό του. Εάν υποθέσουμε ότι προβλέπουμε όλες τις εγγραφές ως 1, τότε το μοντέλο αυτό θα παρουσιάζει ποσοστό επιτυχίας 59,66%. Συνεπώς, στόχος μας είναι η ανάπτυξη ενός μοντέλου που να επιτυγχάνει μεγαλύτερη ακρίβεια από αυτή τη βασική γραμμή αναφοράς.
## 59.66906set.seed(956)
split <- sample.split(Data$Reached.on.Time_Y.N,SplitRatio = 0.65)
Train = subset(Data, split == TRUE)
Test = subset(Data, split == FALSE)## [1] 7149Το train dataset μας δίνει 7149 παρατηρήσεις
## [1] 3850Ενώ το test dataset μας δίνει 3850 παρατηρήσεις
##
## Call:
## glm(formula = Reached.on.Time_Y.N ~ ., family = binomial, data = Train)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.212e+00 2.792e-01 7.926 2.27e-15 ***
## ID -1.539e-04 1.091e-05 -14.114 < 2e-16 ***
## Warehouse_blockB 1.221e-01 9.545e-02 1.279 0.20085
## Warehouse_blockC 3.924e-02 9.483e-02 0.414 0.67905
## Warehouse_blockD 2.008e-02 9.579e-02 0.210 0.83394
## Warehouse_blockF 6.820e-02 8.250e-02 0.827 0.40845
## Mode_of_ShipmentRoad -2.912e-02 9.707e-02 -0.300 0.76421
## Mode_of_ShipmentShip -1.592e-02 7.591e-02 -0.210 0.83394
## Customer_care_calls -7.515e-02 2.762e-02 -2.721 0.00651 **
## Customer_rating 2.636e-02 1.955e-02 1.348 0.17754
## Cost_of_the_Product -1.485e-03 6.397e-04 -2.321 0.02030 *
## Prior_purchases -4.685e-02 1.921e-02 -2.439 0.01475 *
## Product_importancelow -1.932e-01 1.071e-01 -1.804 0.07119 .
## Product_importancemedium -1.772e-01 1.071e-01 -1.655 0.09799 .
## GenderM -9.144e-03 5.521e-02 -0.166 0.86845
## Discount_offered 9.079e-02 5.821e-03 15.597 < 2e-16 ***
## Weight_in_gms -2.210e-04 2.085e-05 -10.596 < 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: 9641.4 on 7148 degrees of freedom
## Residual deviance: 7570.5 on 7132 degrees of freedom
## AIC: 7604.5
##
## Number of Fisher Scoring iterations: 62. Δημιουργία μοντέλου (λογιστικής) παλινδρόμησης
Με βάση τα αποτελέσματα αυτά, πραγματοποιήθηκε η επιλογή μεταβλητών για τη δημιουργία τριών σταδιακών μοντέλων, ξεκινώντας από τις πιο σημαντικές.
Συγκεκριμένα, στο πρώτο μοντέλο επιλέγονται οι μεταβλητές που έχουν υψηλή στατιστική σημαντικότητα (p < 0.001), οι οποίες σημειώνονται με τρία αστεράκια. Πρόκειται για τις Discount_offered και Weight_in_gms. Αυτές οι μεταβλητές παρουσιάζουν ισχυρή συσχέτιση με τη μεταβλητή στόχο (Reached.on.Time_Y.N).
model1<- glm(Reached.on.Time_Y.N~ Weight_in_gms + Discount_offered, data=Train,family=binomial)
summary(model1)##
## Call:
## glm(formula = Reached.on.Time_Y.N ~ Weight_in_gms + Discount_offered,
## family = binomial, data = Train)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.043e-02 8.448e-02 -0.242 0.809
## Weight_in_gms -1.689e-04 1.694e-05 -9.968 <2e-16 ***
## Discount_offered 1.178e-01 5.467e-03 21.540 <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: 9641.4 on 7148 degrees of freedom
## Residual deviance: 7852.1 on 7146 degrees of freedom
## AIC: 7858.1
##
## Number of Fisher Scoring iterations: 6predictTrain1 <- predict(model1,type='response')
predictTest1 <- predict(model1,type='response', newdata=Test)
AIC1 <-AIC(model1)
acc1 <- mean(ifelse(predictTest1 > 0.5, 1, 0) == Test$Reached.on.Time_Y.N)
cat("Το accuracy του 1ου μοντέλου ανέρχεται στο",acc1*100,"%")## Το accuracy του 1ου μοντέλου ανέρχεται στο 63.03896 %## 0 1
## 0.4815306 0.6745774Στο δεύτερο μοντέλο προστίθεται η μεταβλητή Customer_care_calls, η οποία παρουσιάζει μικρότερη σημαντικότητα και συνεπώς μπορεί να ενισχύσει την ακρίβεια του μοντέλου.
model2<- glm(Reached.on.Time_Y.N~ Weight_in_gms + Discount_offered + Customer_care_calls, data=Train,family=binomial)
summary(model2)##
## Call:
## glm(formula = Reached.on.Time_Y.N ~ Weight_in_gms + Discount_offered +
## Customer_care_calls, family = binomial, data = Train)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 8.068e-01 1.672e-01 4.827 1.39e-06 ***
## Weight_in_gms -2.152e-04 1.889e-05 -11.389 < 2e-16 ***
## Discount_offered 1.140e-01 5.509e-03 20.692 < 2e-16 ***
## Customer_care_calls -1.499e-01 2.605e-02 -5.753 8.76e-09 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 9641.4 on 7148 degrees of freedom
## Residual deviance: 7818.7 on 7145 degrees of freedom
## AIC: 7826.7
##
## Number of Fisher Scoring iterations: 6predictTrain2 <- predict(model2,type='response')
predictTest2 <- predict(model2,type='response', newdata=Test)
AIC2 <-AIC(model2)
acc2 <- mean(ifelse(predictTest2 > 0.5, 1, 0) == Test$Reached.on.Time_Y.N)
cat("Το accuracy του 2ου μοντέλου ανέρχεται στο",acc2*100,"%")## Το accuracy του 2ου μοντέλου ανέρχεται στο 63.66234 %## 0 1
## 0.479066 0.676243Τέλος, στο τρίτο μοντέλο ενσωματώνονται και οι μεταβλητές Cost_of_the_Product και Prior_purchases, οι οποίες είναι οι στατιστικά λιγότερο σημαντικές μέχρι τώρα.
model3<- glm(Reached.on.Time_Y.N~ Weight_in_gms + Discount_offered + Customer_care_calls + Cost_of_the_Product + Prior_purchases, data=Train,family=binomial)
summary(model3)##
## Call:
## glm(formula = Reached.on.Time_Y.N ~ Weight_in_gms + Discount_offered +
## Customer_care_calls + Cost_of_the_Product + Prior_purchases,
## family = binomial, data = Train)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.5837951 0.2247922 7.046 1.85e-12 ***
## Weight_in_gms -0.0002472 0.0000200 -12.362 < 2e-16 ***
## Discount_offered 0.1113757 0.0055239 20.163 < 2e-16 ***
## Customer_care_calls -0.1188687 0.0269424 -4.412 1.02e-05 ***
## Cost_of_the_Product -0.0023746 0.0006199 -3.831 0.000128 ***
## Prior_purchases -0.0701426 0.0187787 -3.735 0.000188 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 9641.4 on 7148 degrees of freedom
## Residual deviance: 7789.3 on 7143 degrees of freedom
## AIC: 7801.3
##
## Number of Fisher Scoring iterations: 6predictTrain3 <- predict(model3,type='response')
predictTest3 <- predict(model3,type='response', newdata=Test)
AIC3 <-AIC(model3)
acc3 <- mean(ifelse(predictTest3 > 0.5, 1, 0) == Test$Reached.on.Time_Y.N)
cat("Το accuracy του 3ου μοντέλου ανέρχεται στο",acc3*100,"%")## Το accuracy του 3ου μοντέλου ανέρχεται στο 63.06494 %## 0 1
## 0.4770094 0.6776329Παραδείγματα Logistic Regression Plot
ggplot(Train, aes(Weight_in_gms, Reached.on.Time_Y.N)) +
geom_point() +
geom_smooth(method = "glm", method.args = list(family = "binomial")) +
labs(title = "Logistic Regression Plot 1",
x = "Weight_in_gms",
y = "Probability") +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
Το συμπέρασμα από το γράφημα είναι ότι:
Καθώς αυξάνεται το βάρος του δέματος, μειώνεται η πιθανότητα να παραδοθεί έγκαιρα.
Αυτό υποδηλώνει ότι το βάρος (Weight_in_gms) επηρεάζει αρνητικά την έγκαιρη παράδοση, πιθανώς επειδή τα βαρύτερα δέματα είναι πιο δύσκολα ή πιο αργά στη μεταφορά. Το αποτέλεσμα αυτό το επιβεβαιώνει και η λογιστική παλινδρόμηση, όπου ο συντελεστής του Weight_in_gms ήταν αρνητικός και στατιστικά σημαντικός.
ggplot(Train, aes(Discount_offered, Reached.on.Time_Y.N)) +
geom_point() +
geom_smooth(method = "glm", method.args = list(family = "binomial")) +
labs(title = "Logistic Regression Plot 2",
x = "Discount_offered",
y = "Probability") +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
Το συμπέρασμα από το γράφημα είναι ότι:
Καθώς αυξάνεται η έκπτωση που προσφέρεται, αυξάνεται και η πιθανότητα να φτάσει το δέμα στην ώρα του.
Αυτό σημαίνει ότι μεγαλύτερες εκπτώσεις μπορεί να σχετίζονται με πιο αποτελεσματική εξυπηρέτηση ή προτεραιότητα στην αποστολή. Η θετική αυτή σχέση επιβεβαιώνεται και από το αποτέλεσμα της λογιστικής παλινδρόμησης, όπου ο συντελεστής της μεταβλητής Discount_offered ήταν θετικός και στατιστικά ιδιαίτερα σημαντικός.
3. Εφαρμογή πρόβλεψης
##
## FALSE TRUE
## 0 1115 438
## 1 947 1350ROCRpred2 <- prediction(predictTest2, Test$Reached.on.Time_Y.N)
ROCRperf2 <- performance(ROCRpred2, "tpr", "fpr")
plot(ROCRperf2, colorize = TRUE, print.cutoffs.at=seq(0,1,0.1),text.adj=c(-0.2,1.7))
## [1] 0.7145442Το ROC curve που εμφανίζεται στο τέλος δείχνει την ικανότητα του μοντέλου να διαχωρίζει τις δύο κατηγορίες.
Το AUC (Area Under Curve) με τιμή γύρω στο 0.71 είναι ικανοποιητικό και υποδεικνύει ένα αρκετά καλό μοντέλο.
4. Γενικό Συμπέρασμα
Η λογιστική παλινδρόμηση που εφαρμόστηκε είναι κατάλληλη για ερμηνεία και βασική πρόβλεψη, και αναδεικνύει ότι:
Κάποιες μεταβλητές όπως βάρος και έκπτωση έχουν πραγματική επιχειρησιακή σημασία.
Το μοντέλο έχει καλύτερη επίδοση από ένα τυχαίο/βασικό μοντέλο.
Μπορεί να χρησιμοποιηθεί για ενημέρωση στρατηγικών αποφάσεων στην επιχείρηση.