**Predicting Tire Customer Retention at Tire Rack

Project Objective

To investigate the relationship between wet and noise tire survey ratings on the probability of a customer probably or definitely purchasing a tire again from Tire Rack.

Question 1 and 2: Logistic Regression Model

Step 1: Load required packages

library(readxl) # Allows import of excel files
library(Hmisc) # Allows us to call correlation function
## 
## Attaching package: 'Hmisc'
## The following objects are masked from 'package:base':
## 
##     format.pval, units
library(pscl) # Allows us to find the pseudo r squared
## 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 plot the area under the curve and to get the AUC value
## Type 'citation("pROC")' for a citation.
## 
## Attaching package: 'pROC'
## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var

Step 2: Import the data

tires_df <- read_excel("Class Exercise15_TireRatings.xlsx") # Load tire data

Step 3: Summarize the data for descriptive statistics

head(tires_df) # View a snapshot of the data
## # A tibble: 6 × 5
##   Tire                                     Wet Noise Buy_Again Purchase
##   <chr>                                  <dbl> <dbl>     <dbl>    <dbl>
## 1 BFGoodrich g-Force Super Sport A/S       8     7.2       6.1        0
## 2 BFGoodrich g-Force Super Sport A/S H&V   8     7.2       6.6        1
## 3 BFGoodrich g-Force T/A KDWS              7.6   7.5       6.9        1
## 4 Bridgestone B381                         6.6   5.4       6.6        0
## 5 Bridgestone Insignia SE200               5.8   6.3       4          0
## 6 Bridgestone Insignia SE200-02            6.3   5.7       4.5        0
summary(tires_df) # Get insights from the data
##      Tire                Wet            Noise         Buy_Again    
##  Length:68          Min.   :4.300   Min.   :3.600   Min.   :1.400  
##  Class :character   1st Qu.:6.450   1st Qu.:6.000   1st Qu.:3.850  
##  Mode  :character   Median :7.750   Median :7.100   Median :6.150  
##                     Mean   :7.315   Mean   :6.903   Mean   :5.657  
##                     3rd Qu.:8.225   3rd Qu.:7.925   3rd Qu.:7.400  
##                     Max.   :9.200   Max.   :8.900   Max.   :8.900  
##     Purchase     
##  Min.   :0.0000  
##  1st Qu.:0.0000  
##  Median :0.0000  
##  Mean   :0.4412  
##  3rd Qu.:1.0000  
##  Max.   :1.0000
Interpretation: Tire Rack's survey indicates that consumers on average rated rated 7.32 for wet and 6.90 for noise.

Step 4: Set up the logistic model

model <- glm(Purchase ~ Wet + Noise, data = tires_df, family = binomial)

Step 5: Test independent variables for significance

summary(model) # View the p values and obtain b0, b1, and b2
## 
## Call:
## glm(formula = Purchase ~ Wet + Noise, family = binomial, data = tires_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: 0.01 for wet < 0.05. 0.03 for noise < 0.05. All independent variables are significant.

Question 3: Test overall model significance

pR2(model) # Pseudo R squared
## 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: Model is not very significant because 0.71 is not between
# 0.2 and 0.4

Question 4: Estimate probability that customer will purchase a tier again with a rating of 8 in both independent variables.

newdata1 <- data.frame(Wet = 8, Noise = 8) # Set up input to the model
prob1 <- predict(model, newdata = newdata1, type = "response") # Plug in numbers
prob1 # 0.88
##         1 
## 0.8836964
prob1*100 # 88.37% will purchase a tier again
##        1 
## 88.36964
Interpretation: These customers were happy with their tire quality, so they
bought again.

Question 5: Estimate the probability that customer will purchase a tier again with a rating of 7 in both independent variables.

newdata2 <- data.frame(Wet = 7, Noise = 7) # Set up input to the model
prob2 <- predict(model, newdata = newdata2, type = "response") # Plug in numbers
prob2 # 0.04
##          1 
## 0.04058753
prob2*100 # 4.06% will purchase tier again
##        1 
## 4.058753
Interpretation: Because most of these customers were not happy with their tier quality,
most didn't buy the specific tire again.