Introduction

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.

Part 1: Data preparation

1.1.Load libraries

library(ggplot2)
library(dplyr)
library(completejourney)
library(lubridate)
library(scales)
library(zoo)
library(forcats)
library("gridExtra")

1.2.Load datasets

campaigns <- campaigns
campaign_descriptions <- campaign_descriptions
demographics <- demographics
transactions <- get_transactions()

1.3.Create dataframe

df <- campaigns %>% 
     left_join(campaign_descriptions, by = 'campaign_id') %>% 
     left_join(demographics, by='household_id') %>% 
     left_join(transactions, by ='household_id')

1.4. Data Transformation

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))

Part 2: Data Exploration

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.

Outlier Detection

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)

2.1. Sales on holidays vs. non-holidays

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)

2.2. Weekly Sales on holidays vs. non-holidays

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)

2.3. Correlation between number of campaigns and sales

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.

Summary

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.