Λογιστική Παλινδρομική
Ευαγγελόπουλος Χριστόφορος
2026-04-04
Εισαγωγή και παρουσίαση δεδομένων
Για την παρούσα ανάλυση χρησιμοπείται το dataset “Wine Quality”, το οποίο προέρχεται από έρευνα των Cortez et al. και αφορά δείγματα από τις κόκκινες και λευκές παραλλαγές του πορτογαλικού κρασίου
Περιγραφή δεδομένων
- Fixed acidity: Σταθερή οξύτητα.
- Volatile acidity: Πτητική οξύτητα.
- Citric acid: Κιτρικό οξύ.
- Residual sugar: Υπολειμματικά σάκχαρα.
- Chlorides: Χλωριούχα άλατα.
- Free sulfur dioxide: Ελεύθερο διοξείδιο του θείου.
- Total sulfur dioxide: Συνολικό διοξείδιο του θείου.
- Density: Πυκνότητα.
- pH: Επίπεδο οξύτητας/αλκαλικότητας.
- Sulphates: Θειικά άλατα.
- Alcohol: Περιεκτικότητα σε αλκοόλ.
- Quality : αισθητική αξιολόγηση (από το 0 έως 10)
Στόχος Ανάλυσης
Στην παρούσα μελέτη, ο στόχος μας είναι να εφαρμόσουμε ένα μοντέλο Λογιστικής Παλινδρόμησης για να προβλέψουμε τον τύπο κρασιού , δηλαδή αν ένα κρασί είναι κόκκινο ή λευκό , βασιζόμενοι αποκλειστικά στις 11 φυσικοχημικές του ιδιότητες . Για αυτό τον σκόπο θα δημιουργήσουμε μια binary εξαρτημένη μεταβλητή όπου το 1 θα αντιστοιχεί στο κόκκινο και το 0 στο λευκό .
library(caTools)## Warning: package 'caTools' was built under R version 4.5.3library(ROCR)## Warning: package 'ROCR' was built under R version 4.5.3red_wine <- read.csv("winequality-red.csv", sep=";")
white_wine <- read.csv("winequality-white.csv", sep=";")
red_wine$type <- 1
white_wine$type <-0
wine <-rbind(red_wine, white_wine)
wine$type <- as.factor(wine$type)
head(wine)## fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
## 1 7.4 0.70 0.00 1.9 0.076
## 2 7.8 0.88 0.00 2.6 0.098
## 3 7.8 0.76 0.04 2.3 0.092
## 4 11.2 0.28 0.56 1.9 0.075
## 5 7.4 0.70 0.00 1.9 0.076
## 6 7.4 0.66 0.00 1.8 0.075
## free.sulfur.dioxide total.sulfur.dioxide density pH sulphates alcohol
## 1 11 34 0.9978 3.51 0.56 9.4
## 2 25 67 0.9968 3.20 0.68 9.8
## 3 15 54 0.9970 3.26 0.65 9.8
## 4 17 60 0.9980 3.16 0.58 9.8
## 5 11 34 0.9978 3.51 0.56 9.4
## 6 13 40 0.9978 3.51 0.56 9.4
## quality type
## 1 5 1
## 2 5 1
## 3 5 1
## 4 6 1
## 5 5 1
## 6 5 1Διαχωρισμός Δεδομένων (Train & Test Sets)
set.seed(994)
split <- sample.split(wine$type , SplitRatio = 0.65)
train <- subset(wine, split == TRUE)
test <- subset(wine, split ==FALSE)
cat("Αριθμός καταχωρήσεων στο Train set:" , nrow(train), "\n")## Αριθμός καταχωρήσεων στο Train set: 4223cat("Αριθμός καταχωρήσεων στο Test set:", nrow(test), "\n")## Αριθμός καταχωρήσεων στο Test set: 2274Δημιουργία Μοντέλου Λογιστικής Παλινδρόμησης
log_model <- glm(type ~ ., data = train, family = binomial)
summary(log_model)##
## Call:
## glm(formula = type ~ ., family = binomial, data = train)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.531e+03 2.733e+02 -9.260 < 2e-16 ***
## fixed.acidity -9.526e-01 3.272e-01 -2.912 0.003593 **
## volatile.acidity 7.169e+00 1.526e+00 4.699 2.62e-06 ***
## citric.acid -1.595e+00 1.650e+00 -0.967 0.333740
## residual.sugar -1.052e+00 1.338e-01 -7.860 3.83e-15 ***
## chlorides 2.030e+01 5.294e+00 3.834 0.000126 ***
## free.sulfur.dioxide 8.507e-02 1.733e-02 4.908 9.19e-07 ***
## total.sulfur.dioxide -6.209e-02 7.379e-03 -8.414 < 2e-16 ***
## density 2.538e+03 2.778e+02 9.138 < 2e-16 ***
## pH -4.784e+00 1.911e+00 -2.503 0.012312 *
## sulphates 1.592e+00 1.777e+00 0.896 0.370412
## alcohol 2.776e+00 4.275e-01 6.492 8.44e-11 ***
## quality 2.516e-01 2.777e-01 0.906 0.364857
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4712.32 on 4222 degrees of freedom
## Residual deviance: 224.23 on 4210 degrees of freedom
## AIC: 250.23
##
## Number of Fisher Scoring iterations: 9Significance
- Πολύ ισχυρή στατική σημαντικότητα έχουν οι μεταβλητές όπως : intercept , volatile.acidity , residual.sugar, chlorides , free.sulfur.dioxide , total.sulfur.dioxide, alcohol
- Ισχυρή στατική σημαντικότητα : fixed.acidity
- Απλή στατική σημαντικότητα : pH
Προβλέψεις στο Test Set
predictTest <- predict(log_model, type = 'response', newdata = test)
head(predictTest)## 4 9 14 24 25 27
## 0.9918746 0.9997355 0.9999740 0.9761441 0.9992195 0.9963458Πίνακας Σύγχυσης & Αξιολόγηση
conf_matrix <- table(Actual = test$type , Predicted = predictTest > 0.5)
conf_matrix## Predicted
## Actual FALSE TRUE
## 0 1709 5
## 1 6 554TN <- conf_matrix[1, 1] # True Negatives
FP <- conf_matrix[1, 2] # False Positives
FN <- conf_matrix[2, 1] # False Negatives
TP <- conf_matrix[2, 2] # True Positives
accuracy <- (TN + TP) / (TN + FP + FN + TP)
sensitivity <- TP / (TP + FN)
specificity <- TN / (TN + FP)
cat("Ακρίβεια (Accuracy):", round(accuracy, 4), "\n")## Ακρίβεια (Accuracy): 0.9952cat("Ευαισθησία (Sensitivity):", round(sensitivity, 4), "\n")## Ευαισθησία (Sensitivity): 0.9893cat("Ειδικότητα (Specificity):", round(specificity, 4), "\n")## Ειδικότητα (Specificity): 0.9971baseline_accuracy <- max(table(test$type)) / nrow(test)
cat("Ακρίβεια Baseline Model:" , round(baseline_accuracy, 4), "\n")## Ακρίβεια Baseline Model: 0.7537Παρατήρηση
Συγκρίνοντας το Baseline Model(75,37%) με το δικό μας μοντέλο Λογιστικής Παλινδρόμησης, παρατηρούμε ότι το μοντέλο μας προσφέρει δραματική βελτιώση στην Ακρίβεια (99,52%). Παράλληλα , η υψηλή Ευαισθησία (98,93%) δείχνει ότι εντοπίζει εξαιρετικά σωστά τα κόκκινα κραδία και η υψηλή Ειδικότητα (99,71%) ότι αναγνωρίζει πολύ σωστά τα λευκά κρασία.
Καμπύλη ROC και Υπολογισμός AUC
ROCRpred <- prediction(predictTest, test$type)
ROCRperf <- performance(ROCRpred, "tpr" , "fpr")
plot(ROCRperf, colorize = TRUE, main = "Καμπύλη ROC - Πρόβλεψη τύπου κρασιού")
auc_ROCR <- performance(ROCRpred, measure = "auc")
auc_value <- auc_ROCR@y.values[[1]]
cat("Η τιμή AUC (Area Under Curve) είναι:", round(auc_value, 4), "\n")## Η τιμή AUC (Area Under Curve) είναι: 0.9951Νέα Test συνόλων
train2 <- na.omit(train)
test2 <- na.omit(test)
cat("Αριθμός καταχωρήσεων στο train2:", nrow(train2), "\n")## Αριθμός καταχωρήσεων στο train2: 4223cat("Αριθμός καταχωρήσεων στο test2:", nrow(test2), "\n")## Αριθμός καταχωρήσεων στο test2: 2274Το συγκεκριμένο dataset δεν είχε κενές τιμές .
Συμπεράσματα
Μετά από την εφαρμογή της Λογιστικής Παλινδρόμησης στο σύνολο των δεδομένων του “Wine Quality” παρατηρούμε εξαιρετική προβλεπτική ικανότητα, καθώς το μοντέλο μας μπορεί να προβλέψει σχεδόν με απόλυτη επιτυχία τα κόκκινα και τα λευκά κρασία.