Market Mix Modelling
Parag Verma
16th October, 2022
Introduction
Once a company manufactures its product, it needs a sound channel to push it for sales. This includes making customers aware of the product. This in turn is done through two broad types of Marketing Channels:
- Direct Marketing : Includes promotional channels such as mails,newsletter, ads,websites,etc
- Indirect Marketing : Includes Social Media, Referrals, Live Events, etc
A company uses both these strategies to market their products.Now all these marketing programs incur cost and hence it is very important to understand how effective all the channels in increasing customer sales. Based on how much each marketing tactic influence sales, the spend can then be optimized.
Some commonly used tactics for Direct and Indirect Marketing is shown below
Step 0: Importing the libraries
In this blog, we will take a sample marketing from datarium package and leverage adstock modelling to attribute product sales to different marketing acitivty.
If you unable to run the below piece of code, then you can import the dataset form my github repository.
package.name<-c("dplyr","tidyr","datarium","stats",
"ggplot2","plotly","corrplot","ggcorrplot","RColorBrewer")
for(i in package.name){
if(!require(i,character.only = T)){
install.packages(i)
}
library(i,character.only = T)
}
Step 1: Importing the dataset
data("marketing")
df<-marketing%>%
select(sales,everything())
head(df)
sales youtube facebook newspaper
1 26.52 276.12 45.36 83.04
2 12.48 53.40 47.16 54.12
3 11.16 20.64 55.08 83.16
4 22.20 181.80 49.56 70.20
5 15.48 216.96 12.96 70.08
6 8.64 10.44 58.68 90.00
The attributes are as follows:
- youtube :Advertising budget in thousand dollars
- facebook :Advertising budget in thousand dollars
- newspaper :Advertising budget in thousand dollars
- sales :Sales figures in thousand dollars
Lets assume that these are the data points for the last 200 weeks for a small market.
Step 2: Correlation Between Variables
Since we are trying to find the impact of various marketing channels on sales, lets start by looking at the correlation between variables
cor_matrix <-round(cor(df),2)
cor_matrix
sales youtube facebook newspaper
sales 1.00 0.78 0.58 0.23
youtube 0.78 1.00 0.05 0.06
facebook 0.58 0.05 1.00 0.35
newspaper 0.23 0.06 0.35 1.00
ggcorrplot(cor_matrix, hc.order = TRUE, type = "lower",
lab = TRUE,insig = "blank")
We can see that
- Sales has a high correlation with youtube spend
- Sales has a medium correlation with facebook spend
- Sales has a low correlation with newspaper spend
Since correlation between facebook ,youtube and newspaper spend is very low, hence we can just rule out the issue of multi-collinearity.
Now lets convert the marketing expenses into adstock variables.
Step 3: Defining Adstock Function
Any marketing activity has an impact on its end customer and this effect decays with time. Some channels like TV have a higher impact and its impact decay gradually whereas the impact of other channel such as YouTube ads decays very rapidly.
Our data has three marketing channels:
- facebook: ads on facebook are very limited and hence we will assume it to have a rapid decline rate
- youtube: ads on youtube are in the form of colorful video and hence we will assume it to have a moderate decline rate
- newspaper: ads on newspaper are in the form of front page displays and hence have a relatively higher retention rate
We will now create the decay rate for each of these three channels
Step 3A: Defining Adstock Rate for facebook ads
In modelling adstock, we will also assume that the effect of ad exposure decays is in the form of a moving average.Hence it will be important to define till what past periods we would want to consider in the moving average term.
Lets say, if we are taking a decay rate of 0.1 for fb and if the spend for three consecutive periods are as follows
- Period 1: 10
- Period 2: 15
- Period 3: 20
Then Adstock for Period 3 will be calculated as: 10* 0.1^2 + 15* 0.1 + 20, which will be equal to 21.6
decay_rate_fb <- 0.1
past_memory <- 2
get_adstock_fb <- rep(decay_rate_fb, past_memory+1) ^ c(0:past_memory)
get_adstock_fb
[1] 1.00 0.10 0.01
In short, the effect decays to 10% in the subsequent period and then becomes 1% in the period after that.
Lets look at the first few records of the facebook coluumn and try to come up with transformed variable
df[["facebook"]][1:10]
[1] 45.36 47.16 55.08 49.56 12.96 58.68 39.36 23.52 2.52 3.12
Lets create the third term
45.36* 0.01 + 47.16*0.1 + 55.08 which gives 60.2496
We will check and see if we get the same through adstock transformation
ads_fb <- stats::filter(c(rep(0, past_memory), df[["facebook"]]),
filter = get_adstock_fb,
method="convolution")
ads_fb <- ads_fb[!is.na(ads_fb)] # Removing leading NA
ads_fb[1:5]
[1] 45.3600 51.6960 60.2496 55.5396 18.4668
We have padded the dataset with two zeroes(rep(0,past_memory)),so that we get a valid term for the first facebook expense which from our data is 45.35.Upon adding the two zeroes, the Moving Average term will be = 0.01* 0 + 0.1* 0 + 45.36.If we dont do a zero padding, then the moving average term for the first term will be NA as there will be no past record for the first instance of facebook spend.
Now we can check the third term and it matches our calculation which is 60.2496
Lets plot the facebook adstock
fb_df<-data.frame(Week=1:nrow(df),
Fb_Spend=df[["facebook"]],
Fb_Adstock=ads_fb)
head(fb_df)
Week Fb_Spend Fb_Adstock
1 1 45.36 45.3600
2 2 47.16 51.6960
3 3 55.08 60.2496
4 4 49.56 55.5396
5 5 12.96 18.4668
6 6 58.68 60.4716
p1<-ggplot(data = fb_df, aes(x=Week, y=Fb_Spend)) +
geom_segment( aes(xend=Week, yend=0),color="blue") +
geom_line(aes(y = Fb_Adstock, colour = "red"),
size = 1) +
xlab("Week") + ylab("Facebook Adstock")+
theme(text = element_text(size=15),
axis.text.x=element_text(size=15),
axis.text.y=element_text(size=15))
p1
The segments in blue represent the original spend whereas the ones in red represents adstock transformed spend.
We will repeat the above transformation for youtube and newspaper ads.
Step 3B: Defining Adstock Rate for YouTube ads
We will assume that Youtube ads decays at a rate less than facebook anis equal to 0.15
decay_rate_yt <- 0.15
past_memory <- 2
get_adstock_yt <- rep(decay_rate_yt, past_memory+1) ^ c(0:past_memory)
get_adstock_yt
[1] 1.0000 0.1500 0.0225
ads_yt <- stats::filter(c(rep(0, past_memory), df[["youtube"]]),
filter = get_adstock_yt,
method="convolution")
ads_yt <- ads_yt[!is.na(ads_yt)] # Removing leading NA
ads_yt[1:5]
[1] 276.1200 94.8180 34.8627 186.0975 244.6944
Lets plot the YouTube adstock
yt_df<-data.frame(Week=1:nrow(df),
Yt_Spend=df[["youtube"]],
Yt_Adstock=ads_yt)
head(yt_df)
Week Yt_Spend Yt_Adstock
1 1 276.12 276.1200
2 2 53.40 94.8180
3 3 20.64 34.8627
4 4 181.80 186.0975
5 5 216.96 244.6944
6 6 10.44 47.0745
p2<-ggplot(data = yt_df, aes(x=Week, y=Yt_Spend)) +
geom_segment( aes(xend=Week, yend=0),color="blue") +
geom_line(aes(y = Yt_Adstock, colour = "red"),
size = 1) +
xlab("Week") + ylab("Youtube Adstock")+
theme(text = element_text(size=15),
axis.text.x=element_text(size=15),
axis.text.y=element_text(size=15))
p2
The segments in blue represent the original spend whereas the ones in red represents adstock transformed spend.
Step 3C: Defining Adstock Rate for Newspaper ads
In the beginning of the blog, we discussed that the newspaper ads in general are more effective than youtube and facebook and hence we will assume a decay rate of 0.25
decay_rate_nw <- 0.25
past_memory <- 2
get_adstock_nw <- rep(decay_rate_nw, past_memory+1) ^ c(0:past_memory)
get_adstock_nw
[1] 1.0000 0.2500 0.0625
ads_nw <- stats::filter(c(rep(0, past_memory), df[["newspaper"]]),
filter = get_adstock_nw,
method="convolution")
ads_nw <- ads_nw[!is.na(ads_nw)] # Removing leading NA
ads_nw[1:5]
[1] 83.0400 74.8800 101.8800 94.3725 92.8275
Lets plot the Newspaper adstock
nw_df<-data.frame(Week=1:nrow(df),
Nw_Spend=df[["newspaper"]],
Nw_Adstock=ads_nw)
head(nw_df)
Week Nw_Spend Nw_Adstock
1 1 83.04 83.0400
2 2 54.12 74.8800
3 3 83.16 101.8800
4 4 70.20 94.3725
5 5 70.08 92.8275
6 6 90.00 111.9075
p3<-ggplot(data = nw_df, aes(x=Week, y=Nw_Spend)) +
geom_segment( aes(xend=Week, yend=0),color="blue") +
geom_line(aes(y = Nw_Adstock, colour = "red"),
size = 1) +
xlab("Week") + ylab("NewsPaper Adstock")+
theme(text = element_text(size=15),
axis.text.x=element_text(size=15),
axis.text.y=element_text(size=15))
p3
The segments in blue represent the original spend whereas the ones in red represents adstock transformed spend.
Step 3D: All three Adstock together
Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
ℹ Please use `linewidth` instead.
Since all the adstocks have been created, lets look back the correlation of the transformed variables with sales
Step 3E: Correlation Between Transformed Variables
Get the adstock variables into a data frame
model.df<-df%>%
mutate(Facebook_Adst = ads_fb,
Youtube_Adst=ads_yt,
Newspaper_Adst=ads_nw)%>%
select(-facebook,-newspaper,-youtube)
head(model.df)
sales Facebook_Adst Youtube_Adst Newspaper_Adst
1 26.52 45.3600 276.1200 83.0400
2 12.48 51.6960 94.8180 74.8800
3 11.16 60.2496 34.8627 101.8800
4 22.20 55.5396 186.0975 94.3725
5 15.48 18.4668 244.6944 92.8275
6 8.64 60.4716 47.0745 111.9075
cor_matrix <-round(cor(model.df),2)
cor_matrix
sales Facebook_Adst Youtube_Adst Newspaper_Adst
sales 1.00 0.57 0.78 0.20
Facebook_Adst 0.57 1.00 0.05 0.36
Youtube_Adst 0.78 0.05 1.00 0.04
Newspaper_Adst 0.20 0.36 0.04 1.00
ggcorrplot(cor_matrix, hc.order = TRUE, type = "lower",
lab = TRUE,insig = "blank")
We can see that
- Correaltion of all the variables with sales remains the same
- Newspaper is the only variable whose correlation with sales decreases
- Hence for newspaper, we will retain the original variable for model development
Step 4: Creating the MMX Model
Since we have the adstock transformation for all the three marketing channels, lets model their impact on sales
model.df<-df%>%
mutate(Facebook_Adst = ads_fb,
Youtube_Adst=ads_yt)%>%
select(-facebook,-youtube)
head(model.df)
sales newspaper Facebook_Adst Youtube_Adst
1 26.52 83.04 45.3600 276.1200
2 12.48 54.12 51.6960 94.8180
3 11.16 83.16 60.2496 34.8627
4 22.20 70.20 55.5396 186.0975
5 15.48 70.08 18.4668 244.6944
6 8.64 90.00 60.4716 47.0745
m1<-lm(sales ~.,data=model.df)
summary(m1)
Call:
lm(formula = sales ~ ., data = model.df)
Residuals:
Min 1Q Median 3Q Max
-9.8749 -1.2714 0.4329 1.4293 4.2121
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 1.808690 0.440319 4.108 5.87e-05 ***
newspaper -0.002098 0.006326 -0.332 0.741
Facebook_Adst 0.186019 0.009242 20.127 < 2e-16 ***
Youtube_Adst 0.045169 0.001483 30.458 < 2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 2.173 on 196 degrees of freedom
Multiple R-squared: 0.8814, Adjusted R-squared: 0.8796
F-statistic: 485.5 on 3 and 196 DF, p-value: < 2.2e-16
Step 5: Key Findings from the Model
- The Model is significant indicated by p value less than 0.05
- The Model is able to explain 88%(\(R^2\)) variance in Sales
- The impact of Facebook and Youtube is positive and significant.It means that increasing spending on these two channels increases sales
- For every 1000 Dollars spent on Facebook ads, the sales increases by 188 Dollars
- Similarly,for every 1000 Dollars spent on Youtube ads, the sales increases by 45 Dollars
Step 6: Predicting on actual data using regression model
Now we have 3 columns in the data set along with Sales column.We will create New columns in this data frame based on the beta coefficients obtained from the model m1
head(model.df)
sales newspaper Facebook_Adst Youtube_Adst
1 26.52 83.04 45.3600 276.1200
2 12.48 54.12 51.6960 94.8180
3 11.16 83.16 60.2496 34.8627
4 22.20 70.20 55.5396 186.0975
5 15.48 70.08 18.4668 244.6944
6 8.64 90.00 60.4716 47.0745
Getting the individual components
contri.df<-model.df%>%
mutate(Base_Sales=1.808)%>% # from intercept
mutate(Newspaper_Contribution= -0.0020 *newspaper,
Facebook_Contribution= 0.1860 *Facebook_Adst,
Youtube_Contribution= 0.045 *Youtube_Adst)%>%
select(-newspaper,-Facebook_Adst,-Youtube_Adst)
head(contri.df)
sales Base_Sales Newspaper_Contribution Facebook_Contribution
1 26.52 1.808 -0.16608 8.436960
2 12.48 1.808 -0.10824 9.615456
3 11.16 1.808 -0.16632 11.206426
4 22.20 1.808 -0.14040 10.330366
5 15.48 1.808 -0.14016 3.434825
6 8.64 1.808 -0.18000 11.247718
Youtube_Contribution
1 12.425400
2 4.266810
3 1.568821
4 8.374387
5 11.011248
6 2.118352
Step 7: Relative Contribution of each channel
We will now look at the percentage contribution of Base Sales and the marketing channel.We will remove the newspaper contribution column as it is negative and insignificant from the model
contri.df2<-contri.df%>%
summarise(Total_Base_Sales=sum(Base_Sales),
Total_Facebook_Contribution=sum(Facebook_Contribution),
Total_Youtube_Contribution=sum(Youtube_Contribution))
contri.df2
Total_Base_Sales Total_Facebook_Contribution Total_Youtube_Contribution
1 361.6 1152.436 1859.493
Getting the percentage contribution of each channel
final.df<-contri.df2%>%
gather(key = "Channel",value = "Percentage",Total_Base_Sales:Total_Youtube_Contribution)%>%
mutate(Overall_Contribution=sum(Percentage))%>%
mutate(Percentage_Contribution=round(100*(Percentage/Overall_Contribution),0))
final.df
Channel Percentage Overall_Contribution
1 Total_Base_Sales 361.600 3373.528
2 Total_Facebook_Contribution 1152.436 3373.528
3 Total_Youtube_Contribution 1859.493 3373.528
Percentage_Contribution
1 11
2 34
3 55
Creating the Pie chart
pie_chart <- plot_ly(final.df, labels = ~Channel, values = ~Percentage_Contribution, type = 'pie')
pie_chart <- pie_chart %>% layout(title = 'Percentage Contributon of Each Channel',
xaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE),
yaxis = list(showgrid = FALSE, zeroline = FALSE, showticklabels = FALSE))
pie_chart
Step 8: Recommendations
- 55% of my sales are coming from spend on Youtube ads followed by facebook which contributes to 34% of my sales
- We should allocate my marketing budget in the ratio of 62:38(proportion of 55 and 34) approximately between youtube and facebook
- Newspaper channel doesnt impact my sales and hence We can allocate its budget to facebook and youtube
No comments:
Post a Comment