Week 3 assignment t-Test Results

The experiment began by randomly dividing 100 research subjects into two groups of 50. Next, the members of each group were shown a short video ad promoting a “Cajun Grill Chicken Sandwich” that, they were told, would soon be added to the menu at McDonald’s restaurants. The main character in the ad, a man, sat eating the sandwich while his surroundings slowly picked up the characteristics of a Louisiana bayou.

The ads were identical with one exception: The man in one group’s version of the ad had an obviously lean, muscular “buff” physique, while the man in the other group’s version of the ad had a rounder, less athletic “dad bod” physique. Both men wore identical clothing: Jeans and a plain, blue shirt.

After viewing their group’s ad, subjects were asked a variety of questions about things like how tasty the sandwich looked, how much they would be willing to pay for the new sandwich, and so forth. These questions included a question asking them about how many calories they thought the sandwich contained.

Using the data provided, design, describe, execute, summarize, and publish the results of an analysis that tests for a framing effect. Here are the variables in the data file:

Actor: An indication of the body type of the actor in the ad each group viewed. “Buff” indicates that the row’s individual saw the ad depicting the “buff” actor. “Dad bod” indicates that the row’s individual saw the ad depicting the “dad bod” actor.

Calories: Each subject’s estimate of the number of calories in the new sandwich.

---

Here is the R script that gathered the data and produced results:

# ------------------------------
# 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("YOURDATAFILE") # TYPE YOUR DATA FILE'S NAME

mydata <- mydata %>%
  mutate(
    DV = YOURDVNAME, # TYPE YOUR DEPENDENT VARIABLE'S NAME
    IV = YOURIVNAME  # TYPE YOUR INDEPENDENT VARIABLE'S NAME
  )

# ------------------------------
# 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) +
  # Add group-specific mean lines
  geom_vline(data = group_means, aes(xintercept = mean_DV),
             color = "red", linetype = "dashed", linewidth = 1) +
  facet_grid(IV ~ .) +  # one histogram per group, stacked vertically
  labs(
    title = "DV Distributions by IV Group",
    x = "Dependent Variable",
    y = "Count"
  ) +
  theme_minimal()

# Show graphic
Graphic

# ------------------------------
# Descriptive Statistics
# ------------------------------
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)
  )

# ------------------------------
# Normality Check (Shapiro-Wilk)
# ------------------------------
mydata %>%
  group_by(IV) %>%
  summarise(
    W_statistic = shapiro.test(DV)$statistic,
    p_value     = shapiro.test(DV)$p.value
  )

# ------------------------------
# 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 if group sizes < 40 and 
# distributions are non-normal
wilcox.test(mydata$DV ~ mydata$IV)

# Create a tidy summary of 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]
)

# ------------------------------
# Present Results as a gt Table (APA style)
# ------------------------------
Table <- t_summary %>%
  gt() %>%
  # Round group means and CI to 2 decimals
  fmt_number(columns = c(Mean1, Mean2, CI_low, CI_high), decimals = 2) %>%
  # Round test statistics, df, and p-value to 3 decimals
  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)"
  )

# ------------------------------
# Visual output
# ------------------------------

# Show the graphic
Graphic

# Show the table
Table