Load Packages
library(readxl) # Import excel files
library(Hmisc) # Correlation Function
## Warning: package 'Hmisc' was built under R version 4.4.2
##
## Attaching package: 'Hmisc'
## The following objects are masked from 'package:base':
##
## format.pval, units
library(pscl) # Pseudo R-Square package to evaluate our model with McFadden R Square
## Warning: package 'pscl' was built under R version 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)
## Warning: package 'pROC' was built under R version 4.4.2
## Type 'citation("pROC")' for a citation.
##
## Attaching package: 'pROC'
## The following objects are masked from 'package:stats':
##
## cov, smooth, var
Load and Clean the Data
data <- read_excel("C:/Users/nikol/Downloads/Class Exercise 15_TireRatings.xlsx")
data_df <- subset(data, select = -c(Tire)) # Drop Irrelevant Column
Summarize the Data
head(data_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 0
summary(data_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.0000
Data Description: Description of the features presented in the table below:
Variable | Definition
------------ | ------------
1. Purchase | Our dependent variable, a 1 indicates that the respondent would probably or definetely buy the tire again.
2. Buy-Again | The average of the buy-again responses.
3. Noise | The average ratings for the noise level generated by each tire.
4. Wet | The average ratings for each tire's wet traction performance.
Logit Model
model <- glm(Purchase ~ Wet + Noise, family = binomial, data = data_df) # We are only using independent variables Wet and Noise as that is what the question specified.
summary(model)
##
## Call:
## glm(formula = Purchase ~ Wet + Noise, family = binomial, data = data_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)
Test for McFadden Significance (Pseudo R-Squared)
pR2(model)# McFadden = 0.71
## 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: Since our McFadden value is not between 0.2 and 0.4, we cannot conclude that our model is significant.
Estimating with our Model
new_data1 <- data.frame(Wet = 8, Noise = 8, Purchase = 1)
new_data2 <- data.frame(Wet = 7, Noise = 7, Purchase = 1)
prob1 <- predict(model, newdata = new_data1, type = "response") # Output: 88.37%
prob2 <- predict(model, newdata = new_data2, type = "response") # Output: 4.06%
Interpretation: When the Wet and Noise performance ratings are both 8, the probability that a customer will probably or definetely purchase a tire again is 88.37%. When the Wet and Noise performance ratings are both 7, the probability that a customer will probably or definetely purchase a tire again is 4.07%.