1. Περιγραφή Dataset

Το dataset που χρησιμοποιούμε αφορά φυσικοχημικά χαρακτηριστικά κόκκινου κρασιού και την αξιολόγηση της ποιότητάς του. Περιλαμβάνει 11 εισαγωγικές μεταβλητές και 1 εξαρτημένη μεταβλητή (ποιότητα). Το dataset είναι διαθέσιμο από το UCI Machine Learning Repository.

Πηγή: Wine Quality Dataset - UCI

2. Επιχειρηματική Αναλυτική

Η αξιολόγηση της ποιότητας ενός κρασιού βάσει φυσικοχημικών χαρακτηριστικών αποτελεί σημαντικό εργαλείο για:

  • Οινοπαραγωγούς που θέλουν να βελτιώσουν την παραγωγή.
  • Τυποποιητές που αναζητούν ομοιομορφία.
  • Καταναλωτές και εμπόρους που στηρίζονται σε ποιοτικά πρότυπα.

Ερωτήματα:

  • Ποιο χαρακτηριστικό επηρεάζει περισσότερο την ποιότητα;
  • Μπορεί να προβλεφθεί η ποιότητα μόνο από την οξύτητα ή το αλκοόλ;
  • Υπάρχουν συνδυασμοί μεταβλητών που βελτιώνουν την πρόβλεψη;

3. Διερεύνηση Δεδομένων

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

wine <- read.csv("C:/Users/User/Desktop/wine+quality (1)/winequality-red.csv",sep = ";")

Περιγραφή Μεταβλητών

Πίνακας Μεταβλητών
Μεταβλητή Τύπος
fixed acidity Αριθμητικό
volatile acidity Αριθμητικό
citric acidity Αριθμητικό
residual sugar Αριθμητικό
chlorides Αριθμητικό
free sulfur dioxide Αριθμητικό
total sulfur dioxide Αριθμητικό
density Αριθμητικό
pH Αριθμητικό
sulphates Αριθμητικό
alcohol Αριθμητικό
quality Αριθμητικό

Περιγραφικά Στατιστικά

View(wine)
str(wine)
## 'data.frame':    1599 obs. of  12 variables:
##  $ fixed.acidity       : num  7.4 7.8 7.8 11.2 7.4 7.4 7.9 7.3 7.8 7.5 ...
##  $ volatile.acidity    : num  0.7 0.88 0.76 0.28 0.7 0.66 0.6 0.65 0.58 0.5 ...
##  $ citric.acid         : num  0 0 0.04 0.56 0 0 0.06 0 0.02 0.36 ...
##  $ residual.sugar      : num  1.9 2.6 2.3 1.9 1.9 1.8 1.6 1.2 2 6.1 ...
##  $ chlorides           : num  0.076 0.098 0.092 0.075 0.076 0.075 0.069 0.065 0.073 0.071 ...
##  $ free.sulfur.dioxide : num  11 25 15 17 11 13 15 15 9 17 ...
##  $ total.sulfur.dioxide: num  34 67 54 60 34 40 59 21 18 102 ...
##  $ density             : num  0.998 0.997 0.997 0.998 0.998 ...
##  $ pH                  : num  3.51 3.2 3.26 3.16 3.51 3.51 3.3 3.39 3.36 3.35 ...
##  $ sulphates           : num  0.56 0.68 0.65 0.58 0.56 0.56 0.46 0.47 0.57 0.8 ...
##  $ alcohol             : num  9.4 9.8 9.8 9.8 9.4 9.4 9.4 10 9.5 10.5 ...
##  $ quality             : int  5 5 5 6 5 5 5 7 7 5 ...
summary(wine)
##  fixed.acidity   volatile.acidity  citric.acid    residual.sugar  
##  Min.   : 4.60   Min.   :0.1200   Min.   :0.000   Min.   : 0.900  
##  1st Qu.: 7.10   1st Qu.:0.3900   1st Qu.:0.090   1st Qu.: 1.900  
##  Median : 7.90   Median :0.5200   Median :0.260   Median : 2.200  
##  Mean   : 8.32   Mean   :0.5278   Mean   :0.271   Mean   : 2.539  
##  3rd Qu.: 9.20   3rd Qu.:0.6400   3rd Qu.:0.420   3rd Qu.: 2.600  
##  Max.   :15.90   Max.   :1.5800   Max.   :1.000   Max.   :15.500  
##    chlorides       free.sulfur.dioxide total.sulfur.dioxide    density      
##  Min.   :0.01200   Min.   : 1.00       Min.   :  6.00       Min.   :0.9901  
##  1st Qu.:0.07000   1st Qu.: 7.00       1st Qu.: 22.00       1st Qu.:0.9956  
##  Median :0.07900   Median :14.00       Median : 38.00       Median :0.9968  
##  Mean   :0.08747   Mean   :15.87       Mean   : 46.47       Mean   :0.9967  
##  3rd Qu.:0.09000   3rd Qu.:21.00       3rd Qu.: 62.00       3rd Qu.:0.9978  
##  Max.   :0.61100   Max.   :72.00       Max.   :289.00       Max.   :1.0037  
##        pH          sulphates         alcohol         quality     
##  Min.   :2.740   Min.   :0.3300   Min.   : 8.40   Min.   :3.000  
##  1st Qu.:3.210   1st Qu.:0.5500   1st Qu.: 9.50   1st Qu.:5.000  
##  Median :3.310   Median :0.6200   Median :10.20   Median :6.000  
##  Mean   :3.311   Mean   :0.6581   Mean   :10.42   Mean   :5.636  
##  3rd Qu.:3.400   3rd Qu.:0.7300   3rd Qu.:11.10   3rd Qu.:6.000  
##  Max.   :4.010   Max.   :2.0000   Max.   :14.90   Max.   :8.000

