UNIVERSITY OF CINCINNATI
LINDNER COLLEGE OF BUSINESS

Kazuhide Watanabe

THE STUDY OF WINE QUALITY: PART C

---

Using various hypothesis testing methods to determine how residual sugar influences wine density and overall quality.

---

1. Objective

---

This report aims to examine how physicochemical factors, specifically residual sugar and density affect the overall quality of wine. Building on Cortez et al. (2009), who modeled wine preferences using analytical properties to predict taste quality, this analysis will focus on developing and testing hypotheses that quantify these relationships (ScienceDirect).

2. Materials

---

2.1 Tools & Packages

# Load the dataset and packages
library(ggplot2)
library(dplyr)
library(tidyr)
library(patchwork)
library(stats4)
library(kableExtra)

2.2 Data and Import

This report will use the ‘winequality-red’ dataset which shows 11 different variables with an output variable ‘quality’ characterizing the grade the red or white wine recieved. The population includes all the red wines produced in the north of Portugal. The sample are these 1599 bottles of red wines tested, and we will use them to make inference about the population.

red_df <- read.csv("wine_quality_data/winequality-red.csv", sep = ';')
attach(red_df)

3. Method

---

3.1 Two Grouping Method

3.1.1 Summary Statistics: Residual Sugar

Produce summary statistics of “residual.sugar” and use its median to divide the data into two groups A and B. We want to test if ‘density’ in Group A and Group B has the same population mean.

# Summary statistics of residual sugar
res_sum <- summary(residual.sugar)

# Convert to a data frame
res_sum_df <- data.frame(Statistic = names(res_sum),
                         Value = as.numeric(res_sum))

# Presenting summary statistics in a table
res_sum_df %>%
  kbl(caption = "Table 1: Summary Statistics: Residual Sugar") %>%
  kable_classic(full_width = F, html_font = "Cambria") %>%
  column_spec(1, width = "10em")

Table 1: Summary Statistics: Residual Sugar

Statistic	Value
Min.	0.900000
1st Qu.	1.900000
Median	2.200000
Mean	2.538806
3rd Qu.	2.600000
Max.	15.500000

# Creating Group A and B using median
res_median <- median(residual.sugar)
red_df$res_group <- ifelse(residual.sugar <= res_median, 'A', 'B')

# Displaying the Groupings
Group1_df <- data.frame(residual.sugar, red_df$res_group, density)[1:10,]

Group1_df %>%
  kbl(align = "c", caption = "Table 2: A/B Groupings") %>%
  kable_classic(full_width = F, html_font = "Cambria")

Table 2: A/B Groupings

residual.sugar	red_df.res_group	density
1.9	A	0.9978
2.6	B	0.9968
2.3	B	0.9970
1.9	A	0.9980
1.9	A	0.9978
1.8	A	0.9978
1.6	A	0.9964
1.2	A	0.9946
2.0	A	0.9968
6.1	B	0.9978

3.1.2 Null Hypothesis

There is no difference between Group A and Group B

3.1.3 Visualizing the Hypothesis

# Box plot for Group A and B
ggplot(red_df, aes(x = res_group, y = density)) +
  geom_boxplot(fill = '#722F37', alpha = 0.7) +
  labs(
    title = "Figure 1: Residual Sugar Effects on Density (A/B)",
    x = "Residual Sugar Group",
    y = "Density"
  ) + 
  theme_bw(base_family = "serif")

Analysis:

Looking at the boxplot, there is a difference between the two residual sugar groupings and its affects on density. This visual difference makes me believe that the null hypothesis will not be correct.

3.1.4 A/B Testing and Results

Since we are comparing the performance/output between two groups, we will be doing A/B testing which will use a t-test.

# T-test on Group A and Group B
t.test(density ~ red_df$res_group)

## 
##  Welch Two Sample t-test
## 
## data:  density by red_df$res_group
## t = -14.697, df = 1365.2, p-value < 2.2e-16
## alternative hypothesis: true difference in means between group A and group B is not equal to 0
## 95 percent confidence interval:
##  -0.001513022 -0.001156687
## sample estimates:
## mean in group A mean in group B 
##       0.9961490       0.9974838

