Problem 3: Automobile Purchase

income <- c(45000, 40000, 60000, 50000, 55000, 50000, 35000, 65000, 53000, 48000, 37000, 31000, 40000, 75000, 43000, 49000, 37500, 71000, 34000, 27000)
age <- c(2, 4, 3, 2, 2, 5, 7, 2, 2, 1, 5, 7, 4, 2, 9, 2, 4, 1, 5, 6)
purchase <- c(0, 0, 1, 1, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0, 1, 0, 1, 0, 0, 0)
  1. Fit logistic regression model
Automobile_Purchase <- glm(purchase ~ income + age, family = binomial)
summary(Automobile_Purchase)
## 
## Call:
## glm(formula = purchase ~ income + age, family = binomial)
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)  
## (Intercept) -7.047e+00  4.674e+00  -1.508    0.132  
## income       7.382e-05  6.371e-05   1.159    0.247  
## age          9.879e-01  5.274e-01   1.873    0.061 .
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 27.726  on 19  degrees of freedom
## Residual deviance: 21.082  on 17  degrees of freedom
## AIC: 27.082
## 
## Number of Fisher Scoring iterations: 5

Model adequacy - Overall test

anova(Automobile_Purchase)
## Analysis of Deviance Table
## 
## Model: binomial, link: logit
## 
## Response: purchase
## 
## Terms added sequentially (first to last)
## 
## 
##        Df Deviance Resid. Df Resid. Dev Pr(>Chi)  
## NULL                      19     27.726           
## income  1   0.7349        18     26.991  0.39129  
## age     1   5.9094        17     21.081  0.01506 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
  1. Interpretation
exp(coef(Automobile_Purchase)[-1])
##   income      age 
## 1.000074 2.685551
  1. Estimated probability for Income = $45,000, Age = 5
new_data <- data.frame(income = 45000, age = 5)
pred_prob <- predict(Automobile_Purchase, newdata = new_data, type = "response")
  1. Interaction term
Automobile_Purchase_interaction <- glm(purchase ~ income * age, family = binomial)
summary(Automobile_Purchase_interaction)
## 
## Call:
## glm(formula = purchase ~ income * age, family = binomial)
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)
## (Intercept)  3.144e-01  6.394e+00   0.049    0.961
## income      -1.411e-04  1.412e-04  -0.999    0.318
## age         -2.462e+00  2.081e+00  -1.183    0.237
## income:age   1.014e-04  6.297e-05   1.610    0.107
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 27.726  on 19  degrees of freedom
## Residual deviance: 16.551  on 16  degrees of freedom
## AIC: 24.551
## 
## Number of Fisher Scoring iterations: 6
cat("\nInteraction Term Test:\n")
## 
## Interaction Term Test:
anova(Automobile_Purchase, Automobile_Purchase_interaction, test = "Chisq")
## Analysis of Deviance Table
## 
## Model 1: purchase ~ income + age
## Model 2: purchase ~ income * age
##   Resid. Df Resid. Dev Df Deviance Pr(>Chi)  
## 1        17     21.081                       
## 2        16     16.551  1   4.5307  0.03329 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

```