Διαγράμματα

Scatterplot - Αλκοόλ vs Ποιότητα

ggplot(wine, aes(x = alcohol, y = quality)) +
  geom_point(alpha = 0.5) +
  labs(title = "Αλκοόλ vs Ποιότητα", x = "Αλκοόλ", y = "Ποιότητα")

Σχόλιο: Δεν παρατηρείται ισχυρή συσχέτιση μεταξύ αλκοόλ και ποιότητας με γυμνό μάτι.️ Η μεταβλητή alcohol δεν φαίνεται να προβλέπει ισχυρά την quality.

Boxplot - Ποιότητα ανά Οξύτητα

ggplot(wine, aes(x = factor(quality), y = fixed.acidity)) +
  geom_boxplot() +
  labs(title = "Οξύτητα ανά Ποιότητα", x = "Ποιότητα", y = "Οξύτητα")

Σχόλιο: Οι διάμεσοι τιμών οξύτητας (γραμμή μέσα στο box) παραμένουν σχετικά σταθερές σε όλες τις κατηγορίες ποιότητας.Υπάρχει μεγάλη διακύμανση της οξύτητας ανεξαρτήτως ποιότητας.

Ιστόγραμμα - Κατανομή Αλκοόλ

ggplot(wine, aes(x = alcohol)) +
  geom_histogram(bins = 30, fill = "steelblue", color = "black") +
  labs(title = "Κατανομή Αλκοόλ", x = "Αλκοόλ", y = "Συχνότητα")

Σχόλιο: Η πλειοψηφία των κρασιών έχει περιεκτικότητα σε αλκοόλ μεταξύ 9% και 11.5%.

Bar Chart - Συχνότητα Ποιότητας

ggplot(wine, aes(x = factor(quality))) +
  geom_bar(fill = "coral") +
  labs(title = "Κατανομή Ποιότητας Κρασιού", x = "Ποιότητα", y = "Πλήθος")

Σχόλιο: Η συχνότερη βαθμολογία είναι 5 και 6.

2. Γραμμική Παλινδρόμηση

Ανάλυση Συσχετίσεων

Ο παρακάτω πίνακας παρουσιάζει τους συντελεστές συσχέτισης Pearson μεταξύ των μεταβλητών. Οι τιμές πλησιέστερες στο 1 ή -1 δείχνουν ισχυρή θετική ή αρνητική σχέση αντίστοιχα.Για τα ακόλουθα μοντέλα, επιλέγουμε με φθίνουσα σειρά την μεταβλητή με την μεγαλύτερη συσχέτιση με την μεταβλητή ποιότητας.Χρησιμοποιείται η μέθοδος πρόσθεσης μεταβλητών.

