Logistic Regression

Περιγραφή του Dataset και Προσαρμογή Δεδομένων

Προέλευση και Περιεχόμενο: Το συγκεκριμένο σύνολο δεδομένων περιέχει ιστορικά στοιχεία πωλήσεων από 45 καταστήματα της Walmart που βρίσκονται σε διαφορετικές περιοχές των ΗΠΑ. Περιλαμβάνει εβδομαδιαία δεδομένα για μια περίοδο περίπου 3 ετών (2010-2012) και προέρχεται αρχικά από έναν διαγωνισμό του Kaggle (Walmart Recruiting - Store Sales Forecasting). Περιλαμβάνει τις πωλήσεις, καθώς και εξωτερικούς δείκτες όπως η θερμοκρασία, η τιμή των καυσίμων, η ανεργία και ο δείκτης τιμών καταναλωτή (CPI), επιτρέποντας μια ολιστική προσέγγιση της επιχειρηματικής απόδοσης και των συνθηκών κάτω από τις οποίες λειτουργεί η εταιρεία.
Προσαρμογή για Διωνυμική Λογιστική Παλινδρόμηση: Καθώς για τους σκοπούς της παρούσας εργασίας επιλέχθηκε η εφαρμογή της Διωνυμικής Λογιστικής Παλινδρόμησης, πραγματοποιήθηκε επεξεργασία των αρχικών δεδομένων. Συγκεκριμένα, προστέθηκε μια επιπλέον στήλη η οποία λειτουργεί ως εξαρτημένη μεταβλητή και καθορίζει το αν μια εβδομάδα είναι εμπορικά «επιτυχημένη» ή όχι. Δόθηκε η τιμή 1 (επιτυχία) αν οι πωλήσεις της εβδομάδας ξεπέρασαν τον γενικό μέσο όρο και η τιμή 0 (αποτυχία) αν κυμάνθηκαν κάτω από αυτόν, διαμορφώνοντας έτσι το dataset κατάλληλα για τη δημιουργία του μοντέλου στο συγκεκριμένο case study.

# Φόρτωση  βιβλιοθηκών 
library(caTools)
library(ROCR)

# Φόρτωση
Walmart <- read.csv("Walmart.csv")

#Δημιουργία Binary μεταβλητής(επιτυχία/αποτυχία)
# Βρίσκουμε τον μέσο όρο των πωλήσεων
mean_sales <- mean(Walmart$Weekly_Sales)

Walmart$Success <- ifelse(Walmart$Weekly_Sales > mean_sales, 1, 0)

# Επισκόπηση της δομής των δεδομένων
str(Walmart)

## 'data.frame':    6435 obs. of  9 variables:
##  $ Store       : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ Date        : chr  "5/2/2010" "12/2/2010" "19-02-2010" "26-02-2010" ...
##  $ Weekly_Sales: num  1643691 1641957 1611968 1409728 1554807 ...
##  $ Holiday_Flag: int  0 1 0 0 0 0 0 0 0 0 ...
##  $ Temperature : num  42.3 38.5 39.9 46.6 46.5 ...
##  $ Fuel_Price  : num  2.57 2.55 2.51 2.56 2.62 ...
##  $ CPI         : num  211 211 211 211 211 ...
##  $ Unemployment: num  8.11 8.11 8.11 8.11 8.11 ...
##  $ Success     : num  1 1 1 1 1 1 1 1 1 1 ...

# Βασικά περιγραφικά στατιστικά
summary(Walmart)

