R在线性回归中的应用--分析豆瓣评分与票房之间关系的案例研究

一数据准备

二查看各国影片的票房概况

三通过简单线性回归研究豆瓣评分与票房之间的关系

四小结

一、数据准备

我们需要的票房数据来自CBO中国票房网，中国票房网记录了从2008年到目前为止的每年票房排名前25位的数据。豆瓣评分则来自于豆瓣API。最后我通过整合这两个数据生成了一个名为cmbo_data的数据表。（有机会会写一个如何通过简单的网络爬虫来获取数据的文章）如果你想自己实践以下操作的话，请从这里下载数据，然后使用load()进行调用。

cmbo_data$rating<-as_vector(cmbo_data$rating)#注意cmbo_data的rating字段是list格式的
cmbo_data

输出结果:

排名  影片名 类型  总票房（万）  平均票价    场均人次    国家及地区   上映日期    rating
1   赤壁(上)   战争  27490   33  41  中国/中国香港/韩国  2008-07-10  6.3
2   画皮  爱情  20453   30  41  中国/中国香港/新加坡 2008-09-26  6.5
3   非诚勿扰    爱情  17641   34  62  中国/中国香港 2008-12-18  6.5
4   功夫熊猫    动画  15150   27  36  美国  2008-06-20  7.7
5   功夫熊猫：师傅的秘密  动画  15150   27  36  美国      7.7
6   功夫之王    动作  14560   32  31  美国/中国   2008-04-24  5.2

可以看到“国家和地区”字段包的信息比较繁杂，既有单一国家的，也有多国合拍的。因此，我们可以自行建立一个名为judge_area()的函数，把国家和地区”字段的值转化为只有“单一国家（不是合拍片）”、“中外合拍片（包含中国的合拍片）”，“外国合拍片（不包含中国）”三种类型的字段，来减少该字段信息的复杂度。

judge_area<-function(input){
SET<-unlist(strsplit(input,"/"))
len=length(SET)
if(len == 1){
input
}else if(len>1 & "中国" %in% SET){
"中外合拍片"
} else{
"外国合拍片"
}

}

然后应用这个函数，生成一个新的字段。

Data<-cmbo_data%>%
distinct(`影片名` ,.keep_all=T)%>%
drop_na()%>%
separate(`类型`,c("主类型","次类型"))#把原来的影片类型分为主类型和次要类型，可以忽略sep参数，它会自动匹配。
#应用judge_area()
Data$area<-map_chr(Data$国家及地区,judge_area)#类型

接着再把日期中的年份和月份也作为新的变量

library(lubridate)
Data_pre<-Data%>%
mutate(year=year(ymd(上映日期)),
month=month(ymd(上映日期)))%>%
filter(year %in% c(2008:2017))

二、查看各国影片的票房概况

如果我们特别想知道在这10年里各个国家的影片在中国市场的营收状况的话，该如何处理呢。我们可以使用dplyr包中group_by()和summarise()进行处理。

round_mean<-function(x){round(mean(x),1)}
#按地区
Data_pre%>%
group_by(area)%>%
summarise(`影片数量`=n(),`平均票房`=mean(`总票房（万）`),`豆瓣评分`=mean(rating),`总票房`=sum(`总票房（万）`))%>%arrange(desc(`影片数量`),desc(`总票房`),desc(`豆瓣评分`))

输出结果:

area    影片数量    平均票房    豆瓣评分    总票房
美国        91    55694   7.3    5068143
中外合拍片 85        50367   6.4    4281231
中国      44      61064   6.1    2686818
外国合拍片 18        46684   7.5    840307
日本       2      54812   8.2     109625
印度       1      129658  9.1     129658
中国香港     1      25304   6.9     25304

可以看到美国影片不管是影片的数量还是票房（单位：万）都是处于领先位置的，近十年在国内上映的美国电影的平均票房大概是5.57亿，平均豆瓣评分也高达7.2分。相较而言，中国影片的平均票房虽然高达6.11亿，但是上榜影片的平均豆瓣评分只有6.1分，远逊于其他国家及地区。这里需要补充的一点是：可以看到在上表中，中国香港的影片数量只有一部，原因是在大陆发售的香港影片多是和内地合作拍摄的，少有完全独立拍摄发行的影片，所以大多被归类为“中外合拍片”的范畴里。

