White Wine Quality

Data Exploration

library(ggplot2)
library(GGally)
library(gridExtra)

## Loading required package: grid

ggplot(data=df, aes(x=fixed.acidity)) + geom_histogram(aes(fill=..count..), binwidth = 0.2)

Looks very normal, let’s add boxplot.

ggplot(data=df, aes(y=fixed.acidity, x = quality)) + geom_boxplot(aes(color=quality.factor))

There is no some significant difference between quality and fixed acidity. Remind that fixed acidity means value of the most acids involved with wine.

Move to next variable. It’s volatile acidity (the amount of acetic acid in wine).

ggplot(data=df, aes(x=volatile.acidity)) + geom_histogram(aes(fill=..count..), binwidth=0.02)

Look at relationship with quality.

ggplot(data=df, aes(y=volatile.acidity, x = quality)) + geom_boxplot(aes(fill=quality.factor))

There is no visible separation based on this plot. So I’m going to combine acidity variables with quality.

ggplot(data=subset(df, fixed.acidity < quantile(fixed.acidity, 0.95) & volatile.acidity < quantile(volatile.acidity, .95)), aes(y=fixed.acidity, x = volatile.acidity)) + geom_point(aes(color=quality.factor)) + scale_colour_brewer(type="seq", palette=3)

Unfortunately, no visual understandable separation using this two features. Go forward to next feature from white wine dataset.

g1 <- ggplot(data=df, aes(x=citric.acid)) + geom_histogram(aes(fill=..count..), binwidth=0.03)
g2 <- ggplot(data=df, aes(y=citric.acid, x = quality)) + geom_boxplot(aes(fill=quality.factor))
grid.arrange(g1,g2, ncol=1)

Plots above don’t show any clear patterns. But we can note that there are much more citric.acid outliers with quality equal 6. Look at residual.sugar variable. In histogram below we can observe unusual peaks with count near 600~800, but at the same time boxplots gives us no additional information about patterns.

g1 <- ggplot(data=df, aes(x=residual.sugar)) + geom_histogram(aes(fill=..count..), binwidth=0.5)
g2 <- ggplot(data=df, aes(y=residual.sugar, x = quality)) + geom_boxplot(aes(color=quality.factor))
grid.arrange(g1,g2, ncol=1)

Combining residual.sugar and citric.acid variables to determine some linear separation.

ggplot(data=subset(df, residual.sugar < quantile(residual.sugar, .95) & citric.acid < quantile(citric.acid, .95)), aes(y=residual.sugar, x = citric.acid)) + geom_point(aes(color=quality.factor)) + scale_colour_brewer(type="seq", palette=3)

No clearn patterns, but we can observe quite nice relationship between this variables with different modes(citric.acid - centered, residual.sugar near zero) and plot looks nice. Move to next variable - chlorides.

g1 <- ggplot(data=df, aes(x=chlorides)) + geom_histogram(aes(fill=..count..), binwidth=0.005)
g2 <- ggplot(data=df, aes(y=chlorides, x = quality)) + geom_boxplot(aes(color=quality.factor))
grid.arrange(g1,g2, ncol=1)

## Warning: position_stack requires constant width: output may be incorrect

More meaningful variable. Easily can see to many outliers in wine with quality 5 and 6. But medians is still near the same value for all wine quality.

Exploring together free silfur and total sulfur dioxides. From plots below there is no signifficant information for patterns discovery except few outliers for wine with quality 3.

g1 <- ggplot(data=df, aes(x=free.sulfur.dioxide)) + geom_histogram(aes(fill=..count..), binwidth=5)
g2 <- ggplot(data=df, aes(y=free.sulfur.dioxide, x = quality)) + geom_boxplot(aes(color=quality.factor))
g3 <- ggplot(data=df, aes(x=total.sulfur.dioxide)) + geom_histogram(aes(fill=..count..), binwidth=5)
g4 <- ggplot(data=df, aes(y=total.sulfur.dioxide, x = quality)) + geom_boxplot(aes(color=quality.factor))
grid.arrange(g1,g2,g3,g4, ncol=2)

ggplot(data=subset(df, free.sulfur.dioxide < quantile(free.sulfur.dioxide, .95) & total.sulfur.dioxide < quantile(total.sulfur.dioxide, .95)), aes(y=free.sulfur.dioxide, x = total.sulfur.dioxide)) + geom_jitter(alpha=1/5,aes(color=quality.factor)) + scale_colour_brewer(type="seq", palette=3)

Unfortunately no meaningful separation yet, but insteresting plot above is one of the examples of regression to the mean i think. Going to next variables density and Ph. Density is too simillar for all kinds of wines and hard to investigate due to some outliers, so i decided to use 0.95 quantile to filter data.