Results:

P-value: < 2.2\(e^{-16}\)

Looking at the p-value, it is far below 0.05 meaning we will be rejecting the null hypothesis. This conclusion implies that there is a correlation between ‘residual.sugar’ and ‘density’.

3.2 Four Grouping Method

3.2.1 Summary Statistics: Residual Sugar

Referring back to the summary statistics in Table 1, we will use the 1st, 2nd, and 3rd quantiles to divide the data into four groups A, B, C, and D. We want to test if “density” in the four groups has the same population mean.

# Creating Group A, B, C, and D using quantiles
res_quantile <- quantile(residual.sugar, probs = seq(0, 1, 0.25))

red_df$res_group2 <- cut(red_df$residual.sugar, 
                         breaks = res_quantile, 
                         include.lowest = T,
                         labels = c('A', 'B', 'C', 'D'))

# Displaying Groupings
res.group2 <- NULL

for(i in 1:1599){
  if(residual.sugar[i] <= 1.9) res.group2[i] <- 'A'
    else if(residual.sugar[i] <= 2.2) res.group2[i] <- 'B'
      else if(residual.sugar[i] <= 2.6) res.group2[i] <- 'C'
        else res.group2[i] <- 'D'
}

Group2_df <- data.frame(residual.sugar, red_df$res_group2, density)[1:10,]

Group2_df %>%
  kbl(align = "c", caption = "Table 3: A/B/C/D Groupings") %>%
  kable_classic(full_width = F, html_font = "Cambria") 

Table 3: A/B/C/D Groupings

residual.sugar	red_df.res_group2	density
1.9	A	0.9978
2.6	C	0.9968
2.3	C	0.9970
1.9	A	0.9980
1.9	A	0.9978
1.8	A	0.9978
1.6	A	0.9964
1.2	A	0.9946
2.0	B	0.9968
6.1	D	0.9978

3.2.2 Null Hypothesis

There is no difference between Group A, B, C, D

3.2.3 Visualizing the Hypothesis

# Box plot for Group A, B, C, D
ggplot(red_df, aes(x = res_group2, y = density)) +
  geom_boxplot(fill = '#722F37', alpha = 0.7) +
  labs(
    title = "Figure 2: Residual Sugar Effects on Density (A/B/C/D)",
    x = "Residual Sugar Group",
    y = "Density"
  ) + 
  theme_bw(base_family = "serif")

Analysis:

Looking at the boxplot, there is a small increase between Group A and B, and Group C and D have a very noticeable increase from the other two groups. Visually, there seems to be an overall positive correlation between the residual sugar and density. This visual difference makes me believe that the null hypothesis will not be correct.

3.2.4 ANOVA Testing and Results

Since we are comparing the performance/output between multiple groups, we will be doing ANOVA testing which will use an f-test.

# F-test on Group A, B, C, D
summary(aov((density ~ red_df$res_group2)))

##                     Df   Sum Sq   Mean Sq F value Pr(>F)    
## red_df$res_group2    3 0.000996 0.0003321   112.8 <2e-16 ***
## Residuals         1595 0.004696 0.0000029                   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Results:

P-value: < 2\(e^{-16}\)

Looking at the p-value, it is similar to the A/B test where it is far below 0.05 meaning we will be rejecting the null hypothesis. This conclusion implies that there is a correlation between ‘residual.sugar’ and ‘density’. Comparing the results to the prior method, the p-values as well as the final result yield similar output. Increasing the groupings by a couple was helpful visually, seeing the gradual increase, but the results remained pretty similar with no clear difference. I think dividing the data in 10 groups would become too granular, and it would slowly become similar to a scatter plot with less interpretation opportunity compared to the few groups.

3.3 Four Groupings + Excellence

3.3.1 Contingency Table

Create a 2 by 4 contingency table using the categories A, B, C, D of “residual.sugar” and the binary variable “excellent” you created in Part B.

