This lab builds a marketing response (marketing mix) model for Los Angeles Dodgers home-game attendance in the 2012 season. Response modeling estimates how an outcome such as attendance responds to marketing inputs such as promotions, while controlling for baseline factors like month and day of week (Miller, 2015; James et al., 2021).
Business question: Do bobblehead (and fireworks) promotions increase attendance at Dodgers home games?
We load the data using the approach from Lecture 2, slide 10 (Xu, 2026).
library(readr)
library(dplyr)
library(ggplot2)
library(lattice)
DodgersData <- read_csv(paste0(
"https://raw.githubusercontent.com/utjimmyx/",
"regression/master/DodgersData.csv"
))
# Clean trailing spaces sometimes present in character columns
DodgersData <- DodgersData %>%
mutate(across(where(is.character), trimws))
str(DodgersData)
## tibble [81 × 12] (S3: tbl_df/tbl/data.frame)
## $ month : chr [1:81] "APR" "APR" "APR" "APR" ...
## $ day : num [1:81] 10 11 12 13 14 15 23 24 25 27 ...
## $ attend : num [1:81] 56000 29729 28328 31601 46549 ...
## $ day_of_week: chr [1:81] "Tuesday" "Wednesday" "Thursday" "Friday" ...
## $ opponent : chr [1:81] "Pirates" "Pirates" "Pirates" "Padres" ...
## $ temp : num [1:81] 67 58 57 54 57 65 60 63 64 66 ...
## $ skies : chr [1:81] "Clear" "Cloudy" "Cloudy" "Cloudy" ...
## $ day_night : chr [1:81] "Day" "Night" "Night" "Night" ...
## $ cap : chr [1:81] "NO" "NO" "NO" "NO" ...
## $ shirt : chr [1:81] "NO" "NO" "NO" "NO" ...
## $ fireworks : chr [1:81] "NO" "NO" "NO" "YES" ...
## $ bobblehead : chr [1:81] "NO" "NO" "NO" "NO" ...
summary(DodgersData[, c("attend", "temp")])
## attend temp
## Min. :24312 Min. :54.00
## 1st Qu.:34493 1st Qu.:67.00
## Median :40284 Median :73.00
## Mean :41040 Mean :73.15
## 3rd Qu.:46588 3rd Qu.:79.00
## Max. :56000 Max. :95.00
cat("\nPromotion counts:\n")
##
## Promotion counts:
cat("Bobblehead YES:", sum(DodgersData$bobblehead == "YES"), "\n")
## Bobblehead YES: 11
cat("Fireworks YES:", sum(DodgersData$fireworks == "YES"), "\n")
## Fireworks YES: 14
cat("Cap YES:", sum(DodgersData$cap == "YES"), "\n")
## Cap YES: 2
cat("Shirt YES:", sum(DodgersData$shirt == "YES"), "\n")
## Shirt YES: 3
Key observations
The lecture’s EDA plots (slides 17–18) follow the Dodgers analysis in Miller (2015) / MDS Chapter 8.
group.labels <- c("No Fireworks", "Fireworks")
group.symbols <- c(21, 24)
group.colors <- c("black", "black")
group.fill <- c("black", "red")
xyplot(
attend / 1000 ~ temp | skies + day_night,
data = DodgersData,
groups = fireworks,
pch = group.symbols,
aspect = 1,
cex = 1.5,
col = group.colors,
fill = group.fill,
layout = c(2, 2),
type = c("p", "g"),
strip = strip.custom(strip.levels = TRUE, strip.names = FALSE, style = 1),
xlab = "Temperature (Degrees Fahrenheit)",
ylab = "Attendance (thousands)",
main = "Attendance by Temp, Time, and Skies",
key = list(
space = "top",
text = list(rev(group.labels), col = rev(group.colors)),
points = list(
pch = rev(group.symbols),
col = rev(group.colors),
fill = rev(group.fill)
)
)
)
What this plot shows
group.labels2 <- c("Day", "Night")
group.symbols2 <- c(1, 20)
group.symbols.size <- c(2, 2.75)
bwplot(
opponent ~ attend / 1000,
data = DodgersData,
groups = day_night,
xlab = "Attendance (thousands)",
main = "Attendance by Opponent",
panel = function(x, y, groups, subscripts, ...) {
panel.grid(h = (length(unique(DodgersData$opponent)) - 1), v = -1)
panel.stripplot(
x, y,
groups = groups,
subscripts = subscripts,
cex = group.symbols.size,
pch = group.symbols2,
col = "darkblue"
)
},
key = list(
space = "top",
text = list(group.labels2, col = "black"),
points = list(
pch = group.symbols2,
cex = group.symbols.size,
col = "darkblue"
)
)
)
What this plot shows
We re-level factors so April and Monday are the reference categories, then fit:
\[\text{attend} = \beta_0 + \beta_{\text{month}} + \beta_{\text{day of week}} + \beta_{\text{bobblehead}} + \varepsilon\]
DodgersData$month <- factor(
DodgersData$month,
levels = c("APR", "MAY", "JUN", "JUL", "AUG", "SEP", "OCT")
)
DodgersData$day_of_week <- factor(
DodgersData$day_of_week,
levels = c(
"Monday", "Tuesday", "Wednesday", "Thursday",
"Friday", "Saturday", "Sunday"
)
)
DodgersData$bobblehead <- factor(DodgersData$bobblehead, levels = c("NO", "YES"))
DodgersData$fireworks <- factor(DodgersData$fireworks, levels = c("NO", "YES"))
my.model <- attend ~ month + day_of_week + bobblehead
my.model.fit <- lm(my.model, data = DodgersData)
summary(my.model.fit)
##
## Call:
## lm(formula = my.model, data = DodgersData)
##
## Residuals:
## Min 1Q Median 3Q Max
## -10786.5 -3628.1 -516.1 2230.2 14351.0
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 33909.16 2521.81 13.446 < 2e-16 ***
## monthMAY -2385.62 2291.22 -1.041 0.30152
## monthJUN 7163.23 2732.72 2.621 0.01083 *
## monthJUL 2849.83 2578.60 1.105 0.27303
## monthAUG 2377.92 2402.91 0.990 0.32593
## monthSEP 29.03 2521.25 0.012 0.99085
## monthOCT -662.67 4046.45 -0.164 0.87041
## day_of_weekTuesday 7911.49 2702.21 2.928 0.00466 **
## day_of_weekWednesday 2460.02 2514.03 0.979 0.33134
## day_of_weekThursday 775.36 3486.15 0.222 0.82467
## day_of_weekFriday 4883.82 2504.65 1.950 0.05537 .
## day_of_weekSaturday 6372.06 2552.08 2.497 0.01500 *
## day_of_weekSunday 6724.00 2506.72 2.682 0.00920 **
## bobbleheadYES 10714.90 2419.52 4.429 3.59e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 6120 on 67 degrees of freedom
## Multiple R-squared: 0.5444, Adjusted R-squared: 0.456
## F-statistic: 6.158 on 13 and 67 DF, p-value: 2.083e-07
par(mfrow = c(2, 2))
plot(my.model.fit)
par(mfrow = c(1, 1))
bobbleheadYES), and the effect is highly significant
(p < 0.001).my.model2 <- attend ~ month + day_of_week + bobblehead + fireworks
my.model2.fit <- lm(my.model2, data = DodgersData)
summary(my.model2.fit)
##
## Call:
## lm(formula = my.model2, data = DodgersData)
##
## Residuals:
## Min 1Q Median 3Q Max
## -9504 -3683 -709 2569 15390
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 34321.68 2418.90 14.189 < 2e-16 ***
## monthMAY -2492.79 2193.60 -1.136 0.25990
## monthJUN 7062.62 2616.13 2.700 0.00881 **
## monthJUL 1315.38 2534.42 0.519 0.60549
## monthAUG 2377.88 2300.15 1.034 0.30501
## monthSEP -55.37 2413.63 -0.023 0.98177
## monthOCT -502.88 3873.86 -0.130 0.89711
## day_of_weekTuesday 7750.46 2587.35 2.996 0.00386 **
## day_of_weekWednesday 904.16 2476.14 0.365 0.71617
## day_of_weekThursday 309.24 3341.63 0.093 0.92655
## day_of_weekFriday -12386.23 6901.86 -1.795 0.07729 .
## day_of_weekSaturday 6094.17 2445.16 2.492 0.01521 *
## day_of_weekSunday 6577.96 2400.14 2.741 0.00788 **
## bobbleheadYES 10995.05 2318.43 4.742 1.17e-05 ***
## fireworksYES 17028.78 6381.63 2.668 0.00958 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 5858 on 66 degrees of freedom
## Multiple R-squared: 0.5887, Adjusted R-squared: 0.5015
## F-statistic: 6.749 on 14 and 66 DF, p-value: 2.848e-08
anova(my.model.fit, my.model2.fit)
## Analysis of Variance Table
##
## Model 1: attend ~ month + day_of_week + bobblehead
## Model 2: attend ~ month + day_of_week + bobblehead + fireworks
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 67 2509574563
## 2 66 2265194779 1 244379784 7.1204 0.009581 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# Almost all fireworks nights are Fridays — important for interpretation
table(DodgersData$day_of_week, DodgersData$fireworks)
##
## NO YES
## Monday 12 0
## Tuesday 13 0
## Wednesday 11 1
## Thursday 5 0
## Friday 0 13
## Saturday 13 0
## Sunday 13 0
fw_coef <- coef(summary(my.model2.fit))["fireworksYES", ]
bh_coef2 <- coef(summary(my.model2.fit))["bobbleheadYES", ]
cat(
"fireworksYES estimate:", round(fw_coef["Estimate"], 1),
"| SE:", round(fw_coef["Std. Error"], 1),
"| t:", round(fw_coef["t value"], 3),
"| p:", signif(fw_coef["Pr(>|t|)"], 3), "\n"
)
## fireworksYES estimate: 17028.8 | SE: 6381.6 | t: 2.668 | p: 0.00958
cat(
"bobbleheadYES (Model 2):", round(bh_coef2["Estimate"], 1),
"| p:", signif(bh_coef2["Pr(>|t|)"], 3), "\n"
)
## bobbleheadYES (Model 2): 10995.1 | p: 1.17e-05
Answer: statistically yes — but interpret with caution.
fireworks improves
model fit (p ≈ 0.01), and fireworksYES is
significant in Model 2.The lecture model uses month, day of week, and bobblehead. “Afternoon” implies a day game; “no promotion” means no bobblehead (and, in Model 2, no fireworks). We predict with both models.
# Scenario: Saturday in July, no bobblehead
new_sat_jul <- data.frame(
month = factor("JUL", levels = levels(DodgersData$month)),
day_of_week = factor("Saturday", levels = levels(DodgersData$day_of_week)),
bobblehead = factor("NO", levels = levels(DodgersData$bobblehead))
)
pred1 <- predict(my.model.fit, newdata = new_sat_jul, interval = "prediction")
cat("Model 1 (month + day_of_week + bobblehead)\n")
## Model 1 (month + day_of_week + bobblehead)
cat("Predicted attendance:", round(pred1[1, "fit"]), "\n")
## Predicted attendance: 43131
cat("95% prediction interval: [", round(pred1[1, "lwr"]), ",",
round(pred1[1, "upr"]), "]\n\n")
## 95% prediction interval: [ 29867 , 56395 ]
# Same scenario with Model 2 (also no fireworks)
new_sat_jul2 <- data.frame(
month = factor("JUL", levels = levels(DodgersData$month)),
day_of_week = factor("Saturday", levels = levels(DodgersData$day_of_week)),
bobblehead = factor("NO", levels = levels(DodgersData$bobblehead)),
fireworks = factor("NO", levels = levels(DodgersData$fireworks))
)
pred2 <- predict(my.model2.fit, newdata = new_sat_jul2, interval = "prediction")
cat("Model 2 (adds fireworks = NO)\n")
## Model 2 (adds fireworks = NO)
cat("Predicted attendance:", round(pred2[1, "fit"]), "\n")
## Predicted attendance: 41731
cat("95% prediction interval: [", round(pred2[1, "lwr"]), ",",
round(pred2[1, "upr"]), "]\n")
## 95% prediction interval: [ 28988 , 54475 ]
Note on “afternoon”: The required lecture formula
does not include day_night, so this forecast is for a
Saturday in July with no bobblehead, averaging over
day/night patterns in the training data. A natural extension would add
day_night as a control if day-vs-night differences are a
planning priority.
# Optional extension: include day_night for a true afternoon forecast
my.model3 <- attend ~ month + day_of_week + bobblehead + day_night
my.model3.fit <- lm(my.model3, data = DodgersData)
new_afternoon <- data.frame(
month = factor("JUL", levels = levels(DodgersData$month)),
day_of_week = factor("Saturday", levels = levels(DodgersData$day_of_week)),
bobblehead = factor("NO", levels = levels(DodgersData$bobblehead)),
day_night = "Day"
)
pred3 <- predict(my.model3.fit, newdata = new_afternoon, interval = "prediction")
cat("Extended model with day_night = Day (Saturday afternoon, July, no promo)\n")
## Extended model with day_night = Day (Saturday afternoon, July, no promo)
cat("Predicted attendance:", round(pred3[1, "fit"]), "\n")
## Predicted attendance: 43644
cat("95% prediction interval: [", round(pred3[1, "lwr"]), ",",
round(pred3[1, "upr"]), "]\n")
## 95% prediction interval: [ 29319 , 57970 ]
Bobblehead promotions are associated with roughly 10,700–11,000 additional fans per game after controlling for month and day of week, and that effect stays strong when fireworks is added. Fireworks also appear statistically related to attendance, but because nearly every fireworks night is a Friday, we cannot cleanly separate the fireworks lift from the Friday-night pattern—so fireworks should not be treated as an independently proven attendance lever from this model alone. Management should therefore prioritize bobblehead giveaways on softer dates (for example, midweek games outside peak June weekends), confirm ROI against giveaway cost and per-fan spend, and gather richer controls (opponent, team record, ticket price) before expanding the promotion calendar.
James, G., Witten, D., Hastie, T., & Tibshirani, R. (2021). An Introduction to Statistical Learning (2nd ed.). Springer. https://www.statlearning.com
Miller, T. W. (2015). Modeling Techniques in Predictive Analytics. Pearson FT Press. Supporting materials: https://github.com/mtpa/mds/tree/master/MDS_Chapter_8
Xu, Z. (2026). Lecture 2 — Exploratory Analysis & Marketing Mix Models. California State University. Dataset: https://raw.githubusercontent.com/utjimmyx/regression/master/DodgersData.csv Related analysis: https://rpubs.com/utjimmyx/Predictions