##      Store        Date            Weekly_Sales      Holiday_Flag    
##  Min.   : 1   Length:6435        Min.   : 209986   Min.   :0.00000  
##  1st Qu.:12   Class :character   1st Qu.: 553350   1st Qu.:0.00000  
##  Median :23   Mode  :character   Median : 960746   Median :0.00000  
##  Mean   :23                      Mean   :1046965   Mean   :0.06993  
##  3rd Qu.:34                      3rd Qu.:1420159   3rd Qu.:0.00000  
##  Max.   :45                      Max.   :3818687   Max.   :1.00000  
##   Temperature       Fuel_Price         CPI         Unemployment   
##  Min.   : -2.06   Min.   :2.472   Min.   :126.1   Min.   : 3.879  
##  1st Qu.: 47.46   1st Qu.:2.933   1st Qu.:131.7   1st Qu.: 6.891  
##  Median : 62.67   Median :3.445   Median :182.6   Median : 7.874  
##  Mean   : 60.66   Mean   :3.359   Mean   :171.6   Mean   : 7.999  
##  3rd Qu.: 74.94   3rd Qu.:3.735   3rd Qu.:212.7   3rd Qu.: 8.622  
##  Max.   :100.14   Max.   :4.468   Max.   :227.2   Max.   :14.313  
##     Success      
##  Min.   :0.0000  
##  1st Qu.:0.0000  
##  Median :0.0000  
##  Mean   :0.4469  
##  3rd Qu.:1.0000  
##  Max.   :1.0000

# 3. Διαχωρισμός σε train και test set (65% - 35%)
set.seed(946) 

# Χωρίζω με βάση τη νέα μεταβλητή (Success)
split <- sample.split(Walmart$Success, SplitRatio = 0.65)

# Δημιουργία των sets
train <- subset(Walmart, split == TRUE)
test <- subset(Walmart, split == FALSE)

# Καταγραφή των καταχωρήσεων σε κάθε set
nrow(train)

## [1] 4182

nrow(test)

## [1] 2253

Στη συνέχεια δημιουργώ το μοντέλο στο train set, χωρίς όμως να συμπεριλάβω τις μεταβλητες Date (καθώς δεν μπορεί η R να την διαβάσει και δεν μου είναι χρήσιμη) και Weekly Sales,αφού την χρησιμοποιήσαμε για την δημιουργία της μεταβλητής Success και αν την αφήσουμε, το μοντέλο θα “κλέβει” και θα έχει πάντα 100% επιτυχία (Data Leakage).

# 1. Δημιουργία του μοντέλου στο train set (WalmartModel)
WalmartModel <- glm(Success ~ Holiday_Flag + Temperature + Fuel_Price + CPI + Unemployment, 
                    data = train, 
                    family = "binomial")

# 2. Εμφάνιση των αποτελεσμάτων του μοντέλου (εδώ θα δεις τα αστεράκια!)
summary(WalmartModel)

## 
## Call:
## glm(formula = Success ~ Holiday_Flag + Temperature + Fuel_Price + 
##     CPI + Unemployment, family = "binomial", data = train)
## 
## Coefficients:
##                Estimate Std. Error z value Pr(>|z|)    
## (Intercept)   0.5518910  0.3571880   1.545   0.1223    
## Holiday_Flag  0.2293118  0.1235963   1.855   0.0635 .  
## Temperature   0.0007519  0.0017985   0.418   0.6759    
## Fuel_Price    0.0300000  0.0706214   0.425   0.6710    
## CPI          -0.0020042  0.0008701  -2.303   0.0213 *  
## Unemployment -0.0733237  0.0181751  -4.034 5.48e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 5750.3  on 4181  degrees of freedom
## Residual deviance: 5728.4  on 4176  degrees of freedom
## AIC: 5740.4
## 
## Number of Fisher Scoring iterations: 4

Σημαντικότητα Ανεξάρτητων Μεταβλητών

Με βάση τα αποτελέσματα του μοντέλου λογιστικής παλινδρόμησης στο train set, η μεταβλητή Unemployment (Ανεργία) παρουσιάζει p-value = 5.48e-05 (**), γεγονός που υποδηλώνει ισχυρή στατιστικά σημαντική συσχέτιση σε επίπεδο σημαντικότητας μικρότερο του 0.001, με αρνητική επίδραση στην πιθανότητα επιτυχίας.

Η μεταβλητή CPI (Δείκτης Τιμών Καταναλωτή) έχει p-value = 0.0213 (), άρα είναι στατιστικά σημαντική σε επίπεδο μικρότερο του 0.05 και παρουσιάζει επίσης αρνητική επίδραση. Η μεταβλητή Holiday_Flag (Αργίες) εμφανίζει p-value = 0.0635 (.), γεγονός που δείχνει οριακά στατιστικά σημαντική συσχέτιση σε επίπεδο μικρότερο του 0.1, με θετική επίδραση στην πιθανότητα επιτυχίας.

