用数据来聊聊国产电影~

数据小磨坊

发布于 2018-04-11 15:48:10

6500

发布于 2018-04-11 15:48:10

文章被收录于专栏：数据小魔方数据小魔方

最近国产电影评分风波引起了很多人的关注，豆瓣和猫眼因国产电影评分过低此被电影局约谈了，猫眼电影还因此下线了自己的电影评分系统，作为好奇宝宝，小魔方也来凑一波热闹。

当然今天不是要谈政治啦，刚好最近在学爬虫，那就爬一点儿官产电影的数据，用数据告诉大家，国产电影的真实处境。。（受限于技术手段和代码水平，数据不全，分析过程不敢保证精准，仅作为个人练习使用，请谨慎使用）。

#以下是本文所使用的一些依赖包：

library(rvest)
library(data.table)
library(stringr)
library("dplyr")
library("plyr")
library("ggplot2")
library(ggthemes)

爬虫过程：

url<-'https://movie.douban.com/tag/中国大陆?start='
final <- data.frame()
for (m in 1:99){
fun<-function(m){
url<-paste(url,(m-1)*20,"&type=T",sep='')
web<-read_html(url,encoding="UTF-8")
Name<-web %>% html_nodes("tr>td:nth-child(2)>div.pl2>a")%>% html_text()%>%str_trim()
Abstract<-web %>% html_nodes("tr>td:nth-child(2)>div.pl2>p.pl")%>% html_text()%>%str_trim()
Point<-web %>% html_nodes("div.star.clearfix>span.rating_nums")%>%html_text()%>%as.numeric()
Value<-web %>% html_nodes("div.star.clearfix>span.pl")%>%html_text()%>%as.character()
final<-data.frame(Name=Name[1:20],Abstract=Abstract[1:20],Point=Point[1:20],Value=Value[1:20])
}
final<-rbind(final,fun(m))
}

final$Name<-sub("\n","",final$Name)
final$Name<-sub("/","",final$Name)
final$Name<-sub(" ","",final$Name)
final<-final[1:1961,]

一共爬取了1961条有效电影记录（不知道这个数量是否能够涵盖16年所有公开上映的国产电影数量，其中可能混杂一些影视剧和娱乐节目）。

以下通过则这匹配提取了各部电影的上映具体日期：
m<-regexpr("\\d{4}-\\d{2}-\\d{2}",final$Abstract,perl=TRUE)
final$Date<-substring(final$Abstract,m,m+attr(m,"match.length")-1)
提取出评价人数数据
m1<-regexpr("\\d+",final$Value,perl=TRUE)
final$Value<-substring(final$Value,m1,m1+attr(m1,"match.length")-1)


清除掉电影剧情及演员介绍信息中的无关信息：
final$Abstract<-gsub("\\d{4}-\\d{2}-\\d{2}","",final$Abstract)
final$Abstract<-gsub("(\\(中国大陆\\)|\\(美国\\)|\\(中国台湾\\)|\\(中国香港\\)|\\(荷兰\\))","",final$Abstract)
final$Abstract<-gsub("((\\d{4}-\\d{2})|(\\d+分钟)|\\(.*?电影节\\)|\\(公映版\\)|汉语普通话)","",final$Abstract)
final$Abstract<-gsub("\\/","",final$Abstract)
final$Abstract<-gsub("(中国大陆|中国香港|法国|美国)","",final$Abstract)

预览数据集：

DT::datatable(final)

以下过程将电影的详情介绍信息（包含类型、剧情及演员相关信息）做了分词处理，以便后续进行词云可视化：

newdata<-paste(final$Abstract,collapse=" ")
temp1 <- str_split(newdata,' ')
temp1<-temp1[[1]]
temp1<-gsub("\\.{3}","",temp1)
temp1<-gsub("[a-zA-Z]{2,}","",temp1)
temp1<-grep("\\S",temp1,value=T)

count1<-count(temp1)
count1$x<-as.character(count1$x)
mydata<-filter(count1,nchar(x)>=2,freq>=37,x!="()")

加载词云包，可视化电影类型及高频出境电影明星的词频可视化：

library(wordcloud2)
wordcloud2(mydata, size = 2, fontFamily = "微软雅黑",minRotation = -pi/6, maxRotation = -pi/6,rotateRatio = 1)

