#Tire Rack

#The 68 all-season tires were assesed.Both 
#traction "wet" and the sound "Noise" as seen in 
#the data set were rated on a 10 point scale

Step 1: Load Libraries

#install.packages("readxl")
#install.packages("Hmisc")
#install.packages("pscl")
#if(!require(pROC)) install.packages("pROC")

library(readxl)
library(Hmisc)

## Warning: package 'Hmisc' was built under R version 4.3.3

## 
## Attaching package: 'Hmisc'

## The following objects are masked from 'package:base':
## 
##     format.pval, units

library(pscl)

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

## Type 'citation("pROC")' for a citation.

## 
## Attaching package: 'pROC'

## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var

#Step 2: Load Data

TireRating_df <- read_excel("Class Exercise 15_TireRatings (1).xlsx")
Tire_df <- subset(TireRating_df, select = -c(Tire, Buy_Again))
summary(Tire_df)

##       Wet            Noise          Purchase     
##  Min.   :4.300   Min.   :3.600   Min.   :0.0000  
##  1st Qu.:6.450   1st Qu.:6.000   1st Qu.:0.0000  
##  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.0000

# Interpretation: The median for Wet tires is 4.3, with a median of 7.75 meaning the tires after getting wet 
# meaning that more tires will be purchased afterwards

#Step 3: Create 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: 8

# The p-value from Wet at 0.00760 and Noise at 0.02887, are <0.05 indicating that 
# the independent variables are statistcally significant

#Step 4: Calculate McFadden 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: A McFadden R- squared of 0.71. This means that it 
# is more likely to have a correspondence between the observation and the predicted outcome.

Step 5:

roc_curve <- roc(Tire_df$Purchase, fitted(model))

## Setting levels: control = 0, case = 1

## Setting direction: controls < cases

plot(roc_curve)

auc(roc_curve)

## Area under the curve: 0.9741

# First prediction
new_data1 <- data.frame(Wet = 8, Noise = 8)
prob1 <- predict(model, newdata = new_data1, type = "response")
prob1 * 100

##        1 
## 88.36964

# Second prediction
new_data2 <- data.frame (Wet = 7, Noise = 7)
prob2 <- predict(model, newdata = new_data2, type = "response")
prob2 * 100

##        1 
## 4.058753

coefficients <- summary(model)$coefficients
odds_ratio <- exp(coefficients["Wet", "Estimate"])
odds_ratio

## [1] 29.20949

coefficients <- summary(model)$coefficients
odds_ratio <- exp(coefficients["Noise", "Estimate"])
odds_ratio

## [1] 6.148919