cor_matrix <- cor(wine)
knitr::kable(round(cor_matrix, 2), caption = "Πίνακας Συσχετίσεων Μεταβλητών")
Πίνακας Συσχετίσεων Μεταβλητών
fixed.acidity volatile.acidity citric.acid residual.sugar chlorides free.sulfur.dioxide total.sulfur.dioxide density pH sulphates alcohol quality
fixed.acidity 1.00 -0.26 0.67 0.11 0.09 -0.15 -0.11 0.67 -0.68 0.18 -0.06 0.12
volatile.acidity -0.26 1.00 -0.55 0.00 0.06 -0.01 0.08 0.02 0.23 -0.26 -0.20 -0.39
citric.acid 0.67 -0.55 1.00 0.14 0.20 -0.06 0.04 0.36 -0.54 0.31 0.11 0.23
residual.sugar 0.11 0.00 0.14 1.00 0.06 0.19 0.20 0.36 -0.09 0.01 0.04 0.01
chlorides 0.09 0.06 0.20 0.06 1.00 0.01 0.05 0.20 -0.27 0.37 -0.22 -0.13
free.sulfur.dioxide -0.15 -0.01 -0.06 0.19 0.01 1.00 0.67 -0.02 0.07 0.05 -0.07 -0.05
total.sulfur.dioxide -0.11 0.08 0.04 0.20 0.05 0.67 1.00 0.07 -0.07 0.04 -0.21 -0.19
density 0.67 0.02 0.36 0.36 0.20 -0.02 0.07 1.00 -0.34 0.15 -0.50 -0.17
pH -0.68 0.23 -0.54 -0.09 -0.27 0.07 -0.07 -0.34 1.00 -0.20 0.21 -0.06
sulphates 0.18 -0.26 0.31 0.01 0.37 0.05 0.04 0.15 -0.20 1.00 0.09 0.25
alcohol -0.06 -0.20 0.11 0.04 -0.22 -0.07 -0.21 -0.50 0.21 0.09 1.00 0.48
quality 0.12 -0.39 0.23 0.01 -0.13 -0.05 -0.19 -0.17 -0.06 0.25 0.48 1.00

Δημιουργία Μοντέλων

Ξεκινάμε επιλέγοντας μεταβλητές με την μεγαλύτερη συσχέτιση.

Μοντέλο 1 - Αλκοόλ

model1 <- lm(quality ~ alcohol, data = wine)
summary(model1)
## 
## Call:
## lm(formula = quality ~ alcohol, data = wine)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.8442 -0.4112 -0.1690  0.5166  2.5888 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  1.87497    0.17471   10.73   <2e-16 ***
## alcohol      0.36084    0.01668   21.64   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.7104 on 1597 degrees of freedom
## Multiple R-squared:  0.2267, Adjusted R-squared:  0.2263 
## F-statistic: 468.3 on 1 and 1597 DF,  p-value: < 2.2e-16
ggplot(wine, aes(x = alcohol, y = quality)) +
  geom_point(alpha = 0.5) +
  geom_abline(intercept = coef(model1)[1], slope = coef(model1)[2], color = "red", linewidth = 1.2) +
  labs(title = "Γραμμική Παλινδρόμηση: Ποιότητα ~ Αλκοόλ",
       x = "Αλκοόλ", y = "Ποιότητα")

Σχόλιο: Το αλκοόλ έχει σημαντική θετική επίδραση στην ποιότητα συγκριτικά με άλλες μεταβλητές. Το R² δείχνει ότι εξηγεί ένα μικρό ποσοστό της διακύμανσης(22.7%).

Μοντέλο 2 - Αλκοόλ και Πτητική Οξύτητα

