**Predicting Customer Tire Purchase Likelihood
##project objective
To investigate the impact of tire performance factors on purchase likelihood, utilizing logistic regression analysis to provide actionable insights for enhancing customer satisfaction and optimizing marketing strategies.Question 1 and 2: Model & Pedictor Significance
Step 1 : Install required libraries
#install.packages("readxl")
#install.packages("Hmisc")
#install.packages("pscl")
#if(!require(pROC)) install.packages("pROC")
library(readxl) #allows us to import excel files## Warning: 套件 'readxl' 是用 R 版本 4.4.2 來建造的library(Hmisc) #allows us to call the correlation function## Warning: 套件 'Hmisc' 是用 R 版本 4.4.2 來建造的##
## 載入套件：'Hmisc'## 下列物件被遮斷自 'package:base':
##
## format.pval, unitslibrary(pscl) #allows us to call the pseudo R-square package to evaluate our model## Warning: 套件 'pscl' 是用 R 版本 4.4.2 來建造的## 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 tje curve (AUC) package to get the plot and AUC score## Warning: 套件 'pROC' 是用 R 版本 4.4.2 來建造的## Type 'citation("pROC")' for a citation.##
## 載入套件：'pROC'## 下列物件被遮斷自 'package:stats':
##
## cov, smooth, varStep 2 : Import the data and Clean the data
college_df <- read_excel("Class Exercise 15_TireRatings.xlsx")
coll_df <- subset(college_df, select = -c(Tire))Step 3: Summarize the data (i.e., descriptive statistics)
head(coll_df)## # 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 0Wet: A numerical variable representing the wet performance rating of a tire (e.g., traction or handling on wet surfaces). Values typically range from 1 to 10, with higher values indicating better performance.
Noise: A numerical variable representing the noise performance rating of a tire (e.g., how quiet the tire is during use). Values range from 1 to 10, with higher values indicating less noise.
Buy_Again: A numerical variable representing the likelihood that customers would repurchase the tire. Values range from 1 to 10, with higher values indicating a stronger willingness to repurchase.
Purchase: A binary variable (0 or 1) indicating whether the customer purchased the tire (1 = purchased, 0 = not purchased). This is the dependent variable in the logistic regression model.summary(coll_df)## 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.0000Interpretation: The median Wet performance rating is , with a median Noise performance rating of 7.1. This indicates that most tires have strong wet performance and relatively low noise levels, contributing positively to customer satisfaction.Step 4: Feature selection(i.e., ccoreelation analysis)
corr <- rcorr(as.matrix(coll_df))
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 0Interpretation: All the predictors (i.e., Wet and Noise ratings) are significant with the target variable (Purchase). The strong correlation between predictors does not indicate multicollinearity issues, ensuring the model's reliability.Step 5: Build the logistic regression
model <- glm(Purchase ~ Wet + Noise, data= coll_df, family = binomial)
summary(model)##
## Call:
## glm(formula = Purchase ~ Wet + Noise, family = binomial, data = coll_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: 8Interpretation: All the independent variables (Wet and Noise ratings) were significant predictors of the target variable (Purchase) at the 0.05 significance level (p-value < 0.05).Question 3: Overall Model significant
Lokeihood Ratio TEst
# Fit a null model
null_model <- glm(Purchase ~ 1, data = coll_df, 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 ' ' 1Interpretation:The inclusion of Wet and Noise ratings as predictors in the logistic regression model significantly predicts the likelihood of a customer purchasing a tire, relative to a null model that predicts purchase behavior based solely on the observed mean outcomes. This demonstrates the added predictive power of the performance ratings.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.8305269Interpretation:A McFadden R-squared of 0.705 means that our logistic regression model explains about 70.5% of the variability in the outcome relative to a model with no predictors. This is considered a strong fit, as values above 0.2 are indicative of a useful model, and values near 0.7 suggest excellent predictive performance.Area Under the Curve (QUC)
Interpretation:The Area Under the Curve (AUC) score represents the ability of the model to correctly classify customers who will purchase a tire and those who will not. A higher AUC value indicates better model performance.# Compute ROC Curve and the AUC score
roc_curve <- roc(coll_df$Purchase, fitted(model))## Setting levels: control = 0, case = 1## Setting direction: controls < casesplot(roc_curve)
auc(roc_curve)## Area under the curve: 0.9741Interpretation:An AUC score of 0.97 indicates that the logistic regression model has a high level of accuracy in predicting whether customers will purchase a tire. This reflects excellent model performance in distinguishing between purchasers and non-purchasers.Questiom 4 & 5: Predicting with new 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, type1 = "response")
prob1 * 100## 1
## 202.791#Predict the probability
prob2 <- predict(model, newdata = new_data2, type2 = "response")
prob2 * 100## 1
## -316.286Interpretation:
There's a `11.63%` chance that the customer will not purchase the tire again with a Wet rating of 7 and a Noise rating of 7.
There's a `88.37%` chance that the customer will purchase the tire again with a Wet rating of 8 and a Noise rating of 8.Question 6: odds Ratio
# Extract the coefficients
coefficients <- summary(model)$coefficients
# Calculate the odd ratio for 'Wet'
odds_ratio_program <- exp(coefficients["Wet", "Estimate"])
odds_ratio_program ## [1] 29.20949Interpretation:The odds ratio for Wet performance rating is 29.12, which is significantly greater than 1. This indicates that higher Wet ratings are associated with substantially higher odds of a customer purchasing the tire compared to lower Wet ratings.