R语言-基于豆瓣电影详情数据的清洗和多元回归分析
文章目录
前言
深圳大学传播学院-数据抓取与清洗课程（2021-2022学年第二学期）-微专业期末大作业
老师学期后段R语言讲得飞快，后面期末大作业布置时也改过几次要求，很多微专业同学面对这个作业都比较难受，题主自己也是在解决完其他课程ddl才开始在csdn上现学R语言┭┮﹏┭┮，在课程最终评分时老师给到高分。
那几个晚上熬夜赶工，根据作业的要求从不同博客中人工检索需要的语句，因此想分享到csdn给之后的同学R语言学习作一个参考~
**主要是将自己那几天完工的作业代码放了上来，ddl在即，确实没有很多的时间去钻研，可能并不一定是最优方法，欢迎评论区一起讨论~ **
如果有刚好是深大的网新/微专业同学（或者学弟学妹们），也欢迎随时私聊我交流学习~
第一篇博客，如有错误或者其他的，欢迎评论区指正~
一、数据源说明
豆瓣上7845部电影详情，共有34个字段。
在课程前期的作业一，老师随机给班级近80多个同学随机分配了约100+电影详情的抓取任务，通过八爪鱼软件进行抓取。
豆瓣电影详情页面 参考如下：
抓取字段内容及格式 示例：
共有34个字段，包括“电影名称”、“导演链接”、“上映日期”、“获奖链接”等等。（分成2张图截取）
二、数据合并
1.RData合并
同学们完成电影详情的抓取后，保存为csv或excel格式，导入R语言，存成RData格式，作业要求一为合并全班同学的RData文件，并存成新的movie1中，在后续数据清洗中使用。
RData合并老师有给出代码 这里以供参考
install.packages('stringr')
library(stringr)
setwd('d:\\douban\\detail') #设置工作目录，将同学们的RData文件都放在该目录下
files <- list.files(path = '.\\') # 列出detail文件夹里面所有的文件名
movie <- data.frame()
for(i in 1:length(files) ){
load(file = files[i])
temp <- movie1
row.file <- str_split(files[i],pattern = '_')[[1]]
row.file <- str_remove(row.file[length(row.file)],'\\.Rdata')
if( row.file == nrow(temp)){
movie <- rbind(movie,temp)
} else cat(files[i],'文件名为',row.file,'条','实际为',nrow(temp),'条') #查看文件名登记条数与实际条数的差异
}
files[i] # 查看是哪个文件错误
setdiff(colnames(movie1),colnames(movie)) # 查看列名错误
save(movie1,file = 'xxxx.Rdata') #将合并成功后的movie存成RData文件，准备下一步数据清洗工作
2.csv合并
install.packages('stringr')
library(stringr)
files <- list.files(path = 'd:\\douban\\detail', pattern = '.csv$') #列出detail文件夹里面所有以“csv”结尾的文件名
setwd("d:\\douban\\detail")
movie <- data.frame()
for(i in 1:length(files) ){
temp <- read.csv(file = files[i])
movie <- rbind(movie,temp)
}
三、数据清洗
作业要求再pose一遍~
这一部分提交Rmarkdown文件，代码块中#为一级标题注释，##为二级标题注释，另起一行红色代码块为运行结果，因为部分结果太长，仅保留前6行或后6行。
1.导入数据
#将合并后的RData导入
movie1<-load(file="C:\\workplace\\douban\\finish\\2020081024_detail_raw.RData")
#查看movie列名数量、核对条数等等
dim(movie)
[1] 7845 34
2.总体缺失值、异常值识别
作业要求：数据清洗，对错误字段或空白字段补充完整
这一部分识别、清洗缺失值和异常值较为草率，主要在于后面选取字段进行多元回归分析时，会对该字段作更细致的处理。
2.1缺失值识别
###利用is.na函数判断变量各值是否为缺失值，并返回True或FALSE组成的向量
is.na(movie$电影名称)
###统计缺失值与非缺失值的个数
table(is.na(movie))
FALSE TRUE
257818 8912
###sum()和mean()函数来统计缺失值的个数和占比
sum(is.na(movie))
mean(is.na(movie))
[1] 8912
[1] 0.03341206
###利用complete.cases函数查看完整实例
sum(complete.cases(movie))
[1] 4283
###载入‘mice’
library("mice")
###生成一个以矩阵或数据框形式展示缺失值模式的表格
md.pattern(movie)
因为数据量太大了 图有点丑2333 挺难看的
###载入‘VIM’
library('VIM')
###用aggr函数对数据的缺失值模式进行可视化
aggr(movie[,-1],prop=FALSE,numbers=TRUE)
## Warning in plot.aggr(res, ...): not enough vertical space to display frequencies
## (too many combinations)
2.2缺失值补充
不同电影详情字段的缺失，可能为本身没有（即为0，抓取该电影数据的同学可能没有同意把空白值补为0），如果直接删除可能造成数据不全或缺失，所以对于缺失值采用的是补0；
对于部分数值型字段的缺失，想尝试用随机森林等算法进行插补，但因为时间不足，会在之后继续探索。
movie[is.na(movie)]<-'0'
2.3异常值识别
###提取数值字段
nums<-unlist(lapply(movie, is.numeric))
nums_data<-movie[,nums]
head(nums_data)
A tibble: 6 × 0
发现movie中不含numeric类型变量，均为character字符串类型变量，不作异常值处理
2.4重复值查找（一些尝试）
###安装dplyr
library('dplyr')
###查找movie中是否存在每个字段都一样的重复行，并进行去重
movie_de_dup <- distinct(movie,.keep_all = T)
dim(movie_de_dup)
[1] 7843 34
仅剔除两行，说明movie数据中基本无重复，不确定是否为完全相同，暂作保留，后面仍以movie作为分析对象
3.部分字段数据清洗
作业要求：任选电影详情的5个字段进行数据清洗，要求分类变量1个，连续变量4个
老师提示，如下图
#载入stringr包
library('stringr')
#载入plyr包，提取数字时需要
library(plyr)
3.1日期处理
###分隔字符串
time<-str_split_fixed(movie$上映日期,'\\(',n=2)
###提取第一个字段
time<- time[,1]
head(time)
[1] "2018-01-12" "2019-06-21" "2013-10-10" "2011-07-16" "2014-01-10"
###将字符串前后空格去掉
trimws(time,which = c("both","left","right"),whitespace = "[\t\r\n]")
[7837] " 2016-12-31"
[7838] " 2011-10-27"
[7839] " 1988-12-09"
[7840] " 1992-08-20"
[7841] " 2013-08-12"
[7842] " 1997-09-12"
[7843] " 2004-04-22"
[7844] " 2014-03-20"
[7845] " 2019-08-08"
time<-as.Date(time,format='%Y-%m-%d')
###去除空白
str_trim(time)
###将部分上映日期中的/替换成-
str_replace_all(time,"/","-")
[7816] "2010-04-24" "2005-09-13" "2017-02-11" "2013-01-18" "1960-05-15"
[7821] "2012-01-27" "1962-05-03" "2008-07-12" "2018-12-19" "2012-09-08"
[7826] "2010-02-09" "1932-01-20" "1999-12-17" "2007-10-18" "2001-07-09"
[7831] "1992-09-01" "1984-07-11" "2019-03-15" "2015-10-02" "2019-04-09"
[7836] "2013-06-05" "2016-12-31" "2011-10-27" "1988-12-09" "1992-08-20"
[7841] "2013-08-12" "1997-09-12" "2004-04-22" "2014-03-20" "2019-08-08"
3.2分类变量–语言
对数据中的语言进行排序统计
lang<-movie$语言
top_lang<-unlist(lang)
df<-as.data.frame(table(top_lang))
df<-arrange(df,desc(Freq))
head(df)
top_lang Freq
1 英语 2188
2 汉语普通话 1024
3 日语 751
4 粤语 474
5 韩语 300
6 法语 170
因此该分类变量的处理中，将根据上方排序结果，选取包含英语的赋值4，汉语普通话的赋值3，日韩的赋值2，其他的赋值为1。
for(i in 1:length(movie$语言)){
if(grepl("英语",movie$语言[i]))
{
movie$语言[i]<-4
}
else if (grepl("普通话",movie$语言[i])){
movie$语言[i]<-3
}
else if (grepl("日语",movie$语言[i])||grepl("韩语",movie$语言[i])){
movie$语言[i]<-2
}
else
movie$语言[i]<-1
}
head(movie$语言)
[1] "3" "4" "4" "2" "4" "3"
类型转换：数据中均为character类型，需转换为数值型。
class(movie$语言)
## Rmarkdown中的结果表示
## [1] "character"
language<-as.numeric(movie$语言)
class(language)
## [1] "numeric"
3.3连续变量1–片长 数据清洗
head(movie$片长) #查看数据情况
[1] "138分钟" "100分钟"
[3] "115分钟 / 125分钟(加长版)" "91分钟"
[5] "99分钟(中国大陆) / 98分钟(美国)" "93分钟"
缺失值补0
###缺失值补0
movie$片长[is.na(movie$片长)]<-0
table(is.na(movie$片长))
FALSE
7845
###将字符串前后空格去掉
trimws(movie$片长,which = c("both","left","right"),whitespace = "[\t\r\n]")
###分割字符串
flen=str_split_fixed(string=movie$片长,pattern = '分钟',n=2)
#str_split_fixed返回矩阵格式，定义一个新变量filmlen，将flen第一行赋给filmlen
flimlen<-flen[,1]
flimlen
仍存在部分值为“Canada：105”，采用提取数字的方法
fl1<-str_extract_all(flimlen,regex("[0-9/]"),simplify=TRUE)
fl1
Rmarkdown导出word结果
fl2<-function(x,data){
y<-paste0(data[x,],collapse="")
return(y)
}
ldply(lapply(c(1:nrow(fl1)), data = fl1, fl2))
合并后结果
filmlenok<-ldply(lapply(c(1:nrow(fl1)), data = fl1, fl2))
dim(filmlenok)
[1] 7845 1
filmlenok<-filmlenok[,1]
filmlenok
[1] "138" "100" "115" "91" "99"
[6] "93" "113" "100" "120" "212"
[11] "114" "104" "96" "108" "95"
[16] "89" "108" "99" "133" "116"
[21] "104" "118" "97" "96" "132"
[26] "130" "87" "115" "109" "145"
类型转换
## Rmarkdown中的结果表示
filmlenok<-as.numeric(filmlenok)
## Warning: 强制改变过程中产生了NA
class(filmlenok)
## [1] "numeric"
length(filmlenok)
## [1] 7845
filmlenok
## [1] 138 100 115 91 99 93 113 100 120 212 114 104
## [13] 96 108 95 89 108 99 133 116 104 118 97 96
## [25] 132 130 87 115 109 145 126 143 132 107 124 80
## [37] 85 123 104 101 96 99 110 113 108 135 117 129
## [49] 110 95 124 105 123 130 138 92 122 155 120 83
## [61] 160 151 104 154 122 81 103 107 118 105 87 99
table(is.na(filmlenok))
##
## FALSE TRUE
## 7790 55
#缺失值补0
filmlenok[is.na(filmlenok)]<-0
3.4连续变量2–好评1+好评2 数据清洗
3.4.1处理"好于1"这一列
head(movie$好于1)
## [1] "52% 剧情片" "85% 动画片" "83% 犯罪片" "66% 动画片" "89% 喜剧片"
## [6] "15% 悬疑片"
better1=str_split_fixed(string=movie$好于1,pattern = '%',n=2)
head(better1)
## [,1] [,2]
## [1,] "52" " 剧情片"
## [2,] "85" " 动画片"
## [3,] "83" " 犯罪片"
## [4,] "66" " 动画片"
## [5,] "89" " 喜剧片"
## [6,] "15" " 悬疑片"
better1rate<-better1[,1]
better1[,1]
## [1] "52" "85" "83"
## [4] "66" "89" "15"
## [7] "75" "21" "60"
## [10] "0" "88" "62"
## [13] "17" "52" "19"
## [16] "35" "86" "10"
better1r<-as.numeric(better1rate)
## Warning: 强制改变过程中产生了NA
class(better1r)
## [1] "numeric"
####缺失值补0
better1r[is.na(better1r)]<-0
table(is.na(better1r))
##
## FALSE
## 7845
3.4.2处理"好于2"这一列
head(movie$好于2)
## [1] "69% 爱情片" "95% 喜剧片" "85% 悬疑片" "74% 剧情片" "71% 动画片"
## [6] "9% 惊悚片"
better2=str_split_fixed(string=movie$好于2,pattern = '%',n=2)
head(better2)
## [,1] [,2]
## [1,] "69" " 爱情片"
## [2,] "95" " 喜剧片"
## [3,] "85" " 悬疑片"
## [4,] "74" " 剧情片"
## [5,] "71" " 动画片"
## [6,] "9" " 惊悚片"
better2rate<-better2[,1]
better2r<-as.numeric(better2rate)
####缺失值补0
better2r[is.na(better2r)]<-0
table(is.na(better2r))
##
## FALSE
## 7845
3.4.3 好于1+好于2
betterrate<-better1r+better2r
class(betterrate)
## [1] "numeric"
length(betterrate)
## [1] 7845
3.5连续变量3–短评数+话题数+影评数 数据清洗
3.5.1 短评数、话题数、影评数处理
可参考前处理“片长” 提取数字 方法相同 代码参考如下（只给出短评数处理代码，其他基本相同）
dp2<-str_extract_all(movie$短评数,regex("[0-9/]"),simplify=TRUE)
dp2
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] "2" "1" "5" "0" "5" "9"
## [2,] "9" "2" "9" "0" "3" ""
## [3,] "1" "0" "9" "5" "1" "7"
## [4,] "3" "2" "0" "9" "0" ""
## [5,] "7" "6" "1" "9" "1" ""
## [6,] "1" "7" "3" "4" "" ""
dp3<-function(x,data){
y<-paste0(data[x,],collapse="")
return(y)
}
ldply(lapply(c(1:nrow(dp2)), data = dp2, dp3))
## V1
## 1 215059
## 2 92903
## 3 109517
## 4 32090
## 5 76191
## 6 1734
dpover<-ldply(lapply(c(1:nrow(dp2)), data = dp2, dp3))
dim(dpover)
## [1] 7845 1
dpover1<-dpover[,1]
dpover1<-as.numeric(dpover1)
class(dpover1)
## [1] "numeric"
length(dpover1)
## [1] 7845
3.5.2 相加
commentnum<-dpover1+htover1+ypover1
class(commentnum)
## [1] "numeric"
length(commentnum)
## [1] 7845
3.6连续变量4–想看人数、看过人数 数据清洗
同前 提取数字+合并+类型转换
4.多元回归分析
基于对movie中的语言进行排序号，依次为“英语”、“普通话”、“日语韩语”等，
将其转换为数值（4，3，2，1），由高到低排序对应不同排序的语言，可以作连续变量处理。
analyall<-data.frame(language,betterrate,filmlenok,commentnum,peoplenum)
analyall
## language betterrate filmlenok commentnum peoplenum
## 1 3 121 138 224567 1571751
## 2 4 180 100 93828 618937
## 3 4 168 115 110124 1008538
## 4 2 140 91 32528 212985
## 5 4 160 99 76430 851965
## 6 3 24 93 1794 9217
## 7840 4 44 95 NA 10961
## 7841 2 0 27 NA 9551
## 7842 1 156 93 NA 27932
## 7843 4 62 86 NA 13549
## 7844 3 0 92 NA 5623
## 7845 4 35 118 NA 10184
head(analyall)
## language betterrate filmlenok commentnum peoplenum
## 1 3 121 138 224567 1571751
## 2 4 180 100 93828 618937
## 3 4 168 115 110124 1008538
## 4 2 140 91 32528 212985
## 5 4 160 99 76430 851965
## 6 3 24 93 1794 9217
绘制矩阵散点图
library(car)
###绘制矩阵散点图
scatterplotMatrix(~peoplenum+language+commentnum+betterrate+filmlenok,data = analyall,main="矩阵散点图")
回归计算
lm.sol=lm(peoplenum~commentnum+betterrate+filmlenok+language,data = analyall)
summary(lm.sol)
##
## Call:
## lm(formula = peoplenum ~ commentnum + betterrate + filmlenok +
## language, data = analyall)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2524363 -31447 -3360 20967 2110513
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.916e+04 1.146e+04 -2.545 0.011 *
## commentnum 7.926e+00 4.988e-02 158.895 <2e-16 ***
## betterrate 4.100e+02 4.025e+01 10.187 <2e-16 ***
## filmlenok 1.597e+01 9.466e+01 0.169 0.866
## language -6.795e+02 2.121e+03 -0.320 0.749
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 151500 on 4213 degrees of freedom
## (因为不存在，3627个观察量被删除了)
## Multiple R-squared: 0.8792, Adjusted R-squared: 0.8791
## F-statistic: 7667 on 4 and 4213 DF, p-value: < 2.2e-16
可以看到，调整R2为0.8792；回归方程显著性的F检验中，P值小于显著性水平α（假设取0.05），表明选择线性模型合理。
在回归系数显著性检验中，片长filmlenok、language不显著，所以把这两个变量剔除。
remodel.lm=lm(peoplenum~commentnum+betterrate,data = analyall)
summary(remodel.lm)
##
## Call:
## lm(formula = peoplenum ~ commentnum + betterrate, data = analyall)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2524834 -31313 -3350 20884 2110273
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.954e+04 4.354e+03 -6.784 1.33e-11 ***
## commentnum 7.926e+00 4.910e-02 161.418 < 2e-16 ***
## betterrate 4.104e+02 3.902e+01 10.519 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 151500 on 4215 degrees of freedom
## (因为不存在，3627个观察量被删除了)
## Multiple R-squared: 0.8792, Adjusted R-squared: 0.8792
## F-statistic: 1.534e+04 on 2 and 4215 DF, p-value: < 2.2e-16
F检验：同样是非常显著，p-value < 2.2e-16
调整后的R^2：相关性非常强为0.8792
多重共线性检验
vif(remodel.lm)
## commentnum betterrate
## 1.124029 1.124029
从多重共线性检验效果来看，VIF＜10，多重共线性还可以
三个平方和
SSR=deviance(remodel.lm)
SSR
## [1] 9.674236e+13
R2=summary(remodel.lm)$r.squared
SST=SSR/(1-R2)
SST
## [1] 8.00899e+14
SSE=SST-SSR
SSE
## [1] 7.041566e+14
求置信区间
confint(remodel.lm)
## 2.5 % 97.5 %
## (Intercept) -38074.338099 -21001.16265
## commentnum 7.829552 8.02208
## betterrate 333.950278 486.94827
remodel.lm
##
## Call:
## lm(formula = peoplenum ~ commentnum + betterrate, data = analyall)
##
## Coefficients:
## (Intercept) commentnum betterrate
## -29537.750 7.926 410.449
综上：设y=peoplenum,x1为commentnum，x2为betterrate
多元回归方程y=-29537.750+7.926x1+410.449x2
总结
本文基于7845条豆瓣电影详情数据，进行部分字段的清洗，并进行多元线性回归。
在实践中，可以增加对于R语言的掌握，get提取字段中数字的方法、类型转换的方法、以及stringr包的掌握（删除字符前后空格、提取字段等等）。
1487
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