# Creating a new column, Excellent_Quality, in the red_df dataset
# When quality >=7 the wine is excellent
red_df <- red_df %>%
  mutate(Excellent_Quality = ifelse(quality >= 7, 1,0))

# Checking if the Excellent_Quality column is properly implemented into the data
head(red_df[c('quality', 'Excellent_Quality')], 10) %>%
  kbl(align = "c", caption = "Table 4: Wine Quality Excellence") %>%
  kable_classic(full_width = F, html_font = "Cambria")

Table 4: Wine Quality Excellence

quality	Excellent_Quality
5	0
5	0
5	0
6	0
5	0
5	0
5	0
7	1
7	1
5	0

# Counting instances when Group A and Excellent
A_Excellent <- sum(red_df$res_group2 == 'A' & red_df$Excellent_Quality == 1)

# Counting instances when Group A and Not Excellent
A_notExcellent <- sum(red_df$res_group2 == 'A' & red_df$Excellent_Quality == 0)

# Counting instances when Group B and Excellent
B_Excellent <- sum(red_df$res_group2 == 'B' & red_df$Excellent_Quality == 1)

# Counting instances when Group B and Not Excellent
B_notExcellent <- sum(red_df$res_group2 == 'B' & red_df$Excellent_Quality == 0)

# Counting instances when Group C and Excellent
C_Excellent <- sum(red_df$res_group2 == 'C' & red_df$Excellent_Quality == 1)

# Counting instances when Group C and Excellent
C_notExcellent <- sum(red_df$res_group2 == 'C' & red_df$Excellent_Quality == 0)

# Counting instances when Group D and Excellent
D_Excellent <- sum(red_df$res_group2 == 'D' & red_df$Excellent_Quality == 1)

# Counting instances when Group D and Not Excellent
D_notExcellent <- sum(red_df$res_group2 == 'D' & red_df$Excellent_Quality == 0)

W <- as.table(rbind(c(A_Excellent, B_Excellent, C_Excellent, D_Excellent), c(A_notExcellent, B_notExcellent, C_notExcellent, D_notExcellent)))

dimnames(W) <- list(Rating = c("Excellent", "Not Excellent"), 
                    Groupings = c("A", "B", "C", "D"))
print(W)

##                Groupings
## Rating            A   B   C   D
##   Excellent      53  52  53  59
##   Not Excellent 411 367 308 296

3.3.2 Chi Square Testing and Results

# Performing Chi sq test
Xsq <- chisq.test(W)

Xsq$observed

##                Groupings
## Rating            A   B   C   D
##   Excellent      53  52  53  59
##   Not Excellent 411 367 308 296

Xsq$expected

##                Groupings
## Rating                  A         B         C         D
##   Excellent      62.96936  56.86241  48.99124  48.17699
##   Not Excellent 401.03064 362.13759 312.00876 306.82301

Xsq$residuals

##                Groupings
## Rating                   A          B          C          D
##   Excellent     -1.2563264 -0.6448212  0.5727305  1.5592955
##   Not Excellent  0.4978269  0.2555143 -0.2269479 -0.6178802

Xsq

## 
##  Pearson's Chi-squared test
## 
## data:  W
## X-squared = 5.5, df = 3, p-value = 0.1386

Results:

P-value: 0.1386

Looking at the p-value, it is above 0.05 meaning we will not reject the null hypothesis. This conclusion implies that there is not a correlation between ‘residual.sugar’ and ‘Excellent_Quality’.

3.3.3 Permutation Testing and Results

# Performing permutation test
Chisq <- chisq.test(W, simulate.p.value = T)
Chisq

## 
##  Pearson's Chi-squared test with simulated p-value (based on 2000
##  replicates)
## 
## data:  W
## X-squared = 5.5, df = NA, p-value = 0.1514

Results:

P-value: 0.1514

Looking at the p-value, it is above 0.05 meaning we will not reject the null hypothesis. This conclusion implies that there is not a correlation between ‘residual.sugar’ and ‘Excellent_Quality’.

Both testing methods did not yield a p-value that would result in the rejection of the null hypothesis. This means I can not conclude that ‘residual.sugar’ is a significant factor to the excellence of the red wine.