Predicting Tire Ratings at The Tire Rack

Project Objective

To investigate the relationship between each tire's wet traction performance and noise level generated by each tire on purchase at The Tire Rack.

Question 1 & 2: Develop the logistic regression model and identify significant variables

Step 1: Install and load required libraries

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
## Type 'citation("pROC")' for a citation.
## 
## Attaching package: 'pROC'
## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var

Step 2: Import & clean the data

tire_df <- read_excel("Class Exercise 15_TireRatings.xlsx")
ti_df <- subset(tire_df, select = -c(Buy_Again))
t_df <- subset(ti_df, select = -c(Tire))

Step 3: Summarize the data

head(t_df)
## # A tibble: 6 × 3
##     Wet Noise Purchase
##   <dbl> <dbl>    <dbl>
## 1   8     7.2        0
## 2   8     7.2        1
## 3   7.6   7.5        1
## 4   6.6   5.4        0
## 5   5.8   6.3        0
## 6   6.3   5.7        0
Data Description: A description of some of the features are presented in the table below.
Variable    | Definition
------------|-------------
1. Wet      | the average of the ratings for each tire's wet traction performance
2. Noise    | the ratings for the noise level genearated by each tire
3. Purchase |the respondent buying the tire again (1: yes and 0: no)
summary(t_df)
##       Wet            Noise          Purchase     
##  Min.   :4.300   Min.   :3.600   Min.   :0.0000  
##  1st Qu.:6.450   1st Qu.:6.000   1st Qu.:0.0000  
##  Median :7.750   Median :7.100   Median :0.0000  
##  Mean   :7.315   Mean   :6.903   Mean   :0.4412  
##  3rd Qu.:8.225   3rd Qu.:7.925   3rd Qu.:1.0000  
##  Max.   :9.200   Max.   :8.900   Max.   :1.0000
Interpretation: The median Wet is 7.75 and the median Noise is 7.10. 

Step 4: Feature selection (i.e., correlation analysis)

corr <- rcorr(as.matrix(t_df))
corr
##           Wet Noise Purchase
## Wet      1.00  0.76     0.74
## Noise    0.76  1.00     0.72
## Purchase 0.74  0.72     1.00
## 
## n= 68 
## 
## 
## P
##          Wet Noise Purchase
## Wet           0     0      
## Noise     0         0      
## Purchase  0   0
Interpretation: All the predictors are significant with the target variable.

Step 5: Build the logistic regression model

model <- glm(Purchase ~ Wet + Noise, data = t_df, family = binomial)
summary(model)
## 
## Call:
## glm(formula = Purchase ~ Wet + Noise, family = binomial, data = t_df)
## 
## 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 significant (p-value < 0.05)

Question 3: Assess the overall model significance

Pseido-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
Interpretaion: A McFadden R-squared of 0.7050 means that our LR model explains about 70.5% of the variablity in the outcome relative to a model with no predictors. This is considered a good fit, as values closer to 1 represent better model performance.

Question 4: Predicting with New Information

# Given the following new rating information
new_data1 <- data.frame(Wet = 8, Noise = 8)
new_data2 <- data.frame(Wet = 7, Noise = 7)

# Predict the probability
prob1 <- predict(model, newdata = new_data1, type = "response")
round((prob1 * 100),2)
##     1 
## 88.37
prob2 <- predict(model, newdata = new_data2, type = "response")
round((prob2 * 100),2)
##    1 
## 4.06
Interpretation
(1) There's a 88.37% chance that the customer wil probably or definitely purchase a particular tire again with a Wet performance rating of 8 and a Noise performance rating of 8.
(2) There's a 4.06% chance of the customer will probably or definitely purchase a particular tire again with a Wet and Noise performance ratings of 7.