Αντίθετα, η μεταβλητή Temperature έχει p-value = 0.6759 και δεν είναι στατιστικά σημαντική, ενώ η μεταβλητή Fuel_Price με p-value = 0.6710 επίσης δεν παρουσιάζει στατιστικά σημαντική επίδραση στο μοντέλο.

Συμπέρασμα για τις μεταβλητές

Οι μεταβλητές με ισχυρή συσχέτιση με την εξαρτημένη μεταβλητή είναι η Unemployment (πολύ ισχυρή) και η CPI (στατιστικά σημαντική), ενώ η Holiday_Flag παρουσιάζει μόνο οριακή συσχέτιση. Οι μεταβλητές Temperature και Fuel_Price δεν επηρεάζουν στατιστικά σημαντικά το μοντέλο.

predictTest <- predict(WalmartModel, newdata = test, type = "response")

head(predictTest)

##         2         4         5         8        10        12 
## 0.4672612 0.4123852 0.4128120 0.4146549 0.4230813 0.4231670

Παρατηρήσεις για την συνάρτηση predict

Η συνάρτηση predict εφαρμόζει το μοντέλο λογιστικής παλινδρόμησης στα δεδομένα του test set και επιστρέφει, για κάθε παρατήρηση, την εκτιμώμενη πιθανότητα να ανήκει στην κατηγορία Success = 1. Οι τιμές αυτές κυμαίνονται από 0 έως 1 και δεν αποτελούν τελικές κατηγορίες, αλλά πιθανότητες που εκφράζουν το πόσο «σίγουρο» είναι το μοντέλο για την πρόβλεψή του.
Στη συγκεκριμένη περίπτωση, παρατηρείται ότι οι περισσότερες τιμές κυμαίνονται περίπου μεταξύ 0.4 και 0.49, δηλαδή κοντά στο όριο του 0.5. Αυτό δείχνει ότι το μοντέλο δεν διαχωρίζει με μεγάλη βεβαιότητα τις δύο κατηγορίες (επιτυχημένη ή μη εβδομάδα), καθώς αποδίδει παρόμοιες πιθανότητες σε πολλές παρατηρήσεις.

# Μετατροπή πιθανοτήτων σε κατηγορίες (threshold = 0.5)
predictClass <- ifelse(predictTest > 0.5, 1, 0)

# Confusion Matrix
table(test$Success, predictClass)

##    predictClass
##        0    1
##   0 1162   84
##   1  882  125

# Accuracy
accuracy <- mean(predictClass == test$Success)
accuracy

## [1] 0.5712383

# Sensitivity (Recall για Success = 1)
sensitivity <- sum(predictClass == 1 & test$Success == 1) / sum(test$Success == 1)
sensitivity

## [1] 0.1241311

# Specificity (για Success = 0)
specificity <- sum(predictClass == 0 & test$Success == 0) / sum(test$Success == 0)
specificity

## [1] 0.9325843

# Baseline accuracy (πάντα προβλέπουμε την πιο συχνή κλάση)
baseline <- max(mean(test$Success == 1), mean(test$Success == 0))
baseline

## [1] 0.5530404

Αξιολόγηση Μοντέλου

Για την αξιολόγηση του μοντέλου δημιουργήθηκε confusion matrix με κατώφλι 0.5, μετατρέποντας τις πιθανότητες σε δυαδικές προβλέψεις. Τα αποτελέσματα δείχνουν ότι το μοντέλο ταξινομεί σωστά μεγάλο αριθμό μη επιτυχημένων εβδομάδων (1162), ενώ εντοπίζει σωστά πολύ μικρό αριθμό επιτυχημένων εβδομάδων (125). Αντίθετα, παρατηρείται μεγάλος αριθμός σφαλμάτων όπου επιτυχημένες εβδομάδες προβλέπονται ως μη επιτυχημένες (882 περιπτώσεις).

