计算媒体投放效果

最新推荐文章于 2024-10-28 11:00:05 发布

weixin_33901843

最新推荐文章于 2024-10-28 11:00:05 发布

阅读量189

点赞数

文章标签： python

原文链接：https://my.oschina.net/u/1785519/blog/1572561

版权

2019独角兽企业重金招聘Python工程师标准>>>

投放媒体后计算每个媒体广告的效果

#数据的获取和清洗

#拟合模型

#将每个系数乘以投放额度求的影响贡献量

#计算贡献量

数据的获取和清洗

#数据的清洗和转换
> setwd('C:\\Users\\Xu\\Desktop\\data')
> list.files()
> library(openxlsx)
> rawMix<-read.xlsx("MarketingMix.xlsx")
> head(rawMix)
  Week_Date TV Search Display Print Social  PR    Sales
1     42156  0      0       0     0  34974 949 639003.9
2     42163  0      0       0     0  36194 947 589986.4
3     42170  0      0       0     0  37034 911 672482.5
4     42177  0      0       0     0  37232 793 611432.7
5     42184  0      0       0     0  27229 825 854615.0
6     42191  0      0       0     0  32979 899 537515.9

> str(rawMix)
'data.frame':	58 obs. of  8 variables:
 $ Week_Date: num  42156 42163 42170 42177 42184 ... #实现如期是 num 需要转化为 date
 $ TV       : num  0 0 0 0 0 0 0 0 0 0 ...
 $ Search   : num  0 0 0 0 0 0 0 0 0 0 ...
 $ Display  : num  0 0 0 0 0 0 0 0 0 0 ...
 $ Print    : num  0 0 0 0 0 ...
 $ Social   : num  34974 36194 37034 37232 27229 ...
 $ PR       : num  949 947 911 793 825 899 866 794 789 730 ...
 $ Sales    : num  639004 589986 672483 611433 854615 ...
 
> rawMix$weekNew<-as.Date(rawMix$Week_Date,origin = "1899-12-30") #日期进行转换
> str(rawMix)
'data.frame':	58 obs. of  9 variables:
 $ Week_Date: num  42156 42163 42170 42177 42184 ...
 $ TV       : num  0 0 0 0 0 0 0 0 0 0 ...
 $ Search   : num  0 0 0 0 0 0 0 0 0 0 ...
 $ Display  : num  0 0 0 0 0 0 0 0 0 0 ...
 $ Print    : num  0 0 0 0 0 ...
 $ Social   : num  34974 36194 37034 37232 27229 ...
 $ PR       : num  949 947 911 793 825 899 866 794 789 730 ...
 $ Sales    : num  639004 589986 672483 611433 854615 ...
 $ weekNew  : Date, format: "2015-06-01" "2015-06-08" "2015-06-15" "2015-06-22" ...

数据探索

#数据的探索
#目的是为了对销售量的影响，看下变量与销售的相关性和变量自身的相关性(多重共线性问题)
> cor(rawMix[,2:8])#拿2-8的数据
               TV    Search   Display     Print    Social        PR     Sales
TV      1.0000000 0.3473785 0.3612807 0.1956944 0.3449162 0.3844872 0.4075071
Search  0.3473785 1.0000000 0.6432242 0.2226253 0.3698717 0.4836673 0.7774111  #Search 和 Display相关性较高
Display 0.3612807 0.6432242 1.0000000 0.3897597 0.4632782 0.4294697 0.7715364
Print   0.1956944 0.2226253 0.3897597 1.0000000 0.2141804 0.3192051 0.4029381
Social  0.3449162 0.3698717 0.4632782 0.2141804 1.0000000 0.1640955 0.2368875
PR      0.3844872 0.4836673 0.4294697 0.3192051 0.1640955 1.0000000 0.6467579
Sales   0.4075071 0.7774111 0.7715364 0.4029381 0.2368875 0.6467579 1.0000000

再拟合模型之前需要思考，媒体贡献是存在衰退曲线的，所以先要将这个模型给制作出来

注：在计算营销组合时通常投放还存在饱和效应，可以将变量转化为指数再进行拟合，但我们这里仅计算贡献量

先分析下衰退曲线的模型

（1）

假设第一周投放300，第二周200，第三周100

假设衰退期为第一周0.7,第二周0.2，第三周0.1则每周的效应应该为

第一周 300*0.7

第二周 300*0.2+200*0.7

第三周 300*0.1+200*0.2+100*0.7

总的效应应该为所有的相加起来

（2）

最终需要计算总的效应，也就是每周的相加，所以可以这样，那上面的例子做假设