所有电影类型中，排在前五位的是：剧情片、爱情片、喜剧片、动作片、纪录片。纪录片的上映率这么高吗，感觉有点难以置信。

提取并清洗电影演员及明星的出镜率词频数据：
temp2<-gsub("[\\((][\\s\\S]*[\\))]","",temp1)
temp2<-gsub("\\d+","",temp1)
temp2<-grep("\\S",temp2,value=T)

count2<-count(temp2)
count2<-count2[-c(1:107),]
count2$l<-count2$x %in% mydata$x 
mydata2<-filter(count2,l==FALSE)
mydata2<-mydata2[-c(5,8,9,10),]
mydata2<-mydata2[,1:2]

电影参演明星及演员可视化词云
wordcloud2(mydata2, size =.3,fontFamily = "微软雅黑",color = "random-light", backgroundColor = "grey",shape = 'star')

排在前十位的电影明星分别是：范爷、黄晓明、周迅、黄渤、刘桦、邓超、佟大为、李晨、曾志伟、杨幂。

#前三十的电影明星如下:

mydata2<-filter(mydata2,x!="音乐",x!="日本",x!="日语")
mydata3<-mydata2[order(-mydata2$freq),][1:30,]
windowsFonts(myFont = windowsFont("微软雅黑")) 
ggplot(mydata3,aes(reorder(x,freq),freq))+
geom_bar(stat="identity",position="dodge",fill="#D6B869")+
theme_wsj()+
coord_flip()+
scale_fill_wsj("rgby", "")+
theme(axis.ticks.length=unit(0.5,'cm'))+
geom_text(aes(label=round(freq+0.05,1)), position = position_dodge(0.9),hjust=1.1,colour="white",size=3,fontface="bold")+
guides(fill=guide_legend(title=NULL))+
ggtitle("国产电影最频繁出境明星")+
theme(
      axis.title = element_blank(),
      title=element_text(family="myFont",size=18), 
      legend.position='none',
      panel.grid.major.x=element_line(linetype="dashed",colour="grey60"),
      panel.grid.major.y=element_blank(),
      axis.ticks.x=element_blank(),
      axis.ticks.y=element_line(),
      axis.ticks.length=unit(0.3,'cm'),
      axis.line.x=element_blank(),
      axis.line.y=element_line(),
      axis.text.x=element_text(size=8,family="myFont")
      )

以上是通过对各部电影的详情描述进行分词所获得的电影类型及明星出镜率分析，接下来我们回到最初的数据集，对各部电影的评分评价分数以及上映年份进行更为详细的可视化分析。（为啥冯导可以与范爷并驾齐驱，可能是因为导演的电影比较多，这里爬的时候没有区分出来）

国产电影上映年份、季度、月份、周度
library(lubridate)
final$Date<-as.Date(final$Date) 
final$Year<-year(final$Date)
final$Month<-month(final$Date)
final$Week<-week(final$Date)
final$Quarter<-quarter(final$Date)

以上通过超级好用的时间处理函数lubridate，整理出了所有影片上映的日期的年份、月份、季度、周等时间信息，接下来我们用这四个时间维度分别对电影的评分数据、评论数据进行精细化分析。

datayear<-data.frame(with(final,table(Year)),stringsAsFactors =FALSE)
datayear$Year<-as.numeric(as.character(datayear$Year))
ggplot(datayear,aes(Year,Freq,group=1))+geom_line(size=2,linetype=1,col="steelblue")+
xlim(2000,2017)+
ggtitle("国产电影上映年份频率分布")+
theme(
      axis.title = element_blank(),
      title=element_text(family="myFont",size=18), 
      legend.position='none',
      panel.grid.major.y=element_line(linetype="dashed",colour="grey60"),
      panel.grid.major.x=element_blank(),
      axis.ticks.y=element_blank(),
      axis.ticks.x=element_line(),
      axis.ticks.length=unit(0.3,'cm'),
      axis.line.y=element_blank(),
      axis.line.x=element_line(),
      axis.text.x=element_text(size=8,family="myFont")
      )

因为抓取的电影上映年份以16年居多，所以16年是个高峰不足为奇，17年刚过去一周多，数量自然少一些。

