Class Exercise 15

Project Objective

To investigate the relationship between the independent variables of Noise and Wet rating and purchases for tires.

Step 1: Install and load required libraries

#install.packages("readxl")
#install.packages("Hmisc")
#install.packages("pscl")
library("readxl")

## Warning: package 'readxl' was built under R version 4.4.2

library(pscl)

## 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(Hmisc)

## 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

Step 2: Import and clean the data

data <- read_excel(file.choose())

df <- subset(data, select = -c(Tire)) #drop tire column

Step 3: Summarize the data

head(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(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

Step 4: Feature selection(correlation analysis)

corr <- rcorr(as.matrix(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     0

Interpretation: All the predictors are significant with target variable(Purchase). There’s no multicollinearity to the data.

All

Step 5: Build logistic regression model

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

## 
## Call:
## glm(formula = Purchase ~ Wet + Noise, family = binomial, 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

Question 2: Are the independent variables significant based on the z-test? (Use alpha = 0.05)

Interpretation: Wet and Noise rating variable were significant (p-value < 0.05)

Question 3: Assess the overall model significance using the: McFadden R-Squared

###Likelihood Ratio Test

#Fit a null model
null_model <- glm(Purchase ~ 1, data = df, family = binomial)
null_model

## 
## Call:  glm(formula = Purchase ~ 1, family = binomial, data = df)
## 
## Coefficients:
## (Intercept)  
##     -0.2364  
## 
## Degrees of Freedom: 67 Total (i.e. Null);  67 Residual
## Null Deviance:       93.32 
## Residual Deviance: 93.32     AIC: 95.32

#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 ' ' 1

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.8305269

Interpretation: Under Mcfadden, an R-squared of 0.71 (rounded) means that our Logistics Regression model explains that 71% of the variability in the outcome relative to a model with no predictors. This is considered a good fit.

Question 4&5: Probability with new ratings

new_data1 <- data.frame(Wet = 7, Noise = 7, Purchase = 1)
new_data2 <- data.frame(Wet = 8, Noise = 8, Purchase = 1)

prob1 <- predict(model, newdata = new_data1, type = "response")
prob1 * 100

##        1 
## 4.058753

prob2 <- predict(model, newdata = new_data2, type = "response")
prob2 * 100

##        1 
## 88.36964

Interpretation:
Question 5: There is a 88.37% chance the customer would buy again if they rated their tires 8 for wet and noise.

Question 4: There is a 4.06% chance the customer would buy again if they rated their tires 7 for wet and noise.