Description

A data frame containing the impact of four advertising medias (instagram, youtube, facebook and direct mail) on sales. Data are the advertising budget in thousands of dollars along with the sales (in thousands of units). This is a simulated data for 200 time periods.

Summary Statistics

library(readxl)
sampledf <- read_excel("sampledf.xlsx")

summary(sampledf)
##    directmail         instagram        youtube            facebook      
##  Min.   :  0.3557   Min.   : 0.00   Min.   :  0.8754   Min.   :  2.863  
##  1st Qu.: 15.3308   1st Qu.:12.37   1st Qu.: 87.2246   1st Qu.: 55.245  
##  Median : 30.8682   Median :27.28   Median :177.1314   Median :102.962  
##  Mean   : 36.5538   Mean   :27.74   Mean   :175.4517   Mean   :103.952  
##  3rd Qu.: 51.2574   3rd Qu.:43.12   3rd Qu.:262.5842   3rd Qu.:153.010  
##  Max.   :138.6112   Max.   :64.20   Max.   :385.4458   Max.   :199.836  
##      sales       
##  Min.   : 2.033  
##  1st Qu.:12.089  
##  Median :15.531  
##  Mean   :16.886  
##  3rd Qu.:21.041  
##  Max.   :34.233

Correlation Matrix

library(PerformanceAnalytics)
chart.Correlation(sampledf, histogram = TRUE, pch=19)

Adstock and MMM Model 1

MMM using Multiple Regression

mmm_1 <- lm(sampledf$sales ~ ads_youtube + ads_fb + ads_directmail + ads_ig)
summary(mmm_1)
## 
## Call:
## lm(formula = sampledf$sales ~ ads_youtube + ads_fb + ads_directmail + 
##     ads_ig)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -9.9197 -1.7129  0.2949  1.6273  7.7046 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     2.323190   0.709959   3.272  0.00126 ** 
## ads_youtube     0.045580   0.001773  25.714  < 2e-16 ***
## ads_fb         -0.004210   0.003280  -1.284  0.20075    
## ads_directmail -0.012857   0.007205  -1.784  0.07590 .  
## ads_ig          0.183268   0.010998  16.664  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.585 on 195 degrees of freedom
## Multiple R-squared:  0.8379, Adjusted R-squared:  0.8345 
## F-statistic: 251.9 on 4 and 195 DF,  p-value: < 2.2e-16
#Check for multicollinearity using VIFs
library(mctest)
imcdiag(mmm_1, method = "VIF")
## 
## Call:
## imcdiag(mod = mmm_1, method = "VIF")
## 
## 
##  VIF Multicollinearity Diagnostics
## 
##                   VIF detection
## ads_youtube    1.0241         0
## ads_fb         1.0250         0
## ads_directmail 1.1779         0
## ads_ig         1.1712         0
## 
## NOTE:  VIF Method Failed to detect multicollinearity
## 
## 
## 0 --> COLLINEARITY is not detected by the test
## 
## ===================================
#check for heteroscedasticity
#first, plot the model out and review the residuals vs fitted plot and the Sclae-Location plot
par(mfrow=c(2,2)) # put all 4 charts into 1 page
plot(mmm_1)

#Confirm with an objective test for heteroscedasticity using Breusch Pagan test and NCV test
library(lmtest)
lmtest::bptest(mmm_1)
## 
##  studentized Breusch-Pagan test
## 
## data:  mmm_1
## BP = 3.686, df = 4, p-value = 0.4502
library(car)
car::ncvTest(mmm_1)
## Non-constant Variance Score Test 
## Variance formula: ~ fitted.values 
## Chisquare = 1.938293, Df = 1, p = 0.16385

Model 2

#Create timeseries
library(forecast)

#frequency is 52 to denote weekly as there are about 52 weeks in a year. 
#ts() needs a minimum of 2 periods (52 x 2 = 104 weeks), 
#our data has observations from 200 weeks so this should be sufficient
ts_sales <- ts(sampledf$sales, start = 1, frequency = 52)

ts_sales_comp <- decompose(ts_sales)
plot(ts_sales_comp)

basic_trend <- seq_along(sampledf$sales)