dataquarter<-data.frame(with(final,table(Quarter)),stringsAsFactors =FALSE)
dataquarter$Quarter<-as.numeric(as.character(dataquarter$Quarter))
ggplot(dataquarter,aes(Quarter,Freq))+geom_bar(stat="identity",fill="steelblue")+
ggtitle("国产电影上映季度频率分布")+
theme(
      axis.title = element_blank(),
      title=element_text(family="myFont",size=18), 
      legend.position='none',
      panel.grid.major.y=element_line(linetype="dashed",colour="grey60"),
      panel.grid.major.x=element_blank(),
      axis.ticks.y=element_blank(),
      axis.ticks.x=element_line(),
      axis.ticks.length=unit(0.3,'cm'),
      axis.line.y=element_blank(),
      axis.line.x=element_line(),
      axis.text.x=element_text(size=8,family="myFont")
      )

从季度上来看，3、4季度上映上映最为频繁，可能是暑期档接着和贺岁档，时间段比较特殊。

datamonth<-data.frame(with(final,table(Month)),stringsAsFactors =FALSE)
datamonth$Month<-as.numeric(as.character(datamonth$Month))

ggplot(datamonth,aes(Month,Freq,group=1))+geom_line(size=2,linetype=1,col="steelblue")+
scale_x_continuous(breaks=seq(0,12,1))+
ggtitle("国产电影上映月份频率分布")+
theme(
      axis.title = element_blank(),
      title=element_text(family="myFont",size=18), 
      legend.position='none',
      panel.grid.major.y=element_line(linetype="dashed",colour="grey60"),
      panel.grid.major.x=element_blank(),
      axis.ticks.y=element_blank(),
      axis.ticks.x=element_line(),
      axis.ticks.length=unit(0.3,'cm'),
      axis.line.y=element_blank(),
      axis.line.x=element_line(),
      axis.text.x=element_text(size=8,family="myFont")
      )

从月度数据上来看，也验证了季度数据的趋势，其中第三季度的高峰在9月（算是暑期的尾巴吧），第四季度高峰在12月（年末岁尾的最电影最火了）。

dataweek<-data.frame(with(final,table(Week)),stringsAsFactors =FALSE)
dataweek$Week<-as.numeric(as.character(dataweek$Week))

ggplot(na.omit(dataweek),aes(Week,Freq,group=1))+geom_line(size=2,linetype=1,col="steelblue")+
scale_x_continuous(breaks=seq(0,52,1))+
ggtitle("国产电影上映周分布")+
theme(
      axis.title = element_blank(),
      title=element_text(family="myFont",size=18), 
      legend.position='none',
      panel.grid.major.y=element_line(linetype="dashed",colour="grey60"),
      panel.grid.major.x=element_blank(),
      axis.ticks.y=element_blank(),
      axis.ticks.x=element_line(),
      axis.ticks.length=unit(0.3,'cm'),
      axis.line.y=element_blank(),
      axis.line.x=element_line(),
      axis.text.x=element_text(size=8,family="myFont")
      )

周度数据也非常有趣，第7周、29周、36、37周、45周和51周出现了几个特高点，基本都超过40部/月的量级，也是与月度上映数据吻合。

接下来分析一下评分最高和最低的十部国产影片：

datapointtop<-final[order(-final$Point),][1:15,]


ggplot(datapointtop,aes(reorder(Name,Point),Point))+
geom_bar(stat="identity",position="dodge",fill="#D6B869")+
coord_flip()+
theme(axis.ticks.length=unit(0.5,'cm'))+
geom_text(aes(label=round(Point+0.05,1)), position = position_dodge(0.9),hjust=1.1,colour="white",size=3,fontface="bold")+
guides(fill=guide_legend(title=NULL))+
ggtitle("国产电影评分最高TOP15")+
theme(
      axis.title = element_blank(),
      title=element_text(family="myFont",size=18), 
      legend.position='none',
      panel.grid.major.x=element_line(linetype="dashed",colour="grey60"),
      panel.grid.major.y=element_blank(),
      axis.ticks.x=element_blank(),
      axis.ticks.y=element_line(),
      axis.ticks.length=unit(0.3,'cm'),
      axis.line.x=element_blank(),
      axis.line.y=element_line(),
      axis.text.x=element_text(size=8,family="myFont")
      )

这次真的有点惊讶了，数据显示（仅限所抓取的数据，未覆盖全，并不代表真实情况），评分最高的一部国产剧是老农民，评分高达9.7，从名字上来看挺挺朴实的一部剧，不过我好想没有看过，有空要补脑一下。

