R_project
2025-01-31
Super Bowl Ad Engagement Analysis
Introduction
Super Bowl advertisements are a crucial aspect of the annual sports event, attracting millions of viewers and significant brand investment. This project analyzes Super Bowl ad engagement metrics to determine what factors contribute to higher audience interactions, particularly through YouTube likes and comments. The study also explores brand performance, humor’s impact on engagement, and the relationship between TV viewership and online interactions.
Dataset Overview
The dataset consists of Super Bowl advertisements from 2000 onwards, enriched with additional metrics such as:
- Engagement Metrics: Likes, dislikes, comments, and views on YouTube
- Attributes: Whether the ad features humor, celebrities, animals,
patriotic themes, danger, or explicit product placement
- TV Metrics: TV views in millions, NFL revenue from advertisements
- Ad Descriptions: Brand, year, ad url
The data was sourced from Tidy Tuesday data on GitHub and enriched using statista.
⚠ Dataset Limitation: This dataset does not include all Super Bowl ads. Instead, it consists of 233 ads from the 10 brands that aired the most frequently during Super Bowls in the past two decades. The data was sourced from SuperBowlAds.com, meaning some brands and ads are missing.
library(data.table)
library(skimr)
library(readr)
library(tidyr)
library(ggplot2)
library(scales)
library(RColorBrewer)
#superbowl data from tody tuesday
sb <- fread('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2021/2021-03-02/youtube.csv')
sb <- as.data.table(sb)
skim(sb)| Name | sb |
| Number of rows | 247 |
| Number of columns | 25 |
| Key | NULL |
| _______________________ | |
| Column type frequency: | |
| character | 10 |
| logical | 7 |
| numeric | 7 |
| POSIXct | 1 |
| ________________________ | |
| Group variables | None |
Variable type: character
| skim_variable | n_missing | complete_rate | min | max | empty | n_unique | whitespace |
|---|---|---|---|---|---|---|---|
| brand | 0 | 1.00 | 3 | 9 | 0 | 10 | 0 |
| superbowl_ads_dot_com_url | 0 | 1.00 | 34 | 120 | 0 | 244 | 0 |
| youtube_url | 11 | 0.96 | 43 | 43 | 0 | 233 | 0 |
| id | 11 | 0.96 | 11 | 11 | 0 | 233 | 0 |
| kind | 16 | 0.94 | 13 | 13 | 0 | 1 | 0 |
| etag | 16 | 0.94 | 27 | 27 | 0 | 228 | 0 |
| title | 16 | 0.94 | 6 | 100 | 0 | 228 | 0 |
| description | 16 | 0.94 | 0 | 3611 | 34 | 195 | 0 |
| thumbnail | 129 | 0.48 | 48 | 48 | 0 | 118 | 0 |
| channel_title | 16 | 0.94 | 3 | 37 | 0 | 185 | 0 |
Variable type: logical
| skim_variable | n_missing | complete_rate | mean | count |
|---|---|---|---|---|
| funny | 0 | 1 | 0.69 | TRU: 171, FAL: 76 |
| show_product_quickly | 0 | 1 | 0.68 | TRU: 169, FAL: 78 |
| patriotic | 0 | 1 | 0.17 | FAL: 206, TRU: 41 |
| celebrity | 0 | 1 | 0.29 | FAL: 176, TRU: 71 |
| danger | 0 | 1 | 0.30 | FAL: 172, TRU: 75 |
| animals | 0 | 1 | 0.37 | FAL: 155, TRU: 92 |
| use_sex | 0 | 1 | 0.27 | FAL: 181, TRU: 66 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| year | 0 | 1.00 | 2010.19 | 5.86 | 2000 | 2005 | 2010 | 2015.00 | 2020 | ▇▇▇▇▆ |
| view_count | 16 | 0.94 | 1407556.46 | 11971111.01 | 10 | 6431 | 41379 | 170015.50 | 176373378 | ▇▁▁▁▁ |
| like_count | 22 | 0.91 | 4146.03 | 23920.40 | 0 | 19 | 130 | 527.00 | 275362 | ▇▁▁▁▁ |
| dislike_count | 22 | 0.91 | 833.54 | 6948.52 | 0 | 1 | 7 | 24.00 | 92990 | ▇▁▁▁▁ |
| favorite_count | 16 | 0.94 | 0.00 | 0.00 | 0 | 0 | 0 | 0.00 | 0 | ▁▁▇▁▁ |
| comment_count | 25 | 0.90 | 188.64 | 986.46 | 0 | 1 | 10 | 50.75 | 9190 | ▇▁▁▁▁ |
| category_id | 16 | 0.94 | 19.32 | 8.00 | 1 | 17 | 23 | 24.00 | 29 | ▃▁▂▆▇ |
Variable type: POSIXct
| skim_variable | n_missing | complete_rate | min | max | median | n_unique |
|---|---|---|---|---|---|---|
| published_at | 16 | 0.94 | 2006-02-06 10:02:36 | 2021-01-27 13:11:29 | 2013-01-31 09:13:55 | 227 |
#enriching the data by scraping data from Statista
superbowl_scraped <- fread("https://raw.githubusercontent.com/ghadena/C3-R/refs/heads/main/superbowl_scraped.csv")
superbowl_scraped <- as.data.table(superbowl_scraped)
superbowl_scraped <- superbowl_scraped[year >= 2000, ] #filtering for years after 2000
skim(superbowl_scraped)| Name | superbowl_scraped |
| Number of rows | 25 |
| Number of columns | 4 |
| Key | NULL |
| _______________________ | |
| Column type frequency: | |
| numeric | 4 |
| ________________________ | |
| Group variables | None |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| year | 0 | 1.00 | 2012.00 | 7.36 | 2000.00 | 2006.00 | 2012.00 | 2018.00 | 2024.0 | ▇▇▇▇▇ |
| tv_views(millions) | 0 | 1.00 | 100.92 | 11.09 | 84.34 | 90.75 | 99.18 | 111.32 | 123.4 | ▇▅▃▇▁ |
| avg_cost of 30sec ad (millions $) | 2 | 0.92 | 4.03 | 1.59 | 2.10 | 2.60 | 3.80 | 5.25 | 7.0 | ▇▃▂▃▂ |
| add revenue (millions $) | 2 | 0.92 | 308.02 | 158.39 | 125.00 | 174.25 | 272.00 | 403.00 | 600.0 | ▇▂▃▂▃ |
Research Questions
- What attributes in Super Bowl ads contribute to higher engagement?
Examining the impact of humor, celebrity appearances, patriotism, and other attributes on likes and comments.
- Why do funny ads get fewer likes and comments?
Investigating whether humor interacts with other factors to influence engagement.
- Which brands consistently get the highest engagement, and why?
Analyzing top advertisers based on engagement and identifying key patterns.
- How does TV viewership impact online engagement?
Assessing whether years with higher TV views correspond to higher YouTube likes.
Data Processing and Cleaning
Filtered dataset to include only years 2000 onwards.
Merged additional data sources containing TV views and NFL ad revenue.
Normalized brand engagement metrics to compare advertisers fairly.
Handled missing values by omitting NA values from calculations.
Converted categorical attributes to a long format for better visualization.
# Merging
dt <- merge(sb, superbowl_scraped, by = "year")
# Counting commercials by brand
sb[ , .N, by = .(brand)][order(-N)] ## brand N
## <char> <int>
## 1: Bud Light 63
## 2: Budweiser 43
## 3: Pepsi 25
## 4: Doritos 25
## 5: Hynudai 22
## 6: Coca-Cola 21
## 7: Kia 13
## 8: E-Trade 13
## 9: Toyota 11
## 10: NFL 11# Convert logical variables to long format
logical_vars <- sb %>%
pivot_longer(cols = where(is.logical), names_to = "Variable", values_to = "Value")Attribute Analysis: What Makes Ads More Engaging?
We examined seven key attributes across Super Bowl commercials: Humor, Celebrities, Animals, Patriotism, Danger, Sex Appeal and Product Placement
To answer the first research question, I aggregated the dataset, calculating the average likes and average comments for ads with and without each attribute. Then counted how many times each attribute appeared in the dataset to understand their prevalence. and finally created visualizations to compare engagement across different categories.
Findings: - Patriotic ads: While most Super Bowl ads do not feature patriotic imagery, those that do receive the highest average likes and comments, possibly due to their emotional appeal. - Product visibility: Many ads show the product quickly, but this does not significantly affect likes or comments. - Use of sex: The majority of ads avoid using sexual content—likely because the Super Bowl is a family-friendly event. - Celebrity appearances & danger elements: Ads featuring celebrities and a sense of danger tend to generate more likes and comments than those without these elements. - Humorous ads paradox: Surprisingly, funny ads received fewer likes and comments compared to non-funny ads. Initially, we suspected this was due to a lower number of funny ads, but this was not the case—there were almost twice as many funny ads as non-funny ones. This unexpected trend led us to investigate further in the next section.
# Define the list of categorical columns
categories <- c("funny", "patriotic", "celebrity", "danger", "animals", "use_sex", "show_product_quickly")
# Initialize an empty data.table to store aggregated results
cat_agg <- data.table(category = character(), value = logical(), avg_likes = numeric(), avg_comments = numeric())
# Loop through each category and compute avg_likes and avg_comments
for (category in categories) {
temp_dt <- dt[, .(avg_likes = mean(like_count, na.rm = TRUE),
avg_comments = mean(comment_count, na.rm = TRUE)),
by = category]
setnames(temp_dt, category, "value") # Rename the grouping column to a generic name "value"
temp_dt[, category := category] # Add a new column to indicate the category name
cat_agg <- rbind(cat_agg, temp_dt, fill = TRUE) # Bind the results to the main results_dt
}
setcolorder(cat_agg, c("category", "value", "avg_likes", "avg_comments")) # Reorder columns for clarity
print(cat_agg)## category value avg_likes avg_comments
## <char> <lgcl> <num> <num>
## 1: funny TRUE 3587.0000 120.07190
## 2: funny FALSE 5409.9275 340.68116
## 3: patriotic FALSE 3515.9895 108.72826
## 4: patriotic TRUE 7566.2571 575.57895
## 5: celebrity FALSE 3876.1006 167.68387
## 6: celebrity TRUE 4796.3182 237.11940
## 7: danger FALSE 3917.6968 144.31373
## 8: danger TRUE 4651.6286 286.92754
## 9: animals TRUE 3060.5060 148.04819
## 10: animals FALSE 4780.5282 212.87770
## 11: use_sex FALSE 5462.2590 242.68712
## 12: use_sex TRUE 442.7458 39.32203
## 13: show_product_quickly TRUE 4245.7516 132.21290
## 14: show_product_quickly FALSE 3915.7941 319.17910Visualizations
To illustrate these insights, I included three grouped bar charts: 1. Count of occurrences of each attribute in the dataset. 2. Average likes received by ads based on whether they had the attribute or not. 3. Average comments received by ads based on whether they had the attribute or not.
These visualizations help us identify patterns in Super Bowl ad engagement and provide insights into which elements contribute to higher audience interaction.
#chart 1 counting the occurrence of categories
ggplot(logical_vars, aes(x = Variable, fill = Value)) +
geom_bar(position = "dodge") +
ggtitle("Count of Ad Attributes") +
xlab("Categorical Attributes") +
ylab("Count") +
theme_minimal() +
scale_fill_manual(values = c("TRUE" = "blue", "FALSE" = "red"))
#chart 2 average likes by category
ggplot(cat_agg, aes(x = category, y = avg_likes, fill = value)) +
geom_bar(stat = "identity", position = "dodge") +
labs(title = "Average Likes by Category", x = "Category", y = "Average Likes", fill = "Value (TRUE/FALSE)") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
#chart 3 average commnets by category
ggplot(cat_agg, aes(x = category, y = avg_comments, fill = value)) +
geom_bar(stat = "identity", position = "dodge") +
labs(title = "Average Comments by Category", x = "Category", y = "Average Comments", fill = "Value (TRUE/FALSE)") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Does Humor Really Boost Engagement? Investigating Funny Super Bowl Ads
My initial analysis showed that funny ads received fewer likes and comments than non-funny ones, despite making up the majority of the dataset. To understand why, I explored several factors.
Do Funny Ads Actually Get Less Engagement?
Since humor was expected to drive engagement, I first checked whether funny ads simply had fewer observations, but they actually outnumbered non-funny ads nearly 2:1. This ruled out sample size as a factor. Next, I examined whether funny ads had more variation in likes, but the standard deviation was lower than for non-funny ads. This means funny ads were more consistent in performance. I also analyzed the trend of average likes over time for funny vs. non-funny ads, but the results were inconclusive, showing a largely random pattern—possibly due to a few viral ads and small sample size heavily distorting the data.
Do Other Factors Influence Funny Ads’ Performance?
Certain ad attributes, like celebrity appearances, typically boost engagement. However, I found that celebrity ads that weren’t funny performed best (~10,000 likes on average), while funny ads without celebrities got ~4,700 likes. Funny ads with celebrities performed even worse. This suggests that while celebrities usually increase engagement, humor weakens their impact, possibly by shifting focus away from them.
Are Funny Ads More Entertaining But Less Engaging?
Although funny ads received fewer likes per view, they were watched more often than non-funny ads. This suggests they are entertaining enough to keep viewers watching, but not compelling enough to drive interaction. A check on dislikes revealed that funny ads also received fewer dislikes, reinforcing the idea that they are well-received but not particularly engaging.
Are Funny Ads Misclassified?
The dataset defines a funny ad as jokey, goofy, weird, or silly, or one that attempts to be humorous. However, after reviewing top-performing ads, I found that some—like Super Bowl Babies Choir and Budweiser’s Donkey ad—weren’t labeled as funny, even though they fit the definition. This suggests potential misclassification, which may affect results.
Humor is highly subjective—what one person finds funny, another may not. Unlike other attributes like celebrity appearances, animals, or product placement, which are more objective, humor varies by perception. This subjectivity could explain why the data contradicts expectations, showing that funny ads receive fewer likes and comments despite their entertainment value.
#lets check the distribution of funny videos (count and standard deviation)
dt[, .N, by = funny] ## funny N
## <lgcl> <int>
## 1: TRUE 171
## 2: FALSE 76dt[, .(avg_likes = mean(like_count, na.rm = TRUE),
sd_likes = sd(like_count, na.rm = TRUE)),
by = funny] ## funny avg_likes sd_likes
## <lgcl> <num> <num>
## 1: TRUE 3587.000 23809.09
## 2: FALSE 5409.928 24297.59#examining the trend overtime
dt[, .(avg_likes = mean(like_count, na.rm = TRUE)), by = .(year, funny)][order(year, -avg_likes)]## year funny avg_likes
## <int> <lgcl> <num>
## 1: 2000 TRUE 4198.66667
## 2: 2001 FALSE 250.50000
## 3: 2001 TRUE 59.60000
## 4: 2002 FALSE 3285.50000
## 5: 2002 TRUE 105.28571
## 6: 2003 TRUE 76.00000
## 7: 2003 FALSE 42.00000
## 8: 2004 FALSE 3744.00000
## 9: 2004 TRUE 261.40000
## 10: 2005 TRUE 23.33333
## 11: 2006 TRUE 428.00000
## 12: 2007 TRUE 563.33333
## 13: 2007 FALSE 149.80000
## 14: 2008 TRUE 470.45455
## 15: 2008 FALSE 159.00000
## 16: 2009 TRUE 694.90909
## 17: 2009 FALSE 507.50000
## 18: 2010 TRUE 297.80000
## 19: 2010 FALSE 252.00000
## 20: 2011 TRUE 215.16667
## 21: 2011 FALSE 78.66667
## 22: 2012 TRUE 39583.57143
## 23: 2012 FALSE 12071.75000
## 24: 2013 TRUE 699.22222
## 25: 2013 FALSE 448.60000
## 26: 2014 TRUE 3190.33333
## 27: 2014 FALSE 263.40000
## 28: 2015 TRUE 1216.25000
## 29: 2015 FALSE 585.40000
## 30: 2016 TRUE 10491.83333
## 31: 2016 FALSE 7003.33333
## 32: 2017 FALSE 13240.25000
## 33: 2017 TRUE 589.00000
## 34: 2018 TRUE 3805.83333
## 35: 2018 FALSE 634.85714
## 36: 2019 TRUE 13928.00000
## 37: 2019 FALSE 240.40000
## 38: 2020 FALSE 43915.00000
## 39: 2020 TRUE 2625.80000
## year funny avg_likesggplot(dt[, .(avg_likes = mean(like_count, na.rm = TRUE)), by = .(year, funny)],
aes(x = year, y = avg_likes, color = funny, group = funny)) +
geom_line(size = 1) +
geom_point(size = 2) +
labs(title = "Trend of Average Likes Over Time (Funny vs. Not Funny Ads)",
x = "Year", y = "Average Likes", color = "Funny") +
theme_minimal()
#examining the influence of other factors
dt[, .(avg_likes = mean(like_count, na.rm = TRUE)), by = .(funny, celebrity, animals)][order(-avg_likes)] ## funny celebrity animals avg_likes
## <lgcl> <lgcl> <lgcl> <num>
## 1: FALSE TRUE FALSE 10140.9524
## 2: TRUE FALSE FALSE 4749.9118
## 3: FALSE FALSE TRUE 4613.0000
## 4: TRUE TRUE FALSE 3071.0345
## 5: TRUE FALSE TRUE 3031.5000
## 6: FALSE FALSE FALSE 2242.5417
## 7: TRUE TRUE TRUE 942.1333
## 8: FALSE TRUE TRUE 405.0000#funny videos get more views but less likes
dt[, .(avg_views = mean(view_count, na.rm = TRUE), avg_likes = mean(like_count, na.rm = TRUE)), by = funny] ## funny avg_views avg_likes
## <lgcl> <num> <num>
## 1: TRUE 1462225 3587.000
## 2: FALSE 1286830 5409.928dt[, likes_per_view := like_count / view_count]
ggplot(dt[, .(avg_likes_per_view = mean(likes_per_view, na.rm = TRUE)), by = funny],
aes(x = as.factor(funny), y = avg_likes_per_view, fill = as.factor(funny))) +
geom_bar(stat = "identity") +
labs(title = "Likes per View: Funny vs. Not Funny Ads",
x = "Funny", y = "Average Likes per View") +
theme_minimal() 
#lets check the another engagement metric, number of dislikes.
dt[, .(avg_dislikes = mean(dislike_count, na.rm = TRUE)), by = funny]## funny avg_dislikes
## <lgcl> <num>
## 1: TRUE 746.5513
## 2: FALSE 1030.2029#lets check the top 20 videos by engagement and examine potential classification issues. (superbowl babay choir and the budwiser donley videos are misclassified imo)
dt[order(-like_count)][1:20, .(year, funny, brand, title, like_count, view_count)]## year funny brand
## <int> <lgcl> <char>
## 1: 2012 TRUE Doritos
## 2: 2020 FALSE NFL
## 3: 2019 TRUE Bud Light
## 4: 2012 FALSE Coca-Cola
## 5: 2016 TRUE Coca-Cola
## 6: 2017 FALSE Budweiser
## 7: 2000 TRUE Budweiser
## 8: 2016 FALSE NFL
## 9: 2018 TRUE NFL
## 10: 2014 TRUE Doritos
## 11: 2020 TRUE Doritos
## 12: 2002 FALSE Pepsi
## 13: 2004 FALSE Budweiser
## 14: 2009 TRUE Coca-Cola
## 15: 2018 FALSE Pepsi
## 16: 2015 TRUE Doritos
## 17: 2013 TRUE Doritos
## 18: 2016 TRUE Doritos
## 19: 2007 TRUE Doritos
## 20: 2013 TRUE Doritos
## year funny brand
## title
## <char>
## 1: Doritos Sling Baby
## 2: NEXT 100 || NFL Super Bowl LIV Commercial
## 3: Game of Thrones X Bud Light | Official Super Bowl LIII Ad | Extended Version | HBO
## 4: Coke 2012 Commercial: ""Catch"" starring NE_Bear
## 5: Hulk vs. Ant-Man - Coca-Cola: Coke Mini
## 6: Budweiser 2017 Super Bowl Commercial | “Born The Hard Way”
## 7: budweiser wassup commercial
## 8: “Super Bowl Babies Choir” feat. Seal | Music Video
## 9: Touchdown Celebrations to Come | NFL | Super Bowl LII Commercial
## 10: Doritos Time Machine - Crash the Super Bowl 2014 WINNER OFFICIAL
## 11: Doritos Super Bowl Commercial 2020 Lil Nas X, Sam Elliott The Cool Ranch
## 12: Britney Spears - Pepsi Now and Then Commercial [HD Master]
## 13: Budweiser Donkey
## 14: Coca-Cola Avatar
## 15: Pepsi Super Bowl Commercial 2018 Cindy Crawford, Britney Spears
## 16: Middle Seat - Doritos Crash the Super Bowl 2015 WINNER OFFICIAL
## 17: 2013 SuperBowl XLVII Doritos Goat 4 Sale Commercial
## 18: Doritos Dogs - Crash the Super Bowl 2016 WINNER OFFICIAL
## 19: Live the Flavor
## 20: Fashionista Daddy - Doritos Commercial
## title
## like_count view_count
## <int> <int>
## 1: 275362 176373378
## 2: 175429 26727063
## 3: 94799 7658201
## 4: 92333 22849816
## 5: 58957 6428474
## 6: 48423 28785122
## 7: 24840 3624622
## 8: 20690 4921309
## 9: 20508 3464175
## 10: 18729 7952240
## 11: 10717 1990447
## 12: 5929 385777
## 13: 3744 1939823
## 14: 3511 1452877
## 15: 2849 669906
## 16: 2746 2319854
## 17: 2541 576696
## 18: 2534 1214968
## 19: 2508 1683994
## 20: 2491 1404745
## like_count view_countVisualizing Likes Distribution for Funny vs. Non-Funny Ads
To compare engagement, I created three boxplots: • The first included all ads, showing non-funny ads had higher likes overall. • The second excluded the top 5% of extreme values, revealing clearer patterns. • The third used a log scale, further confirming that non-funny ads consistently received more likes than funny ones.
# including all observations
ggplot(dt, aes(x = as.factor(funny), y = like_count, fill = as.factor(funny))) +
geom_boxplot() +
labs(title = "Likes Distribution: Funny vs. Non-Funny Ads",
x = "Funny", y = "Like Count", fill = "Funny") +
theme_minimal()
# excluding outliars - top 5%
dt_filtered <- dt[like_count <= quantile(like_count, 0.95, na.rm = TRUE)]
ggplot(dt_filtered, aes(x = as.factor(funny), y = like_count, fill = as.factor(funny))) +
geom_boxplot() +
labs(title = "Likes Distribution (Excluding Top 5% Outliers): Funny vs. Non-Funny Ads",
x = "Funny", y = "Like Count", fill = "Funny") +
theme_minimal()
# on log scale
ggplot(dt, aes(x = as.factor(funny), y = like_count, fill = as.factor(funny))) +
geom_boxplot() +
scale_y_log10() +
labs(title = "Likes Distribution (Log Scale): Funny vs. Non-Funny Ads",
x = "Funny", y = "Log10(Likes)", fill = "Funny") +
theme_minimal()
Ad Success Is More Than Just Likes
While my analysis focuses on likes and comments as engagement metrics, they do not fully define ad success. A truly successful ad could drive sales, brand awareness, or cultural impact—factors that are difficult to quantify but often more important than online engagement. Some funny ads may generate buzz or brand recognition without necessarily earning more likes.
While humor is often seen as a winning strategy, simply being funny does not guarantee engagement. Other elements—emotional appeal, storytelling, and branding strategies—may play a bigger role in making an ad truly successful.
Brand Performance: Which Brands Dominate Engagement?
To investigate which brands consistently received higher likes and engagement, I created two datasets: 1. Brand Performance Table – Calculated average likes, comments, dislikes, and ad counts for each brand. 2. Attribute Composition Table – Measured how often each brand used specific features (e.g., funny, celebrity, patriotic) in their ads, expressed as percentages. This table also included average likes, comments, dislikes, and views per brand.
# Calculate average likes, comments, dislikes, and ad counts for each brand
brand_engagement <- dt[, .(
avg_likes = mean(like_count, na.rm = TRUE),
avg_comments = mean(comment_count, na.rm = TRUE),
avg_dislikes = mean(dislike_count, na.rm = TRUE),
total_ads = .N
), by = brand][order(-avg_likes)]
print(brand_engagement)## brand avg_likes avg_comments avg_dislikes total_ads
## <char> <num> <num> <num> <int>
## 1: NFL 24918.1111 1389.33333 1171.22222 11
## 2: Doritos 14180.4783 166.31818 4223.73913 25
## 3: Coca-Cola 8011.5500 132.35000 2314.85000 21
## 4: Budweiser 2399.0541 312.65789 492.83784 43
## 5: Bud Light 1863.9286 147.77586 245.19643 63
## 6: Pepsi 616.5000 53.62500 30.25000 25
## 7: Toyota 531.6000 59.22222 38.50000 11
## 8: E-Trade 218.6667 31.20000 11.08333 13
## 9: Hynudai 191.0909 15.90476 13.13636 22
## 10: Kia 177.2500 13.63636 5.25000 13# Calculate attribute contribution and average engagement (likes, comments, dislikes)
attribute_contribution <- dt[, .(
funny_pct = mean(funny, na.rm = TRUE) * 100,
celebrity_pct = mean(celebrity, na.rm = TRUE) * 100,
animals_pct = mean(animals, na.rm = TRUE) * 100,
product_pct = mean(show_product_quickly, na.rm = TRUE) * 100,
patriotic_pct = mean(patriotic, na.rm = TRUE) * 100,
danger_pct = mean(danger, na.rm = TRUE) * 100,
sex_pct = mean(use_sex, na.rm = TRUE) * 100,
avg_likes = mean(like_count, na.rm = TRUE),
avg_comments = mean(comment_count, na.rm = TRUE),
avg_dislikes = mean(dislike_count, na.rm = TRUE),
avg_views = mean(view_count, na.rm = TRUE) # Removed * 100
), by = brand][order(-avg_likes)]
print(attribute_contribution)## brand funny_pct celebrity_pct animals_pct product_pct patriotic_pct
## <char> <num> <num> <num> <num> <num>
## 1: NFL 18.18182 72.72727 0.00000 54.54545 36.363636
## 2: Doritos 96.00000 16.00000 40.00000 88.00000 4.000000
## 3: Coca-Cola 38.09524 28.57143 57.14286 71.42857 23.809524
## 4: Budweiser 48.83721 11.62791 55.81395 62.79070 37.209302
## 5: Bud Light 95.23810 26.98413 38.09524 82.53968 4.761905
## 6: Pepsi 72.00000 64.00000 12.00000 60.00000 12.000000
## 7: Toyota 54.54545 18.18182 27.27273 81.81818 18.181818
## 8: E-Trade 92.30769 0.00000 30.76923 53.84615 15.384615
## 9: Hynudai 54.54545 27.27273 31.81818 54.54545 13.636364
## 10: Kia 61.53846 53.84615 38.46154 30.76923 15.384615
## danger_pct sex_pct avg_likes avg_comments avg_dislikes avg_views
## <num> <num> <num> <num> <num> <num>
## 1: 0.00000 0.000000 24918.1111 1389.33333 1171.22222 4097797.78
## 2: 44.00000 24.000000 14180.4783 166.31818 4223.73913 8550789.43
## 3: 28.57143 4.761905 8011.5500 132.35000 2314.85000 1618888.35
## 4: 16.27907 18.604651 2399.0541 312.65789 492.83784 974118.08
## 5: 42.85714 42.857143 1863.9286 147.77586 245.19643 240237.19
## 6: 24.00000 44.000000 616.5000 53.62500 30.25000 118028.80
## 7: 36.36364 9.090909 531.6000 59.22222 38.50000 113519.00
## 8: 23.07692 23.076923 218.6667 31.20000 11.08333 144923.42
## 9: 27.27273 13.636364 191.0909 15.90476 13.13636 47743.27
## 10: 38.46154 46.153846 177.2500 13.63636 5.25000 32287.15Which Brands Receive the Most Likes?
A simple bar chart of average likes per brand revealed that: • NFL led with ~25,000 average likes per ad. • Doritos followed with ~15,000. • Coca-Cola, Budweiser, and Bud Light came next. • The remaining brands—Pepsi, Toyota, E-Trade, Hyundai, and Kia—all averaged under 1,000 likes per ad.
#average likes per brand
ggplot(attribute_contribution, aes(x = reorder(brand, -avg_likes), y = avg_likes, fill = brand)) +
geom_bar(stat = "identity") +
labs(title = "Average Likes by Brand", x = "Brand", y = "Average Likes") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
What Makes Certain Brands More Engaging?
To explore why some brands performed better, I normalized attribute percentages per brand to sum to 100% and converted the data into a long format for visualization.
# Normalize attribute percentages to sum to 100% per brand
attribute_contribution[, total_pct := funny_pct + celebrity_pct + animals_pct + product_pct + patriotic_pct + danger_pct + sex_pct]
attribute_contribution[, ':=' (
funny_pct = funny_pct / total_pct * 100,
celebrity_pct = celebrity_pct / total_pct * 100,
animals_pct = animals_pct / total_pct * 100,
product_pct = product_pct / total_pct * 100,
patriotic_pct = patriotic_pct / total_pct * 100,
danger_pct = danger_pct / total_pct * 100,
sex_pct = sex_pct / total_pct * 100
)]
# Convert data to long format for the stacked bar
attribute_long <- melt(attribute_contribution, id.vars = "brand",
measure.vars = c("funny_pct", "celebrity_pct", "animals_pct", "product_pct", "patriotic_pct", "danger_pct", "sex_pct"),
variable.name = "attribute", value.name = "percentage")A stacked bar chart showed that NFL, the top performer, used celebrities the most, which may have contributed to its high engagement. NFL ads also incorporated patriotic themes more than any other brand, suggesting that emotional appeal might play a role in driving likes.
# chart 6: Create a 100% stacked bar chart
ggplot(attribute_long, aes(x = reorder(brand, -percentage), y = percentage, fill = attribute)) +
geom_bar(stat = "identity", position = "fill") + # "fill" ensures each bar sums to 100%
scale_y_continuous(labels = scales::percent_format(scale = 100)) + # Format y-axis as percentages
labs(title = "Normalized Attribute Usage by Brand (100% Stacked Bar Chart)",
x = "Brand", y = "Percentage of Ads", fill = "Attribute") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Adding an Extra Layer: Likes as a Percentage of Total Engagement
To enhance the analysis, I calculated each brand’s share of total likes and overlaid this on the stacked bar chart. This provided a clearer picture of how brand attributes correlate with engagement levels.
Overall, brands that leveraged emotional appeal—celebrities, patriotism, and nostalgia—tended to achieve higher engagement, while those that relied more on product-focused or action-driven ads performed less consistently.
# Calculate % of total likes for each brand
total_likes <- sum(attribute_contribution$avg_likes, na.rm = TRUE)
attribute_contribution[, likes_pct := (avg_likes / total_likes) * 100]
ggplot() +
# Stacked bar chart (attributes)
geom_bar(data = attribute_long,
aes(x = brand, y = percentage / 100, fill = attribute),
stat = "identity", position = "fill") +
# Line and points for % of total likes (on the same y-axis)
geom_line(data = attribute_contribution,
aes(x = brand, y = likes_pct / 100, group = 1, color = "Likes % of Total"),
size = 1.5) +
geom_point(data = attribute_contribution,
aes(x = brand, y = likes_pct / 100, color = "Likes % of Total"),
size = 2) +
scale_color_manual(values = c("Likes % of Total" = "black"), name = "Metric") + # Add to legend
# Labels for % of total likes
geom_text(data = attribute_contribution,
aes(x = brand, y = (likes_pct / 100) + 0.04, label = paste0(round(likes_pct, 1), "%")),
vjust = -0, color = "black", size = 2.5) +
# Formatting
scale_y_continuous(labels = percent_format(),
breaks = seq(0, 1, by = 0.25), # Set ticks at 0, 25, 50, 75, 100
expand = expansion(mult = c(0, 0.1))) + # Add space for labels
labs(title = "Super Bowl Ad Strategies: Attribute Breakdown and Engagement Comparison by Brand",
subtitle = "Analyzing the attribute composition of Super Bowl ads by top brands \nand how their content translates into audience engagement (measured by percentage of total likes).",
x = "Brand", y = "Percentage", fill = "Attribute") +
# Theme adjustments
theme_minimal(base_size = 12) + # Keep minimal theme
theme(panel.grid.major = element_blank(), # Remove major grid lines
panel.grid.minor = element_blank(), # Remove minor grid lines
axis.text.x = element_text(angle = 45, hjust = 1, vjust = 1),
plot.title = element_text(hjust = 0.5, size = 15, margin = margin( b = 10)), # Add top margin
plot.subtitle = element_text(hjust = 0, size = 10, margin = margin(b = 5)), # Add bottom margin
plot.margin = margin(t = 20, r = 0, b = 10, l = 10)
) # Better x-axis rotation
Does Higher TV Viewership Lead to More Online Engagement?
One question I explored was whether years with higher Super Bowl TV viewership also led to more engagement on YouTube. If more people saw the ads on TV, did that translate into more online reactions? This could help determine whether traditional TV exposure still influences digital engagement or if some brands are simply better at making viral ads.
Data Challenges & Adjustments
Initially, I plotted a scatter plot of TV views vs. YouTube likes per ad, but the visualization was misleading because: 1. TV viewership data was aggregated per year, while likes were per individual ad, making direct comparisons inaccurate. 2. A single extreme outlier—the 2012 Doritos ad (275,000 likes)—heavily skewed the trend.
#correcting column name
setnames(dt, "tv_views(millions)", "tv_views_million")
#TV viewership and youtube likes
ggplot(dt, aes(x = tv_views_million, y = like_count)) +
geom_point(alpha = 0.6) +
geom_point(data = dt[which.max(like_count)], aes(x = tv_views_million , y = like_count),
color = "red", size = 3) +
scale_x_continuous(labels = scales::comma) + # No scientific notation
scale_y_continuous(labels = scales::comma) + # No scientific notation
labs(title = "YouTube Views vs. Likes",
x = "TV Views (millions)", y = "Likes",
subtitle = "Red point = Outlier (Doritos 2012 ad) with 275k Youtube Likes") +
theme_minimal()
#identifying the outliar
dt[which.max(view_count)]## Key: <year>
## year brand superbowl_ads_dot_com_url
## <int> <char> <char>
## 1: 2012 Doritos https://superbowl-ads.com/2012-doritos-sling-baby/
## youtube_url funny show_product_quickly
## <char> <lgcl> <lgcl>
## 1: https://www.youtube.com/watch?v=6SWNLDdnz0A TRUE TRUE
## patriotic celebrity danger animals use_sex id kind
## <lgcl> <lgcl> <lgcl> <lgcl> <lgcl> <char> <char>
## 1: FALSE FALSE FALSE FALSE FALSE 6SWNLDdnz0A youtube#video
## etag view_count like_count dislike_count
## <char> <int> <int> <int>
## 1: BB4lUj_1vsbD0I0kNQ_DdZovEcw 176373378 275362 92990
## favorite_count comment_count published_at title
## <int> <int> <POSc> <char>
## 1: 0 1234 2013-04-12 22:49:58 Doritos Sling Baby
## description
## <char>
## 1: Top ad of the 2012 Super Bowl according to USA Today Ad Meter\nRated Most Memorable Super Bowl ad of 2012 by Nielsen\nRated Best-Liked Super Bowl ad of 2012 by Nielsen
## thumbnail channel_title category_id
## <char> <char> <int>
## 1: https://i.ytimg.com/vi/6SWNLDdnz0A/sddefault.jpg Madison McQueen 25
## tv_views_million avg_cost of 30sec ad (millions $) add revenue (millions $)
## <num> <num> <num>
## 1: 111.35 3.5 244
## likes_per_view
## <num>
## 1: 0.001561245dt[which.max(like_count)]## Key: <year>
## year brand superbowl_ads_dot_com_url
## <int> <char> <char>
## 1: 2012 Doritos https://superbowl-ads.com/2012-doritos-sling-baby/
## youtube_url funny show_product_quickly
## <char> <lgcl> <lgcl>
## 1: https://www.youtube.com/watch?v=6SWNLDdnz0A TRUE TRUE
## patriotic celebrity danger animals use_sex id kind
## <lgcl> <lgcl> <lgcl> <lgcl> <lgcl> <char> <char>
## 1: FALSE FALSE FALSE FALSE FALSE 6SWNLDdnz0A youtube#video
## etag view_count like_count dislike_count
## <char> <int> <int> <int>
## 1: BB4lUj_1vsbD0I0kNQ_DdZovEcw 176373378 275362 92990
## favorite_count comment_count published_at title
## <int> <int> <POSc> <char>
## 1: 0 1234 2013-04-12 22:49:58 Doritos Sling Baby
## description
## <char>
## 1: Top ad of the 2012 Super Bowl according to USA Today Ad Meter\nRated Most Memorable Super Bowl ad of 2012 by Nielsen\nRated Best-Liked Super Bowl ad of 2012 by Nielsen
## thumbnail channel_title category_id
## <char> <char> <int>
## 1: https://i.ytimg.com/vi/6SWNLDdnz0A/sddefault.jpg Madison McQueen 25
## tv_views_million avg_cost of 30sec ad (millions $) add revenue (millions $)
## <num> <num> <num>
## 1: 111.35 3.5 244
## likes_per_view
## <num>
## 1: 0.001561245To correct this, I aggregated likes per year and created a new yearly engagement dataset, allowing for a clearer comparison between average YouTube likes and total TV viewership per year.
# Aggregate data: Average likes per year
yearly_engagement <- dt[, .(avg_likes = mean(like_count, na.rm = TRUE)), by = .(year, tv_views_million)]
# Load necessary library for ColorBrewer palettes
display.brewer.all() # Shows all available palettes
# Define a color palette for years
year_colors <- brewer.pal(n = 12, name = "RdPu") # Using a ColorBrewer palette
# Identify the outliers
max_outlier <- yearly_engagement[which.max(avg_likes)] # 2012 (doritos ad - 275k likes)
second_outlier <- yearly_engagement[order(-avg_likes)][2] # 2020
second_outlier## year tv_views_million avg_likes
## <int> <num> <num>
## 1: 2020 100.45 20976.56dt[order(-like_count)][2] # (nfl LIV comercial - 175k likes)## year brand superbowl_ads_dot_com_url
## <int> <char> <char>
## 1: 2020 NFL https://superbowl-ads.com/2020-nfl-next-100/
## youtube_url funny show_product_quickly
## <char> <lgcl> <lgcl>
## 1: https://www.youtube.com/watch?v=lbkafMhmvMo FALSE FALSE
## patriotic celebrity danger animals use_sex id kind
## <lgcl> <lgcl> <lgcl> <lgcl> <lgcl> <char> <char>
## 1: TRUE TRUE FALSE FALSE FALSE lbkafMhmvMo youtube#video
## etag view_count like_count dislike_count
## <char> <int> <int> <int>
## 1: GJ7PT7v2TCLH_na-2HG7nYXBEMI 26727063 175429 7445
## favorite_count comment_count published_at
## <int> <int> <POSc>
## 1: 0 8441 2020-02-03 00:21:31
## title
## <char>
## 1: NEXT 100 || NFL Super Bowl LIV Commercial
## description
## <char>
## 1: A kick return 100 years in the making. Here’s to the next 100 and the game’s future stars! #NFLNext100 #SBLIV \n\nSubscribe to NFL: http://j.mp/1L0bVBu\n\nCheck out our other channels:\nNFL Vault http://www.youtube.com/nflvault\nNFL Network http://www.youtube.com/nflnetwork\nNFL Films http://www.youtube.com/nflfilms\nNFL Rush http://www.youtube.com/nflrush\nNFL Play Football https://www.youtube.com/playfootball\nNFL Podcasts https://www.youtube.com/nflpodcasts\n\n#NFL #Football #AmericanFootball
## thumbnail channel_title category_id
## <char> <char> <int>
## 1: https://i.ytimg.com/vi/lbkafMhmvMo/sddefault.jpg NFL 17
## tv_views_million avg_cost of 30sec ad (millions $) add revenue (millions $)
## <num> <num> <num>
## 1: 100.45 5.6 449
## likes_per_view
## <num>
## 1: 0.006563722# Scatter plot with color and annotations
ggplot(yearly_engagement, aes(x = tv_views_million, y = avg_likes, color = year)) +
geom_point(size = 4) + # Bigger points
geom_smooth(method = "lm", se = FALSE, color = "black", linetype = "dashed") + # Trend line
scale_x_continuous(labels = scales::comma) +
scale_y_continuous(labels = scales::comma) +
scale_color_gradientn(colors = brewer.pal(n = 9, name = "RdPu")) + # Apply color scheme
labs(
title = "TV Views vs. Average YouTube Likes per Year",
subtitle = "Analyzing whether years with more Super Bowl viewers generate more online engagement",
x = "TV Views (millions)",
y = "Average YouTube Likes",
color = "Year",
caption = "Each point represents a year. Trend line shows overall correlation."
) +
theme_minimal() +
# Annotation for Max Outlier (Doritos 2012 Ad)
annotate("text", x = max_outlier$tv_views_million, y = max_outlier$avg_likes + 5000,
label = "Doritos 2012 Ad\n~275k Likes", color = "black", size = 4, hjust = 0.5) +
geom_segment(aes(x = max_outlier$tv_views_million, y = max_outlier$avg_likes - 20000,
xend = max_outlier$tv_views_million, yend = max_outlier$avg_likes - 5000),
arrow = arrow(length = unit(0.2, "cm")), color = "black") +
# Annotation for Second Outlier
annotate("text", x = second_outlier$tv_views_million, y = second_outlier$avg_likes + 5000,
label = paste0("NFL 2020 Ad\n~178k Likes"),
color = "black", size = 4, hjust = 0.5) +
geom_segment(aes(x = second_outlier$tv_views_million, y = second_outlier$avg_likes - 20000,
xend = second_outlier$tv_views_million, yend = second_outlier$avg_likes - 5000),
arrow = arrow(length = unit(0.2, "cm")), color = "black")
Findings: The Impact of TV Exposure on YouTube Likes
The revised scatter plot provided more context by specifically highlighting two major outliers: • 2012 Doritos Ad (275K likes) • 2020 NFL LIV Commercial (175K likes)
Additionally, the visualization used a ColorBrewer palette to differentiate the years, making it easier to spot trends over time. This helped reveal a positive correlation between TV views and online engagement, suggesting that in years with higher TV viewership, ads also received more YouTube likes. However, this trend was heavily influenced by the two outliers, indicating that virality, rather than TV exposure alone, may be a key driver of engagement.
Possible Explanations 1. Changing Viewing Habits & Online Presence • Over the years, people have become more active online, leading to higher engagement rates regardless of TV viewership. • The increase in social media usage and YouTube popularity likely contributes to the rising trend in likes over time. 2. How People Watch the Super Bowl Has Changed • In the early 2000s, many people watched the game in sports bars or large group settings, where engagement with ads may have been lower. • Today, many viewers watch individually on personal devices and engage more actively by liking and sharing ads online. • Some may even skip TV ads altogether and watch the best commercials later on YouTube. 3. Platform Shifts: The TikTok & Instagram Factor • Engagement patterns may be changing, with younger audiences shifting from YouTube to platforms like TikTok and Instagram. • Companies may now focus more on short-form ad placements, which could explain why YouTube likes alone may not capture the full picture of ad success.
While TV exposure may still play a role in ad success, online engagement is shaped by many other factors, from virality and content strategy to shifts in audience behavior.
Conclusion and Key Takeaways:
- Humor alone does not guarantee high engagement – combining humor with celebrities may reduce effectiveness.
- Celebrity endorsements and patriotic themes tend to increase engagement, particularly in NFL and Pepsi ads.
- NFL commercials dominate online engagement, likely due to audience interest and familiarity with the brand.
- Higher TV views do not always translate into higher YouTube engagement, indicating that viral success is independent of broadcast reach.
- Certain years, such as 2012 (Doritos) and 2020 (NFL), skew the trend due to highly viral ads.
Future Considerations:
- Expanding engagement analysis beyond YouTube (e.g., Twitter, TikTok, and sales data).
- Investigating whether certain ad types lead to increased product sales.
- Analyzing sentiment analysis from YouTube comments to understand audience reactions.
Prepared by Ghadena Hgaig
January 2025