#fit the model
mmm_2 <- tslm(ts_sales ~ trend + season + ads_youtube + ads_fb + ads_directmail + ads_ig)
summary(mmm_2)
## 
## Call:
## tslm(formula = ts_sales ~ trend + season + ads_youtube + ads_fb + 
##     ads_directmail + ads_ig)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -6.3452 -1.2745  0.1522  1.3676  6.0379 
## 
## Coefficients:
##                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)     6.095402   1.480297   4.118 6.44e-05 ***
## trend          -0.001908   0.003124  -0.611 0.542351    
## season2        -3.720722   1.737572  -2.141 0.033942 *  
## season3        -6.087388   1.747536  -3.483 0.000657 ***
## season4        -1.753918   1.731329  -1.013 0.312749    
## season5        -4.124893   1.762572  -2.340 0.020652 *  
## season6        -2.992000   1.733690  -1.726 0.086544 .  
## season7        -2.783376   1.723116  -1.615 0.108447    
## season8        -2.083179   1.746722  -1.193 0.234993    
## season9        -2.331214   1.774232  -1.314 0.190974    
## season10       -3.593851   1.751020  -2.052 0.041951 *  
## season11       -4.829943   1.737701  -2.780 0.006177 ** 
## season12       -4.342149   1.727664  -2.513 0.013070 *  
## season13       -3.920954   1.728276  -2.269 0.024783 *  
## season14       -3.199697   1.765304  -1.813 0.071999 .  
## season15       -1.302767   1.758498  -0.741 0.460005    
## season16       -2.385503   1.731521  -1.378 0.170451    
## season17       -3.507917   1.736630  -2.020 0.045256 *  
## season18       -2.709664   1.742481  -1.555 0.122142    
## season19       -4.455393   1.765155  -2.524 0.012693 *  
## season20       -2.179200   1.727063  -1.262 0.209077    
## season21       -3.936458   1.731872  -2.273 0.024520 *  
## season22       -4.846354   1.760413  -2.753 0.006672 ** 
## season23       -6.839973   1.742463  -3.925 0.000134 ***
## season24       -3.496759   1.764266  -1.982 0.049397 *  
## season25       -1.672419   1.756723  -0.952 0.342698    
## season26       -4.841310   1.756273  -2.757 0.006603 ** 
## season27       -6.857329   1.766405  -3.882 0.000158 ***
## season28       -1.131607   1.753179  -0.645 0.519664    
## season29       -4.312590   1.743914  -2.473 0.014572 *  
## season30       -3.098009   1.732640  -1.788 0.075889 .  
## season31       -4.021734   1.738849  -2.313 0.022156 *  
## season32       -4.337931   1.744959  -2.486 0.014071 *  
## season33       -3.742492   1.731717  -2.161 0.032349 *  
## season34       -3.120320   1.742777  -1.790 0.075500 .  
## season35       -2.950533   1.759155  -1.677 0.095679 .  
## season36       -2.802971   1.750602  -1.601 0.111551    
## season37       -2.362910   1.736421  -1.361 0.175720    
## season38       -0.947490   1.734009  -0.546 0.585632    
## season39       -2.339739   1.744282  -1.341 0.181925    
## season40       -0.529271   1.763683  -0.300 0.764541    
## season41       -1.655132   1.746097  -0.948 0.344777    
## season42       -3.231996   1.743766  -1.853 0.065877 .  
## season43       -3.947067   1.755941  -2.248 0.026117 *  
## season44       -3.258741   1.755724  -1.856 0.065502 .  
## season45       -5.350528   1.914452  -2.795 0.005906 ** 
## season46       -3.478926   1.882595  -1.848 0.066677 .  
## season47       -1.060674   1.874340  -0.566 0.572354    
## season48       -0.953717   1.876145  -0.508 0.611999    
## season49       -4.801874   1.886460  -2.545 0.011974 *  
## season50       -1.670044   1.892560  -0.882 0.379027    
## season51       -5.597448   1.890463  -2.961 0.003593 ** 
## season52       -4.692462   1.902338  -2.467 0.014819 *  
## ads_youtube     0.044965   0.001919  23.429  < 2e-16 ***
## ads_fb         -0.003220   0.003573  -0.901 0.369071    
## ads_directmail -0.013747   0.007866  -1.748 0.082676 .  
## ads_ig          0.175709   0.011972  14.676  < 2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.431 on 143 degrees of freedom
## Multiple R-squared:  0.8949, Adjusted R-squared:  0.8537 
## F-statistic: 21.73 on 56 and 143 DF,  p-value: < 2.2e-16

Move Facebook Spend to Instagram & YouTube

#what performance looks like with no change
forecast_unchanged <- forecast(mmm_2, h=200)
ggplot2::autoplot(forecast_unchanged, ts.colour = 'black', size= 0.7, predict.size = 0.7, predict.colour = 'red', conf.int = TRUE, conf.int.fill = 'red', main = "Forecasted Unchanged", predict.linetype='dashed') 

#forecast with budget changes
forecast_new_spends <- forecast(mmm_2, newdata=new_spends)
## Warning in forecast.lm(mmm_2, newdata = new_spends): Could not find required
## variable ads_directmail in newdata. Specify newdata as a named data.frame
ggplot2::autoplot(forecast_new_spends, ts.colour = 'black', size= 0.7, predict.size = 0.7, predict.colour = 'blue', conf.int = TRUE, conf.int.fill = 'blue', main = "Forecasted New Spend")

