数据预处理
我们先加载相关的包并把上次爬来的数据读入环境。
library(data.table)
library(dplyr)
library(ggplot2)
library(stringr)
library(tm)
library(magrittr)
library(textcat)
library(tidytext)
library(RTextTools)
data <- read.csv("GoodReadsData.csv", stringsAsFactors = FALSE)
data <- data.table(data)
快速浏览一遍后,去除那些不是用英语撰写的评论。
data$language <- as.factor(textcat(data$review))
data <- data[language == "english"]
此处采用的语言检测算法效果并不是特别好,会把一些评论归类成奇奇怪怪的语言,不过对于目前而言够用了。
之后我们把没有打星评级的评论和太短的评论删除。
data <- data[rating %in% c('did not like it',
'it was ok',
'liked it',
'really liked it',
'it was amazing')]
data <- data[length(data$review) >= 5]
最后,我们把评级改用数字编码,把用做筛选条件的language和reviewer列删除,再新增一列review_id作为识别码。
data$rating[data$rating == 'did not like it'] <- 1
data$rating[data$rating == 'it was ok' ] <- 2
data$rating[data$rating == 'liked it' ] <- 3
data$rating[data$rating == 'really liked it'] <- 4
data$rating[data$rating == 'it was amazing' ] <- 5
data$rating <- as.integer(data$rating)
data$language <- NULL
data$reviewer <- NULL
data$review.id <- 1:nrow(data)
万事俱备,开始EDA吧!
探索性数据分析
我们先来看看评级的分布,如下图所示,评级分布很不均匀,这对后续分析有指导意义。
barplot(table(as.factor(data$rating)),
ylim = c(0,5000),
main = "Distribution of ratings")
评级分布图:
让我们再来看看评论长度的分布:
data$review.length = nchar(data$review)
hist(data$review.length,
ylim = c(0,5000),
main = "Distribution of review length" )
评论长度分布图:
图中有一个长尾,掐指一算我们发现只有45条评论超过了8000词。让我们删除它们使得该数据的偏度降低(如果这些论评论出现了某些高频词,会扭曲该词的权重)。
n <- nrow(data[data$review.length >= 8000])
data <- data[data$review.length <= 8000]
hist(data$review_length, ylim = c(0,3000), main = "Distribution of review length" )
修正后的图:
现在看起来好多了,最后让我们看看不同评级的评论长度分布。
with(data, boxplot(review.length~rating,
main = "Distribution of review length by rating"))
不同评级的评论长度分布:
直观看来,好评的长度会比差评短,但趋势并不是太明显。让我们用情感分析法试试,利用tidytest包中的mutatis mutandis方法,详情参看the analyses of David Robinson on Yelp’s reviews。
情感分析
这一部分,我们会研究词语的褒义和贬义是否和评级有关。为达成这一目的,我们需要一部包含每个词语褒贬程度的词典,此处使用tidytext包中的sentiments数据集。
# 加载第一部情感词典AFINN
AFINN <- sentiments %>%
filter(lexicon == "AFINN") %>%
select(word, afinn_score = score)
head(AFINN)
# 第二部词典Bing
Bing <- sentiments %>%
filter(lexicon == "bing") %>%
select(word, bing_sentiment = sentiment)
head(Bing)
然后,我们把数据集揉成一个长面板(每个词一行)并添加每个词的褒贬程度得分。
# 把数据清洗成长面板并添加每个词的情感得分
review_words <- data %>%
unnest_tokens(word, review) %>%
select(-c(book, review_length)) %>%
left_join(AFINN, by = "word") %>%
left_join(Bing, by = "word")
现在我们的数据集长这样:
我们可以根据每条评论的平均褒贬程度得分来给它们定性,无论用AFINN词典还是Bing词典得到的结果都一致。
# 按照观测的得分进行分组
review_mean_sentiment <- review_words %>%
group_by(review_id, rating) %>%
summarize(mean_sentiment = mean(afinn_score, na.rm = TRUE))
输出是这个样子的:
那么,评级和评论的平均褒贬得分相关性如何呢?
theme_set(theme_bw())
ggplot(review.mean.sentiment, aes(rating, mean.sentiment, group = rating)) +
geom_boxplot() +
ylab("Average sentiment score")
如图:
我们走上正道了,从这幅图我们可以明显的发现不同评级的评论褒贬得分有差异。1星评论的得分往往是负的,而5星评论则不部分为正。让我们生成一个新的数据框来存储这一特征,方便后续分析使用。(注意:部分评论太短或者使用的词不再词典内,所以它们没有分数)
review.mean.sentiment <- review.mean.sentiment %>%
select(-rating) %>% # 移除评级以防万一
data.table()
clean.data <- data %>%
left_join(review.mean.sentiment, by = "review.id")
如果我们用每个词得分的中位数代替平均数作为特征,评级和它的关系就更明显了。
review.median.sentiment <- review.words %>%
group_by(review.id, rating) %>%
summarize(median.sentiment = median(afinn.score, na.rm = TRUE))
theme_set(theme_bw())
ggplot(review.median.sentiment, aes(rating, median.sentiment, group = rating)) +
geom_boxplot() +
ylab("Median sentiment score")
如图:
我们把这一特征也保留在数据集里。
review.median.sentiment <- review.median.sentiment %>%
select(-rating) %>%
data.table()
clean.data <- clean.data %>%
left_join(review.median.sentiment, by = "review.id")
最后,我们来计算下每条评论里褒义词和贬义词的个数,位后续的机器学习算法做准备。
# 根据AFINN计算每条评论的贬义词数量
review.count.afinn.negative <- review.words %>%
filter(afinn.score < 0) %>%
group_by(review.id, rating) %>%
summarize(count.afinn.negative = n())
# 把结果转移到我们的数据集中
review.count.afinn.negative <- review.count.afinn.negative %>%
select(-rating) %>%
data.table()
clean.data <- clean.data %>%
left_join(review.count.afinn.negative, by = "review.id")
# 根据AFINN计算每条评论的褒义词数量
review.count.afinn.positive <- review.words %>%
filter(afinn.score > 0) %>%
group_by(review.id, rating) %>%
summarize(count.afinn.positive = n())
# 把结果转移到我们的数据集中
review.count.afinn.positive <- review.count.afinn.positive %>%
select(-rating) %>%
data.table()
clean.data <- clean.data %>%
left_join(review.count.afinn.positive, by = "review.id")
# 根据Bing计算每条评论的贬义词数量
review.count.bing.negative <- review.words %>%
filter(bing.sentiment == "negative") %>%
group_by(review.id, rating) %>%
summarize(count.bing.negative = n())
# 把结果转移到我们的数据集中
review.count.bing.negative <- review.count.bing.negative %>%
select(-rating) %>%
data.table()
clean.data <- clean.data %>%
left_join(review.count.bing.negative, by = "review.id")
# 根据Bing计算每条评论的褒义词数量
review.count.bing.positive <- review.words %>%
filter(bing.sentiment == "positive") %>%
group_by(review.id, rating) %>%
summarize(count.bing.positive = n())
# 把结果转移到我们的数据集中
review.count.bing.positive <- review.count.bing.positive %>%
select(-rating) %>%
data.table()
clean.data <- clean.data %>%
left_join(review.count.bing.positive, by = "review.id")
最后,把所有数据保存在一个文件里方便日后调用。
write.csv(clean.data, "GoodReadsCleanData.csv", row.names = FALSE)
处于探索性分析的目的,我们可以换一种角度,把每个词而不是每条评论作为分析单位。首先,我们统计每个词在所有评论中出现的次数和包含该词的评论个数与其平均星级。然后我们只保留在3条以上的评论中出现过的词来避免一些生僻词的影响。
word.mean.summaries <- review.words %>%
count(review.id, rating, word) %>%
group_by(word) %>%
summarize(reviews = n(),
uses = sum(n),
average.rating = mean(rating)) %>%
filter(reviews >= 3) %>%
arrange(average.rating)
输出如下:
之后,我们对每个词的平均评级和AFINN中的得分进行比较。
word.mean.afinn <- word.mean.summaries %>%
inner_join(AFINN)
ggplot(word.mean.afinn, aes(afinn.score, average.rating, group = afinn.score)) +
geom_boxplot() +
xlab("AFINN score of word") +
ylab("Mean rating of reviews with this word")
注:原文刊载于Datescience+网站