#定义一个函数
lagpad<-function(x,k){c(rep(0,k),x[1:(length(x)-k)])}#向右边移动k位，并且移动的k位用0补充
                                                     #R中本身向右平移的函数 lag()但只能作用于时间序列
                                                     #rep()重复

> test<-c(300,200,100) #假设第一周投放300，第二周200，第三周100
> testLag<-sapply(0:2,function(x) lagpad(test,x))
> testLag
     [,1] [,2] [,3]
[1,]  300    0    0
[2,]  200  300    0
[3,]  100  200  300

 #通过这样的方法可以计算总的效应
> as.matrix(testLag)%*%c(0.7,0.2,0.1) #乘以一个向量
     [,1]
[1,]  210
[2,]  200
[3,]  140
 
 #整个定义为函数
decayf<-function(x,k,parm){
  xlag<-sapply(0:(k-1),function(y) lagpad(x,y))
  as.matrix(xlag)%*%parm
}

拟合模型

需要模型成共线性的如 sales= INTRCEPT + a*TV + b*PRINT，相当于所有的销售量等于媒体的投放量*系数之和+基础销售量

#一些参数带到 decayf()函数中去做尝试
> decay_Search<-decayf(rawMix$Search,3,c(0.8,0.1,0.1))
> decay_Display<-decayf(rawMix$Display,3,c(0.5,0.3,0.2))
> decay_TV<-decayf(rawMix$TV,5,rep(0.2,5))
> decay_Print<-decayf(rawMix$Print,4,rep(0.25,4))
> decay_Social<-decayf(rawMix$Social,2,c(0.7,0.3))
> decay_PR<-decayf(rawMix$PR,3,c(0.4,0.4,0.2))

> modDecay<-data.frame(wday=rawMix$weekNew,Sales=rawMix$Sales, decay_TV,decay_Print,decay_PR,decay_Display,decay_Social,decay_Search) #将结果转化为数据框
> str(modDecay)
'data.frame':	58 obs. of  8 variables:
 $ wday         : Date, format: "2015-06-01" "2015-06-08" "2015-06-15" "2015-06-22" ...
 $ Sales        : num  639004 589986 672483 611433 854615 ...
 $ decay_TV     : num  0 0 0 0 0 0 0 0 0 0 ...
 $ decay_Print  : num  0 0 0 0 0 ...
 $ decay_PR     : num  380 758 933 871 829 ...
 $ decay_Display: num  0 0 0 0 0 0 0 0 0 0 ...
 $ decay_Social : num  24482 35828 36782 37173 30230 ...
 $ decay_Search : num  0 0 0 0 0 0 0 0 0 0 ...
 
 
> mod.lm<-lm(Sales~decay_TV+decay_Print+decay_PR+decay_Display+decay_Search++decay_Social,data=modDecay) #拟合模型
> summary(mod.lm)

Call:
lm(formula = Sales ~ decay_TV + decay_Print + decay_PR + decay_Display + 
    decay_Search + +decay_Social, data = modDecay)

Residuals:
    Min      1Q  Median      3Q     Max 
-612754 -216368  -23446  165218  926416 

Coefficients:
                Estimate Std. Error t value Pr(>|t|)    
(Intercept)    8.222e+05  2.498e+05   3.291 0.001814 ** 
decay_TV       7.509e-04  9.367e-04   0.802 0.426466    
decay_Print    2.023e-02  3.957e-02   0.511 0.611380    
decay_PR       7.640e+02  1.964e+02   3.889 0.000292 ***
decay_Display  7.889e-02  1.544e-02   5.111 4.85e-06 ***
decay_Search   1.395e+00  5.941e-01   2.349 0.022735 *  
decay_Social  -1.506e+01  6.363e+00  -2.366 0.021807 *  
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 310400 on 51 degrees of freedom
Multiple R-squared:  0.8162,	Adjusted R-squared:  0.7945 
F-statistic: 37.73 on 6 and 51 DF,  p-value: < 2.2e-16

> library(MASS)  #选择合适模型
> stepAIC(mod.lm)
Start:  AIC=1473.43
Sales ~ decay_TV + decay_Print + decay_PR + decay_Display + decay_Search + 
    +decay_Social

                Df  Sum of Sq        RSS    AIC
- decay_Print    1 2.5183e+10 4.9388e+12 1471.7
- decay_TV       1 6.1918e+10 4.9755e+12 1472.2
<none>                        4.9136e+12 1473.4
- decay_Search   1 5.3162e+11 5.4452e+12 1477.4
- decay_Social   1 5.3944e+11 5.4531e+12 1477.5
- decay_PR       1 1.4575e+12 6.3711e+12 1486.5
- decay_Display  1 2.5169e+12 7.4305e+12 1495.4

