R语言编程实现批量化处理非结构化的QQ聊天记录(优化版)

　　　昨日天朗气清，惠风和畅，突然跟群友聊天，说到QQ群聊天记录的事，正好手边有时间，立刻导出QQ的群消息聊天记录，打算分析一下，然并卵……腾讯对QQ聊天记录不知道是按啥规则保存，反正就是标准的非格式化数据，根本不能直接分析，在前期还得做很多处理，那么问题来了，第一:怎么弄成结构化的数据呢？这句就是废话。好吧。的确是。。。第二:那就这么弄吧？那就往下看吧~

---

主要思路分析

下面就是主要思路：

　　首先观察数据，这里装装老中医看病的样子，也就是老中医说的望，我瞅啊瞅，瞅半天，发现了一些规律。如图说明：

　　如上下图比对：我会发现时间信息记录里面包含了时间，昵称，还有圆括号里面的QQ号，但是群备注的昵称是可以换的，取决于你开心就好，那么我就不能只单单提取昵称，因为在不同的时间段里它有可能是不一样的，所以我也应该提取()或<>中的数据，这个数据是唯一且不变的，即代表该QQ用户。

　　

从上面两张图，我标红的地方给大家说下我发现的规律：
　　 QQ聊天记录从第8行开始，就会出现：空行->时间信息、QQ昵称或群备注名或无->聊天记录->空行……如此循环下去，即是两空行之间为一次聊天记录，所以刚开始我以空行为线索下手处理数据，后来发现这种处理方式有很大弊端，即如下图所示：
　　

　　我假如以空行为线索来区别每次聊天记录的话，有时候我们聊代码，或者某些人的聊天习惯总是会留空行，这时候就会出现原本是一条聊天记录会被分为2条或多条聊天记录，所以以空行来判断是否为一条聊天记录的方法是不可行的……
　　没事的，一切都会好起来的……我在这个时候总是安慰自己说，哈哈，突然我又看到了一个规律。即用每次聊天记录的时间来匹配，如下图，即为一次记录，那么空行对于我来说，就没有太大用了，所以将所有空行去掉，免得又出啥幺蛾子了…..
　　

　　

　　该方法存在的弊端就是假如某行的聊天记录正好出现这种时间格式且在字段首端，该方法也会匹配进去，即下表所示情况，但是这种聊天消息数据出现的概率极低，测试了几个不同群的聊天记录，均未遇到，如遇到，请告知一声，在想解决办法进行改进……
　　

记录类别	记录情景
聊天记录时间信息	2016-09-23 14:42:33 magic-xx-xx(12341414)
聊天消息信息	2016-10-23 12:31:12 我要去北京玩

---

批量化处理QQ聊天记录

　　基于上面的思路分析之后，我即可编写R程序，那么还有一个问题是 :你问题怎么这么多啊，唉……就是我既然处理QQ聊天记录的非结构化数据，我当然希望批量处理一堆从QQ里面导出来的聊天记录，怎么做到批量处理呢？基于我上面的观察规律和总结，我发现了的确是可以批量的，因为全部的规则都是如此(至少我现在处理到的是这样的规律)，那么马上上代码吧….

---

编码问题

　　怎么从QQ里面导出聊天记录请自行百度，请保存为txt文本格式，那么这里有一个编码问题，这个QQ聊天记录的编码问题我现在也没搞明白怎么回事，但是我新建一个txt文件，然后将导入下来的信息复制粘贴进行保存之后，出现这么一个提示。
　　

　　

　　我想这个就是编码乱码问题出现的原因，我直接点击确定，保存为新的txt文件，然后导入到R语言中，神奇的没乱码，信息也没丢失，我占时这么解决编码问题吧。　　

---

R语言处理代码及注释

博主感言

　　这里的话，真心要感谢使用了该代码的孩子们，不然我不会想着优化它，之前写完了也没寻思时间问题，当时测试的数据大概1Mb左右，跑了6min左右，所以觉得还可以；后来有一个朋友使用了该代码跑了他的6Mb的数据，结果发现迟迟不出结果，也不报错，最后时间定格在了大概5hours，这是一个多么悲伤的故事，我自己知道我的代码是有些地方浪费内存，但也想到会是这么夸张的结果，时间是多么的是钱啊，所以今天优化了一下代码，测试之后之前的5小时竟然缩短为不到1min,看到这个结果，我突然喷了一句，还有谁，哈哈。
　　主要处理的思路是：将迭代部分的转为向量化~

那么在使用我自己写的函数，请先安装stringr包

install.packages("stringr")

　　下载好这个包之后，可以将下面代码复制，然后单独保存为一个R文件，使用source()函数，引用加载该R文件(注意工作路径)，如下图：

