Wine Quality Predictor
Wine Quality Predictor
INTRODUCTION
Team Member : Shradhit Subudhi
Professor’s Name : Dr. Douglas Jones
Course Period : Fall - 2018 (September - December)
Date : “December 3, 2018”
Inspiration for Project
“In wine, there’s truth” - Pliny the Elder.
Question
Can we predict the quality of wine using data analysis techniques?
Wine Data Set - Info
The two datasets are related to red and white variants of the Portuguese “Vinho Verde” wine. Due to privacy and logistic issues, only physicochemical (inputs) and sensory (the output) variables are available (e.g. there is no data about grape types, wine brand, wine selling price, etc.).
These datasets can be viewed as classification or regression tasks. The classes are ordered and not balanced (e.g. there are much more normal wines than excellent or poor ones). Outlier detection algorithms could be used to detect the few excellent or poor wines. Also, we are not sure if all input variables are relevant. So it could be interesting to test feature selection methods.
We worked on predicting the white wine quality for this project. Worst wine is represented with 0 and the best wine is represented as 10.
Packages Installed
library("rmdformats")
library("corrgram")
library("MASS")
library("ggplot2")
library("naniar")
library("e1071")
library("lattice")##
## Attaching package: 'lattice'
## The following object is masked from 'package:corrgram':
##
## panel.fill
library("caret")
library("car")## Loading required package: carData
library("caTools")
library("corrplot")## corrplot 0.84 loaded
library("knitr")Inputting Data
Importing the data with the help of a url and assigning it to white.
white_url <- "https://archive.ics.uci.edu/ml/machine-learning-databases/wine-quality/winequality-white.csv"
whitewine <- read.csv(white_url, header = TRUE, sep = ";")
white <- whitewineData - First View
Viewing the loaded data.
str(white)## 'data.frame': 4898 obs. of 12 variables:
## $ fixed.acidity : num 7 6.3 8.1 7.2 7.2 8.1 6.2 7 6.3 8.1 ...
## $ volatile.acidity : num 0.27 0.3 0.28 0.23 0.23 0.28 0.32 0.27 0.3 0.22 ...
## $ citric.acid : num 0.36 0.34 0.4 0.32 0.32 0.4 0.16 0.36 0.34 0.43 ...
## $ residual.sugar : num 20.7 1.6 6.9 8.5 8.5 6.9 7 20.7 1.6 1.5 ...
## $ chlorides : num 0.045 0.049 0.05 0.058 0.058 0.05 0.045 0.045 0.049 0.044 ...
## $ free.sulfur.dioxide : num 45 14 30 47 47 30 30 45 14 28 ...
## $ total.sulfur.dioxide: num 170 132 97 186 186 97 136 170 132 129 ...
## $ density : num 1.001 0.994 0.995 0.996 0.996 ...
## $ pH : num 3 3.3 3.26 3.19 3.19 3.26 3.18 3 3.3 3.22 ...
## $ sulphates : num 0.45 0.49 0.44 0.4 0.4 0.44 0.47 0.45 0.49 0.45 ...
## $ alcohol : num 8.8 9.5 10.1 9.9 9.9 10.1 9.6 8.8 9.5 11 ...
## $ quality : int 6 6 6 6 6 6 6 6 6 6 ...
Looking at the output we get to know that we have 4898 samples and 12 variables.
The response variable is quality.
The eleven predictor variables are of the numeric class and the response variable, quality, is of the integer class.
We don’t see any categorical variable in the dataset.
Columns
We then check the names of the variables present in the data.
colnames(white)## [1] "fixed.acidity" "volatile.acidity" "citric.acid"
## [4] "residual.sugar" "chlorides" "free.sulfur.dioxide"
## [7] "total.sulfur.dioxide" "density" "pH"
## [10] "sulphates" "alcohol" "quality"
Look at the summary to better understand the dataset.
summary(white)## fixed.acidity volatile.acidity citric.acid residual.sugar
## Min. : 3.800 Min. :0.0800 Min. :0.0000 Min. : 0.600
## 1st Qu.: 6.300 1st Qu.:0.2100 1st Qu.:0.2700 1st Qu.: 1.700
## Median : 6.800 Median :0.2600 Median :0.3200 Median : 5.200
## Mean : 6.855 Mean :0.2782 Mean :0.3342 Mean : 6.391
## 3rd Qu.: 7.300 3rd Qu.:0.3200 3rd Qu.:0.3900 3rd Qu.: 9.900
## Max. :14.200 Max. :1.1000 Max. :1.6600 Max. :65.800
## chlorides free.sulfur.dioxide total.sulfur.dioxide
## Min. :0.00900 Min. : 2.00 Min. : 9.0
## 1st Qu.:0.03600 1st Qu.: 23.00 1st Qu.:108.0
## Median :0.04300 Median : 34.00 Median :134.0
## Mean :0.04577 Mean : 35.31 Mean :138.4
## 3rd Qu.:0.05000 3rd Qu.: 46.00 3rd Qu.:167.0
## Max. :0.34600 Max. :289.00 Max. :440.0
## density pH sulphates alcohol
## Min. :0.9871 Min. :2.720 Min. :0.2200 Min. : 8.00
## 1st Qu.:0.9917 1st Qu.:3.090 1st Qu.:0.4100 1st Qu.: 9.50
## Median :0.9937 Median :3.180 Median :0.4700 Median :10.40
## Mean :0.9940 Mean :3.188 Mean :0.4898 Mean :10.51
## 3rd Qu.:0.9961 3rd Qu.:3.280 3rd Qu.:0.5500 3rd Qu.:11.40
## Max. :1.0390 Max. :3.820 Max. :1.0800 Max. :14.20
## quality
## Min. :3.000
## 1st Qu.:5.000
## Median :6.000
## Mean :5.878
## 3rd Qu.:6.000
## Max. :9.000
Removing the Duplicate Rows
#white <- unique(white)
white <- white[!duplicated(white), ]
dim(white)## [1] 3961 12
The rows got reduced to 3961 after removing the duplicates.
Checking for NA
Graphically
Checking if there are any missing (NA) values.
vis_miss(white)100% values of all columns are present.
Technically
sum(is.na(white))## [1] 0
There is no NA values in the data set.
Response Count
table(white$quality)##
## 3 4 5 6 7 8 9
## 20 153 1175 1788 689 131 5
We can see that the class is skewed i.e. it has imbalance.
There are 3961 samples but only 20 points are from 3rd class and only 5 points are from the 9th class.
Wines with lowest and highest quality are rare. Generally, wines have quality 5 and 6 which is in the medium range(not low, not high).
#rounds the values in its first argument to the specified number of decimal places (default 0).
round(cor(white, method = "pearson"), 2)## fixed.acidity volatile.acidity citric.acid
## fixed.acidity 1.00 -0.02 0.30
## volatile.acidity -0.02 1.00 -0.16
## citric.acid 0.30 -0.16 1.00
## residual.sugar 0.08 0.10 0.11
## chlorides 0.02 0.09 0.13
## free.sulfur.dioxide -0.06 -0.10 0.09
## total.sulfur.dioxide 0.08 0.10 0.12
## density 0.27 0.06 0.16
## pH -0.43 -0.05 -0.18
## sulphates -0.02 -0.02 0.05
## alcohol -0.11 0.05 -0.08
## quality -0.12 -0.19 0.01
## residual.sugar chlorides free.sulfur.dioxide
## fixed.acidity 0.08 0.02 -0.06
## volatile.acidity 0.10 0.09 -0.10
## citric.acid 0.11 0.13 0.09
## residual.sugar 1.00 0.08 0.31
## chlorides 0.08 1.00 0.10
## free.sulfur.dioxide 0.31 0.10 1.00
## total.sulfur.dioxide 0.41 0.19 0.62
## density 0.82 0.25 0.29
## pH -0.17 -0.09 -0.01
## sulphates -0.02 0.02 0.04
## alcohol -0.40 -0.36 -0.25
## quality -0.12 -0.22 0.01
## total.sulfur.dioxide density pH sulphates alcohol
## fixed.acidity 0.08 0.27 -0.43 -0.02 -0.11
## volatile.acidity 0.10 0.06 -0.05 -0.02 0.05
## citric.acid 0.12 0.16 -0.18 0.05 -0.08
## residual.sugar 0.41 0.82 -0.17 -0.02 -0.40
## chlorides 0.19 0.25 -0.09 0.02 -0.36
## free.sulfur.dioxide 0.62 0.29 -0.01 0.04 -0.25
## total.sulfur.dioxide 1.00 0.54 0.01 0.14 -0.45
## density 0.54 1.00 -0.06 0.08 -0.76
## pH 0.01 -0.06 1.00 0.14 0.09
## sulphates 0.14 0.08 0.14 1.00 -0.02
## alcohol -0.45 -0.76 0.09 -0.02 1.00
## quality -0.18 -0.34 0.12 0.05 0.46
## quality
## fixed.acidity -0.12
## volatile.acidity -0.19
## citric.acid 0.01
## residual.sugar -0.12
## chlorides -0.22
## free.sulfur.dioxide 0.01
## total.sulfur.dioxide -0.18
## density -0.34
## pH 0.12
## sulphates 0.05
## alcohol 0.46
## quality 1.00
Correlation Matrix
We now check the correlation matrix, confidence interval with the help of corrplot package.It also helps us to do matrix reordering.
corrplot(cor(white))corrgram(white, type="data", lower.panel=panel.conf,
upper.panel=panel.shade, main= "Corrgram for wine quality dataset", order=T, cex.labels=1.2)Sugar,pH and citric acid factors are not playing a really big role in the quality of wine.
alcohol is kind of strongly correlated to the quality of wine.
Histogram
Plotting the histograms using hist() for the data.
attach(white)
par(mfrow=c(2,2), oma = c(1,1,0,0) + 0.1, mar = c(3,3,1,1) + 0.1)
barplot((table(quality)), col=c("slateblue4", "slategray", "slategray1", "slategray2", "slategray3", "skyblue4"))
mtext("Quality", side=1, outer=F, line=2, cex=0.8)
truehist(fixed.acidity, h = 0.5, col="slategray3")
mtext("Fixed Acidity", side=1, outer=F, line=2, cex=0.8)
truehist(volatile.acidity, h = 0.05, col="slategray3")
mtext("Volatile Acidity", side=1, outer=F, line=2, cex=0.8)
truehist(citric.acid, h = 0.1, col="slategray3")
mtext("Citric Acid", side=1, outer=F, line=2, cex=0.8)par(mfrow=c(2,2), oma = c(1,1,0,0) + 0.1, mar = c(3,3,1,1) + 0.1)
truehist(residual.sugar, h = 5, col="slategray3")
mtext("Residual Sugar", side=1, outer=F, line=2, cex=0.8)
truehist(chlorides, h = 0.01, col="slategray3")
mtext("Chloride", side=1, outer=F, line=2, cex=0.8)
truehist(alcohol, h = 0.5, col="slategray3")
mtext("Alcohol", side=1, outer=F, line=2, cex=0.8)
truehist(density, h = 0.005, col="slategray3")
mtext("Density", side=1, outer=F, line=2, cex=0.8)par(mfrow=c(2,2), oma = c(1,1,0,0) + 0.1, mar = c(3,3,1,1) + 0.1)
truehist(free.sulfur.dioxide, h = 10, col="slategray3")
mtext("Free Sulfur Dioxide", side=1, outer=F, line=2, cex=0.8)
truehist(pH, h = 0.1, col="slategray3")
mtext("pH values", side=1, outer=F, line=2, cex=0.8)
truehist(sulphates, h = 0.1, col="slategray3")
mtext("sulphates", side=1, outer=F, line=2, cex=0.8)
truehist(total.sulfur.dioxide, h = 20, col="slategray3")
mtext("total.sulfur.dioxide", side=1, outer=F, line=2, cex=0.8)Boxplot
Y ^(lambda) where Y would be the values in the dataset and lambda would be the exponent (ranges from -5 to 5).
Examples
If lambda = 2, all the values would be squared.
If lambda = 0.5, the square root of the values would be taken.
If lambda = 0, the log of the values would be taken.
Plotting the boxplots using boxplot() for the data.
par(mfrow=c(1,5), oma = c(1,1,0,0) + 0.1, mar = c(3,3,1,1) + 0.1)
boxplot(fixed.acidity, col="slategray2", pch=19)
mtext("Fixed Acidity", cex=0.8, side=1, line=2)
boxplot(volatile.acidity, col="slategray2", pch=19)
mtext("Volatile Acidity", cex=0.8, side=1, line=2)
boxplot(citric.acid, col="slategray2", pch=19)
mtext("Citric Acid", cex=0.8, side=1, line=2)
boxplot(residual.sugar, col="slategray2", pch=19)
mtext("Residual Sugar", cex=0.8, side=1, line=2)
boxplot(chlorides, col="slategray2", pch=19)
mtext("Chlorides", cex=0.8, side=1, line=2)par(mfrow=c(1,6), oma = c(1,1,0,0) + 0.1, mar = c(3,3,1,1) + 0.1)
boxplot(alcohol, col="slategray2", pch=19)
mtext("Alcohol", cex=0.8, side=1, line=2)
boxplot(density, col="slategray2", pch=19)
mtext("density", cex=0.8, side=1, line=2)
boxplot(free.sulfur.dioxide, col="slategray2", pch=19)
mtext("free.sulfur.dioxide", cex=0.8, side=1, line=2)
boxplot( pH, col="slategray2", pch=19)
mtext("pH", cex=0.8, side=1, line=2)
boxplot(sulphates, col="slategray2", pch=19)
mtext("sulphates", cex=0.8, side=1, line=2)
boxplot(total.sulfur.dioxide, col="slategray2", pch=19)
mtext("total.sulfur.dioxide", cex=0.8, side=1, line=2)detach(white)Observations regarding variables: All variables have outliers.
Quality has most values concentrated in the categories 5, 6 and 7. Only a small proportion is in the categories [3, 4] and [8, 9] and none in the categories [1, 2, 10].
Fixed acidity, volatile acidity and citric acid have outliers. If those outliers are eliminated then distribution of the variables may be considered to be symmetric.
Residual sugar has a positively skewed distribution; even after eliminating the outliers, distribution will remain skewed.
Some of the variables, e.g . free sulphur dioxide and density, have a few outliers but these are very different from the rest.Mostly outliers are on the larger side.
Alcohol has an irregular shaped distribution but it does not have pronounced outliers.
Skewness
Checking the skewness of the individual variables of the data to check whether the data is normally distributed or not.
attach(white)
skewness(quality)## [1] 0.1119192
skewness(chlorides)## [1] 4.965313
skewness(free.sulfur.dioxide)## [1] 1.565494
skewness(residual.sugar)## [1] 1.332629
skewness(alcohol)## [1] 0.4503553
skewness(citric.acid)## [1] 1.309609
skewness(density)## [1] 1.272354
skewness(fixed.acidity)## [1] 0.6955731
skewness(volatile.acidity)## [1] 1.639838
skewness(total.sulfur.dioxide)## [1] 0.4564538
skewness(sulphates)## [1] 0.9371431
skewness(pH)## [1] 0.4551119
colnames(white)## [1] "fixed.acidity" "volatile.acidity" "citric.acid"
## [4] "residual.sugar" "chlorides" "free.sulfur.dioxide"
## [7] "total.sulfur.dioxide" "density" "pH"
## [10] "sulphates" "alcohol" "quality"
detach(white)Skewness Rule of Thumb
If skewness is 0, the data are perfectly symmetrical.
As a general rule of thumb: If skewness is less than -1 or greater than 1, the distribution is highly skewed.
If skewness is between -0.5 and 0.5, the distribution is approximately symmetric.
Data Transformation / Preparation
Box Cox Transformation
We use the Boxcox transformation and transform the data and then again check the skewness.
preprocess_white <- preProcess(white[,1:11], c("BoxCox", "center", "scale"))
new_white <- data.frame(trans = predict(preprocess_white, white))
colnames(new_white)## [1] "trans.fixed.acidity" "trans.volatile.acidity"
## [3] "trans.citric.acid" "trans.residual.sugar"
## [5] "trans.chlorides" "trans.free.sulfur.dioxide"
## [7] "trans.total.sulfur.dioxide" "trans.density"
## [9] "trans.pH" "trans.sulphates"
## [11] "trans.alcohol" "trans.quality"
Skewness - Transformed Data
skewness(new_white$trans.quality)## [1] 0.1119192
skewness(new_white$trans.chlorides)## [1] -0.1496158
skewness(new_white$trans.free.sulfur.dioxide)## [1] 0.0950346
skewness(new_white$trans.residual.sugar)## [1] -0.05826498
skewness(new_white$trans.alcohol)## [1] 0.03929004
skewness(new_white$trans.citric.acid)## [1] 1.309609
skewness(new_white$trans.density)## [1] 1.099659
skewness(new_white$trans.fixed.acidity)## [1] 0.1131388
skewness(new_white$trans.volatile.acidity)## [1] 0.171864
skewness(new_white$trans.total.sulfur.dioxide)## [1] 0.008931003
skewness(new_white$trans.sulphates)## [1] -0.01873289
skewness(new_white$trans.pH)## [1] 0.0002881265
Removal of Outliers
Most parametric statistics, like means, standard deviations, and correlations, and every statistic based on these, are highly sensitive to outliers.The assumptions of common statistical procedures, like linear regression and ANOVA, are also based on these statistics, outliers can disrupt the analysis. Thus, we remove the outliers.
Possibly, the most important step in data preparation is to identify outliers. Since this is a multivariate data, we consider only those points which do not have any predictor variable value to be outside of limits constructed by boxplots. The following rule is applied:
A predictor value is considered to be an outlier only if it is greater than SD - 3. The rationale behind this rule is that the extreme outliers are all on the higher end of the values and the distributions are all positively skewed.
new_white <- new_white[!abs(new_white$trans.fixed.acidity) > 3,]
new_white <- new_white[!abs(new_white$trans.volatile.acidity) > 3,]
new_white <- new_white[!abs(new_white$trans.citric.acid) > 3,]
new_white <- new_white[!abs(new_white$trans.residual.sugar) > 3,]
new_white <- new_white[!abs(new_white$trans.chlorides) > 3,]
new_white <- new_white[!abs(new_white$trans.density) > 3,]
new_white <- new_white[!abs(new_white$trans.pH) > 3,]
new_white <- new_white[!abs(new_white$trans.sulphates) > 3,]
new_white <- new_white[!abs(new_white$trans.alcohol) > 3,]We now check the correlation matrix, confidence interval with the help of corrplot package.It also helps us to do matrix reordering.
corrplot(cor(new_white), type = "lower")corrgram(new_white, type="data", lower.panel=panel.conf,
upper.panel=panel.shade, main= "Corrgram for wine quality dataset", order=T, cex.labels=1.1)Linear Model
Assumption for linear model
Linear regression is an analysis that assesses whether one or more predictor variables explain the dependent (criterion) variable. The regression has five key assumptions:
Linear relationship
Multivariate normality
No or little multicollinearity
No auto-correlation
Homoscedasticity
Train - Test Set
set.seed(100)
trainingRowIndex <- sample(1:nrow(new_white), 0.8*nrow(new_white))
whitetrain <- new_white[trainingRowIndex, ]
whitetest <- new_white[-trainingRowIndex, ] Model Selection
Base Model - Trying to choose the best linear model..
linear_0 <- lm(trans.quality ~ . , whitetrain) # taking all the points.
summary(linear_0)##
## Call:
## lm(formula = trans.quality ~ ., data = whitetrain)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.7154 -0.4737 -0.0370 0.4768 3.0699
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.86221 0.01377 425.612 < 2e-16 ***
## trans.fixed.acidity 0.06476 0.02128 3.044 0.002356 **
## trans.volatile.acidity -0.16696 0.01530 -10.909 < 2e-16 ***
## trans.citric.acid 0.06819 0.01749 3.898 9.91e-05 ***
## trans.residual.sugar 0.35957 0.03351 10.729 < 2e-16 ***
## trans.chlorides -0.06810 0.01921 -3.545 0.000398 ***
## trans.free.sulfur.dioxide 0.12545 0.01886 6.652 3.43e-11 ***
## trans.total.sulfur.dioxide -0.05308 0.02141 -2.480 0.013199 *
## trans.density -0.47660 0.05724 -8.327 < 2e-16 ***
## trans.pH 0.13383 0.01873 7.144 1.13e-12 ***
## trans.sulphates 0.07597 0.01463 5.192 2.22e-07 ***
## trans.alcohol 0.15887 0.03593 4.422 1.01e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.751 on 2988 degrees of freedom
## Multiple R-squared: 0.308, Adjusted R-squared: 0.3055
## F-statistic: 120.9 on 11 and 2988 DF, p-value: < 2.2e-16
Checking Multicollinarilty
In multicollinearity,collinearity exists between three or more variables even if no pair of variables has a particularly high correlation. This means that there is redundancy between predictor variables.
In the presence of multicollinearity, the solution of the regression model becomes unstable.
Multicollinearity can assessed by computing a score called the variance inflation factor (or VIF), which measures how much the variance of a regression coefficient is inflated due to multicollinearity in the model.
The VIF of a predictor is a measure for how easily it is predicted from a linear regression using the other predictors.
# Variance inflation factor
vif(linear_0)## trans.fixed.acidity trans.volatile.acidity
## 2.230946 1.162012
## trans.citric.acid trans.residual.sugar
## 1.172273 5.903351
## trans.chlorides trans.free.sulfur.dioxide
## 1.452565 1.898081
## trans.total.sulfur.dioxide trans.density
## 2.415348 16.176165
## trans.pH trans.sulphates
## 1.710817 1.124369
## trans.alcohol
## 6.687425
We can see multicollinarity over here. We remove trans.density cause it exibits multicollinarity.
Now fitting the new model.
linear_1 <- lm(trans.quality ~ . -trans.density , whitetrain)
summary(linear_1)##
## Call:
## lm(formula = trans.quality ~ . - trans.density, data = whitetrain)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.6568 -0.4768 -0.0324 0.4722 3.0679
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.86572 0.01392 421.278 < 2e-16 ***
## trans.fixed.acidity -0.04727 0.01667 -2.835 0.004607 **
## trans.volatile.acidity -0.15950 0.01545 -10.322 < 2e-16 ***
## trans.citric.acid 0.05733 0.01764 3.250 0.001167 **
## trans.residual.sugar 0.11454 0.01622 7.062 2.03e-12 ***
## trans.chlorides -0.08891 0.01926 -4.616 4.08e-06 ***
## trans.free.sulfur.dioxide 0.13794 0.01901 7.255 5.11e-13 ***
## trans.total.sulfur.dioxide -0.07259 0.02152 -3.373 0.000752 ***
## trans.pH 0.05698 0.01649 3.456 0.000556 ***
## trans.sulphates 0.05205 0.01451 3.587 0.000340 ***
## trans.alcohol 0.41616 0.01853 22.455 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7596 on 2989 degrees of freedom
## Multiple R-squared: 0.292, Adjusted R-squared: 0.2896
## F-statistic: 123.3 on 10 and 2989 DF, p-value: < 2.2e-16
vif(linear_1)## trans.fixed.acidity trans.volatile.acidity
## 1.338853 1.158030
## trans.citric.acid trans.residual.sugar
## 1.165763 1.351630
## trans.chlorides trans.free.sulfur.dioxide
## 1.427982 1.886078
## trans.total.sulfur.dioxide trans.pH
## 2.386416 1.295562
## trans.sulphates trans.alcohol
## 1.081025 1.739920
We fit another model.
linear_2 <- lm(trans.quality ~ . -trans.density - trans.fixed.acidity, whitetrain)
summary(linear_2)##
## Call:
## lm(formula = trans.quality ~ . - trans.density - trans.fixed.acidity,
## data = whitetrain)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.6697 -0.4717 -0.0311 0.4764 2.9648
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.86541 0.01394 420.774 < 2e-16 ***
## trans.volatile.acidity -0.15724 0.01545 -10.178 < 2e-16 ***
## trans.citric.acid 0.04561 0.01717 2.657 0.007937 **
## trans.residual.sugar 0.11487 0.01624 7.075 1.86e-12 ***
## trans.chlorides -0.09141 0.01926 -4.745 2.18e-06 ***
## trans.free.sulfur.dioxide 0.14654 0.01879 7.797 8.66e-15 ***
## trans.total.sulfur.dioxide -0.08141 0.02132 -3.819 0.000137 ***
## trans.pH 0.07510 0.01522 4.935 8.45e-07 ***
## trans.sulphates 0.05175 0.01453 3.562 0.000373 ***
## trans.alcohol 0.41542 0.01855 22.391 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7605 on 2990 degrees of freedom
## Multiple R-squared: 0.2901, Adjusted R-squared: 0.2879
## F-statistic: 135.7 on 9 and 2990 DF, p-value: < 2.2e-16
We fit another model removing trans.citric.acid.
linear_4 <- lm(trans.quality ~ . -trans.density - trans.fixed.acidity - trans.citric.acid, whitetrain)
summary(linear_4)##
## Call:
## lm(formula = trans.quality ~ . - trans.density - trans.fixed.acidity -
## trans.citric.acid, data = whitetrain)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.7122 -0.4640 -0.0368 0.4873 3.0119
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.86240 0.01391 421.531 < 2e-16 ***
## trans.volatile.acidity -0.16539 0.01516 -10.911 < 2e-16 ***
## trans.residual.sugar 0.11679 0.01624 7.193 7.99e-13 ***
## trans.chlorides -0.09122 0.01928 -4.731 2.34e-06 ***
## trans.free.sulfur.dioxide 0.14497 0.01880 7.710 1.70e-14 ***
## trans.total.sulfur.dioxide -0.07492 0.02120 -3.534 0.000415 ***
## trans.pH 0.06711 0.01493 4.494 7.25e-06 ***
## trans.sulphates 0.05462 0.01450 3.767 0.000169 ***
## trans.alcohol 0.41760 0.01855 22.508 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.7612 on 2991 degrees of freedom
## Multiple R-squared: 0.2884, Adjusted R-squared: 0.2865
## F-statistic: 151.5 on 8 and 2991 DF, p-value: < 2.2e-16
Trying to figure out the important predictor values
corrplot(cor(new_white), type = "lower")vif(linear_4)## trans.volatile.acidity trans.residual.sugar
## 1.109472 1.348887
## trans.chlorides trans.free.sulfur.dioxide
## 1.424964 1.836333
## trans.total.sulfur.dioxide trans.pH
## 2.305832 1.058009
## trans.sulphates trans.alcohol
## 1.074973 1.736160
ANOVA
Analysis of variance (ANOVA) is a collection of statistical models and their associated estimation procedures used to analyze the differences among group means in a sample. ANOVA provides a statistical test of whether the population means of several groups are equal, and therefore generalizes the t-test to more than two groups. It is useful for comparing (testing) three or more group means for statistical significance.
par(mfrow=c(2,2), oma = c(1,1,0,0) + 0.1, mar = c(3,3,1,1) + 0.1)
plot(linear_4)F - Test
Null Hypothesis - Ho : B1 = B2 = B3 = B4 = 0 Alternate Hypothesis - Ho : B1 or B2 ….B11 != 0 (Bj where j ranges from 1 to 11)
F- Statistic - p value <= 2.2e -16
We can see that p value is less than 0.05. Thus we can reject the null hypothesis and accept the alternate hypothesis. Thus,we can say that the model is significant.
Stepwise
steplinear <- step(linear_0)## Start: AIC=-1705.85
## trans.quality ~ trans.fixed.acidity + trans.volatile.acidity +
## trans.citric.acid + trans.residual.sugar + trans.chlorides +
## trans.free.sulfur.dioxide + trans.total.sulfur.dioxide +
## trans.density + trans.pH + trans.sulphates + trans.alcohol
##
## Df Sum of Sq RSS AIC
## <none> 1685.4 -1705.8
## - trans.total.sulfur.dioxide 1 3.469 1688.9 -1701.7
## - trans.fixed.acidity 1 5.226 1690.6 -1698.6
## - trans.chlorides 1 7.090 1692.5 -1695.3
## - trans.citric.acid 1 8.571 1694.0 -1692.6
## - trans.alcohol 1 11.030 1696.4 -1688.3
## - trans.sulphates 1 15.206 1700.6 -1680.9
## - trans.free.sulfur.dioxide 1 24.957 1710.3 -1663.8
## - trans.pH 1 28.788 1714.2 -1657.0
## - trans.density 1 39.107 1724.5 -1639.0
## - trans.residual.sugar 1 64.932 1750.3 -1594.4
## - trans.volatile.acidity 1 67.124 1752.5 -1590.7
summary(steplinear)##
## Call:
## lm(formula = trans.quality ~ trans.fixed.acidity + trans.volatile.acidity +
## trans.citric.acid + trans.residual.sugar + trans.chlorides +
## trans.free.sulfur.dioxide + trans.total.sulfur.dioxide +
## trans.density + trans.pH + trans.sulphates + trans.alcohol,
## data = whitetrain)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.7154 -0.4737 -0.0370 0.4768 3.0699
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 5.86221 0.01377 425.612 < 2e-16 ***
## trans.fixed.acidity 0.06476 0.02128 3.044 0.002356 **
## trans.volatile.acidity -0.16696 0.01530 -10.909 < 2e-16 ***
## trans.citric.acid 0.06819 0.01749 3.898 9.91e-05 ***
## trans.residual.sugar 0.35957 0.03351 10.729 < 2e-16 ***
## trans.chlorides -0.06810 0.01921 -3.545 0.000398 ***
## trans.free.sulfur.dioxide 0.12545 0.01886 6.652 3.43e-11 ***
## trans.total.sulfur.dioxide -0.05308 0.02141 -2.480 0.013199 *
## trans.density -0.47660 0.05724 -8.327 < 2e-16 ***
## trans.pH 0.13383 0.01873 7.144 1.13e-12 ***
## trans.sulphates 0.07597 0.01463 5.192 2.22e-07 ***
## trans.alcohol 0.15887 0.03593 4.422 1.01e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.751 on 2988 degrees of freedom
## Multiple R-squared: 0.308, Adjusted R-squared: 0.3055
## F-statistic: 120.9 on 11 and 2988 DF, p-value: < 2.2e-16
ANOVA
Analysis of variance (ANOVA) is a collection of statistical models and their associated estimation procedures used to analyze the differences among group means in a sample. ANOVA provides a statistical test of whether the population means of several groups are equal, and therefore generalizes the t-test to more than two groups. It is useful for comparing (testing) three or more group means for statistical significance.
anova(linear_4,steplinear)## Analysis of Variance Table
##
## Model 1: trans.quality ~ (trans.fixed.acidity + trans.volatile.acidity +
## trans.citric.acid + trans.residual.sugar + trans.chlorides +
## trans.free.sulfur.dioxide + trans.total.sulfur.dioxide +
## trans.density + trans.pH + trans.sulphates + trans.alcohol) -
## trans.density - trans.fixed.acidity - trans.citric.acid
## Model 2: trans.quality ~ trans.fixed.acidity + trans.volatile.acidity +
## trans.citric.acid + trans.residual.sugar + trans.chlorides +
## trans.free.sulfur.dioxide + trans.total.sulfur.dioxide +
## trans.density + trans.pH + trans.sulphates + trans.alcohol
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 2991 1733.2
## 2 2988 1685.4 3 47.827 28.264 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Used the stepwise model because it has lower RSS and ANOVA tells that it’s significant.
par(mfrow=c(2,2), oma = c(1,1,0,0) + 0.1, mar = c(3,3,1,1) + 0.1)
plot(steplinear)Residuals vs Fitted plot shows if residuals have non-linear patterns.Residuals around a horizontal line without distinct patterns, that is a good indication we don’t have non-linear relationships.
Normal QQ plot shows residuals fitting the line. Hence, can call it norlly distibuted residuals.
Scale-Location plot shows if residuals are spread equally along the ranges of predictors. This is how you can check the assumption of equal variance (homoscedasticity). It’s good if you see a horizontal line with equally (randomly) spread points.
Residuals vs Leverage plot has a typical look when there is some influential case. You can barely see Cook’s distance lines (a red dashed line) because all cases are well inside of the Cook’s distance.
Predicting - Trained Set
Predict is a generic function for predictions from the results of various model fitting functions. The function invokes particular methods which depend on the class of the first argument.
distPred <- predict(steplinear, whitetrain)
head(distPred)## 1426 1180 2658 259 2246 2323
## 5.880671 5.626071 6.517168 6.331008 5.915127 5.247180
Converting the Number to a Whole Number
We use the ceiling operation for rounding the numeric values towards near integer values.
distPred1 <- ceiling(distPred)
head(distPred1)## 1426 1180 2658 259 2246 2323
## 6 6 7 7 6 6
Training Data Confusion Matrix
Table function performs categorical tabulation of data with the variable and its frequency. table() function is also helpful in creating Frequency tables with condition and cross tabulations.
trn_tab <- table(predicted = distPred1, actual = whitetrain$trans.quality)
trn_tab## actual
## predicted 3 4 5 6 7 8 9
## 5 2 20 71 20 1 0 0
## 6 7 85 718 700 114 16 1
## 7 4 8 106 601 421 92 3
## 8 0 0 0 2 5 3 0
Accuracy for the Linear Model
We check the accuracy of the linear model.
sum(diag(trn_tab))/length(whitetest$trans.quality)## [1] 0.26
Accuracy Prediction over train set Linear Model is 26%.
Testing or Validating the Model
distPred <- predict(steplinear, whitetest)
head(distPred)## 1 4 13 25 28 30
## 4.900123 5.784360 6.037997 5.133616 5.952417 6.431214
Round the numeric values to the nearest integer values.
distPred1 <- ceiling(distPred)
head(distPred1)## 1 4 13 25 28 30
## 5 6 7 6 6 7
tst_tab <- table(predicted = distPred1, actual = whitetest$trans.quality)
tst_tab## actual
## predicted 3 4 5 6 7 8
## 5 1 6 17 6 1 0
## 6 1 20 166 204 20 1
## 7 1 2 25 162 103 12
## 8 0 0 0 0 2 0
Accuracy - Test Data
Checking the accuracy of the test data.
sum(diag(tst_tab))/length(whitetest$trans.quality)## [1] 0.06133333
Accuracy Prediction over test set Linear Model is 6.13%.
Ordinal Logistic Regression Model
Assumptions for Logistic Regression
First, binary logistic regression requires the dependent variable to be binary and ordinal logistic regression requires the dependent variable to be ordinal.
Second, logistic regression requires the observations to be independent of each other. In other words, the observations should not come from repeated measurements or matched data.
Third, logistic regression requires there to be little or no multicollinearity among the independent variables. This means that the independent variables should not be too highly correlated with each other.
Fourth, logistic regression assumes linearity of independent variables and log odds. although this analysis does not require the dependent and independent variables to be related linearly, it requires that the independent variables are linearly related to the log odds. (Did Not check for this! To improve model. We can try this in future.)
Finally, logistic regression typically requires a large sample size.
Ordinal logistic regression can be used to model a ordered factor response.
We use as.factor() to covert the variables into factors, that is, categorical variables.
#using the orignal and making changes specifically required for Logistic Regession.
white$quality2 <- as.factor(white$quality)Train - Test Set
set.seed(3000)
spl = sample.split(white$quality2, SplitRatio = 0.7)
whitetrain = subset(white, spl==TRUE)
whitetest = subset(white, spl==FALSE)
head(whitetrain)## fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
## 2 6.3 0.30 0.34 1.60 0.049
## 7 6.2 0.32 0.16 7.00 0.045
## 10 8.1 0.22 0.43 1.50 0.044
## 11 8.1 0.27 0.41 1.45 0.033
## 12 8.6 0.23 0.40 4.20 0.035
## 13 7.9 0.18 0.37 1.20 0.040
## free.sulfur.dioxide total.sulfur.dioxide density pH sulphates alcohol
## 2 14 132 0.9940 3.30 0.49 9.5
## 7 30 136 0.9949 3.18 0.47 9.6
## 10 28 129 0.9938 3.22 0.45 11.0
## 11 11 63 0.9908 2.99 0.56 12.0
## 12 17 109 0.9947 3.14 0.53 9.7
## 13 16 75 0.9920 3.18 0.63 10.8
## quality quality2
## 2 6 6
## 7 6 6
## 10 6 6
## 11 5 5
## 12 5 5
## 13 5 5
Fitting Model
polr() is the fuction used to fit the ordinal logistic regression model.
require(MASS)
require(reshape2)## Loading required package: reshape2
# Hess=TRUE to let the model output show the observed information matrix from optimization which is used to get standard errors.
o_lrm <- polr(quality2 ~ . - quality, data = whitetrain, Hess=TRUE)# should not use vif to check for multicollinarilty in case of categorical veriable.
vif(o_lrm)## Warning in vif.default(o_lrm): No intercept: vifs may not be sensible.
## fixed.acidity volatile.acidity citric.acid
## 9.437704e+08 3.828385e+08 6.424758e+05
## residual.sugar chlorides free.sulfur.dioxide
## 1.845434e+12 1.457669e+00 6.425308e+00
## total.sulfur.dioxide density pH
## 2.228460e+16 4.943074e+10 1.096931e+10
## sulphates alcohol
## 1.373230e+08 2.243821e+16
summary(o_lrm)## Call:
## polr(formula = quality2 ~ . - quality, data = whitetrain, Hess = TRUE)
##
## Coefficients:
## Value Std. Error t value
## fixed.acidity 0.19109 0.049513 3.859
## volatile.acidity -4.16006 0.396986 -10.479
## citric.acid 0.47473 0.315331 1.506
## residual.sugar 0.18950 0.009254 20.477
## chlorides -1.02123 1.618406 -0.631
## free.sulfur.dioxide 0.01804 0.002996 6.022
## total.sulfur.dioxide -0.00179 0.001256 -1.425
## density -405.55303 0.611027 -663.724
## pH 2.37597 0.279420 8.503
## sulphates 1.83492 0.325575 5.636
## alcohol 0.51080 0.042104 12.132
##
## Intercepts:
## Value Std. Error t value
## 3|4 -393.5020 0.6212 -633.4946
## 4|5 -391.1957 0.6196 -631.3735
## 5|6 -388.2891 0.6262 -620.0709
## 6|7 -385.6073 0.6410 -601.5335
## 7|8 -383.3112 0.6550 -585.2349
## 8|9 -380.0386 0.8192 -463.9258
##
## Residual Deviance: 6145.137
## AIC: 6179.137
Smaller the AIC better is the model. So let’s try step wise logistic regression.
Stepwise
o_lr = step(o_lrm)## Start: AIC=6179.14
## quality2 ~ (fixed.acidity + volatile.acidity + citric.acid +
## residual.sugar + chlorides + free.sulfur.dioxide + total.sulfur.dioxide +
## density + pH + sulphates + alcohol + quality) - quality
##
## Df AIC
## - chlorides 1 6177.5
## - total.sulfur.dioxide 1 6179.0
## <none> 6179.1
## - citric.acid 1 6179.4
## - fixed.acidity 1 6183.7
## - alcohol 1 6203.4
## - sulphates 1 6206.0
## - density 1 6207.4
## - free.sulfur.dioxide 1 6213.1
## - pH 1 6217.6
## - residual.sugar 1 6222.9
## - volatile.acidity 1 6287.0
##
## Step: AIC=6177.52
## quality2 ~ fixed.acidity + volatile.acidity + citric.acid + residual.sugar +
## free.sulfur.dioxide + total.sulfur.dioxide + density + pH +
## sulphates + alcohol
##
## Df AIC
## - total.sulfur.dioxide 1 6177.4
## <none> 6177.5
## - citric.acid 1 6177.6
## - fixed.acidity 1 6183.0
## - alcohol 1 6201.6
## - sulphates 1 6204.9
## - density 1 6208.0
## - free.sulfur.dioxide 1 6211.1
## - pH 1 6218.7
## - residual.sugar 1 6225.4
## - volatile.acidity 1 6288.9
##
## Step: AIC=6177.36
## quality2 ~ fixed.acidity + volatile.acidity + citric.acid + residual.sugar +
## free.sulfur.dioxide + density + pH + sulphates + alcohol
##
## Df AIC
## - citric.acid 1 6177.3
## <none> 6177.4
## - fixed.acidity 1 6184.0
## - alcohol 1 6200.2
## - sulphates 1 6204.0
## - density 1 6213.2
## - free.sulfur.dioxide 1 6216.0
## - pH 1 6219.7
## - residual.sugar 1 6229.7
## - volatile.acidity 1 6307.1
##
## Step: AIC=6177.31
## quality2 ~ fixed.acidity + volatile.acidity + residual.sugar +
## free.sulfur.dioxide + density + pH + sulphates + alcohol
##
## Df AIC
## <none> 6177.3
## - fixed.acidity 1 6184.9
## - alcohol 1 6201.8
## - density 1 6211.8
## - sulphates 1 6212.1
## - pH 1 6218.1
## - free.sulfur.dioxide 1 6225.9
## - residual.sugar 1 6228.4
## - volatile.acidity 1 6316.1
We see some of the variables got eliminated.
fixed.acidity, alcohol, density, sulphates, pH, free.sulfur.dioxide, residual.sugar, volatile.acidity are the variables being considered.
head(fitted(o_lr))## 3 4 5 6 7 8
## 2 0.012733201 0.102476569 0.5891421 0.2675954 0.02514971 0.002792462
## 7 0.007370319 0.062364804 0.5085991 0.3739248 0.04270917 0.004839804
## 10 0.002796939 0.024740172 0.3137434 0.5415504 0.10395809 0.012702967
## 11 0.001083919 0.009752403 0.1561342 0.5775992 0.22198247 0.032135733
## 12 0.005402251 0.046583924 0.4488420 0.4350332 0.05727276 0.006603401
## 13 0.001270388 0.011408834 0.1775801 0.5833461 0.19772064 0.027554412
## 9
## 2 0.0001105250
## 7 0.0001919682
## 10 0.0005080325
## 11 0.0013121200
## 12 0.0002624039
## 13 0.0011195326
Training Set Accuracy
predicting -
p <- predict(o_lr, type = "class")
head(p)## [1] 5 5 6 6 5 6
## Levels: 3 4 5 6 7 8 9
Confusion Matrix Test
cm1 = as.matrix(table(Actual = whitetrain$quality2, Predicted = p))
cm1## Predicted
## Actual 3 4 5 6 7 8 9
## 3 0 1 5 7 0 1 0
## 4 0 4 64 38 1 0 0
## 5 0 0 425 393 4 0 0
## 6 1 0 239 936 76 0 0
## 7 0 0 19 355 107 1 0
## 8 0 0 2 59 31 0 0
## 9 0 0 0 1 3 0 0
sum(diag(cm1))/length(whitetrain$quality2)## [1] 0.530833
Training Set Accuracy is 53.08%
Test Set Accuracy
Accuray for the test set.
tst_pred <- predict(o_lr, newdata = whitetest, type = "class")Confusion Matrix Test
cm2 <- table(predicted = tst_pred, actual = whitetest$quality2)
cm2## actual
## predicted 3 4 5 6 7 8 9
## 3 0 0 0 0 0 0 0
## 4 0 0 0 0 0 0 0
## 5 2 32 177 93 6 1 0
## 6 3 14 171 410 156 26 0
## 7 1 0 5 33 45 12 1
## 8 0 0 0 0 0 0 0
## 9 0 0 0 0 0 0 0
Test Set Accuracy
sum(diag(cm2))/length(whitetrain$quality2)## [1] 0.227912
Test Set Accuracy - 22.8 %
Binomial Logistic Regression Model
The variable to be predicted is binary and hence we use binomial logistic regression.
white$category[white$quality <= 5] <- 0
white$category[white$quality > 5] <- 1
white$category <- as.factor(white$category)head(white)## fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
## 1 7.0 0.27 0.36 20.7 0.045
## 2 6.3 0.30 0.34 1.6 0.049
## 3 8.1 0.28 0.40 6.9 0.050
## 4 7.2 0.23 0.32 8.5 0.058
## 7 6.2 0.32 0.16 7.0 0.045
## 10 8.1 0.22 0.43 1.5 0.044
## free.sulfur.dioxide total.sulfur.dioxide density pH sulphates alcohol
## 1 45 170 1.0010 3.00 0.45 8.8
## 2 14 132 0.9940 3.30 0.49 9.5
## 3 30 97 0.9951 3.26 0.44 10.1
## 4 47 186 0.9956 3.19 0.40 9.9
## 7 30 136 0.9949 3.18 0.47 9.6
## 10 28 129 0.9938 3.22 0.45 11.0
## quality quality2 category
## 1 6 6 1
## 2 6 6 1
## 3 6 6 1
## 4 6 6 1
## 7 6 6 1
## 10 6 6 1
Train Test Split
set.seed(3000)
spl = sample.split(white$category, SplitRatio = 0.7)
whitetrain = subset(white, spl==TRUE)
whitetest = subset(white, spl==FALSE)
head(whitetrain)## fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
## 2 6.3 0.30 0.34 1.60 0.049
## 7 6.2 0.32 0.16 7.00 0.045
## 10 8.1 0.22 0.43 1.50 0.044
## 11 8.1 0.27 0.41 1.45 0.033
## 13 7.9 0.18 0.37 1.20 0.040
## 15 8.3 0.42 0.62 19.25 0.040
## free.sulfur.dioxide total.sulfur.dioxide density pH sulphates alcohol
## 2 14 132 0.9940 3.30 0.49 9.5
## 7 30 136 0.9949 3.18 0.47 9.6
## 10 28 129 0.9938 3.22 0.45 11.0
## 11 11 63 0.9908 2.99 0.56 12.0
## 13 16 75 0.9920 3.18 0.63 10.8
## 15 41 172 1.0002 2.98 0.67 9.7
## quality quality2 category
## 2 6 6 1
## 7 6 6 1
## 10 6 6 1
## 11 5 5 0
## 13 5 5 0
## 15 5 5 0
glm()= Generalized linear model
We will use the glm() - Generalized linear model command to run a logistic regression, regressing success on the numeracy and anxiety scores.
model_glm <- glm(category ~ . - quality - quality2, data = whitetrain, family=binomial(link = "logit"))
#backwards = step(fullmod,trace=0) would suppress step by step output.Stepwise
model_gl <- step(model_glm)## Start: AIC=2821.85
## category ~ (fixed.acidity + volatile.acidity + citric.acid +
## residual.sugar + chlorides + free.sulfur.dioxide + total.sulfur.dioxide +
## density + pH + sulphates + alcohol + quality + quality2) -
## quality - quality2
##
## Df Deviance AIC
## - total.sulfur.dioxide 1 2797.9 2819.9
## - chlorides 1 2797.9 2819.9
## - fixed.acidity 1 2798.0 2820.0
## <none> 2797.8 2821.8
## - citric.acid 1 2800.2 2822.2
## - free.sulfur.dioxide 1 2806.9 2828.9
## - pH 1 2809.7 2831.7
## - density 1 2811.5 2833.5
## - sulphates 1 2817.4 2839.4
## - residual.sugar 1 2823.2 2845.2
## - alcohol 1 2826.3 2848.3
## - volatile.acidity 1 2916.6 2938.6
##
## Step: AIC=2819.87
## category ~ fixed.acidity + volatile.acidity + citric.acid + residual.sugar +
## chlorides + free.sulfur.dioxide + density + pH + sulphates +
## alcohol
##
## Df Deviance AIC
## - chlorides 1 2798.0 2818.0
## - fixed.acidity 1 2798.0 2818.0
## <none> 2797.9 2819.9
## - citric.acid 1 2800.2 2820.2
## - pH 1 2809.7 2829.7
## - density 1 2811.8 2831.8
## - free.sulfur.dioxide 1 2813.1 2833.1
## - sulphates 1 2817.8 2837.8
## - residual.sugar 1 2823.4 2843.4
## - alcohol 1 2826.6 2846.6
## - volatile.acidity 1 2920.6 2940.6
##
## Step: AIC=2817.97
## category ~ fixed.acidity + volatile.acidity + citric.acid + residual.sugar +
## free.sulfur.dioxide + density + pH + sulphates + alcohol
##
## Df Deviance AIC
## - fixed.acidity 1 2798.2 2816.2
## <none> 2798.0 2818.0
## - citric.acid 1 2800.3 2818.3
## - pH 1 2810.3 2828.3
## - density 1 2812.6 2830.6
## - free.sulfur.dioxide 1 2813.1 2831.1
## - sulphates 1 2818.1 2836.1
## - residual.sugar 1 2825.1 2843.1
## - alcohol 1 2826.7 2844.7
## - volatile.acidity 1 2922.7 2940.7
##
## Step: AIC=2816.17
## category ~ volatile.acidity + citric.acid + residual.sugar +
## free.sulfur.dioxide + density + pH + sulphates + alcohol
##
## Df Deviance AIC
## <none> 2798.2 2816.2
## - citric.acid 1 2800.6 2816.6
## - free.sulfur.dioxide 1 2813.1 2829.1
## - pH 1 2817.6 2833.6
## - sulphates 1 2818.2 2834.2
## - density 1 2824.1 2840.1
## - residual.sugar 1 2841.8 2857.8
## - alcohol 1 2863.4 2879.4
## - volatile.acidity 1 2927.8 2943.8
#model_gl = step(model_glm,trace=0) would suppress step by step output.Prediction - Train
The default is on the scale of the linear predictors; the alternative “response” is on the scale of the response variable. Thus for a default binomial model the default predictions are of log-odds (probabilities on logit scale) and type = “response” gives the predicted probabilities
head(fitted(model_gl))## 2 7 10 11 13 15
## 0.3085439 0.3942105 0.6825519 0.8508986 0.8124451 0.4915685
head(predict(model_gl))## 2 7 10 11 13 15
## -0.80693550 -0.42964756 0.76552441 1.74166660 1.46597646 -0.03372931
head(predict(model_gl, type = "response"))## 2 7 10 11 13 15
## 0.3085439 0.3942105 0.6825519 0.8508986 0.8124451 0.4915685
Catagorizing Set
trn_pred <- ifelse(predict(model_gl, type = "response") > 0.5,"Good Wine", "Bad Wine")
head(trn_pred)## 2 7 10 11 13 15
## "Bad Wine" "Bad Wine" "Good Wine" "Good Wine" "Good Wine" "Bad Wine"
Confusion Matrix - Training Set
Obtaining confusion matrix of the training data.
trn_tab <- table(predicted = trn_pred, actual = whitetrain$category)
trn_tab## actual
## predicted 0 1
## Bad Wine 504 254
## Good Wine 440 1575
Training Set Accuracy
Checking accuracy of the training set.
sum(diag(trn_tab))/length(whitetrain$category)## [1] 0.7497295
We can see that Binomial Logistic Regressio gives an training set accuracy of 74.97295%.
Confusion Matrix - Test Set
Confusion matrix for the test data.
# Making predictions on the test set.
tst_pred <- ifelse(predict(model_gl, newdata = whitetest, type = "response") > 0.5, "Good Wine", "Bad Wine")
tst_tab <- table(predicted = tst_pred, actual = whitetest$category)
tst_tab## actual
## predicted 0 1
## Bad Wine 212 110
## Good Wine 192 674
Test Set Accuracy
Checking accuracy for the test data.
sum(diag(tst_tab))/length(whitetest$category)## [1] 0.7457912
We can see that Binomial Logistic Regression gives an test set accuracy of 74.58%.
Conclusion
Please, use binomial logistic regression to predict the quality of wine.