Question 1 & 2: Develop the Model & Assess Predictor
Significance
Step 1: Install and load required libraries
#install.packages("readxl")
#install.packages("hmisc")
#install.packages("pscl")
if(!require(pROC)) install.packages("pROC")
## Loading required package: pROC
## Type 'citation("pROC")' for a citation.
##
## Attaching package: 'pROC'
## The following objects are masked from 'package:stats':
##
## cov, smooth, var
library(readxl) #allows us to import excel files
library(Hmisc) #allows us to call the correlation function
##
## Attaching package: 'Hmisc'
## The following objects are masked from 'package:base':
##
## format.pval, units
library(pscl) #allows us to call the pseudo R-square package to evaluate our model
## Classes and Methods for R originally developed in the
## Political Science Computational Laboratory
## Department of Political Science
## Stanford University (2002-2015),
## by and under the direction of Simon Jackman.
## hurdle and zeroinfl functions by Achim Zeileis.
library(pROC) #allows us to run the area under the curve (AUC) package to get the plot and AUC score
Step 2: Import & clean the data
Tires <- read_excel("Class Exercise 15_TireRatings.xlsx")
Tire_R <- subset(Tires, select = -c(Tire)) #drop irrelevant column
Step 3: Summarize the data
head(Tire_R)
## # A tibble: 6 × 4
## Wet Noise Buy_Again Purchase
## <dbl> <dbl> <dbl> <dbl>
## 1 8 7.2 6.1 0
## 2 8 7.2 6.6 1
## 3 7.6 7.5 6.9 1
## 4 6.6 5.4 6.6 0
## 5 5.8 6.3 4 0
## 6 6.3 5.7 4.5 0
Data Description: A description of the features are presented in the table below
Variable | Defintion
_____________ | _____________
1. Wet | Purchase of a Wet Performance Tire Rating
2. Noise | Purchase of a Noise Performance Tire Rating
3. Buy_Again | Likelihood of purchasing a Wet or Noise Performaning tire again (1: yes and 0: no)
summary(Tire_R)
## Wet Noise Buy_Again Purchase
## Min. :4.300 Min. :3.600 Min. :1.400 Min. :0.0000
## 1st Qu.:6.450 1st Qu.:6.000 1st Qu.:3.850 1st Qu.:0.0000
## Median :7.750 Median :7.100 Median :6.150 Median :0.0000
## Mean :7.315 Mean :6.903 Mean :5.657 Mean :0.4412
## 3rd Qu.:8.225 3rd Qu.:7.925 3rd Qu.:7.400 3rd Qu.:1.0000
## Max. :9.200 Max. :8.900 Max. :8.900 Max. :1.0000
Interpretation: The median of wet tire purchases is 7.75 and the median of noise tire purchases is 7.10.
Step 4: Feature selection (i.e., correlation analysis)
corr <- rcorr(as.matrix(Tire_R))
corr
## Wet Noise Buy_Again Purchase
## Wet 1.00 0.76 0.91 0.74
## Noise 0.76 1.00 0.83 0.72
## Buy_Again 0.91 0.83 1.00 0.83
## Purchase 0.74 0.72 0.83 1.00
##
## n= 68
##
##
## P
## Wet Noise Buy_Again Purchase
## Wet 0 0 0
## Noise 0 0 0
## Buy_Again 0 0 0
## Purchase 0 0 0
Interpretation: All the variables are not significant with the target variable
Step 5: Build the logistic regression model
model <- glm(Purchase ~ Wet + Noise, data = Tire_R, family = binomial)
summary(model)
##
## Call:
## glm(formula = Purchase ~ Wet + Noise, family = binomial, data = Tire_R)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -39.4982 12.4779 -3.165 0.00155 **
## Wet 3.3745 1.2641 2.670 0.00760 **
## Noise 1.8163 0.8312 2.185 0.02887 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 93.325 on 67 degrees of freedom
## Residual deviance: 27.530 on 65 degrees of freedom
## AIC: 33.53
##
## Number of Fisher Scoring iterations: 8
Interpretation: All the independent variables were not significant (p-value > 0.05)
Question 3: Overall Model Significance
Likelihood Ratio Test
# Fit a null model
null_model <- glm(Purchase ~ 1, data = Tire_R, family = binomial)
# Perform likelihood ratio test
anova(null_model, model, test = "Chisq")
## Analysis of Deviance Table
##
## Model 1: Purchase ~ 1
## Model 2: Purchase ~ Wet + Noise
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 67 93.325
## 2 65 27.530 2 65.795 5.162e-15 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Interpretation: The inclusion of how tires performed in wet enviroments and how much noise they absored used as predictors in our LR model does not significantly predict the likelihood of someone purchasing the tires again, relative to a model that predicts buy again based solely on the mean of observed outcomes (i.e., null model)
Pseudo R-squared
pR2(model)
## fitting null model for pseudo-r2
## llh llhNull G2 McFadden r2ML r2CU
## -13.7649516 -46.6623284 65.7947536 0.7050093 0.6199946 0.8305269
Interpretation: A McFadden R-square of 0.705 means that our LR model explains that about 70.5% of the variability in the outcome relative to a model with no predictors. This is not considered a good fit, we need a value between 0.2 to 0.4 to be seen as a useful model
Area Under the Curve (AUC)
The Area Under the Curve (AUC) score represents the ability of the model to correctly classify customers who will purchase tires again and those who will not.
# Compute ROC Curve and the AUC score
roc_curve <- roc(Tire_R$Purchase, fitted(model))
## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
plot(roc_curve)
auc(roc_curve)
## Area under the curve: 0.9741
Interpretation: An AUC score of 0.97 indicates that the LR model has a high level of accuracy in predicting likelihood of customers purchasing tires again
Question 6: Odds Ratio
# Extract the coefficients
coefficients <- summary(model)$coefficients
# Calculate the odd ratio for "Noise"
odds_ratio_noise <- exp(coefficients["Noise", "Estimate"])
odds_ratio_noise
## [1] 6.148919
# Calculate the odd ratio for "Wet"
odds_ratio_wet <- exp(coefficients["Wet", "Estimate"])
odds_ratio_wet
## [1] 29.20949
Interpretation: Both odd ratios are greater than 1 indicating that purchasing Noise Performance and Wet Performance tires is associated with higher odds of customers purchasing Wet and Noise rated tires again.