1.# 加载rJava、Rwordseg、tm、lda库
library(rJava);
library(Rwordseg);
library("lda", lib.loc="~/R/win-library/3.3")
library("tm", lib.loc="~/R/win-library/3.3")
2.# == 读入数据
lecture=read.csv("E:\\worldcup_test.txt",sep=",");
1.用正则剔除URL
res=lecture[lecture!=" "];
res=gsub(pattern="http://t.cn/[A-Za-z0-9]+$+","",res);
res=gsub(pattern="[我|你|的|了|是]","",res);
2.jieba
library(jiebaR) #加载
3.加入词典,以及停用词,去除标点
cutter <- worker(bylines = T,user = "G:\\hhe\\15W.txt",stop_word = "G:\\hhe\\dtop.txt")
4.分词
comments_seg <- cutter["G:\\hhe\\8yue2.txt"]
5.读入分词后的文件
comments<- readLines("G:\\hhe\\8yue2.segment.2017-05-04_19_40_41.txt",encoding="UTF-8")
6.向量化
comments <- as.list(comments) #将向量转化为列表
doc.list <- strsplit(as.character(comments),split=" ") #将每行文本,按照空格分开,每行变成一个词向量,储存在列表里
7.创建一个词典,并给每个词取一个编号:
term.table <- table(unlist(doc.list))
#这里有两步,unlist用于统计每个词的词频;table把结果变成一个交叉表式的factor,原理类似python里的词典,key是词,value是词频.
8.排序
term.table <- sort(term.table, decreasing = TRUE) #按照词频降序排列
9.为了提高建模效果,我们可以将单字去掉,同时也可以把出现次数少于5次的词去掉。
del <- term.table < 5| nchar(names(term.table))<2 #把不符合要求的筛出来
term.table <- term.table[!del] #去掉不符合要求的
vocab <- names(term.table) #创建词库
10.把文本的格式整理成lda包建模需要的格式
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)
11.参数设定
这些为LDA建模需要先设置的几个参数,关于alpha、eta的设置和作用,引用梁斌penny的一段话:
其中α,大家可以调大调小了试试看,调大了的结果是每个文档接近同一个topic,即让p(wi|topici)发挥的作用小,这样p(di|topici)发挥的作用就大。其中的β,调大的结果是让p(di|topici)发挥的作用变下,而让p(wi|topici)发挥的作用变大,体现在每个topic更集中在几个词汇上面,或者而每个词汇都尽可能的百分百概率转移到一个topic上。
接下来是主题建模的过程,以文本量大小和迭代次数多少,用时会不同,多则几十分钟,少则一两分钟。
K <- 10 #主题数
G <- 5000 #迭代次数
alpha <- 0.10
eta <- 0.02
12.开始建模,以文本量大小和迭代次数多少,用时会不同
library(lda)
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)
13.可视化参数
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, ])) #每篇文章的长度,即有多少个词
14.可视化
library(LDAvis)
json <- createJSON(phi = phi, theta = theta,
doc.length = doc.length, vocab = vocab,
term.frequency = term.frequency)#json为作图需要数据,下面用servis生产html文件,通过out.dir设置保存位置
serVis(json, out.dir = './vis', open.browser = FALSE)
15为了解决乱码的问题,我们需要将其中的lda.json文件的编码改成UTF8格式,你可以手动改,也可以用R来自动改。
writeLines(iconv(readLines("./vis/lda.json"), from = "GBK", to = "UTF8"),
file("./vis/lda.json", encoding="UTF-8"))