三、通过简单线性回归研究豆瓣评分与票房之间的关系

虽然在这个各种牛逼算法横行的时代，线性回归多少会给人一种很土很低端的感觉，但是得益于它的易解释性，它依然是分析和研究问题的重要手段。

下面我们将使用lm()来拟合票房与字段year（上映年分）month（上映月份）以及rating(豆瓣评分)之间的关系。

lm1<-lm(`总票房（万）`~rating+year+month,data = Data_pre)

summary(lm1)

输出结果：

Call:
lm(formula = `总票房（万）` ~ rating + year + month, data = Data_pre)

Residuals:
Min     1Q Median     3Q    Max
-98682 -19126  -5469   8150 245663

Coefficients:
Estimate Std. Error t value
(Intercept) -22098907    1677716  -13.17
rating           2667       1984    1.34
year            11000        833   13.20
month            -446        688   -0.65
Pr(>|t|)
(Intercept)   <2e-16 ***
rating          0.18
year          <2e-16 ***
month           0.52
---
Signif. codes:
0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 36600 on 238 degrees of freedom
Multiple R-squared:  0.438, Adjusted R-squared:  0.431
F-statistic: 61.7 on 3 and 238 DF,  p-value: <2e-16

可以看到了year字段和票房有着很明显的关系，不仅系数为11000（也就是说year增加1，票房增加大约1个亿），且在统计上有意（p值非常非常小）。然而rating以及month和票房的关系似乎没有被证明，至少可以说这种关系在统计上是无意的。

上映年份对票房的影响其实是自然而然就能想到的，在year字段的背后，其实包含了人均收入的提高，电影院的普及，看电影这种生活方式的普及等潜的变量的影响。

那么如果我们想要在控制year字段影响的情况下，查看票房和豆瓣评分之间的关系的话应当如何做呢？我们可以通过ggplot的facet_grid()函数来按年份生成豆瓣评分（rating）与票房（box office）之间的折线以及回归线图。

p<-ggplot(Data_pre,aes(rating,`总票房（万）`))+
geom_point()+
geom_line()

p1<-p+geom_smooth(method =  "lm",se = F)+
facet_grid(.~year)+
labs(x="Rating",y="Box Office(10k)")

p1

图中的蓝线即为回归线，可以看到豆瓣评分在整体上和票房的关系是正的（蓝线的斜率为正），但是这种关系不是很明晰，在今年甚至出现了负相关。

另外，为了确定线性模型拟合质量的好坏，我们可以在图中添加R^2（拟合优度判定系数）来确认。

不过在此之前我们需要对应每一个年份来生成一个线性回归模型。为此需要

step1:使用 tidyr包中的nest()函数将用于模型的数据整合成一个字段。

step2:建立一个以dataframe为参数的用来拟合线性模型的函数。

step3:用broom包中的glance函数添加R^2等模型信息。

step4:用tidyr包中的unnest()函数取消之前的nest。

step1

Data_nest<-Data_pre%>%
select(`影片名`,year,rating,`总票房（万）`)%>%
group_by(year)%>%
nest()

Data_nest

step2

Data_nest_lm<-Data_nest%>%
mutate(model=map(data,regression))

Data_nest_lm

step3、step4

library(broom)
model_info<-Data_nest_lm%>%
mutate(model_info=map(model,glance))%>%
unnest(model_info,.drop=T)

model_info

然后将新生成的model_info数据中的R^2添加到上图中：



可以看到除了2010年使用豆瓣评分作为预测变量的线性模型地拟合效果还可以以外（R^2=0.38），其他年份的拟合效果并不咋地。

四、小结

美国影片在国内的竞争力还是很强劲的，这一点不仅体现在票房上，也体现在豆瓣评分上。令人感到意外的是，国产影片的整体质量虽然一般，但是票房成绩（上榜影片地平均票房甚至超过美国）却出奇的好，如果算上和国外共同制作的合拍片，中国公司参与制作的影片的整体票房表现还是比较抢眼的。

豆瓣评分和票房当之间虽然存在着正相关，但是这种关系在统计上并没有被确认，甚至在今年还出现了负相关，电影票房与电影质量的脱节确实是一个值得思考的问题，这一点其实可以进一步深挖。

另外Data_pre中还包含了诸如电影类型等字段，如果你感兴趣的话也可以自行查看、分析其他因素和票房之间的关系。