Valentine’s Day Purchases

Tidy Tuesday

I analyzed TidyTuesday data about trends in Valentine’s Day consumer data across year, age, and gender.

Author

Sydney Lewis

Published

February 13, 2024

Introduction

Happy Valentine’s Day! ❤️💌🌹 This dataset from TidyTuesday offered an opportunity to learn more about spending patterns on Valentine’s Day. I also took this as a chance to learn more about incorporating unique shapes into a visualization, by including hearts on these different plots. I added comments to my code for each section identifying where I specified these different heart details.

Loading the Data

Here you’ll find code that downloads the TidyTuesday datasets and loads them into my local environment.

Code

library(tidyverse)

download_and_save <- function(file_name, url) {
  data_folder <- "data"
  file_path <- file.path("data", file_name)
  # See if the file already exists
  if (!file.exists("data")) {
    dir.create("data", recursive = TRUE)
  }
  if (!file.exists(file_path)) {
    # Download the data if it does not exist
    data <- readr::read_csv(url)
    # Saves the data to the path with the desired name
    write.csv(data, file = file_path, row.names = FALSE)
  }
}

# Uses download_and_save function with historical_spending.csv from GitHub
download_and_save("historical_spending.csv", 'https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2024/2024-02-13/historical_spending.csv')

# Uses download_and_save function with gifts_age.csv from GitHub
download_and_save("gifts_age.csv", "https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2024/2024-02-13/gifts_age.csv")

# Uses download_and_save function with gifts_gender.csv from GitHub
download_and_save("gifts_gender.csv", "https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2024/2024-02-13/gifts_gender.csv")

# Loads datasets into my environment
historical_spending <- read_csv("data/historical_spending.csv")
gifts_age <- read_csv("data/gifts_age.csv")
gifts_gender <- read_csv("data/gifts_gender.csv")

Analysis

Spending by Year

From 2010 to 2022, spending has increased for many different gifts. The amount spent on jewelry appears to have had the largest increase where as spending on greeting cards has remained fairly consistent over time.

Code

historical_spending |>
  select(-c(PercentCelebrating, PerPerson)) |>
  pivot_longer(
    -Year,
    names_to = "item",
    values_to = "spent"
  ) |>
  mutate(item = str_replace_all(item, "(?<=[a-z])(?=[A-Z])", " ")) |>
  mutate(item = factor(item, levels = c("Jewelry", "Evening Out", "Clothing", "Gift Cards", "Flowers", "Candy", "Greeting Cards"))) |>
  ggplot(aes(x = Year, y = spent, color = item, group = item)) +
  geom_line() +
  geom_text(aes(label = "♥", x = Year, y = spent), size = 5.5) + 
  scale_x_continuous(breaks = unique(historical_spending$Year), 
                     labels = as.character(unique(historical_spending$Year))) +
  theme_minimal() + 
  labs(x = "Year", 
       y = "Amount Spent ($)", 
       title = "Amount Spent on Valentine's Day Gift Categories Over Time", 
       color = "Category") +
  guides(color = guide_legend(override.aes = list(label = "♥"))) +
  scale_color_manual(values = c("#CF597EFF", "#009392FF", "#EEB479FF", "#39B185FF", "#9CCB86FF", "#E88471FF", "#C75DABFF"))

Spending across Age

This chart displays the percentage of individuals spending on different types of gifts. Overall, it appears that the proportion of people buying gifts decreases as age increases. One category where this isn’t the case is with greeting cards, where a larger proprotion of older adults are purchasing than younger adults. In nearly every age group, candy is the most popular category for people to spend more.

Code

gifts_age |>
  pivot_longer(
    -c(Age, SpendingCelebrating),
    names_to = "item",
    values_to = "percent"
  ) |>
  mutate(item = str_replace_all(item, "(?<=[a-z])(?=[A-Z])", " ")) |>
  group_by(item) |>
  mutate(average_percent = mean(percent, na.rm = TRUE)) |>
  ungroup() |>
  mutate(item = reorder(item, average_percent)) |>
  ggplot(aes(x = Age, y = item, fill = percent)) + 
  geom_tile() + 
  ## I used the code below to overlay the hearts onto my heatmap
  geom_text(aes(label = "♥", x = Age, y = item), color = "white", size = 18, vjust = 0.5) +
  geom_text(aes(label = sprintf("%.f%%", percent)), color = "darkred", size = 3.25, fontface = "bold") +
  scale_fill_gradient(low = "#ffd3e5", high = "#ca0050") + 
  theme_minimal() +
  theme(legend.position = "top") +
  labs(x = "Age Group", 
       y = "", 
       fill = "Percent of respondants \nspending (%)", 
       title = "Compares the Proportion of those Spending on \nValentine's Day Gift Categories Across Age Groups") +
  coord_fixed(ratio = 1)

Spending across Gender

The following plot compares spending across gender. For several categories, spending is very similar across gender, with some categories like gift cards, clothing, greeting cards, and candy, having a larger amount of women making these purchases, though the difference is modest. For a few categories, like flowers and jewelry, a much larger proportion of men than women spend money on these types of gifts. These results align with what I may have originally expected, as flowers and jewelry are especially gendered gifts.

Code

gifts_gender %>%
  select(-SpendingCelebrating) %>%
  pivot_longer(
    -Gender,
    names_to = "item",
    values_to = "percent"
  ) %>%
  mutate(item = str_replace_all(item, "(?<=[a-z])(?=[A-Z])", " ")) |>
  group_by(item) %>%
  mutate(avg_percent = mean(percent)) %>%
  ungroup() %>%
  mutate(item = fct_reorder(item, avg_percent)) %>%
  ggplot(aes(x = item, y = percent, fill = Gender)) +
  geom_col(position = "dodge") +
  geom_text(aes(label = paste0(round(percent, 1), "%"), y = percent),
            position = position_dodge(width = 0.9),
            vjust = 1.5,
            size = 3.5,
            color = "black") +
  ## I used the code below to add the hearts onto the barplots below the percentages
  geom_text(aes(label = "♥", y = percent),
            position = position_dodge(width = 0.9),
            vjust = 1.6,
            size = 10,
            color = "white") +
  scale_fill_manual(values = c("Men" = "#a6ceb1", "Women" = "#f4c7d9")) +
  theme_minimal() +
  theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
  labs(x = "", 
       y = "Percent Spending on Category", 
       fill = "Gender", 
       title = "Comparison of Spending on Valentine's Day Gift Categories \nby Gender")

Conclusions

Overall, I had a lot of fun with this analysis! It is always interesting to see trends in consumer spending and I can imagine that type of information would be incredibly relevant when designing targeted ads around holidays. I also enjoyed finding ways to add hearts to my plots, which while a bit silly, added some visual interest to these otherwise fairly basic plots.