To investigate the relationship between tire's wet traction performance and noise level generated with whether the customer will buy the tire again at a tire rack#install.packages("readxl")
#install.packages("Hmisc")
#install.packages("pscl")
#install.packages("tidyxl")
#if(!require(prOC)) install.packages("pROC")
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, unitslibrary(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, vartires_df <- read_excel("~/Desktop/r markdown/Class Exercise 15_TireRatings.xlsx")
tire_df <- subset(tires_df, select = -c(Buy_Again)) # drop irrelevant columnhead(tire_df)## # A tibble: 6 × 4
## Tire Wet Noise Purchase
## <chr> <dbl> <dbl> <dbl>
## 1 BFGoodrich g-Force Super Sport A/S 8 7.2 0
## 2 BFGoodrich g-Force Super Sport A/S H&V 8 7.2 1
## 3 BFGoodrich g-Force T/A KDWS 7.6 7.5 1
## 4 Bridgestone B381 6.6 5.4 0
## 5 Bridgestone Insignia SE200 5.8 6.3 0
## 6 Bridgestone Insignia SE200-02 6.3 5.7 0Data Description: A description of the features presented below
Variable. | Definition
--------------- ------------
1.Wet traction performance | Measures how well tire grips a wet road surface
2.noise level generated. | measures in decibels how loud a tire is
3.Purchase. |whether someone is purchasing the tire(1:buy-again response is 7 or more
0:buy again is less than 7)
``` r
summary(tire_df)## Tire Wet Noise Purchase
## Length:68 Min. :4.300 Min. :3.600 Min. :0.0000
## Class :character 1st Qu.:6.450 1st Qu.:6.000 1st Qu.:0.0000
## Mode :character 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.0000Interpretation:The median Noise level is 7.1, with a median of 7.75 wet traction performancetire_df <- tire_df[sapply(tire_df, is.numeric)]
corr <- rcorr(as.matrix(tire_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 0Interpretation: all the predictors are significant with the targert variable(i.e, Purchase). There's multicollinarity in the data between the wet traction and noise level.model <- glm(Purchase ~ Wet + Noise, data = tire_df, family = binomial)
summary(model)##
## Call:
## glm(formula = Purchase ~ Wet + Noise, family = binomial, data = tire_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 were significant(p-value < 0.05)## Question 3: Overall Model Significance
###LIkelihood Ratio Test
# fit a null model
null_model <-glm(Purchase ~ 1, data = tire_df, family = binomial)
# perform likelihood
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 traction and noise level are predictors in our LR model does indeed significantly predict the likelihoods of People purchasing tires from the tire rack, relative to a model that predicts purchase based solely on the mean of observed outcomes(i.e, null model)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.71 means that our LR model explains about 70% of the variability in the outcome relative to a model with no predictors. This is considered a strong fit, where values above 0.2 to 0.4 are often seen as indicative of a useful model.# Given the following new student information
new_data1 <- data.frame(Wet = 8, Noise = 8)#will probably purchase again
new_data2 <- data.frame(Wet = 7, Noise = 7)#will probably purchase again
# predict the probability
# (a) probability that the customer will probably or definitely purchase a particular tire again
prob1 <- predict(model, newdata = new_data1, type = "response" )
prob1 * 100## 1
## 88.36964# (b) probability that the customer will probably or definitely purchase a particular tire again with different ratings
prob1 <- predict(model, newdata = new_data2, type = "response" )
prob1 * 100## 1
## 4.058753Interpretation
(1) Theres a 88.37% chance that the customer will probably or definitely purchase a particular tire again with a wet traction rating of 8 and a noise level of 8.
(2)Theres a 4.06% chance that the customer will probably or definitely purchase a particular tire again with a wet traction rating of 7 and a noise level of 7.