Framing theory describes a media message consumer’s response, such as an attitude, judgement or action, depending at least partly upon exposure to cues embedded in the media message. A cue prompts the message consume to apply a particular interpretive frame to the message, and this frame application leads to the response.
Considering this theory, a cue embedded in an advertisement could influence consumer judgement about a product being advertised. Specifically, the physical attributes of the actor in a fast-food sandwich advertisement might influence viewer estimates of how many calories the advertised sandwich contains.
Average sandwich calorie estimates among viewers of the ad showing the “buff” actor will differ from average sandwich calorie estimates among viewers of the ad showing the “dad bod” actor.
The dependent variable in the analysis was a continuous measure of how many calories advertisement viewers guessed were in the advertised Cajun Grill Chicken Sandwich. The categorical independent variable indicated whether each viewer had watched an ad featuring a “buff” actor or an ad featuring an actor with a “dad bod.”
A sample of 100 subjects were divided randomly into two groups of 50. Each group then viewed either one ad or the other. After viewing the advertisement, subjects completed a questionnaire asking, among other things, how many calories they though were in the Cajun Grill Chicken Sandwich.
An independent-samples t-test was used to test for a statistically significant difference between the average calorie estimates among the “buff” and “dad bod” ad viewers.
The graph below highlights the group distributions and averages. A normality test found that neither group distribution differed significantly from normal and, in any case, both groups exceeded 40 cases, meaning that non-normality would pose minimal problems for a t-test analysis.
The calorie estimates averaged higher among the “dad bod” ad viewers than among the “buff” ad viewers. A t-test found the difference statistically significant. These results supported the hypothesis above.
| Independent Samples t-Test Results | ||||||||
| Welch's t-test (unequal variances assumed) | ||||||||
| Group 1 | Group 2 | Mean (Group 1) | Mean (Group 2) | t Statistic | Degrees of Freedom | p-value | 95% CI (Lower) | 95% CI (Upper) |
|---|---|---|---|---|---|---|---|---|
| Buff | Dad bod | 584.26 | 656.28 | −2.671 | 97.069 | 0.009 | −125.53 | −18.51 |
# ------------------------------
# Setup
# ------------------------------
if (!require("dplyr")) install.packages("dplyr")
if (!require("ggplot2")) install.packages("ggplot2")
if (!require("gt")) install.packages("gt")
if (!require("gtExtras")) install.packages("gtExtras")
library(dplyr)
library(ggplot2)
library(gt)
library(gtExtras)
options(scipen = 999)
# ------------------------------
# Load Data
# ------------------------------
mydata <- read.csv("SandwichAd.csv") #McDonald's Sandwich Advertising
mydata <- mydata %>%
mutate(
DV = Calories,
IV = Actor
)
# ------------------------------
# Histograms of DV per IV group with group means
# ------------------------------
# Calculate group means
group_means <- mydata %>%
group_by(IV) %>%
summarise(
mean_DV = mean(DV, na.rm = TRUE),
.groups = "drop"
)
Graphic <- ggplot(mydata, aes(x = DV)) +
geom_histogram(
binwidth = diff(range(mydata$DV, na.rm = TRUE)) / 30,
color = "black",
fill = "#1f78b4",
alpha = 0.7
) +
geom_vline(
data = group_means,
aes(xintercept = mean_DV),
color = "red",
linetype = "dashed",
linewidth = 1
) +
facet_grid(IV ~ .) +
labs(
title = "DV Distributions by IV Group",
x = "Dependent Variable",
y = "Count"
) +
theme_minimal()
# Show graphic
Graphic
# ------------------------------
# Descriptive Statistics
# ------------------------------
Descriptives <- mydata %>%
group_by(IV) %>%
summarise(
count = n(),
mean = mean(DV, na.rm = TRUE),
sd = sd(DV, na.rm = TRUE),
min = min(DV, na.rm = TRUE),
max = max(DV, na.rm = TRUE),
.groups = "drop"
)
DescriptivesTable <- Descriptives %>%
gt() %>%
fmt_number(
columns = c(mean, sd, min, max),
decimals = 2
) %>%
tab_header(
title = "Descriptive Statistics",
subtitle = "Summary statistics by group"
) %>%
cols_label(
IV = "Group",
count = "N",
mean = "Mean",
sd = "Standard Deviation",
min = "Minimum",
max = "Maximum"
)
# ------------------------------
# Normality Check (Shapiro-Wilk)
# ------------------------------
shapiro_summary <- mydata %>%
group_by(IV) %>%
summarise(
W_statistic = shapiro.test(DV)$statistic,
p_value = shapiro.test(DV)$p.value,
.groups = "drop"
)
ShapiroTable <- shapiro_summary %>%
gt() %>%
fmt_number(
columns = c(W_statistic, p_value),
decimals = 3
) %>%
tab_header(
title = "Shapiro-Wilk Normality Test Results",
subtitle = "Tests of normality within each group"
) %>%
cols_label(
IV = "Group",
W_statistic = "W Statistic",
p_value = "p-value"
) %>%
tab_source_note(
source_note = md(
"NOTE: If one or both of the p-values are less than .05 and if the groups are smaller than 40, the t-test's normality assumption may be violated, and you should use the Wilcoxon rank-sum test results instead of the t-test results."
)
)
# ------------------------------
# Inferential Tests
# ------------------------------
# Run Welch's t-test (default for two groups)
t_res <- t.test(
DV ~ IV,
data = mydata,
var.equal = FALSE
)
# Run Wilcoxon rank-sum test
wilcox_res <- wilcox.test(
DV ~ IV,
data = mydata
)
# Create a tidy summary of t-test results
t_summary <- tibble(
Group1 = levels(as.factor(mydata$IV))[1],
Group2 = levels(as.factor(mydata$IV))[2],
Mean1 = t_res$estimate[1],
Mean2 = t_res$estimate[2],
t = t_res$statistic,
df = t_res$parameter,
p = t_res$p.value,
CI_low = t_res$conf.int[1],
CI_high = t_res$conf.int[2]
)
# Create a tidy summary of Wilcoxon results
wilcox_summary <- tibble(
Group1 = levels(as.factor(mydata$IV))[1],
Group2 = levels(as.factor(mydata$IV))[2],
W = wilcox_res$statistic,
p = wilcox_res$p.value
)
# ------------------------------
# Present t-Test Results as gt Table
# ------------------------------
Table <- t_summary %>%
gt() %>%
fmt_number(
columns = c(Mean1, Mean2, CI_low, CI_high),
decimals = 2
) %>%
fmt_number(
columns = c(t, df, p),
decimals = 3
) %>%
tab_header(
title = "Independent Samples t-Test Results",
subtitle = "Welch's t-test (unequal variances assumed)"
) %>%
cols_label(
Group1 = "Group 1",
Group2 = "Group 2",
Mean1 = "Mean (Group 1)",
Mean2 = "Mean (Group 2)",
t = "t Statistic",
df = "Degrees of Freedom",
p = "p-value",
CI_low = "95% CI (Lower)",
CI_high = "95% CI (Upper)"
)
# ------------------------------
# Present Wilcoxon Results as gt Table
# ------------------------------
WilcoxonTable <- wilcox_summary %>%
gt() %>%
fmt_number(
columns = c(W, p),
decimals = 3
) %>%
tab_header(
title = "Wilcoxon Rank-Sum Test Results",
subtitle = "Nonparametric comparison of group distributions"
) %>%
cols_label(
Group1 = "Group 1",
Group2 = "Group 2",
W = "W Statistic",
p = "p-value"
)
# ------------------------------
# Visual Output
# ------------------------------
# Histogram
Graphic
# Descriptive statistics table
DescriptivesTable
# Shapiro-Wilk table
ShapiroTable
# Wilcoxon rank-sum table
WilcoxonTable
# Welch's t-test table
Table