【黑科技】数据分析师的秘密-QQ聊天记录分析(三)

上两篇分析了群的活跃状况,成员活跃状况,以及一些文本的分析,包括词云,聊天关键字, 实体识别,情感分析等等,这篇只围绕一个问题来,那就是提取谈话内容的问题,并找到类似 的问题,通过这个分析,我们可以大致了解群里问的都是哪一些问题,也方便给群成员给与适当 的学习资料,当我们提取这些问题后,再用专业人士给与解答,作为学习素材,以便后者查阅, 此篇用knitr写成,所以图片信息较少,主要是整个分析的代码和流程。

1

获取数据

data=read.csv(file=file.choose()) data=data[,4:10] #去掉一些无关信息

看看表的前10行

2

初步判别问题

library(jiebaR) #初步认为包含这些字符的为问题,判别条件一 asknum<-grep("什么|吗|怎么|为什么|大神|帮忙|请问|求教|怎么|求助|请教|干啥的|有没有",as.vector(data$txt)) data$ask<-c(rep(0,nrow(data))) #包含6个字符以上的为有效问题 判别条件二 data$ask[asknum[which(nchar(as.vector(data$txt[asknum]))>6)]]<-1

#筛选出问题 library(dplyr) data1<-filter(data,ask==1)

3

提取有效的问题

tag<-worker("tag") #初始化词性标注 tager<-c() #判别条件三 认为包含动词和包含英文词的语句,这是因为在这个群的特定条件下 for (i in 1:nrow(data1)) { tager<-tag [as.character( data1$txt[i])] if(sum(c("eng") %in% names(tager))==0) data1$ask[i]<-0 if(sum(c("v","vn") %in% names(tager))==0) data1$ask[i]<-0 } data2<-filter(data1,ask==1)

4

提取关键字

key=worker("keywords") #初始化关键字提取 cut=worker() #初始化分词 filter_words =c("请问","大神") keytxt<-c() keytxt1<-c() #循环提取问题关键字 for(i in 1:nrow(data2)) { k<-vector_keywords(filter_segment(cut[as.character(data2$txt[i])],filter_words),key) keytxt[i]<-paste(k,collapse = ",") } data2$keyword<-keytxt

5

找到相似的问题

#自定义相似度函数,相同的个数除以总的不同的个数和,类似于杰卡德系数,但是这里用的是关键#字个数,为什么会用这种方法,这里先不说,可见文章最后. sim<-function(a,b) {s<-sum(a %in% b)/(length(a)+length(b)-sum(a %in% b));return(s)}

#循环产生965个变量并赋值为关键字符串向量 for(i in 1:nrow(data2)) { z<-unlist(strsplit(data2$keyword[i],",")) eval(parse(text=paste(paste("a",i,sep=""), "=z"))) }

a1

## [1] "数组" "period" "递增" "输出" "符合"

a2

## [1] "python" "过用" "networkx" "接触"

a3

## [1] "scipy" "blas" "安装" "包含" "能够"

a566

## [1] "web" "这点" "软件" "感觉"

#构建相似度矩阵 options(digits =4) x<-matrix(1:(nrow(data2))^2,nrow(data2),nrow(data2)) for(i in 1:nrow(data2)) { for(j in 1:nrow(data2)) { x[i,j]<-eval(parse(text=paste("sim(",paste("a",i,sep=""),",",paste("a",j,sep = ""),")",sep =""))) }} x[1:10,1:10]

## [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] ## [1,] 1 0 0.0000 0.0000 0.0000 0 0 0 0.0000 0 ## [2,] 0 1 0.0000 0.0000 0.0000 0 0 0 0.0000 0 ## [3,] 0 0 1.0000 0.4000 0.1667 0 0 0 0.1111 0 ## [4,] 0 0 0.4000 1.0000 0.0000 0 0 0 0.1667 0 ## [5,] 0 0 0.1667 0.0000 1.0000 0 0 0 0.0000 0 ## [6,] 0 0 0.0000 0.0000 0.0000 1 0 0 0.0000 0 ## [7,] 0 0 0.0000 0.0000 0.0000 0 1 0 0.0000 0 ## [8,] 0 0 0.0000 0.0000 0.0000 0 0 1 0.0000 0 ## [9,] 0 0 0.1111 0.1667 0.0000 0 0 0 1.0000 0 ## [10,] 0 0 0.0000 0.0000 0.0000 0 0 0 0.0000 1

#找到相似度大于一个阈值的数 x[row(x)<col(x)]<-0 #取下三角阵 corr<-which(x>0.3) #这里阈值设定是0.3,可以设定其他,来对比效果 r<-corr%/%965+1 #行数 c<-corr%%965 #列数 c[which(c==0)]<-965 #排除整除的情况 h<-c() s<-c() for(i in 1:length(r)) { if(r[i]!=c[i]) {h=c(h,r[i]);s=c(s,c[i])} } #排除对角线的情况

df<-data.frame(h=h,s=s,txt=data2$txt[h],txt2=data2$txt[s]) 看看找到类似的问题,下表中txt与txt2 表示为类似的问题。

可以看到取阈值为0.3时,效果还可以,基本上相似的问题都可以判别出来.但效果并不是很好,因为我阈值取得比较小.

使用这种方法是因为QQ群每一句话都比较短,所以自己尝试过很多文本相似度的方法,包括各种距离,余弦相似度,simhash等等, 效果都不太理想,那样构建的文档--词矩阵太稀疏.所以自己写了这个算法,用关键字结合杰卡德系数的方法.得到效果还算满意,当然由于自己技术有限,欢迎各位拍砖,若有更好办法,可以 @白加黑治感冒,进行交流,不胜感激.

End

PPV课原创文章，未经许可严禁转载