MiM 811 - Marketing Analytics Quiz 4

Logistic Regression / Predictive Modeling

1 Introduction

This project uses logistic regression to predict customer subscription behavior based on age and gender. By quantifying how these demographics drive conversion, this analysis identifies high-value customer segments. The resulting evidence-based insights will guide managerial decisions on marketing investment and targeting strategy.

2 Define Outcome and Select Predictors

• Outcome: Subscribe (Binary, 1=Yes)
  
• Predictors: Age, Gender

3 Loading & Reading Data

# Load the data
library(readxl)
Q4 <- read_excel("Logitsubscribedata.xlsx", 
    sheet = "data")
# Clean column names for easier R handling
colnames(Q4) <- c("Age", "Gender", "Subscribe")
Q4$Gender <- factor(Q4$Gender, levels = c(0, 1), labels = c("Man", "Woman"))
Q4$Subscribe <- factor(Q4$Subscribe, levels = c(0, 1), labels = c("No", "Yes"))
str(Q4)

## tibble [1,345 × 3] (S3: tbl_df/tbl/data.frame)
##  $ Age      : num [1:1345] 33 45 57 32 56 60 40 55 27 48 ...
##  $ Gender   : Factor w/ 2 levels "Man","Woman": 1 2 1 2 1 2 1 1 1 2 ...
##  $ Subscribe: Factor w/ 2 levels "No","Yes": 1 1 1 1 1 2 1 1 1 1 ...

4 Descriptive Statistics & Summary

4.1 Summary

summary(Q4)

##       Age          Gender    Subscribe 
##  Min.   :20.00   Man  :662   No :1025  
##  1st Qu.:29.00   Woman:683   Yes: 320  
##  Median :40.00                         
##  Mean   :39.65                         
##  3rd Qu.:50.00                         
##  Max.   :60.00

4.2 Subscription Rate

prop.table(table(Q4$Subscribe))

## 
##        No       Yes 
## 0.7620818 0.2379182

4.3 Gender Distribution

prop.table(table(Q4$Gender))

## 
##       Man     Woman 
## 0.4921933 0.5078067

5 Estimate The Logistic Regression Model

logit_model <- glm(Subscribe ~ Age + Gender, 
                   data = Q4, 
                   family = binomial(link = "logit"))

# Display the summary output
summary(logit_model)

## 
## Call:
## glm(formula = Subscribe ~ Age + Gender, family = binomial(link = "logit"), 
##     data = Q4)
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  0.597628   0.230870   2.589  0.00964 ** 
## Age         -0.052399   0.005895  -8.888  < 2e-16 ***
## GenderWoman  0.407014   0.133725   3.044  0.00234 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1475.9  on 1344  degrees of freedom
## Residual deviance: 1381.1  on 1342  degrees of freedom
## AIC: 1387.1
## 
## Number of Fisher Scoring iterations: 4

# 4. Alternative Specification (Age Squared for non-linear effects)
model_sq <- glm(Subscribe ~ Age + I(Age^2) + Gender, 
                data = Q4, 
                family = binomial(link = "logit"))

# Compare models using AIC (Lower is better)
cat("AIC Model 1 (Linear Age):", AIC(logit_model), "\n")

## AIC Model 1 (Linear Age): 1387.112

cat("AIC Model 2 (Age Squared):", AIC(model_sq), "\n")

## AIC Model 2 (Age Squared): 1385.573

6 Bonus Insights

6.1 Simple Visualization: Predicted Probabilities

library(ggplot2)

# Create a data frame for predictions
new_data <- expand.grid(
  Age = seq(min(Q4$Age), max(Q4$Age), length.out = 100),
  Gender = factor(c("Man", "Woman"), levels = c("Man", "Woman"))
)

# Generate predicted probabilities
new_data$prob <- predict(logit_model, newdata = new_data, type = "response")

# Plotting
ggplot(new_data, aes(x = Age, y = prob, color = Gender)) +
  geom_line(size = 1) +
  labs(title = "Probability of Subscription vs. Age",
       subtitle = "Higher subscription likelihood among younger females",
       x = "Age", y = "Predicted Probability") +
  theme_minimal()

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

6.2 Segmentation Insight

# Assign predicted probabilities to the original dataset
Q4$pred_prob <- predict(logit_model, type = "response")

# Identify the 'Top Tier' Segment (Top 25% likely to subscribe)
top_tier <- Q4 %>% filter(pred_prob > quantile(pred_prob, 0.75))

# Summary of the Top Tier
summary(top_tier[, c("Age", "Gender")])

##       Age          Gender   
##  Min.   :20.00   Man  :100  
##  1st Qu.:21.25   Woman:226  
##  Median :24.00              
##  Mean   :24.71              
##  3rd Qu.:27.75              
##  Max.   :32.00

6.3 Model Limitations and Bias

While statistically significant, this model has limitations. The low Pseudo R-squared indicates omitted variable bias, as we lack data on key drivers like income or brand loyalty. There is also a risk of selection bias if this sample doesn’t represent the broader market. Finally, these results show correlation, not causality; for example, high engagement in younger women might be driven by the specific marketing channels they use rather than age itself.