R语言代码（优化前代码）

下面即为structure_QQ_data函数代码及注释：

structure_QQ_data<-function(dirword){
start_time<-Sys.time();
print(paste("Start Time:",start_time))
library(stringr)
x<-readLines(dirword) #按行读取数据
x<-x[8:(length(x))]   #获取第8行到最后一行的数据
x<-x[x!='']           #去除空行的数据
#正则匹配含有该格式的行,返回布尔值
index<-grepl('^[0-9]+[-]+[0-9]+[-]+[0-9]+[[:space:]]+[0-9]+[:]+[0-9]+',x)
#获取布尔值为TRUE的行，即为每条消息记录的第一行
index_T<-which(index==T)
#将每两个消息记录第一行之间为一则消息
mydata<-list();
k=1
for(i in 0:(length(index_T)-2)){
  mydata[k]<-list(paste0(x[(index_T[1+i]):(index_T[2+i]-1)],collapse=';'))
  k<-k+1
}
#将每则QQ消息按 时间信息与聊天信息分为两列
new_mydata<-sapply(mydata, function(x) sub(';','*',x))
time_name<-sapply(strsplit(new_mydata,split='[*]'),'[',1)
message<-sapply(strsplit(new_mydata,split='[*]'),'[',2)
QQ_message_data<-data.frame(time_name,message,stringsAsFactors = F)
#在对时间信息这一列进行细分(为日期,时间,QQ昵称,QQ号)
myday<-myhour<-myname<-NULL;
for(i in 1:nrow(QQ_message_data)){
  location<-str_locate_all(QQ_message_data$time_name,' ')
  location0<-str_locate(QQ_message_data$time_name,'[(|<]')
  myday[i]<-str_trim(substr(QQ_message_data$time_name[i],1,location[[i]][1,1]))
  myhour[i]<-str_trim(substr(QQ_message_data$time_name[i],location[[i]][1,1],
                             location[[i]][2,1]))
  myname[i]<-substr(QQ_message_data$time_name[i],location[[i]][2,1],
                    (location0[i]-1))
}
#正则匹配获取QQ号
myid<-gsub('[()<>]','',str_extract_all(QQ_message_data$time_name,
  '[<|(]+[[:digit:]]*[[:alpha:]]*[@]*[[:digit:]]*[.]*[[:alpha:]]*[>|)]*'))
#转换为数据框
new_qq_data<-data.frame(myday,myhour,myname,myid,
                        QQ_message_data$message,stringsAsFactors = F)
colnames(new_qq_data)<-c('date','time','nickname','qq','message')
end_time<-Sys.time();
print(paste("End Time:",end_time))
print(paste("Time Consuming:",(end_time-start_time)))
return(new_qq_data)
}

R语言代码（优化后代码）

structure_QQ_data<-function(dirword){
  start_time<-Sys.time();
  print(paste("Start Time:",start_time))
  library(stringr)
  x<-readLines(dirword)
  x<-x[8:(length(x))]
  x<-x[x!='']
  index<-grepl('^[0-9]+[-]+[0-9]+[-]+[0-9]+[[:space:]]+[0-9]+[:]+[0-9]+',x)
  index_T<-which(index==T)
  mydata<-list();
  k=1
  for(i in 0:(length(index_T)-2)){
    mydata[k]<-list(paste0(x[(index_T[1+i]):(index_T[2+i]-1)],collapse=';'))
    k<-k+1
  }
  #在后面的处理部门，多使用正则匹配向量化，大大缩短时间
  new_mydata<-sapply(mydata, function(x) sub(';','*',x))
  time_name<-sapply(strsplit(new_mydata,split='[*]'),'[',1)
  message<-sapply(strsplit(new_mydata,split='[*]'),'[',2)
  mydate<-sapply(strsplit(time_name,split=' '),'[',1)
  myhour<-sapply(strsplit(time_name,split=' '),'[',2)
  myname_id<-sapply(strsplit(time_name,split=' '),'[',3)
  myname<-str_trim(gsub('\\([0-9]+\\)$|<.*@.*>$','',myname_id))
  myid<-gsub('[()<>]','',str_extract_all(myname_id,'\\([0-9]+\\)$|<.*@.*>$'))
  new_qq_data<-data.frame(mydate,myhour,myname,myid,message,stringsAsFactors = F)
  colnames(new_qq_data)<-c('date','time','nickname','qq','message')
  end_time<-Sys.time();
  print(paste("End Time:",end_time))
  print(paste("Time Consuming:",(end_time-start_time)))
  return(new_qq_data)
}

处理好的数据样式

---

有问题，请多多指正，在此抛砖引玉了，跟大家共同学习！！！