前言

开篇碎碎念：R语言老师出的实验题，在原本代码的基础上进行修改才跑通的，小小记录一下(≧▽≦)

一、案例背景

随着电子商务的迅速发展和网络购物的流行，人们对于网络购物的需求变得越来越高，也给电商企业带来巨大的发展机遇，与此同时，这种需求也推动了更多电商企业的崛起，引发了激烈的竞争。而在这种激烈竞争的大背景下，除了提高商品质量、压低价格外，了解更多消费者的心声对电商企业来说也变得越来越有必要。其中非常重要的方式就是对消费者的评论文本数据进行内在信息的分析。

本案例主要针对京东商城上美的电热水器的文本评论数据进行分析,流程如下。

相关文件下载链接：

下载链接：https://pan.baidu.com/s/1VG_XT5jAinCUt6xpQHzgDg?pwd=bqtu
提取码：bqtu

二、代码

1.数据爬取

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(httr)
library(jsonlite) response <- GET(url)
web <- content(response,as="text",encoding="GBK")
# 由于读取到的源码不是标准的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 # 评论内容#  批量提取评论数据
#  首先先构建评论地址
# 其中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_comm
ent98vv80998&productId=1106432&score=3&sortType=5&page=',i-1,'&pageSize=10&isShadowS
ku=0&rid=0&fold=1')
neg_url[[i]] <- paste0('https://club.jd.com/comment/productPageComments.action?callback=fetchJSON_comm
ent98vv80998&productId=1106432&score=1&sortType=5&page=',i-1,'&pageSize=10&isShadowS
ku=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){response_pos <- GET(as.character(content_url[i, 1]))pos_web <- content(response_pos, as = "text", encoding = "GBK")pos_web <- substr(pos_web, nchar("fetchJSON_comment98vv80998") + 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(3)response_neg <- GET(as.character(content_url[i, 2]))neg_web <- content(response_neg, as = "text", encoding = "GBK")neg_web <- substr(neg_web, nchar("fetchJSON_comment98vv80998") + 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(3)
}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(neg_reviews))
head(neg_reviews)
reviews <- rbind.data.frame(pos_reviews, neg_reviews)#创建文件路径，若以创建则不需要重复创建
dir.create("./tmp")# 将评论数据输出
write.csv(reviews, "./tmp/reviews.csv", row.names = FALSE)

2.数据预处理

# 去重，去除完全重复的数据
meidi_reviews <- read.csv("./tmp/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)
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)
#  统计词频
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)

3.数据分析（情感倾向）

# 载入分词结果
word <- read.csv("./tmp/word.csv", stringsAsFactors = FALSE)# 情感词定位
# 读入正面、负面情感评价词
pos.comment <- read.table("./data/词库/正面评价词语（中文）.txt",fileEncoding = "GB2312")
neg.comment <- read.table("./data/词库/负面评价词语（中文）.txt",fileEncoding = "GB2312")
pos.emotion <- read.table("./data/词库/正面情感词语（中文）.txt",fileEncoding = "GB2312")
neg.emotion <- read.table("./data/词库/负面情感词语（中文）.txt",fileEncoding = "GB2312")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_wordif(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)

4.使用LDA模型进行主题分析

# 载入情感分析后的数据
posdata <- read.csv("./tmp/posdata.csv", stringsAsFactors = FALSE)
negdata <- read.csv("./tmp/negdata.csv", stringsAsFactors = FALSE)# 构建语料库
library(NLP)
library(tm)
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) / lmessage("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)

总结

原版代码使用的是RCurl包中的getURL()函数进行的页面的读取，但之后总是有一些小问题，索性换一种方法采用httr进行页面读取，这里使用的LDA模型是一种主题模型，用于将文本数据表示为主题分布。它可以用于文本分类、信息检索、推荐系统等应用场景，能够自动发现文本中的主题，并且有很强可解释性。

R语言实验---电商产品评论数据情感分析相关推荐

数据挖掘实战—电商产品评论数据情感分析
文章目录引言一.评论预处理 1.评论去重 2.数据清洗二.评论分词 1.分词.词性标注.去除停用词 2.提取含名词的评论 3.绘制词云查看分词效果三.构建模型 1.评论数据情感倾向分析 1.1 ...
【项目实战】Python实现基于LDA主题模型进行电商产品评论数据情感分析
说明:这是一个机器学习.数据挖掘实战项目(附带数据+代码+文档+视频讲解),如需数据+代码+文档+视频讲解可以直接到文章最后获取. 视频: Python实现基于LDA模型进行电商产品评论数据情感分析 ...
基于电商产品评论数据情感分析
#!/usr/bin/env python # coding: utf-8# # -- 基于电商产品评论数据情感分析 --# ### 1.案例简介 # # 1.利用文本挖掘技术,对碎片化.非结构化的电 ...
毕业设计之 - 大数据分析：电商产品评论数据情感分析
文章目录 1 简介数据分析目的数据预处理评论去重数据清洗分词.词性标注.去除停用词提取含名词的评论绘制词云¶ 词典匹配评论数据情感倾向分析修正情感倾向 LinearSVC模型预测情感 ...
数据挖掘作业学习学习笔记-电商产品评论数据情感分析
使用的教材:<电商产品评论数据情感分析> 作业&学习笔记:数据挖掘第14周说明:书本内容详实.此篇用于自己期末回顾知识的重点内容,故做出的学习笔记缺省了书本原本的其他精粹. 随着 ...
数据分析与挖掘实战-电商产品评论数据情感分析
电商产品评论数据情感分析背景随着网上购物越来越流行,人们对于网上购物的需求越来越高,这让京东.淘宝等电商平台得到了很大的发展机遇.但是,这种需求也推动了更多的电商平台的崛起,引发了激烈的竞争.在这 ...
《Python数据分析与挖掘实战》第15章 ——电商产品评论数据情感分析（LED）
文章目录 1.挖掘背景与目标 2.2 数据探索与预处理 2.1 数据筛选 2.2 数据去重 2.3 删除前缀评分 2.4 jieba分词 3 基于LDA 模型的主题分析 4.权重 5.如何在主题空间比 ...
数据分析与挖掘：电商产品评论数据情感分析
电商产品评论数据情感分析 1. 背景与挖掘目标 2. 分析方法与过程 2.1 数据抽取 2.2 评论预处理 2.3 LDA 主题分析 1. 背景与挖掘目标项目为<Python 数据分析与挖掘实 ...
Python文本挖掘练习（五）// 电商产品评论数据情感分析
第一部分案例简介本案例首先利用Python文本挖掘技术,对碎片化.非结构化的电商网站评论数据进行清洗与处理,转化为结构化数据.然后对文本数据进一步挖掘与分析,采用决策树算法构建情感分类模型,探索用 ...

R语言实验---电商产品评论数据情感分析

文章目录

前言