R语言大数据分析之新闻文本数据分析

前一阵子完成了一个约90w条json数据的大数据新闻分析作业，发现对于类似数据格式的以R语言为分析工具的数据分析博客不是很全，相关信息十分零散。因此我整理了一些处理超大文本的方法和技巧，其中借鉴了一些博主的思想方法，作为学习和总结的资料。
文本大数据分析的基本思路
首先温故一下处理大数据文本文件的相关思想方法。我觉得主要有以下几个方面：
1.数据读取和格式识别（清楚的知道是什么格式的文件，文件包含的数据信息有哪些等等）
2.数据预处理/数据清洗/数据变换（这一步实际上是处理周期比较长的，需要把数据按照自己的要求处理为没有缺失值或错误值的整齐的文件，我比较喜欢处理为csv格式，当然mdb格式也是很好的）
3.文本数据挖掘，包括定量aggregate和主题分析
4.数据可视化
5.撰写数据分析报告
R读取json格式的超大文件
json格式文件流（一个90w左右行数的ndjson格式文件）看上去很可怕，但是是格式化的比较好处理的。笔者通过不断的尝试，发现json流处理是比较好的处理方法，即使用readlines函数嵌套数据转换语句实现批量格式的数据读写。
我参考了以下格式的代码R语言readlines函数用法
实现了不同编码格式的json文件的批量读入csv操作（也可以读入mySQL)
我处理的json新闻包含了title,content,sentiment,appName,id,sourceRegion,createDate,publishDate等多条数据标签。其中批量读取的方式大同小异，就是在编码转换上要花费一番功夫。
话不多说，上代码：

library(rjson)
setwd("E:/")
con <- file("E:/.txt", "r")
line=readLines(con,n=1)
while( length(line) != 0 ){
  line=readLines(con,n=1)
  line<-iconv(line, from="UTF-8",to="GBK")//防止出现中文乱码
  result <- fromJSON(line)
  data<-t(result$title)
  newstext<-data
  for (i in 1:length(newstext)) {
    write.table(newstext[[i]], "title.csv",col.names = F, append = T)
  }
}
close(con)

通过这行代码，可以将文本信息输出为一个只有一列的文本。笔者试验过这对于短而有序的文本时可以实现的，但是长篇文本就会出现数据乱七八糟的现象。
同样的，对于时间戳编码的时间数据，做一个简单的数据转换即可：

while(length(line) != 0 ){
  line=readLines(con,n=1)
  result <- fromJSON(line)
  time <-as.POSIXct(result$createDate,origin="1970-01-01")
  data<-t(time)
  newstext<-data
  for (i in 1:length(newstext)) {
    write.table(newstext[[i]], "createTime.csv",col.names = F, append = T)
  }
}

数据可视化
我比较常用的包是ggplot2包，因此这里用ggplot2包多唠嗑一下。
通过数据处理我们得到了非常整齐的csv格式文件，进行简单的合并以后，读取csv文件，很快就可以进行一定的统计处理。比如，对包含时间信息的数据，可以这样处理：

appName$createdate<-as.Date(appName$createdate, format='%Y/%m/%d')
appn <- appName %>%
  group_by(appname) %>%
  summarise(app数量=n())%>%
  arrange(desc(app数量))//生成按照日期分类汇总并按照数量排序的app数量分布统计文件

简单筛选一下，避免数据太多，然后可视化即可。

ggplot(appn,aes(x =appname, y =app数量,group=1)) + geom_line(stat="identity",size=1)

当然可视化并不一定仅仅考虑R的包，合理的运用一些其他数据分析软件也是很棒的，比如绘制地图我就用了excel和tableau，这两个软件比较傻瓜易懂，用户交互页面也十分新手友好。
文本挖掘之分词
用R的包做文本挖掘其实很简单，但是分词是比较头秃的一块，分词做出来约等于成功了一半。笔者尝试了几个分词的方法，最后还是参考了一些非常优秀的博客做出来了：

myfile<-read.csv(file.choose(),header=FALSE)
myfile.res <- myfile[myfile!=" "]
print(myfile.words <- unlist(lapply(X = myfile.res,FUN = segmentCN)))
myfile.words <- gsub(pattern="http:[a-zA-Z\\/\\.0-9]+","",myfile.words)
myfile.words <- gsub("\n","",myfile.words)
myfile.words <- gsub("　","",myfile.words)
data_stw=read.table(file=file.choose(),colClasses="character")
stopwords_CN=c(NULL)
for(i in 1:dim(data_stw)[1]){
  stopwords_CN=c(stopwords_CN,data_stw[i,1])
}
for(j in 1:length(stopwords_CN)){
  myfile.words <- subset(myfile.words,myfile.words!=stopwords_CN[j])
}
myfile.words <- subset(myfile.words, nchar(as.character(myfile.words))>1)

这里的中文停用词表，在百度上都是开源的，本质上是一个txt文件，过滤一些常用的词，自己也可以自定义一些常用词词典（比如数字，的，了这种）。
TF-IDF词频权重
这一块其实对于我的研究意义不是很大，这里依然贴上一些使用的代码：