g1 <- ggplot(data=df, aes(x=exp(density))) + geom_histogram(aes(fill=..count..), binwidth=0.001) 
g2 <- ggplot(data=df, aes(y=exp(density), x = quality)) + geom_boxplot(aes(color=quality.factor))
g3 <- ggplot(data=df, aes(x=pH)) + geom_histogram(aes(fill=..count..), binwidth=0.02)
g4 <- ggplot(data=df, aes(y=pH, x = quality)) + geom_boxplot(aes(color=quality.factor))
grid.arrange(g1,g2,g3,g4, ncol=2)

## Warning: position_stack requires constant width: output may be incorrect

## Warning: position_stack requires constant width: output may be incorrect

We can see some interesting trends from this plots, like with less density -> quality higher. The same is for pH, but in median thinking. Combine this two features to look at this data.

ggplot(data=subset(df, density < quantile(density, .95) & pH < quantile(pH, .95)), aes(y=density, x = pH)) + geom_jitter(aes(color=quality.factor)) + scale_colour_brewer(type="seq", palette=3) + geom_abline(intercept = .992, slope = 0)

Look like under black line there is more chance that wine quality is high. In someway first result.

Okey. And the last two variables alcohol and sulphates.

g1 <- ggplot(data=df, aes(x=alcohol)) + geom_histogram(aes(fill=..count..), binwidth=0.1) 
g2 <- ggplot(data=df, aes(y=alcohol, x = quality)) + geom_boxplot(aes(color=quality.factor))
g3 <- ggplot(data=df, aes(x=sulphates)) + geom_histogram(aes(fill=..count..), binwidth=0.02)
g4 <- ggplot(data=df, aes(y=sulphates, x = quality)) + geom_boxplot(aes(color=quality.factor))
grid.arrange(g1,g2,g3,g4, ncol=2)

## Warning: position_stack requires constant width: output may be incorrect

In median thinking more alcohol in wine implies higher quality, based on this plots, unfortunately sulphates is not so separable for different wine qualities. Combining isn’t suitable due to low variability of sulphates variables.

Correlation exploration

Let’s look at correlations between all variables and numeric analogue of quality.

library(corrgram)

corrgram(df, type="data", lower.panel=panel.conf, 
         upper.panel=panel.shade, main= "Corrgram for wine quality dataset", order=T, cex.labels=1.4)

Notes:

1. Highest correlation for quality with alcohol 0.44. I’ve note this before during exploration.
2. Highest correaltion between residual sugar and density 0.84.
3. A lot of correlations are meaningless due to confidence interval.
4. Lowest correlation for quality with density -0.31.
5. Lowest correlation between alcohol and density -0.78 .

From corrgram we can conclude next important variables for quality prediction (decision is made using confidence intervals):

1. pH (0.1)
2. alcohol (0.44)
3. fixed.acidity (-0.11)
4. volatile.acidity (-0.19)
5. chlorides (-0.21)
6. density (-0.31)
7. residual.sugar (-0.10)
8. total.sulfur.dioxide (-0.17)

Multivariate plots for understanding patterns between features

ggplot(data=subset(df, density < 1.005), aes(x=alcohol, y = density, color = quality.factor)) + xlab("Alcohol") +
  ylab("Density") + ggtitle("Alcohol and density by quality") +
  stat_binhex()

We easily can see some patterns here. This patterns is small clusters where quality is the same. This plot is awesome, it shows quality, density, alcohol relationship. With low alcohol or high density it’s more usual to be low quality wine.

Next plot is about pH and chlorides. They both has high absolute correlation among others variables.

ggplot(data=subset(df, chlorides < 0.2), aes(x=pH, y = chlorides, color = quality.factor)) + xlab("pH") +
  ylab("Chlorides") + ggtitle("pH and Chlorides by quality") +
  stat_binhex()

We got more patterns. High chlorides means low quality. Based on this two plots we can easily predict whether wine is low or high quality, but this is not our case, so we move to prediction.

ggplot(data=subset(df,density < 1.005) , aes(x=alcohol, y=density, color=quality.factor)) + geom_point() + facet_wrap(~quality.factor) + geom_smooth(colour='black')

We can see some bound trends between this variables across different wine qualities.

ggplot(data=subset(df, chlorides < 0.2), aes(x=pH, y = chlorides, color = quality.factor)) + geom_point() + facet_wrap(~quality.factor) + geom_smooth(colour='black')

Unfortunately here we can observate some stability between this variables, trend is the same, no unusual things.

Let’s explore the highest correlation variable by quality.