Step:  AIC=1471.73
Sales ~ decay_TV + decay_PR + decay_Display + decay_Search + 
    decay_Social

                Df  Sum of Sq        RSS    AIC
- decay_TV       1 5.6163e+10 4.9950e+12 1470.4
<none>                        4.9388e+12 1471.7
- decay_Social   1 5.1484e+11 5.4536e+12 1475.5
- decay_Search   1 5.4051e+11 5.4793e+12 1475.8
- decay_PR       1 1.5883e+12 6.5271e+12 1485.9
- decay_Display  1 2.7644e+12 7.7032e+12 1495.5

Step:  AIC=1470.38
Sales ~ decay_PR + decay_Display + decay_Search + decay_Social

                Df  Sum of Sq        RSS    AIC
<none>                        4.9950e+12 1470.4
- decay_Social   1 6.0844e+11 5.6034e+12 1475.0
- decay_Search   1 1.3276e+12 6.3226e+12 1482.0
- decay_PR       1 1.7638e+12 6.7588e+12 1485.9
- decay_Display  1 2.7211e+12 7.7160e+12 1493.6

Call:
lm(formula = Sales ~ decay_PR + decay_Display + decay_Search + 
    decay_Social, data = modDecay)

Coefficients:
  (Intercept)       decay_PR  decay_Display   decay_Search   decay_Social  
    8.322e+05      8.106e+02      7.978e-02      1.696e+00     -1.541e+01

将每个系数乘以投放额度求的影响贡献量

> coeff<-mod.lm$coefficients  #提取拟合的系数

我们要求将变量的每个值与系数相乘求和即可，所以将列表进行下列的转换

> coef.df<-data.frame(var=names(coeff),coef=as.vector(coeff)) #将数据系数转换为数据框，含是系数名称，列是系数值
> coef.df
            var          coef
1   (Intercept)  8.221908e+05
2      decay_TV  7.509029e-04
3   decay_Print  2.022937e-02
4      decay_PR  7.639506e+02
5 decay_Display  7.889260e-02
6  decay_Search  1.395443e+00
7  decay_Social -1.505728e+01


> library(reshape2)  #宽表转化为长表
> head(modDecay)
        wday    Sales decay_TV decay_Print decay_PR decay_Display decay_Social decay_Search
1 2015-06-01 639003.9        0           0    379.6             0      24481.8            0
2 2015-06-08 589986.4        0           0    758.4             0      35828.0            0
3 2015-06-15 672482.5        0           0    933.0             0      36782.0            0
4 2015-06-22 611432.7        0           0    871.0             0      37172.6            0
5 2015-06-29 854615.0        0           0    829.4             0      30229.9            0
6 2015-07-06 537515.9        0           0    848.2             0      31254.0            0
> modx<-melt(modDecay,id=c('wday')) #melt()宽变长，cast()长变宽
> head(modx)
        wday variable    value
1 2015-06-01    Sales 639003.9
2 2015-06-08    Sales 589986.4
3 2015-06-15    Sales 672482.5
4 2015-06-22    Sales 611432.7
5 2015-06-29    Sales 854615.0
6 2015-07-06    Sales 537515.9

> mody<-merge(modx,coef.df,by.x='variable',by.y='var',all.x=T) #通过varible,var将变革整合在一起
> head(mody)
       variable       wday value      coef
1 decay_Display 2015-06-01     0 0.0788926
2 decay_Display 2015-06-08     0 0.0788926
3 decay_Display 2015-06-15     0 0.0788926
4 decay_Display 2015-06-22     0 0.0788926
5 decay_Display 2015-06-29     0 0.0788926
6 decay_Display 2015-07-06     0 0.0788926

计算贡献量

mody$contr<-(mody$value)*(mody$coef) #计算每行的贡献量，我们需要将每个变量的贡献量相加，所以使用 plyr包

> library(plyr)
> chn_contr <- ddply(mody,.(variable),summarise,contr=sum(contr)) #分组求和并且计算贡献量
> chn_contr
       variable     contr
1      decay_TV   4018415
2   decay_Print   1857004
3      decay_PR  44022654
4 decay_Display  24078166
5  decay_Social -31393235
6  decay_Search  14238806

#产品销售量除了广告媒体的贡献量外还有基础的销售量
> sum(modDecay$Sales)-sum(chn_contr$contr,na.rm = T)
[1] 47687069

转载于:https://my.oschina.net/u/1785519/blog/1572561