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.
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
library(PerformanceAnalytics)
chart.Correlation(sampledf, histogram = TRUE, pch=19)
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
#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
#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