《数据挖掘实验》数据处理实验报告三

实验名称： 数据处理 实验目的： 1、掌握数据的处理方法及其实现。 2、掌握Apriori关联分析。 实验设备与环境：计算机，R及RStduio等。 实验内容： 1、对C题评论数据进行数据预处理（酒店和景点其一），包括缺失值统计及其处理、分类统计、频率占比分析。 2、对任务1处理好的数据分词，生成词云图。 3、熟悉Apriori算法的使用，对酒店（或景点）的数据分词进行关联分析。 实验设计过程及分析： # 代码 8-4 # 设置工作目录 setwd(\"D:/万学英\") # 去重，去除完全重复的数据 meidi_reviews <- read.csv(\"D:/万学英/酒店评论（样例数据）.csv\ meidi_reviews <- unique(meidi_reviews[,c(2,3)]) # 对评论内容去重, reviews <- meidi_reviews$评论详情 # 代码 8-5 # 去除去除英文字母、数字等 reviews <- gsub(\"[a-zA-Z0-9]\ # 由于评论主要为京东美的电热水器的评论，因此去除这些词语 reviews <- gsub(\"很好\ reviews <- gsub(\"排队\ reviews <- gsub(\"服务\ reviews <- gsub(\"热水器\ # 代码 8-6 # 分词 install.packages(\"jiebaR\") library(jiebaR) # Version:0.9.1 cutter <- worker(type = \"tag\ 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$评论详情, n_word) nature <- unlist(sapply(seg_word, names)) result <- data.frame(index, unlist(seg_word), nature, type) colnames(result) <- c(\"id\ 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) # 代码 8-7 # 提取含有名词类的评论数据 is_n <- subset(result, grepl(\"n\ result <- result[result$id %in% is_n$id, ] # 代码 8-8 # 绘制词云 # 查看分词效果，最快捷的方式是绘制词云 install.packages(\"wordcloud2\") 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, \"./word.csv\ 先对数据进行处理，去除重复的数据。然后对评论进行分词，统计词频，用head(word.frep)显示词频，根据词频的结果取前20的数据绘制饼图。 library(wordcloud2)载入wordcloud2包，然后绘制词云，查看分词效果。最后将结果进行保存。 第二步 # 载入分词结果 word <- read.csv(\"word.csv\ # 情感词定位 # 情感词定位 # 读入正面、负面情感评价词 pos.comment <- read.table(\"./正面评价词语（中文）.txt\") neg.comment <- read.table(\"./负面评价词语（中文）.txt\") pos.emotion <- read.table(\"./正面情感词语（中文）.txt\") neg.emotion <- read.table(\"./负面情感词语（中文）.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\ negative$weight <- rep(-1, length(negative)) colnames(negative) <- c(\"word\ # 将正面、负面词语合并 posneg <- rbind(positive, negative) head(posneg, 20) # 将分词结果与正负面情感词表合并，定位情感词 #install.packages(\"plyr\") library(plyr) data.posneg <- join(word, posneg, by = \"word\ head(data.posneg) # 根据情感词前是否有否定词或双层否定词对情感值进行修正 # 载入否定词表 notdict <- read.table(\"./not.csv\ 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\ 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\\"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:1424, ], color = \"random-dark\") # 统计负面面评论词频 negFrep <- table(negdata$word) negFrep <- sort(negFrep, decreasing = TRUE) negFrep <- data.frame(negFrep) head(negFrep) wordcloud2(negFrep[1:82, ], color = \"random-dark\") #保存结果 write.csv(negdata, \"./negdata.csv\ write.csv(posdata, \"./posdata.csv\ 将分词的结果进行分类，然后给词语赋权重。提取正负面的评论信息，绘制正面评论词频和负面评论词频的词云。 第三步 # 载入情感分析后的数据 posdata <- read.csv(\"./posdata.csv\ negdata <- read.csv(\"./negdata.csv\ # 构建语料库 install.packages(\"NLP\") library(NLP) install.packages(\"tm\") 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)) # 构造主题间余弦相似度函数 install.packages(\"topicmodels\") 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\ 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 \ } 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主题分析 control <- list(burnin = 500, iter = 1000, keep = 100) neg.gibbs <- LDA(neg.gxjz, k = 3, method = \"Gibbs\ pos.gibbs <- LDA(pos.gxjz, k = 3, method = \"Gibbs\ pos.termsl <- terms(pos.gibbs, 10) neg.termsl <- terms(neg.gibbs, 10) pos.termsl neg.termsl # 将主题结果写出 write.csv(neg.termsl, \"./neg_termsl.csv\ write.csv(pos.termsl, \"./pos_termsl.csv\ 结论分析与心得体会： 通过本次实验报告我能够进一步的掌握数据的处理方法及其实现通过老师给的代码以及自己的编辑和同学的讨论，能够再一步掌握Apriori关联分析，希望再一步研究能够更加掌握数据的处理方法。