Predictive Model for Los Angeles Dodgers Promotion and Attendance (R)
Victor Gonzalez
10/1/2026
R Markdown
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
Introduction
It is tough to make good predictions. The numerous factors or variables, independent and dependent, involved in many sporting events contribute to the unpredictability. However, using carefully-selected variables, it is still possible to make marketing promotions more accountable.
The goal of this case study is to analyze if bobblehead promotions increase attendance at Dodgers home games. Using the fitted predictive model we can predict the attendance for the game in the forthcoming season and we can predict the attendance with or without bobblehead promotion.
The motivation of this case study is to design a predictive model, and report any interesting findings to support critical business decision making.
Pre-Processing
Important Tips: please make sure DodgersData.csv is uploaded to the SAME folder as this .Rmd file.
Load the required libraries and the data
library(lattice) # Graphics Package
library(ggplot2) # Graphical Package
library(readr)
# DodgersData.csv must be in the same folder as this .Rmd file
DodgersData <- read_csv("DodgersData.csv")## Rows: 81 Columns: 12
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (9): month, day_of_week, opponent, skies, day_night, cap, shirt, firewor...
## dbl (3): day, attend, temp
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.Data cleanup and exploratory analysis
Evaluate the structure and re-level the factor variables for “Day of Week” and “Month” in the right order.
# Remove stray spaces (the skies column has "Clear " with a trailing space)
DodgersData$skies <- trimws(DodgersData$skies)
# read_csv imports text as character, so convert to ordered factors
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"))
# Check the structure of the data
str(DodgersData)## spc_tbl_ [81 × 12] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ month : Factor w/ 7 levels "APR","MAY","JUN",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ 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: Factor w/ 7 levels "Monday","Tuesday",..: 2 3 4 5 6 7 1 2 3 5 ...
## $ 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" ...
## - attr(*, "spec")=
## .. cols(
## .. month = col_character(),
## .. day = col_double(),
## .. attend = col_double(),
## .. day_of_week = col_character(),
## .. opponent = col_character(),
## .. temp = col_double(),
## .. skies = col_character(),
## .. day_night = col_character(),
## .. cap = col_character(),
## .. shirt = col_character(),
## .. fireworks = col_character(),
## .. bobblehead = col_character()
## .. )
## - attr(*, "problems")=<pointer: 0x651bf748a260># Evaluate the factor levels
levels(DodgersData$month)## [1] "APR" "MAY" "JUN" "JUL" "AUG" "SEP" "OCT"levels(DodgersData$day_of_week)## [1] "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"
## [7] "Sunday"# First 10 rows of the data frame
head(DodgersData, 10)## # A tibble: 10 × 12
## month day attend day_of_week opponent temp skies day_night cap shirt
## <fct> <dbl> <dbl> <fct> <chr> <dbl> <chr> <chr> <chr> <chr>
## 1 APR 10 56000 Tuesday Pirates 67 Clear Day NO NO
## 2 APR 11 29729 Wednesday Pirates 58 Cloudy Night NO NO
## 3 APR 12 28328 Thursday Pirates 57 Cloudy Night NO NO
## 4 APR 13 31601 Friday Padres 54 Cloudy Night NO NO
## 5 APR 14 46549 Saturday Padres 57 Cloudy Night NO NO
## 6 APR 15 38359 Sunday Padres 65 Clear Day NO NO
## 7 APR 23 26376 Monday Braves 60 Cloudy Night NO NO
## 8 APR 24 44014 Tuesday Braves 63 Cloudy Night NO NO
## 9 APR 25 26345 Wednesday Braves 64 Cloudy Night NO NO
## 10 APR 27 44807 Friday Nationals 66 Clear Night NO NO
## # ℹ 2 more variables: fireworks <chr>, bobblehead <chr>Let R identify the temperature, the attendance, the opponent, and the promotion (i.e., bobblehead) for the 20th home game of the season.
DodgersData[20, c("temp", "attend", "opponent", "bobblehead")]## # A tibble: 1 × 4
## temp attend opponent bobblehead
## <dbl> <dbl> <chr> <chr>
## 1 70 47077 Snakes YESDodgersData[25, c("temp", "attend", "opponent", "bobblehead")]## # A tibble: 1 × 4
## temp attend opponent bobblehead
## <dbl> <dbl> <chr> <chr>
## 1 61 36561 Astros NOLet R identify the average value for attendance.
meanattend <- mean(DodgersData$attend)
meanattend## [1] 41040.07medianattend <- median(DodgersData$attend)
medianattend## [1] 40284Let R identify the number of promotions they have had.
promotions <- sum(DodgersData$bobblehead == "YES")
promotions## [1] 11Night_games <- sum(DodgersData$day_night == "Night")
Night_games## [1] 66Note: You may perform the regression analysis using Excel.
If you chose to use R and RStudio, please work on any two of the first three questions (1a, 1b, and 1c) and the last two questions (2 and 3).
If you chose to use Excel, please post your spreadsheet solutions and the answers to Questions 1a, 1b, 1c, 2, and 3.
Q 1a: Let R identify the temperature, the attendance, the opponent, and the promotion (i.e., bobblehead) for the 25th home game of the season. Report your results.
row25 <- DodgersData[25, c("temp", "attend", "opponent", "bobblehead")]
row25## # A tibble: 1 × 4
## temp attend opponent bobblehead
## <dbl> <dbl> <chr> <chr>
## 1 61 36561 Astros NOAnswer: In the 25th home game of the season, the temperature was 61 degrees Fahrenheit and the attendance was 36,561 fans. The visiting team was the Astros, and there was no bobblehead promotion at that game.
Q 1b: What is the median value of attendance? Please review your in-class notes and write your function and answer below.
median(DodgersData$attend)## [1] 40284Answer: I used the median() function. The median
attendance was 40,284 fans, which means half of the home games had more
fans than this and half had fewer.
Q 1c: How many night games did the Dodgers have? Please review your in-class notes and write your function and answer below.
sum(DodgersData$day_night == "Night")## [1] 66Answer: I used sum(DodgersData$day_night == "Night"),
which counts every game marked as a night game. The Dodgers had 66 night
games out of 81 home games.
Exploratory analysis
The results show that in 2012 there were a few promotions (see the last four columns): Cap, Shirt, Fireworks, Bobblehead.
We have data from April to October for games played in the Day or Night under Clear or Cloudy Skies.
Dodger Stadium has a capacity of about 56,000. Looking at the entire (sample) data shows that the stadium filled up only twice in 2012. There were only two cap promotions and three shirt promotions, which is not enough data for any inferences. Fireworks and Bobblehead promotions have happened a few times.
Furthermore, there were eleven bobblehead promotions and most of them (six) were on Tuesday nights.
Evaluate Attendance by Weather
ggplot(DodgersData, aes(x = temp, y = attend/1000, color = fireworks)) +
geom_point() +
facet_wrap(day_night ~ skies) +
ggtitle("Dodgers Attendance By Temperature By Time of Game and Skies") +
theme(plot.title = element_text(lineheight = 3, face = "bold",
color = "black", size = 10)) +
xlab("Temperature (Degrees Fahrenheit)") +
ylab("Attendance (Thousands)")
Strip Plot of Attendance by Opponent or Visiting Team
ggplot(DodgersData, aes(x = attend/1000, y = opponent, color = day_night)) +
geom_point() +
ggtitle("Dodgers Attendance By Opponent") +
theme(plot.title = element_text(lineheight = 3, face = "bold",
color = "black", size = 10)) +
xlab("Attendance (Thousands)") +
ylab("Opponent (Visiting Team)")
Design Predictive Model
To advise the management if promotions impact attendance we will need to identify if there is a positive effect, and if there is a positive effect how much of an effect it is.
To provide this advice, I built a linear model for predicting attendance using Month, Day of Week and the indicator variable Bobblehead promotion.
# Model with the bobblehead variable entered last
my.model <- attend ~ month + day_of_week + bobblehead
# Use the full data set to estimate the increase in attendance
# due to bobbleheads, controlling for other factors
my.model.fit <- lm(my.model, data = DodgersData)
print(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# Save key results so they can be used in the answers below
bobble_effect <- coef(my.model.fit)["bobbleheadYES"]
bobble_p <- summary(my.model.fit)$coefficients["bobbleheadYES", "Pr(>|t|)"]
model_r2 <- summary(my.model.fit)$r.squared
temp_cor <- cor(DodgersData$temp, DodgersData$attend)Answers to Questions 2 to 4
Q 2: Interpret one of the box plots or scatter plots in plain language.
Answer: I looked at the scatter plot of attendance by temperature. Each dot is one home game, with temperature across the bottom and attendance (in thousands) up the side. The correlation between temperature and attendance is only 0.1, which is a very weak positive relationship. In plain language, attendance goes up only slightly when the weather is warmer, so temperature does not explain much of why some games draw bigger crowds than others. The plot also shows that fireworks games (the colored dots) are spread across the whole range of attendance and do not stand out as bigger crowds.
Q 3: Explain the final statistical results in plain language.
Answer: The model compares attendance while accounting for the month and the day of the week, so bobblehead games are compared fairly with other games. It estimates that games with a bobblehead promotion drew about 10,715 more fans on average than games without one. This difference is statistically significant (p = 3.59^{-5}), so it is very unlikely to be just random chance. The model explains about 54% of the differences in attendance from game to game. Day of the week also matters: Tuesday, Saturday, and Sunday games drew noticeably more fans than Mondays. For management, this means bobblehead promotions appear to be a worthwhile way to boost attendance. There were only eleven bobblehead games, so the result should be confirmed with more data, and since most were on Tuesday nights, part of the effect could be tied to that day.
Q 4: Please read the tutorial “Advanced topics - Formatting a testable marketing hypothesis.docx” and develop two “draft” hypotheses for your group project.
Answer:
Draft Hypothesis 1: Dodgers home games with a bobblehead promotion will have higher average attendance than home games without a bobblehead promotion, after controlling for month and day of the week.
Draft Hypothesis 2: Dodgers home games played on weekends will have higher average attendance than games played on weekdays.
Reference
This case study is originally from Modeling Techniques in Predictive Analysis by Thomas W. Miller. Thank you, Dr. Miller!
This book is a must-read for digital marketers!!! Enjoy and have fun!