#overlaying them together using autolayer()
forecast_unchanged <- forecast(mmm_2, h=200)
ggplot2::autoplot(forecast_unchanged, ts.colour = 'black', size= 0.7, predict.size = 0.7, predict.colour = 'red', conf.int = TRUE, conf.int.fill = 'red', main = "Forecasted Combined", predict.linetype='dashed') + forecast::autolayer(forecast_new_spends, col = 'blue')

#Get fitted values
#Finally, you can access fitted values from the model by quering forecast_new_spends$fitted

print(forecast_new_spends$fitted)
## Time Series:
## Start = c(1, 1) 
## End = c(4, 44) 
## Frequency = 52 
##         1         2         3         4         5         6         7         8 
## 24.353146 15.521163 11.792882 21.672733 15.752009 14.375862 14.581113 15.044127 
##         9        10        11        12        13        14        15        16 
##  6.352046 13.426123  6.807912 20.601436 12.753616 10.889192 21.711427 25.913787 
##        17        18        19        20        21        22        23        24 
## 15.653798 29.814705 12.760228 18.391277 19.533342 18.262049  5.025013 17.060525 
##        25        26        27        28        29        30        31        32 
## 11.237799 16.828211 15.213148 23.627901 22.772974 12.258957 26.506112 14.891584 
##        33        34        35        36        37        38        39        40 
##  8.980119 21.849388 11.645328 19.833626 28.869890 21.734342 13.655289 25.842607 
##        41        42        43        44        45        46        47        48 
## 21.667360 20.634102 25.129361 19.077583  8.468190 17.145478 13.023995 25.988631 
##        49        50        51        52        53        54        55        56 
## 19.396410 11.651040 12.292451 10.459861 27.821549 22.758988 23.447271 26.990886 
##        57        58        59        60        61        62        63        64 
## 10.894557 14.440315 27.893858 23.570971  9.454853 25.759470 21.144893 15.260517 
##        65        66        67        68        69        70        71        72 
## 20.409555 11.633230 12.926898 14.597440 24.287764 26.975142 22.763354 14.617009 
##        73        74        75        76        77        78        79        80 
## 11.694506 10.207181 18.113972 14.319116  7.929353 14.639585  6.959939 12.479645 
##        81        82        83        84        85        86        87        88 
## 12.263506 18.678282 10.873033 15.937133 23.330395 19.481164 15.166739 18.251259 
##        89        90        91        92        93        94        95        96 
## 14.299543 20.799059 13.364689  7.971874 22.865529 26.672406 13.705484 19.556341 
##        97        98        99       100       101       102       103       104 
## 14.144778 17.472897 29.227363 22.862457 15.943402 29.184016 21.924679 17.186174 
##       105       106       107       108       109       110       111       112 
## 26.649674 22.247955  6.282596  9.181999  2.459138 20.827364 17.249287 24.295022 
##       113       114       115       116       117       118       119       120 
## 17.845073 19.507572 17.611220 15.275108 14.480282  8.465982 17.588203  9.883769 
##       121       122       123       124       125       126       127       128 
## 15.895939  9.721135 15.464851 19.894952 23.127692 11.239508  7.469331  7.675613 
##       129       130       131       132       133       134       135       136 
## 28.107507  9.508800  8.378554 19.660219  9.464890 20.108382 13.066431 14.873794 
##       137       138       139       140       141       142       143       144 
## 14.127941 25.307393 13.105119 22.833080 14.051556 21.903492 23.778938 14.478303 
##       145       146       147       148       149       150       151       152 
## 13.140267 11.229103 18.660017 26.510372 15.076722 12.712515 23.999498 14.605195 
##       153       154       155       156       157       158       159       160 
## 17.528817 22.716318 18.173935  6.070199 19.820917 11.273201  7.877269 15.646887 
##       161       162       163       164       165       166       167       168 
## 16.056882 16.410913 19.354662 22.559198 15.297283 16.943222 11.269987 14.340436 
##       169       170       171       172       173       174       175       176 
## 18.782470 20.973257 11.967001 17.403621  9.432507 13.768991 15.040244 29.399549 
##       177       178       179       180       181       182       183       184 
## 23.846322 14.415104 16.016430 15.767890 14.506273 14.850946  4.716995 28.194645 
##       185       186       187       188       189       190       191       192 
## 23.252143 24.810182 12.298483 17.817279 23.992414  8.492168 13.375099 10.632028 
##       193       194       195       196       197       198       199       200 
##  5.828219 21.127213 19.832160  9.978723 11.212660 15.019801 26.428260 19.668479