title: “Week 5 Data Lab” author: “Anna Schulte” date: “2024-09-30” output: html_document —

Package Requirements

Week 5 Lab

This lab provides a summary of plots created using the Complete Journey data set.

Plot 1: Yogurt Bought by Age Group

Ages 45 - 54 purchase the most yogurt

joined_data <- transactions %>%
  left_join(demographics, by = "household_id") %>%
  left_join(products, by = "product_id")
 
joined_data <- joined_data %>%
  filter(!is.na(age))
 
yogurt_by_age <- joined_data %>%
  filter(product_category == "YOGURT")
 
age_yogurt_quantity <- yogurt_by_age %>%
  group_by(age) %>%
  summarise(total_quantity = sum(quantity))
 
ggplot(age_yogurt_quantity, aes(x = age, y = total_quantity, group = 1)) +
  geom_line(color = "blue") +
  geom_point(color = "green", size = 2) +
  labs(title = "Yogurt Bought by Age Group",
       x = "Age Group",
       y = "Quantity of Yogurt")

Plot 2: Products Sold By Hour of the Day

Between 1PM - 5PM tends to be the busiest time to shop

top_departments <- transactions %>%
  left_join(products, by = "product_id") %>%
  group_by(department) %>%
  summarize(total_quantity = sum(quantity), .groups = "drop") %>%
  top_n(5, wt = total_quantity) %>%
  pull(department)
 
vis2_data <- transactions %>%
  left_join(products, by = "product_id") %>%
  mutate(hour = hour(transaction_timestamp)) %>%
  group_by(hour, department) %>%
  summarise(quantity = sum(quantity), .groups = "drop") %>%
  filter(department %in% top_departments, hour >= 5, hour <= 23)
 
ggplot(vis2_data, aes(x = factor(hour), y = quantity, fill = department)) +
  geom_bar(stat = "identity") +
  scale_y_continuous(name = "Number of products sold", labels = scales::comma) +
  labs(title = "Products Sold by Hour of the Day (Top 5 Departments)",
       x = "Hour of the Day",
       y = "Quantity Sold",
       fill = "Department") +
  theme_light() +
  theme(legend.position = "bottom",
        legend.text = element_text(size = 8))

Plot 3: Coupon Redemption by Household Income

Households in the 50-74K Income Range are redeeming the most coupons

visual3_joined_data <- coupon_redemptions %>%
  left_join(demographics, by = "household_id") %>%
  filter(!is.na(redemption_date), !is.na(income)) %>%
  group_by(income) %>%
  summarize(redemptions = sum(!is.na(redemption_date)))
 
ggplot(visual3_joined_data, aes(x = income, y = redemptions)) +
  geom_bar(stat = "identity", fill = "pink", color = "white") +
  labs(
    title = "Coupon Redemptions by Income Level",
    x = "Income Level",
    y = "Total Coupon Redemptions"
  ) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))