The Regork Marketing Team is making a year-round plan to allocate their budget on promotions. They are curious if there are any times of the year, such as holidays, that experienced the spike in sale, in order to plan accordingly and optimize the Return on Ads (ROAs) for the following year.
The project will explore and analyze the sales in 2017 to uncover the differences in sales among holidays and non-holidays to decide which time of the year worth extra of marketing budget.
library(ggplot2)
library(dplyr)
library(completejourney)
library(lubridate)
library(scales)
library(zoo)
library(forcats)
library("gridExtra")
campaigns <- campaigns
campaign_descriptions <- campaign_descriptions
demographics <- demographics
transactions <- get_transactions()
df <- campaigns %>%
left_join(campaign_descriptions, by = 'campaign_id') %>%
left_join(demographics, by='household_id') %>%
left_join(transactions, by ='household_id')
We will add ‘IsHoliday’ feature for the data frame for the transactions happened on Super Bowl, Labor Day, Thanksgiving, and Christmas.
df <- df %>% mutate(IsHoliday = case_when(lubridate::date(transaction_timestamp) == '2017-02-05' |
lubridate::date(transaction_timestamp) == '2017-09-04' |
lubridate::date(transaction_timestamp) == '2017-11-23' |
lubridate::date(transaction_timestamp) == '2017-12-24' ~ 1,
TRUE ~ 0))
summary(df)
## campaign_id household_id campaign_type start_date
## Length:7305332 Length:7305332 Type A:3452705 Min. :2016-11-14
## Class :character Class :character Type B:3007523 1st Qu.:2017-05-08
## Mode :character Mode :character Type C: 845104 Median :2017-08-08
## Mean :2017-08-06
## 3rd Qu.:2017-10-30
## Max. :2017-12-28
##
## end_date age income
## Min. :2017-01-16 19-24: 238119 50-74K :1243746
## 1st Qu.:2017-06-25 25-34: 944627 35-49K : 938333
## Median :2017-09-24 35-44:1420268 75-99K : 586214
## Mean :2017-09-20 45-54:1736486 25-34K : 391415
## 3rd Qu.:2017-12-24 55-64: 277685 Under 15K: 380949
## Max. :2018-02-28 65+ : 269557 (Other) :1346085
## NA's :2418590 NA's :2418590
## home_ownership marital_status household_size
## Renter : 302096 Married :2274876 1 :1350342
## Probable Renter : 43334 Unmarried:1735763 2 :1794358
## Homeowner :3251170 Unknown : 0 3 : 816723
## Probable Homeowner: 62609 NA's :3294693 4 : 458945
## Unknown : 0 5+ : 466374
## NA's :3646123 NA's:2418590
##
## household_comp kids_count store_id
## 1 Adult Kids : 519981 0 :2861801 Length:7305332
## 1 Adult No Kids :1350342 1 : 991028 Class :character
## 2 Adults Kids :1504960 2 : 531993 Mode :character
## 2 Adults No Kids:1511459 3+ : 501920
## Unknown : 0 Unknown: 0
## NA's :2418590 NA's :2418590
##
## basket_id product_id quantity sales_value
## Length:7305332 Length:7305332 Min. : 0.0 Min. : 0.000
## Class :character Class :character 1st Qu.: 1.0 1st Qu.: 1.290
## Mode :character Mode :character Median : 1.0 Median : 2.070
## Mean : 113.5 Mean : 3.146
## 3rd Qu.: 1.0 3rd Qu.: 3.490
## Max. :89638.0 Max. :840.000
##
## retail_disc coupon_disc coupon_match_disc week
## Min. : 0.0000 Min. : 0.00000 Min. :0.000000 Min. : 1.00
## 1st Qu.: 0.0000 1st Qu.: 0.00000 1st Qu.:0.000000 1st Qu.:14.00
## Median : 0.0400 Median : 0.00000 Median :0.000000 Median :26.00
## Mean : 0.5292 Mean : 0.02043 Mean :0.003589 Mean :26.76
## 3rd Qu.: 0.6500 3rd Qu.: 0.00000 3rd Qu.:0.000000 3rd Qu.:40.00
## Max. :130.0200 Max. :55.93000 Max. :7.700000 Max. :53.00
##
## transaction_timestamp IsHoliday
## Min. :2017-01-01 06:53:26.00 Min. :0.00000
## 1st Qu.:2017-03-27 22:48:10.00 1st Qu.:0.00000
## Median :2017-06-25 11:49:22.00 Median :0.00000
## Mean :2017-06-28 04:30:55.00 Mean :0.01044
## 3rd Qu.:2017-09-26 16:36:08.25 3rd Qu.:0.00000
## Max. :2017-12-31 23:01:20.00 Max. :1.00000
##
From the summary table, we are seeing that our metric (sales_value) has the mean of \(3.146\) and Q3 of \(3.49\), while its max is \(840\). Hence, there must be outliers in the data. To decide whether we should remove the outliers, let’s do examinations on it.
plot_1 <- ggplot(data=df, aes(y=sales_value)) +
geom_boxplot() +
labs(title = "Sales Distribution in 2017",
subtitle = "Household transaction data covering 2017",
y = "Total Sales ($)") +
scale_y_continuous(labels=comma) +
theme(plot.title = element_text(face = "bold"),
plot.subtitle = element_text(face = "italic"),
panel.background = element_rect(fill = "white"),
panel.grid.major = element_line(color = "lightgray"),
axis.title.x=element_blank(),
axis.text.x=element_blank(),
axis.ticks.x=element_blank())
print(plot_1)
According to the box plot, We are seeing that out of 7M+ product purchases, there were only a few outliers having sales value higher than $300. To determine whether we should remove the outliers, we will see if these outliers happened during holidays or not.
df[df$sales_value > 300,] %>%
group_by(IsHoliday) %>%
summarize(n_days = n())
## # A tibble: 1 Ă— 2
## IsHoliday n_days
## <dbl> <int>
## 1 0 14
The outliers did not occur on any holidays (IsHoliday = 1) identified, we will go ahead and remove these outliers from the data frame.
df <- df %>%
filter(sales_value <= 300)
To compare the differences in sales among holidays and non-holidays, we will use the sales of the day as the metric. In other words, we will compare the sales on each holiday and average daily sales for non-holidays.
df_holiday <- df %>%
filter(IsHoliday == 1) %>%
group_by(lubridate::date(transaction_timestamp)) %>%
summarize(sales = sum(sales_value))
colnames(df_holiday)[1] <- "date"
avg_daily_sales<- df %>%
filter(IsHoliday == 0) %>%
group_by(lubridate::date(transaction_timestamp)) %>%
summarize(daily_sales = sum(sales_value)) %>%
summarise_if(is.numeric, mean)
new_row <- c('2017-01-01',avg_daily_sales)
new_row <- as.data.frame(new_row)
colnames(new_row) <- c("date","sales")
new_row <- transform(new_row, date = as.Date(date))
#create a data frame of day sales
df_holiday <- bind_rows(df_holiday,new_row) %>%
mutate('typeofdays' = case_when(date == '2017-02-05' ~ 'Super Bowl',
date == '2017-09-04' ~ 'Labor Day',
date == '2017-11-23' ~ 'Thanksgiving',
date == '2017-12-24' ~ 'Christmas',
date == '2017-01-01' ~ 'Average Day'))
plot_2 <- ggplot(data=df_holiday, aes(x=reorder(typeofdays,-sales),
y=sales,
fill=factor(ifelse(typeofdays=="Average Day","Highlighted","Normal")))) +
geom_bar(stat="identity",show.legend = FALSE) +
scale_fill_manual(name = "typeofdays", values=c("#89CFF0","#002D62")) +
labs(title = "Sales of the day on holidays and non-holidays",
subtitle = "Disclaimer: Daily sales for non-holidays measured by average",
x = "Type",
y = "Total Sales ($)") +
scale_y_continuous(labels=comma) +
theme(plot.title = element_text(face = "bold"),
plot.subtitle = element_text(face = "italic"),
panel.background = element_rect(fill = "white"),
panel.grid.major = element_line(color = "lightgray"),
axis.title.x=element_blank())
print(plot_2)
All of other holidays (Super Bowl, Labor Day, Christmas) have higher sales than average of non-holidays. Meanwhile, we are seeing that sales on Thanksgiving is significantly lower than other holidays and average day. This phenomenon can be understood as not many stores open on Thanksgiving and our customers have a high chance to stay at home and giving thanks to each other.
Hence, only from the day sales, we could not confirm that Thanksgiving is not a profitable holiday. To have a better judgement, we will look at the weekly sales of the holiday and non-holiday weeks as customers have habit of buying and preparing a few days before the actual holiday.
df_week <- df %>%
group_by(week) %>%
summarize(weekly_sales = sum(sales_value),
weekly_qty = sum(quantity),
holiday_week = sum(IsHoliday))
df_week$weektype <- as.factor(ifelse(df_week$week==6, "Super Bowl",
ifelse(df_week$week==37, "Labor Day",
ifelse(df_week$week==48, "Thanksgiving",
ifelse(df_week$week==52, "Christmas","Non-Holidays")))))
plot_3 <- df_week %>%
mutate(IsHolidayWeek = case_when(holiday_week==0 ~ 'Non-Holidays',
holiday_week>0 ~ 'Holidays')) %>%
group_by(IsHolidayWeek) %>%
summarize(avg_sales = mean(weekly_sales)) %>%
ggplot(aes(x=IsHolidayWeek,
y=avg_sales,
fill=factor(ifelse(IsHolidayWeek=="Non-Holidays","Highlighted","Normal")))) +
geom_bar(stat="identity",show.legend = FALSE) +
scale_fill_manual(name = "typeofdays", values=c("#89CFF0","#002D62")) +
labs(title = "Average Week Sales on holidays and non-holidays",
subtitle = "Disclaimer: Weekly sales for non-holidays measured by average",
x = "Type",
y = "Total Sales ($)") +
scale_y_continuous(labels=comma) +
theme(plot.title = element_text(face = "bold"),
plot.subtitle = element_text(face = "italic"),
panel.background = element_rect(fill = "white"),
panel.grid.major = element_line(color = "lightgray"),
axis.title.x=element_blank())
plot_4 <- df_week %>% group_by(weektype) %>%
summarize(avg_sales = mean(weekly_sales)) %>%
ggplot(aes(x=reorder(weektype,-avg_sales),
y=avg_sales,
fill=factor(ifelse(weektype=="Non-Holidays","Highlighted","Normal")))) +
geom_bar(stat="identity",show.legend = FALSE) +
scale_fill_manual(name = "typeofdays", values=c("#89CFF0","#002D62")) +
labs(title = "Week Sales on each holiday and non-holidays",
subtitle = "Disclaimer: Weekly sales for non-holidays measured by average",
x = "Type",
y = "Total Sales ($)") +
scale_y_continuous(labels=comma) +
theme(plot.title = element_text(face = "bold"),
plot.subtitle = element_text(face = "italic"),
panel.background = element_rect(fill = "white"),
panel.grid.major = element_line(color = "lightgray"),
axis.title.x=element_blank())
plot_5 <- grid.arrange(plot_3,plot_4,nrow=2)
We recognize that there were some marketing campaigns running all year round, so we are wondering if the campaigns could affect the sales for each holidays.
Let’s count number of campaigns running during these holidays.
cmp <- campaign_descriptions %>%
mutate(SuperBowl = ifelse((start_date <= '2017-02-05') & (end_date >= '2017-02-05'),1,0),
LaborDay = ifelse((start_date <= '2017-09-04') & (end_date >= '2017-09-04'),1,0),
Thanksgiving = ifelse((start_date <= '2017-11-23') & (end_date >= '2017-11-23'),1,0),
Christmas = ifelse((start_date <= '2017-12-24') & (end_date >= '2017-12-24'),1,0)) %>%
summarize_if(is.numeric, sum, na.rm=TRUE)
df_holiday <- df_holiday %>%
mutate(n_cmp = case_when(typeofdays == 'Super Bowl' ~ 2,
typeofdays == 'Labor Day' ~ 2,
typeofdays == 'Thanksgiving' ~ 3,
typeofdays == 'Christmas' ~ 5))
plot_6 <- df_holiday %>%
ggplot(aes(x=reorder(typeofdays,-sales))) +
geom_bar(aes(y=sales),
stat="identity",
fill = "#89CFF0") +
geom_point(aes(y=n_cmp*15000), size = 3, color = "#002D62") +
scale_y_continuous(labels=comma,
name = 'Total Sales ($)',
sec.axis = sec_axis(~./15000,name = "Number of Campaigns")) +
labs(title = "Sales and number of campaigns on each holidays",
subtitle = "Sales and campaign data covering 2016-2017",
x = "Type") +
theme(plot.title = element_text(face = "bold"),
plot.subtitle = element_text(face = "italic"),
panel.background = element_rect(fill = "white"),
panel.grid.major = element_line(color = "lightgray"),
axis.title.x=element_blank(),
axis.title.y = element_text(vjust = +3))
plot_6
## Warning: Removed 1 rows containing missing values (`geom_point()`).
We are seeing that there are no strong correlation between the number of campaigns running through each holidays and the sales value. Hence,the marketing should improve the efficiency or quality of their campaigns for each holidays and especially focus on the top profitable holidays: Super Bowl, Labor Day, and Christmas.
Through the exploration and visualization, we discovered that SALES on holidays and the week of that holidays are higher than other normal weeks. With the insights, the Marketing Team should start planning their budget for campaigns according to the level of profitability of each holiday based on week sales (Christmas > Super Bowl > Labor Day > Thanksgiving)
Besides, the sales are not strongly impacted by the number of marketing campaigns running around that day. The team should not run as many campaigns as possible around the holiday but instead focus on improving the quality of the campaigns for each holidays. The team should remind that quality is better than quantity, regarding the marketing campaigns.