Sunday, October 16, 2022

Market Mix Modelling in R

Market Mix Modelling


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


My Channel

Web Scraping Tutorial 4- Getting the busy information data from Popular time page from Google

Popular Times Popular Times In this blog we will try to scrape the ...