评分最高的电影有一个趋势，选材和主题都偏现实和文化类，我觉得这是一个好的现象，能体现电影写实性和文化传承的效果，虽然这样的剧本和影片，可能很多小伙伴不愿意付费去看。

datapointbot<-final[order(final$Point),][1:15,]


ggplot(datapointbot,aes(reorder(Name,Point),Point))+
geom_bar(stat="identity",position="dodge",fill="#D6B869")+
coord_flip()+
theme(axis.ticks.length=unit(0.5,'cm'))+
geom_text(aes(label=round(Point+0.05,1)), position = position_dodge(0.9),hjust=1.1,colour="white",size=3,fontface="bold")+
guides(fill=guide_legend(title=NULL))+
ggtitle("国产电影评分最低BOT")+
theme(
      axis.title = element_blank(),
      title=element_text(family="myFont",size=18), 
      legend.position='none',
      panel.grid.major.x=element_line(linetype="dashed",colour="grey60"),
      panel.grid.major.y=element_blank(),
      axis.ticks.x=element_blank(),
      axis.ticks.y=element_line(),
      axis.ticks.length=unit(0.3,'cm'),
      axis.line.x=element_blank(),
      axis.line.y=element_line(),
      axis.text.x=element_text(size=8,family="myFont")
      )

评分最低的一部是心理罪，仅为2.1，而且评分最低的几部好像也不是大家耳熟能详的名字，好吧突然看到了16年的央视春晚，我能说我已经不看春晚好多年了吗！（实在不好意思，本来是想抓电影的，不知道为啥央视春晚要出来捣乱，肯定是走错片场了~）

以各部电影评价人数多少作为该作品关注度指标，我们可以统计最受关注的电影和最不受关注的电影榜单。

final$Value<-as.numeric(final$Value)
dataValuetop15<-final[order(-final$Value),][1:15,]


ggplot(dataValuetop15,aes(reorder(Name,Value),Value))+
geom_bar(stat="identity",position="dodge",fill="#D6B869")+
coord_flip()+
theme(axis.ticks.length=unit(0.5,'cm'))+
geom_text(aes(label=round(Value+0.05,1)), position = position_dodge(0.9),hjust=1.1,colour="white",size=3,fontface="bold")+
guides(fill=guide_legend(title=NULL))+
ggtitle("国产电影关注度最高TOP15")+
theme(
      axis.title = element_blank(),
      title=element_text(family="myFont",size=18), 
      legend.position='none',
      panel.grid.major.x=element_line(linetype="dashed",colour="grey60"),
      panel.grid.major.y=element_blank(),
      axis.ticks.x=element_blank(),
      axis.ticks.y=element_line(),
      axis.ticks.length=unit(0.3,'cm'),
      axis.line.x=element_blank(),
      axis.line.y=element_line(),
      axis.text.x=element_text(size=8,family="myFont")
      )

关注度最高的一步电影是《让子弹飞》，好吧竟然是好你年前的一步老电影，获评570641。前十名中我看到了《少年派的奇幻漂流》、《大话西游之大圣娶亲》、《人在囧途之泰囧》、《老炮》、《美人鱼》等。虽然热度很高，都是评分并非遥遥领先，基本都在7~8分之间。

dataValuebot15<-final[order(final$Value),][1:15,]


ggplot(dataValuebot15,aes(reorder(Name,Value),Value))+
geom_bar(stat="identity",position="dodge",fill="#D6B869")+
coord_flip()+
theme(axis.ticks.length=unit(0.5,'cm'))+
geom_text(aes(label=round(Value+0.05,1)), position = position_dodge(0.9),hjust=1.1,colour="white",size=3,fontface="bold")+
guides(fill=guide_legend(title=NULL))+
ggtitle("国产电影关注度最低BOT15")+
theme(
      axis.title = element_blank(),
      title=element_text(family="myFont",size=18), 
      legend.position='none',
      panel.grid.major.x=element_line(linetype="dashed",colour="grey60"),
      panel.grid.major.y=element_blank(),
      axis.ticks.x=element_blank(),
      axis.ticks.y=element_line(),
      axis.ticks.length=unit(0.3,'cm'),
      axis.line.x=element_blank(),
      axis.line.y=element_line(),
      axis.text.x=element_text(size=8,family="myFont")
      )