Tire Ratings Survey
Project Objective
To investigate the relationship between Purchasing again and the ratings forWet and Noise.Question 1 and 2: Develop the logistic regression model. Are the independent variables significant based on the z-test? (alpha=0.05)
###Step 1: Install and load required libraries
install.packages("Readxl")## Installing package into 'C:/Users/12092/AppData/Local/R/win-library/4.4'
## (as 'lib' is unspecified)## Warning: package 'Readxl' is not available for this version of R
##
## A version of this package for your version of R might be available elsewhere,
## see the ideas at
## https://cran.r-project.org/doc/manuals/r-patched/R-admin.html#Installing-packages## Warning: Perhaps you meant 'readxl' ?install.packages("Hmisc")## Installing package into 'C:/Users/12092/AppData/Local/R/win-library/4.4'
## (as 'lib' is unspecified)## package 'Hmisc' successfully unpacked and MD5 sums checked## Warning: cannot remove prior installation of package 'Hmisc'## Warning in file.copy(savedcopy, lib, recursive = TRUE): problem copying
## C:\Users\12092\AppData\Local\R\win-library\4.4\00LOCK\Hmisc\libs\x64\Hmisc.dll
## to C:\Users\12092\AppData\Local\R\win-library\4.4\Hmisc\libs\x64\Hmisc.dll:
## Permission denied## Warning: restored 'Hmisc'##
## The downloaded binary packages are in
## C:\Users\12092\AppData\Local\Temp\Rtmpw7Dj2h\downloaded_packagesinstall.packages("pscl")## Installing package into 'C:/Users/12092/AppData/Local/R/win-library/4.4'
## (as 'lib' is unspecified)## package 'pscl' successfully unpacked and MD5 sums checked## Warning: cannot remove prior installation of package 'pscl'## Warning in file.copy(savedcopy, lib, recursive = TRUE): problem copying
## C:\Users\12092\AppData\Local\R\win-library\4.4\00LOCK\pscl\libs\x64\pscl.dll to
## C:\Users\12092\AppData\Local\R\win-library\4.4\pscl\libs\x64\pscl.dll:
## Permission denied## Warning: restored 'pscl'##
## The downloaded binary packages are in
## C:\Users\12092\AppData\Local\Temp\Rtmpw7Dj2h\downloaded_packagesinstall.packages("pROC")## Installing package into 'C:/Users/12092/AppData/Local/R/win-library/4.4'
## (as 'lib' is unspecified)## package 'pROC' successfully unpacked and MD5 sums checked## Warning: cannot remove prior installation of package 'pROC'## Warning in file.copy(savedcopy, lib, recursive = TRUE): problem copying
## C:\Users\12092\AppData\Local\R\win-library\4.4\00LOCK\pROC\libs\x64\pROC.dll to
## C:\Users\12092\AppData\Local\R\win-library\4.4\pROC\libs\x64\pROC.dll:
## Permission denied## Warning: restored 'pROC'##
## The downloaded binary packages are in
## C:\Users\12092\AppData\Local\Temp\Rtmpw7Dj2h\downloaded_packageslibrary(readxl)
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, unitslibrary(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(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###Step 2: Import and clean the data
df <- read_excel(file.choose())
tire_df <- subset(df, select = -c(Tire))Step 3: Summarize the data
head(tire_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 0summary(tire_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 rating is 7.75 and the median Noise Rating is 6.90. The median rating for Buy Again is 5.65 meaning out most individuals will possibly buy again. Step 4: Correlation
corr <- rcorr(as.matrix(tire_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 are significant. There's is multicollinearity in the data.Step 5: Build the logistic regression model
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 are significant (p-value < 0.05)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-Sqaured of 0.71 means that there is a 71% of the variability in the outcome relative to a model with no predictors. This is considered a good fit. Area Under the Curve (AUC)
roc_curve <- roc(tire_df$Purchase, fitted(model))## Setting levels: control = 0, case = 1## Setting direction: controls < casesplot(roc_curve)
auc(roc_curve)## Area under the curve: 0.9741Question 4 and 5: Predicting with new information
new_data1 <- data.frame(Wet = 8, Noise = 8)
new_data2 <- data.frame(Wet = 7, Noise = 7)
prob1 <- predict(model, newdata = new_data1, type = "response")
prob1 * 100## 1
## 88.36964prob2 <- predict(model, newdata = new_data2, type = "response")
prob2 * 100## 1
## 4.058753Interpretation:
(1) There is a 88.37% chance that they will buy all season tires from Tire Rack again.
(2) There is a 4.06% chance that they will buy all season tired from Tire Rack again.