【R语言 商务数据分析实战8】
chapter 8
电商产品评论数据情感分析
网页爬虫+文本数据预处理>>对数据进行情感分析>>用LDA模型对正、负评论进行主题分析
文本数据预处理主要有文本去重、文本清洗、分词、去除停用词,其中中文的分词和英文的分词会用到不同的程序包,R中关分词的程序包主要都对英文比较可爱,后期想看看关于自然语言的相关知识。
8.2 任务实现
获取评论页面网页源码(数据获取)
# 设置工作目录
setwd()
# 对一个URL进行测试
url <- 'https://club.jd.com/comment/productPageComments.action?callback=fetchJSON_comment98vv80998&productId=1106432&score=0&sortType=5&page=0&pageSize=10&isShadowSku=0&rid=0&fold=1'
# 加载需要的包
library(RCurl) # 需要使用getURL函数
library(jsonlite) # Version:1.5 需要使用fromJSON函数
# 读取网页源码
web <- getURL(url, .encoding = 'GBK')
# 代码 8-2
# 由于读取到的源码不是标准的JSON格式,因此需要将符合JSON格式的内容提取出来
web <- substr(web,
nchar("fetchJSON_comment98vv80998") + 2,
nchar(web) - 2)
# 将JSON格式数据转为R语言列表格式
result <- jsonlite::fromJSON(web)
# 提取评论数据
result$comments$referenceName # 品牌名
result$comments$nickname # 用户昵称
result$comments$creationTime # 发表时间
result$comments$content # 评论内容
# 代码 8-3
# 批量提取评论数据
# 首先先构建评论地址
# 其中score=1表示差评数据,3表示好评数据
pos_url <- list() # 初始化好评评论地址集
neg_url <- list() # 初始化差评评论地址集
n <- 100 # 该商品评论页数最大100页
for(i in 1:n){
pos_url[[i]] <- paste0('https://club.jd.com/comment/productPageComments.action?callback=fetchJSON_comment98vv80998&productId=1106432&score=3&sortType=5&page=',i-1,'&pageSize=10&isShadowSku=0&rid=0&fold=1')
neg_url[[i]] <- paste0('https://club.jd.com/comment/productPageComments.action?callback=fetchJSON_comment98vv80998&productId=1106432&score=1&sortType=5&page=',i-1,'&pageSize=10&isShadowSku=0&rid=0&fold=1')
}
content_url <- data.frame(pos_url = unlist(pos_url),
neg_url = unlist(neg_url))
head(content_url)
# 批量提取评论数据
pos_content <- list()
neg_content <- list()
for(i in 1:n){
# 好评数据提取
pos_web <- getURL(as.character(content_url[i, 1]), .encoding = 'GBK')
pos_web <- substr(pos_web,
nchar("fetchJSON_comment98vv80926") + 2,
nchar(pos_web) - 2)
pos_result <- jsonlite::fromJSON(pos_web)
pos_content[[i]] <- data.frame(referenceName = pos_result$comments$referenceName,
nickname = pos_result$comments$nickname,
creationTime = pos_result$comments$creationTime,
content = pos_result$comments$content)
message("pos_page ", i)
Sys.sleep(2)
# 差评数据提取
neg_web <- getURL(as.character(content_url[i, 2]), .encoding = 'GBK')
neg_web <- substr(neg_web,
nchar("fetchJSON_comment98vv80926") + 2,
nchar(neg_web) - 2)
neg_result <- jsonlite::fromJSON(neg_web)
neg_content[[i]] <- data.frame(referenceName = neg_result$comments$referenceName,
nickname = neg_result$comments$nickname,
creationTime = neg_result$comments$creationTime,
content = neg_result$comments$content)
message("neg_page ", i)
Sys.sleep(2)
}
pos_reviews <- Reduce(rbind, pos_content)
pos_reviews$type <- rep('pos', nrow(pos_reviews))
head(pos_reviews)
neg_reviews <- Reduce(rbind, neg_content)
neg_reviews$type <- rep('neg', nrow(pos_reviews))
head(neg_reviews)
reviews <- rbind.data.frame(pos_reviews, neg_reviews)
# 将评论数据输出
write.csv(reviews, "./tmp/reviews.csv", row.names = FALSE)
对电商产品评论数据进行预处理
# 设置工作目录
setwd()
# 去重,去除完全重复的数据
meidi_reviews <- read.csv("./data/reviews.csv", stringsAsFactors = FALSE)
meidi_reviews <- unique(meidi_reviews[, c(4, 5)]) # 对评论内容去重,
reviews <- meidi_reviews$content
# 去除去除英文字母、数字等
reviews <- gsub("[a-zA-Z0-9]", "", reviews)
# 由于评论主要为京东美的电热水器的评论,因此去除这些词语
reviews <- gsub("京东", "", reviews)
reviews <- gsub("美的", "", reviews)
reviews <- gsub("电热水器", "", reviews)
reviews <- gsub("热水器", "", reviews)
# 分词
library(jiebaR) # Version:0.9.1
cutter <- worker(type = "tag", stop_word = "./data/stoplist.txt")
seg_word <- list()
for(i in 1:length(reviews)){
seg_word[[i]] <- segment(reviews[i], cutter)
}
head(seg_word, 40)
# 将词语转为数据框形式,一列是词,一列是词语所在的句子ID,最后一列是词语在该句子的位置
n_word <- sapply(seg_word, length) # 每个词条的词个数
index <- rep(1:length(seg_word), n_word) # 每个词条有多少个词就复制多少次
type <- rep(meidi_reviews$type, n_word)
nature <- unlist(sapply(seg_word, names))
result <- data.frame(index, unlist(seg_word), nature, type)
colnames(result) <- c("id", "word","nature", "type")
head(result)
# 将每个词在每个词条的位置标记出来
n_word <- sapply(split(result,result$id), nrow)
index_word <- sapply(n_word, seq_len)
index_word <- unlist(index_word)
result$index_word <- index_word
head(result)
# 提取含有名词类的评论数据
is_n <- subset(result, grepl("n", result$nature), "id")
result <- result[result$id %in% is_n$id, ]
# 绘制词云
# 查看分词效果,最快捷的方式是绘制词云
library(wordcloud2) # Version:0.2.0
# 统计词频
word.frep <- table(result$word)
word.frep <- sort(word.frep, decreasing = TRUE)
word.frep <- data.frame(word.frep)
head(word.frep)
wordcloud2(word.frep[1:100,], color = "random-dark")
write.csv(result, "./tmp/word.csv", row.names = FALSE)
评论数据情感倾向分析
# 【匹配情感词】
# 设置工作目录
setwd()
# 载入分词结果
word <- read.csv("./tmp/word.csv", stringsAsFactors = FALSE)
# 情感词定位
# 读入正面、负面情感评价词
pos.comment <- read.table("./data/正面评价词语(中文).txt")
neg.comment <- read.table("./data/负面评价词语(中文).txt")
pos.emotion <- read.table("./data/正面情感词语(中文).txt")
neg.emotion <- read.table("./data/负面情感词语(中文).txt")
positive <- rbind(pos.comment, pos.emotion)
negative <- rbind(neg.comment, neg.emotion)
# 查看正负面情感词表是否有相同的词语,如果有则根据情况将其删除
sameWord <- intersect(positive[, 1], negative[, 1])
positive <- data.frame(setdiff(positive[, 1], sameWord))
negative <- data.frame(setdiff(negative[, 1], sameWord))
# 给正面、负面词语赋权重,正面词语为1,负面为-1
positive$weight <- rep(1, length(positive))
colnames(positive) <- c("word", "weight")
negative$weight <- rep(-1, length(negative))
colnames(negative) <- c("word", "weight")
# 将正面、负面词语合并
posneg <- rbind(positive, negative)
head(posneg, 20)
# 将分词结果与正负面情感词表合并,定位情感词
library(plyr)
data.posneg <- join(word, posneg, by = "word", match = "first")
head(data.posneg)
# 【修正情感倾向】
# 根据情感词前是否有否定词或双层否定词对情感值进行修正
# 载入否定词表
notdict <- read.table("./data/not.csv", stringsAsFactors = FALSE)
notdict$weight <- rep(-1, length(notdict))
# 处理否定修饰词
data.posneg$amend_weight <- data.posneg$weight
only_inclination <- data.posneg[!is.na
(data.posneg$weight), ] # 只保留有情感值的词语
index <- as.numeric(row.names(only_inclination)) # 词语对应整个文档的位置
for(i in 1:nrow(only_inclination)){
# 提取第i个情感词所在的评论
review <- data.posneg[which(data.posneg$id == only_inclination[i,]$id), ]
# 第i个情感值在该文档的位置
affective <- only_inclination[i,]$index_word
if(affective == 2){ # 如果情感词的位置是某个文档的第二个词
# 如果情感词前的一个词在否定词表内出现则求出个数
a.1 <- sum(review$word[affective - 1] %in% notdict[,1])
# 如果求出的和为奇数,认为该词为相反的情感值
if(a.1 == 1) data.posneg$amend_weight[index[i]] <- -data.posneg$weight [index[i]]
}else if(affective >= 3){
a.2 <- sum(review$word[affective - c(1,2)] %in% notdict[,1])
if(a.2 == 1) data.posneg$amend_weight[index[i]] <- -data.posneg$weight [index[i]]
}
}
# 更新只保留情感值的数据
# 只保留有情感值的词语
only_inclination <- data.posneg[!is.na
(data.posneg$amend_weight), ]
index <- as.numeric(row.names(only_inclination))
head(only_inclination)
# 计算每条评论的情感值
meidi.posneg <- aggregate(only_inclination$amend_weight,
by = list(only_inclination$id), sum)
head(meidi.posneg)
colnames(meidi.posneg) <- c("id", "weight")
meidi.posneg <- meidi.posneg[-which(meidi.posneg$weight == 0), ]
meidi.posneg$a_type <- rep(NA, nrow(meidi.posneg))
meidi.posneg$a_type[which(meidi.posneg$weight > 0)] <- "pos"
meidi.posneg$a_type[which(meidi.posneg$weight < 0)] <- "neg"
head(meidi.posneg)
result <- join(meidi.posneg, word[,c(1, 4)], by = "id",
type = "left", match = "first")
head(result)
#计算情感分析的准确率
Confusion_matrix<-table(result$type,result$a_type)
Confusion_matrix
(Confusion_matrix[1,1]+Confusion_matrix[2,2]) / sum(Confusion_matrix)
# 【查看情感分析效果】
# 提取正负面评论信息
head(meidi.posneg)
ind.neg <- subset(meidi.posneg, meidi.posneg$weight < 0, select = c("id"))
ind.pos <- subset(meidi.posneg,meidi.posneg$weight > 0, select = c("id"))
negdata <- word[word$id %in% ind.neg$id, ]
posdata <- word[word$id %in% ind.pos$id, ]
head(negdata)
head(posdata)
# 绘制词云
# 查看分词效果,最快捷的方式是绘制词云
library(wordcloud2)
# 统计正面评论词频
posFrep <- table(posdata$word)
posFrep <- sort(posFrep, decreasing = TRUE)
posFrep <- data.frame(posFrep)
head(posFrep)
wordcloud2(posFrep[1:100, ], color = "random-dark")
# 统计负面面评论词频
negFrep <- table(negdata$word)
negFrep <- sort(negFrep, decreasing = TRUE)
negFrep <- data.frame(negFrep)
head(negFrep)
wordcloud2(negFrep[1:100, ], color = "random-dark")
write.csv(negdata, "./tmp/negdata.csv", row.names = FALSE)
write.csv(posdata, "./tmp/posdata.csv", row.names = FALSE)
使用LDA模型进行主题分析
# 【建立文档-词条矩阵】
# 设置工作目录
setwd()
# 载入情感分析后的数据
posdata <- read.csv("./tmp/posdata.csv", stringsAsFactors = FALSE)
negdata <- read.csv("./tmp/negdata.csv", stringsAsFactors = FALSE)
# 构建语料库
library(NLP)
library(tm) # Version:0.7-1
pos.corpus <- Corpus(VectorSource(posdata$word))
neg.corpus <- Corpus(VectorSource(negdata$word))
# 词条-文档关系矩阵
pos.gxjz <- DocumentTermMatrix(pos.corpus,
control = list(wordLengths = c(1, Inf),
bounds = list(global = 5, Inf),
removeNumbers = TRUE))
neg.gxjz <- DocumentTermMatrix(neg.corpus,
control = list(wordLengths = c(1, Inf),
bounds = list(global = 5, Inf),
removeNumbers = TRUE))
# 【主题数寻优】
# 构造主题间余弦相似度函数
library(topicmodels)
lda.k <- function(gxjz){
# 初始化平均余弦相似度
mean_similarity <- c()
mean_similarity[1] = 1
# 循环生成主题并计算主题间相似度
for(i in 2:10){
control <- list(burnin = 500, iter = 1000, keep = 100)
Gibbs <- LDA(gxjz, k = i, method = "Gibbs", control = control)
term <- terms(Gibbs, 50) # 提取主题词
# 构造词频向量
word <- as.vector(term) # 列出所有词
freq <- table(word) # 统计词频
unique_word <- names(freq)
mat <- matrix(rep(0, i * length(unique_word)), # 行数为主题数,列数为词
nrow = i, ncol = length(unique_word))
colnames(mat) <- unique_word
# 生成词频向量
for(k in 1:i){
for(t in 1:50){
mat[k, grep(term[t,k], unique_word)] <- mat[k, grep(term[t, k], unique_word)] + 1
}
}
p <- combn(c(1:i), 2)
l <- ncol(p)
top_similarity <- c()
for(j in 1:l){
# 计算余弦相似度
x <- mat[p[, j][1], ]
y <- mat[p[, j][2], ]
top_similarity[j] <- sum(x * y) / sqrt(sum(x^2) * sum(y ^ 2))
}
mean_similarity[i] <- sum(top_similarity) / l
message("top_num ", i)
}
return(mean_similarity)
}
# 计算平均主题余弦相似度
pos_k <- lda.k(pos.gxjz)
neg_k <- lda.k(neg.gxjz)
par(mfrow = c(2, 1))
plot(pos_k, type = "l")
plot(neg_k, type = "l")
par(mfrow = c(1, 1))
# 【进行LDA主题分析】
# LDA主题分析
control <- list(burnin = 500, iter = 1000, keep = 100)
neg.gibbs <- LDA(neg.gxjz, k = 3, method = "Gibbs", control = control)
pos.gibbs <- LDA(pos.gxjz, k = 3, method = "Gibbs", control = control)
pos.termsl <- terms(pos.gibbs, 10)
neg.termsl <- terms(neg.gibbs, 10)
pos.termsl
neg.termsl
# 将主题结果写出
write.csv(neg.termsl, "./tmp/neg_termsl.csv", row.names = FALSE)
write.csv(pos.termsl, "./tmp/pos_termsl.csv", row.names = FALSE)