ggplot(data=subset(df, density < 1.005), aes(x=density, y = residual.sugar, color = quality.factor)) + geom_point() + facet_wrap(~quality.factor) + geom_smooth(colour='black')

Investigate next relationship between alcohol and free.sulfur.dioxide by quality.

ggplot(aes(x=alcohol,y=chlorides, colour=quality.factor), data = df) +
  stat_smooth(method=loess, fullrange=TRUE, alpha = 0.1, size =1.5 )# +

This plot gives us more visual separation between low and high quality wine. High quality wine have the lowest chlorides and alcohol more than 10%. And the lowest quality wine have more chlorides and low alcohol.

Let’s make a scatter plot of chlorides versus alcohol by quality.

ggplot(aes(x=alcohol, y=chlorides, color = quality.factor), data = df) + geom_point() + 
  facet_wrap(~quality.factor) + geom_smooth(colour='black')

Very interesting peaks for quality 5 and 6.

Prediction white wine quality based on features.

I want to use naive bayes model as my main model.

library(caret)
library(klaR)
df_pred <- df
df_pred$quality <- NULL
ctrl <- trainControl(method = "repeatedcv",  repeats = 3)
fit <- train(quality.factor ~ ., data = df_pred, method = "nb", trControl = ctrl)
fit

## Naive Bayes 
## 
## 4898 samples
##   11 predictor
##    7 classes: '3', '4', '5', '6', '7', '8', '9' 
## 
## No pre-processing
## Resampling: Cross-Validated (10 fold, repeated 3 times) 
## 
## Summary of sample sizes: 4408, 4408, 4410, 4407, 4407, 4408, ... 
## 
## Resampling results across tuning parameters:
## 
##   usekernel  Accuracy   Kappa      Accuracy SD  Kappa SD  
##   FALSE      0.4430940  0.2172146  0.02194368   0.03204352
##    TRUE      0.4890338  0.2553144  0.02233617   0.03212159
## 
## Tuning parameter 'fL' was held constant at a value of 0
## Accuracy was used to select the optimal model using  the largest value.
## The final values used for the model were fL = 0 and usekernel = TRUE.

Not good not bad, but acceptable as for initial solution. Let’s visualize density estimation. Accuracy is the ratio of true classified divided by all true classified plus false classified wines. Train control is 10-fold cross validation repeated 3-times. For highest accuracy is used kernel estimation (not gaussian distributed parameters). Accuracy equal 0.4888546.

plot(fit$finalModel)

From densities we can easily observe that the main variable for wine quality separation is alcohol.

Final plots and Summary

ggplot(data=df, aes(y=alcohol, x = quality)) + geom_boxplot(aes(color=quality.factor)) + 
  xlab("Quality") + ylab("Alcohol") + ggtitle("Alcohol by quality")

ggplot(data=subset(df, density < quantile(density, .95) & pH < quantile(pH, .95)), aes(y=density, x = pH)) + geom_jitter(alpha=1/4, aes(color=quality.factor)) + scale_colour_brewer(type="seq", palette=3) + geom_abline(intercept = .992, slope = 0) + ylab("density") + xlab("pH") + ggtitle("Ph and density by quality Separation")

ggplot(aes(x=alcohol, y=chlorides, color = quality.factor), data = df) + geom_point() + 
  facet_wrap(~quality.factor) + geom_smooth(colour='black') + ylab("Chlorides") + xlab("Alcohol") +
  ggtitle("Chlorides vs Alcohol by Quality")

Reflection

The white wine quality data set contains information on almost 4898 wines, their chemical properties and wine quality from best experts (i believe). I’ve asked a question how we can predict wine quality using only information about chemical properties of this wine. Quality measures from 0 (worst) to 10 (best). I started by understanding the individual variables in the data set and their influence on wine quality. I’ve transformed quality from numeric to ordered factor. During exploration I’ve found some linear patterns how to separate low and high quality wines. The highest influence on wine quality is alcohol content in wine, it’s has the highest correlation and density separation. During correlation analysis I’ve found four important variables for this task are Alcohol, pH, density and chlorides. This variables I’ve included in simple naive bayes model for predicting wine quality. I’ve obtained 0.4888546 accuracy. It’s quite high, but for initial result is ok. From multivariate plots i can conclude, that there are non linear patterns in this data set. More better model for prediction is SVM, it’s gives high accuracy as described in this article http://www3.dsi.uminho.pt/pcortez/white.pdf.

List of Resources

1. Chunk Options. Url: http://yihui.name/knitr/options/#chunk_options.
2. Wine quality Prediction. Url: http://www3.dsi.uminho.pt/pcortez/white.pdf.