Η συνολική ακρίβεια (accuracy) του μοντέλου είναι 57.1%, ενώ η ακρίβεια του baseline μοντέλου είναι 55.3%. Αυτό δείχνει ότι το μοντέλο βελτιώνει ελάχιστα την πρόβλεψη σε σχέση με μια απλή στρατηγική που προβλέπει πάντα την πιο συχνή κατηγορία.

Το sensitivity είναι ιδιαίτερα χαμηλό (12.4%), γεγονός που σημαίνει ότι το μοντέλο αποτυγχάνει να εντοπίσει τις περισσότερες επιτυχημένες εβδομάδες. Αντίθετα, το specificity είναι πολύ υψηλό (93.3%), δείχνοντας ότι το μοντέλο αναγνωρίζει με μεγάλη ακρίβεια τις μη επιτυχημένες εβδομάδες.

Συνολικά, το μοντέλο παρουσιάζει έντονη μεροληψία προς την κατηγορία 0 (μη επιτυχημένες εβδομάδες) και δεν καταφέρνει να διαχωρίσει αποτελεσματικά τις δύο κατηγορίες. Αυτό επιβεβαιώνει και την προηγούμενη παρατήρηση ότι οι προβλεπόμενες πιθανότητες βρίσκονται κοντά στο 0.5, γεγονός που υποδηλώνει χαμηλή διακριτική ικανότητα του μοντέλου.

# Δημιουργία ROCRpred αντικειμένου
ROCRpred <- prediction(predictTest, test$Success)

# Αφαίρεση missing values
Walmart2 <- na.omit(Walmart)

# Νέος διαχωρισμός
set.seed(946)
split2 <- sample.split(Walmart2$Success, SplitRatio = 0.65)

train2 <- subset(Walmart2, split2 == TRUE)
test2 <- subset(Walmart2, split2 == FALSE)

# Πλήθος παρατηρήσεων
nrow(train2)

## [1] 4182

nrow(test2)

## [1] 2253

Για την αντιμετώπιση πιθανών ελλιπών τιμών χρησιμοποιήθηκε η εντολή na.omit, ωστόσο δεν παρατηρήθηκε αλλαγή στον αριθμό των καταχωρήσεων. Αυτό δείχνει ότι το dataset δεν περιείχε missing values ή είχε ήδη καθαριστεί προηγουμένως.

Στη συνέχεια πραγματοποιήθηκε εκ νέου διαχωρισμός σε training και test set, όπου το train2 περιλαμβάνει 4182 παρατηρήσεις και το test2 2253 παρατηρήσεις.

# Δημιουργία performance για ROC curve
ROCRperf <- performance(ROCRpred, "tpr", "fpr")

# Plot ROC curve με χρωματισμό
plot(ROCRperf, colorize = TRUE, main = "ROC Curve")

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

## [1] 0.5456496

Καμπύλη ROC και AUC

Για την αξιολόγηση της διακριτικής ικανότητας του μοντέλου κατασκευάστηκε η καμπύλη ROC, η οποία απεικονίζει τη σχέση μεταξύ του True Positive Rate (sensitivity) και του False Positive Rate για διαφορετικά κατώφλια ταξινόμησης. Η καμπύλη σχεδιάστηκε με χρήση color-coding για καλύτερη οπτικοποίηση.

Η τιμή του AUC υπολογίστηκε ίση με 0.5465. Η τιμή αυτή είναι αρκετά κοντά στο 0.5, γεγονός που υποδηλώνει ότι το μοντέλο έχει πολύ χαμηλή διακριτική ικανότητα και η απόδοσή του προσεγγίζει αυτή μιας τυχαίας πρόβλεψης.

Συνολικά, το αποτέλεσμα αυτό επιβεβαιώνει τα προηγούμενα ευρήματα από το confusion matrix και τις τιμές sensitivity και specificity, όπου φάνηκε ότι το μοντέλο δεν καταφέρνει να διαχωρίσει αποτελεσματικά τις επιτυχημένες από τις μη επιτυχημένες εβδομάδες. Συνεπώς, το μοντέλο κρίνεται περιορισμένης χρησιμότητας για προβλεπτικούς σκοπούς στη συγκεκριμένη μορφή του.