library(pacman)
p_load(rlang,data.table,tidyverse)
unnest_dt <- function(tbl, col) {
  tbl <- as.data.table(tbl)
  col <- ensyms(col)
  clnms <- syms(setdiff(colnames(tbl), as.character(col)))
  tbl <- as.data.table(tbl)
  tbl <- eval(
    expr(tbl[, as.character(unlist(!!!col)), by = list(!!!clnms)])
  )
  colnames(tbl) <- c(as.character(clnms), as.character(col))
  tbl
}
f_table<-corpus %>% 
  unnest_dt(word) %>% 
  count(id,word)
f_table %>%
  bind_tf_idf(term = word,document = id,n = n) -> tf_idf_table
View(tf_idf_table)
tf_idf_table %>% 
  group_by(id) %>% 
  top_n(15,tf_idf) %>% 
  ungroup() -> top15

词云
我的词云用的是wordcloud包，其原理就是将统计好的词频表按频数高低分配文字的大小和颜色。所以也不是非常神秘，是文本可视化的一个比较常见的手段。Tableau，python等等也可以做的很好。比较后悔的一点是我可以尝试wordcloud2包，相比于wordcloud，2在视觉上更好看一些，也可以绘制组合自己想要的形状。

mycolors <- brewer.pal(8,"Dark2")
#设置字体
windowsFonts(myFont=windowsFont("华文中宋"))
#画图
wordcloud(freq$word,freq$freq.Freq,random.order=FALSE,random.color=FALSE,colors=mycolors,family="myFont")

文本情感分析
其实我做的几个文本分析都比较机械，情感分析也是运用了简单匹配的思想方法，在褒贬词表的基础上逐一匹配文章的情感倾向，如果遇正打1分，遇负打-1分，这种方法其实存在一些误差，但是可以相对的比较一些定性的情感情况。

title<-read.csv("E:/title.csv")
pos <- read.csv("E:/praise.csv", header = T, sep = ",", stringsAsFactors = F)
weight <- rep(1, length(pos[,1]))
pos <- cbind(pos, weight)
neg <- read.csv("E:/degrade.csv", header = T, sep = ",", stringsAsFactors = F)
weight <- rep(-1, length(neg[,1]))
neg <- cbind(neg, weight)
posneg <- rbind(pos,neg)  #正负词典合并
names(posneg) <- c("term", "weight")
posneg <- posneg[!duplicated(posneg$term), ]
dict <- posneg[, "term"]

IDA主题分析
我觉得IDA是文本数据分析中比较有用的一个方法，它可以很好地通过向量化将主题进行聚类。这块网上的代码比较多，我就不细讲了。关键在于不断的尝试寻找到最适合的聚类数k。

comments_segged<- readLines("E:/article-analyse/myfile1.txt") #读取分词结果
comments <- as.list(comments_segged) #将向量转化为列表
doc.list <- strsplit(as.character(comments),split=" ") #将每行文本，按照空格分开，每行变成一个词向量，储存在列表里
term.table <- table(unlist(doc.list)) #这里有两步，unlist用于统计每个词的词频；table把结果变成一个交叉表式的factor，原理类似python里的词典，key是词，value是词频
term.table <- sort(term.table, decreasing = TRUE) #按照词频降序排列
del <- term.table < 5| nchar(names(term.table))<2 #把不符合要求的筛出来
term.table <- term.table[!del] #去掉不符合要求的
vocab <- names(term.table) #创建词库
get.terms <- function(x) {
  index <- match(x, vocab) # 获取词的ID
  index <- index[!is.na(index)] #去掉没有查到的，也就是去掉了的词
  rbind(as.integer(index - 1), as.integer(rep(1, length(index)))) 
  }#生成上图结构}
documents <- lapply(doc.list, get.terms)
documents
K <- 3#主题数
G <- 5000 #迭代次数
alpha <- 0.10 
eta <- 0.02
set.seed(357) 
fit <- lda.collapsed.gibbs.sampler(documents = documents, K = K, vocab = vocab, num.iterations = G, alpha = alpha, eta = eta, initial = NULL, burnin = 0, compute.log.likelihood = TRUE)
theta <- t(apply(fit$document_sums + alpha, 2, function(x) x/sum(x))) #文档—主题分布矩阵
phi <- t(apply(t(fit$topics) + eta, 2, function(x) x/sum(x))) #主题-词语分布矩阵
term.frequency <- as.integer(term.table) #词频
doc.length <- sapply(documents, function(x) sum(x[2, ])) #每篇文章的长度，即有多少个词
library(servr)
json <- createJSON(phi = phi, theta = theta, 
                   doc.length = doc.length, vocab = vocab,
                   term.frequency = term.frequency)#json为作图需要数据，下面用servis生产html文件，通过out.dir设置保存位置
json
serVis(json, out.dir = '.vis', open.browser = FALSE)
writeLines(iconv(readLines("./vis/lda.json"), from = "GBK", to = "UTF8"), 
           file("./vis/lda.json"))
json1<-fromJSON(file="E:/article-analyse/HAPPY3.vis/lda.json")
json1
setwd("E:/article-analyse")
data1<-json1$token.table$Term
write.table(data1[[i]], "LDATERM.csv",col.names = F, append = T)

分析结果示例