library(tidyverse)
library(completejourney)
library(scales)
transactions <- get_transactions()
promotions <- get_promotions()
total_coupons_issued <- campaign_descriptions %>%
group_by(campaign_type) %>%
summarise(total_coupons = n())
weekly_coupon_redemption <- coupon_redemptions %>%
inner_join(campaign_descriptions, by = "campaign_id") %>%
mutate(week = week(redemption_date)) %>%
group_by(campaign_type) %>%
arrange(week) %>%
# Calculate weekly redemption counts
mutate(weekly_count = n()) %>%
group_by(campaign_type, week) %>%
summarise(
redemption_count = n(),
cumulative_redemption = cumsum(n())
) %>%
ungroup() %>%
left_join(total_coupons_issued, by = "campaign_type") %>%
mutate(
redemption_rate = (cumulative_redemption / total_coupons) * 100
)
ggplot(weekly_coupon_redemption, aes(x = week, y = redemption_count, fill = campaign_type)) +
geom_area(alpha = 0.6, position = "identity") +
geom_line(aes(y = redemption_rate * max(redemption_count) / max(redemption_rate), color = campaign_type), size = 1.2) +
scale_y_continuous(
name = "Weekly Coupon Redemptions",
labels = comma,
sec.axis = sec_axis(~ . * max(weekly_coupon_redemption$redemption_rate) / max(weekly_coupon_redemption$redemption_count),
name = "Redemption Rate (%)")
) +
facet_wrap(~ campaign_type, ncol = 1, scales = "free_y") +
scale_fill_brewer(palette = "Set2") +
scale_color_brewer(palette = "Dark2") +
scale_x_continuous(breaks = seq(1, 52, by = 4)) +
labs(
title = "Weekly Coupon Redemption Trends by Campaign Type",
subtitle = "Including cumulative redemptions and redemption rates over time",
x = "Week of the Year",
y = "Number of Coupons Redeemed",
fill = "Campaign Type",
color = "Campaign Type",
caption = "Data from Campaign Descriptions and Coupon Redemptions Tables"
) +
geom_text(data = weekly_coupon_redemption %>% group_by(campaign_type) %>% top_n(1, redemption_count),
aes(label = paste("Peak:", redemption_count)),
vjust = -1, size = 3.5, color = "black") +
theme_minimal(base_size = 15) +
theme(
plot.title = element_text(size = 20, face = "bold"),
plot.subtitle = element_text(size = 14),
axis.title.y = element_text(size = 14),
axis.title.y.right = element_text(size = 14, angle = 90),
axis.title.x = element_text(size = 14),
legend.position = "bottom",
legend.key.size = unit(0.8, "cm"),
legend.text = element_text(size = 12),
panel.grid.minor = element_blank()
)
monthly_spend_coupon <- transactions %>%
mutate(
month = month(transaction_timestamp, label = TRUE), # Use month labels
redemption_status = ifelse(coupon_disc > 0, "Redeemed Coupons", "No Coupons")
) %>%
group_by(month, redemption_status) %>%
summarise(
monthly_spend = sum(sales_value),
total_discount = sum(retail_disc + coupon_disc + coupon_match_disc),
avg_spend_per_household = mean(sales_value),
num_transactions = n()
) %>%
ungroup()
ggplot(monthly_spend_coupon, aes(x = month, y = monthly_spend, fill = redemption_status)) +
geom_bar(stat = "identity", position = "dodge") +
geom_line(aes(y = total_discount, group = redemption_status, color = redemption_status),
size = 1.2, position = position_dodge(width = 0.9)) +
geom_point(aes(y = total_discount, color = redemption_status),
size = 3, position = position_dodge(width = 0.9)) +
geom_text(aes(label = round(monthly_spend, 0)),
position = position_dodge(width = 0.9), vjust = -0.5, size = 3) +
scale_fill_manual(values = c("Redeemed Coupons" = "cyan", "No Coupons" = "orange")) +
scale_color_manual(values = c("Redeemed Coupons" = "cyan", "No Coupons" = "orange")) +
scale_y_continuous(name = "Amount (in $)", labels = scales::comma) +
labs(
title = "Impact of Coupon Redemption on Monthly Spend and Discount Usage",
subtitle = "Comparison of monthly spend and discounts between coupon redeemers and non-redeemers",
x = "Month",
fill = "Coupon Redemption Status",
color = "Coupon Redemption Status",
caption = "Data from Transactions Table"
) +
theme_minimal() +
theme(
plot.title = element_text(size = 16, face = "bold"),
plot.subtitle = element_text(size = 12),
axis.title.y = element_text(size = 12),
legend.position = "top",
legend.title = element_blank(),
legend.background = element_rect(fill = "white", color = "black"),
panel.grid.minor = element_blank()
)
redemption_by_campaign_category <- coupon_redemptions %>%
inner_join(coupons, by = c("coupon_upc", "campaign_id")) %>% # First join with coupons table to get product_id
inner_join(campaign_descriptions, by = "campaign_id") %>%
inner_join(products, by = "product_id") %>%
group_by(campaign_type, product_category) %>%
summarise(redemption_count = n()) %>%
ungroup()
top_8_categories <- redemption_by_campaign_category %>%
group_by(product_category) %>%
summarise(total_redemption = sum(redemption_count)) %>%
top_n(8, wt = total_redemption) %>%
pull(product_category)
# Filter the data to include only the top 8 categories
filtered_redemptions <- redemption_by_campaign_category %>%
filter(product_category %in% top_8_categories)
if (nrow(filtered_redemptions) == 0) {
stop("No data left after filtering. Check the filtering criteria.")
} else {
ggplot(filtered_redemptions, aes(x = product_category, y = redemption_count, fill = product_category)) +
geom_col(show.legend = FALSE) +
geom_text(aes(label = redemption_count), size = 3, color = "black", vjust = -0.5) +
facet_wrap(~ campaign_type) +
scale_fill_brewer(palette = "Set2") +
labs(
title = "Top 8 Product Categories by Coupon Redemption and Campaign Type",
subtitle = "Comparison of coupon redemptions across product categories and campaign types",
x = "Product Category",
y = "Number of Coupons Redeemed",
caption = "Data from Campaign Descriptions, Coupon Redemptions, and Products Tables"
) +
theme_minimal(base_size = 14) +
theme(
plot.title = element_text(size = 18, face = "bold"),
plot.subtitle = element_text(size = 14),
axis.text.x = element_text(angle = 45, hjust = 1), # Rotate x-axis labels for better readability
strip.text = element_text(size = 14, face = "bold"), # Facet label styling
panel.spacing = unit(1, "lines") # Increase spacing between facets
)
}