model2 <- lm(quality ~ alcohol + volatile.acidity, data = wine)
summary(model2)
## 
## Call:
## lm(formula = quality ~ alcohol + volatile.acidity, data = wine)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.59342 -0.40416 -0.07426  0.46539  2.25809 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       3.09547    0.18450   16.78   <2e-16 ***
## alcohol           0.31381    0.01601   19.60   <2e-16 ***
## volatile.acidity -1.38364    0.09527  -14.52   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.6678 on 1596 degrees of freedom
## Multiple R-squared:  0.317,  Adjusted R-squared:  0.3161 
## F-statistic: 370.4 on 2 and 1596 DF,  p-value: < 2.2e-16

Σχόλιο: Με την προσθήκη της πτητικής οξύτητας το R² αυξάνεται αξιοσημείωτα και το SSE μειώνεται σημαντικά.

Μοντέλο 3 - Προσθήκη Θειικών αλάτων

model3 <- lm(quality ~ alcohol + sulphates + volatile.acidity,  data = wine)
summary(model3)
## 
## Call:
## lm(formula = quality ~ alcohol + sulphates + volatile.acidity, 
##     data = wine)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -2.7186 -0.3820 -0.0641  0.4746  2.1807 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       2.61083    0.19569  13.342  < 2e-16 ***
## alcohol           0.30922    0.01580  19.566  < 2e-16 ***
## sulphates         0.67903    0.10080   6.737 2.26e-11 ***
## volatile.acidity -1.22140    0.09701 -12.591  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.6587 on 1595 degrees of freedom
## Multiple R-squared:  0.3359, Adjusted R-squared:  0.3346 
## F-statistic: 268.9 on 3 and 1595 DF,  p-value: < 2.2e-16

Σχόλιο: Η προσθήκη θειικών αλάτων και των λοιπών μεταβλητών, όπως θα φανεί παρακάτω, δεν βελτιώνουν σημαντικά το R², και βελτιώνουν ελάχιστα το SSE.

Μοντέλο 4 - Προσθήκη Κιτρικού Οξέος

model4 <- lm(quality ~ alcohol + sulphates  + volatile.acidity + citric.acid, data = wine)
summary(model4)
## 
## Call:
## lm(formula = quality ~ alcohol + sulphates + volatile.acidity + 
##     citric.acid, data = wine)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -2.71408 -0.38590 -0.06402  0.46657  2.20393 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       2.64592    0.20106  13.160  < 2e-16 ***
## alcohol           0.30908    0.01581  19.553  < 2e-16 ***
## sulphates         0.69552    0.10311   6.746 2.12e-11 ***
## volatile.acidity -1.26506    0.11266 -11.229  < 2e-16 ***
## citric.acid      -0.07913    0.10381  -0.762    0.446    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 0.6588 on 1594 degrees of freedom
## Multiple R-squared:  0.3361, Adjusted R-squared:  0.3345 
## F-statistic: 201.8 on 4 and 1594 DF,  p-value: < 2.2e-16

3. Αξιολόγηση Μοντέλων

Σύγκριση αποτελεσμάτων

Σύγκριση Μοντέλων Γραμμικής Παλινδρόμησης
Μεταβλητές R_squared SSE RMSE
alcohol 0.227 805.87 0.71
alcohol, volatile acidity 0.317 711.80 0.67
alcohol, volatile acidity, sulphates 0.336 692.10 0.66
alcohol, volatile acidity, sulphates, citric.acid 0.336 691.85 0.66

Βλέπουμε πως με την προσθήκη επιπλέον μεταβλητών με ισχυρή συσχέτιση οι μετρικές απόδοσης βελτιώνονται. Αν και η βελτίωση γίνεται σε μικρό βαθμό, το μοντέλο με τις καλύτερες μετρικές απόδοσης είναι το 4ο.

4. Εφαρμογή καλύτερου μοντέλου

predict_model <- predict(model4)

-Το αλκοόλ και η πτυτική οξύτητα είναι οι πιο σημαντικές μεταβλητές, με βάση τη σημαντική αύξηση του R² όταν προστίθονται.

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

-Το πλήρες μοντέλο έχει το χαμηλότερο SSE αλλά και το υψηλότερο R² (0.361). Όμως το όφελος από τις επιπλέον μεταβλητές είναι μικρό σε σχέση με την πολυπλοκότητα που προσθέτουν.