R language-text mining topic Model Text classification

# # # #需要先安装几个R包, if you have these packages, you can omit the steps to install the package.
#install. Packages ("Rwordseg")
#install. Packages ("TM");
#install. Packages ("Wordcloud");
#install. Packages ("Topicmodels")

The data used in the example

data from Sougou laboratory data. data URL:http://download.labs.sogou.com/dl/sogoulabdown/SogouC.mini.20061102.tar.gz File Structure└─Sample ├─C000007 car├─C000008 Finance├─C000010 IT ├─C000013 Health├─C000014 Sports├─C000016 Tour├─C000020 Education├─C000022 Recruitment├─C000023 └─C000024 militaryuse Python to preprocess the data to a train. csv file and process each file text into 1 rows.

Preprocessing Python scripts
<ignore_js_op> combinesample.zip (720 Bytes, download count:)

The data you need
<ignore_js_op> train.zip (130.2 KB, downloaded: 164)
You can also use R to directly transform raw data into train.csv data.

Article Required Stopwords
<ignore_js_op> stopwords.zip (2.96 KB, download times:)

1. Read the database

1. CSV <-read.csv ("D://wb//train.csv", Header=t, Stringsasfactors=f)
2. mystopwords<-unlist (read.table ("D://wb//stopwords.txt", Stringsasfactors=f))

Copy Code

2.

Data preprocessing (Chinese word segmentation, stopwords processing)

2. Library (tm);
4. #移除数字
5. RemoveNumbers = function (x) {ret = Gsub ("[0-90123456789]", "" ", X)}
6. Sample.words <-lapply (csv$$$ $text, removenumbers)

Copy Code

2. #处理中文分词, the RWORDSEG package is used here
4. wordsegment<-function (x) {
5. Library (RWORDSEG)
6. SEGMENTCN (x)
7. }
9. Sample.words <-lapply (sample.words, wordsegment)

Copy Code

2. # # #stopwords处理
3. # # #先处理中文分词, then process stopwords to prevent global replacement of lost information
5. Removestopwords = function (x,words) {
6. ret = character (0)
7. Index <-1
8. It_max <-Length (x)
9. while (index <= It_max) {
10. if (length (words[words==x[index)]) <1) RET <-C (Ret,x[index])
11. Index <-Index +1
12. }
13. Ret
14. }
17. Sample.words <-lapply (sample.words, Removestopwords, Mystopwords)

Copy Code

3. Wordcloud Display

1. #构建语料库
2. Corpus = Corpus (Vectorsource (sample.words))
3. Meta (corpus, "cluster") <-csv$$$ $type
4. Unique_type <-Unique (csv$$$ $type)
5. #建立文档-Entry matrix
6. (Sample.dtm <-Documenttermmatrix (corpus, control = list (Wordlengths = C (2, INF))))

Copy Code

2. #install. Packages ("Wordcloud"); # #需要wordcloud包的支持
3. Library (Wordcloud);
4. #不同文档wordcloud对比图
5. SAMPLE.TDM <-Termdocumentmatrix (corpus, control = list (Wordlengths = C (2, INF)));
7. Tdm_matrix <-As.matrix (SAMPLE.TDM);
9. PNG (Paste ("D://wb//sample_comparison", ". png", Sep = ""), width =, height = 1500);
10. Comparison.cloud (Tdm_matrix,colors=rainbow (Ncol (Tdm_matrix)); # # # #由于颜色问题, slightly modified
11. Title (main = "Sample comparision");
12. Dev.off ();

Copy Code

2. #按分类汇总wordcloud对比图
3. n <-nrow (CSV)
4. ZZ1 = 1:n
5. Cluster_matrix<-sapply (unique_type,function (type) {apply (tdm_matrix[,zz1[csv$$$ $type ==type]],1,sum)})
6. PNG (Paste ("D://wb//sample_ Cluster_comparison", ". png", Sep = ""), Width = +, height = 800)
7. Comparison.cloud (Cluster_matrix,colors=brewer.pal (Ncol (Cluster_matrix), "paired")) # #由于颜色分类过少, modify here slightly
8. Title (main = "Sample cluster comparision")
9. Dev.off ()

Copy Code

<ignore_js_op>

It can be seen that data distribution is not uniform, culture, auto and other data is very small.

2. #按各分类画wordcloud
3. Sample.cloud <-function (cluster, maxwords = 100) {
4. Words <-Sample.words[which (csv$$$ $type ==cluster)]
5. Allwords <-unlist (words)
7. Wordsfreq <-Sort (table (allwords), decreasing = T)
8. Wordsname <-names (wordsfreq)
10. PNG (Paste ("D://wb//sample_", Cluster, ". png", Sep = ""), Width = $, height = 600)
11. Wordcloud (Wordsname, wordsfreq, scale = C (6, 1.5), Min.freq = 2, max.words = maxwords, colors = Rainbow (100))
12. Title (main = Paste ("cluster:", cluster))
13. Dev.off ()
14. }
15. Lapply (Unique_type,sample.cloud) # unique (csv$$$ $type)

Copy Code

<ignore_js_op>
<ignore_js_op>

4. Thematic model analysis

4. Library (SLAM)
6. Summary (Col_sums (SAMPLE.DTM))
8. TERM_TFIDF <-tapply (sample.dtm$$$ $v/row_sums (SAMPLE.DTM) [sample.dtm$$$ $i], sample.dtm$$$ $j, mean) *
10. Log2 (Ndocs (SAMPLE.DTM)/col_sums (Sample.dtm > 0))
12. Summary (TERM_TFIDF)
18. Sample.dtm <-sample.dtm[, TERM_TFIDF >= 0.1]
20. Sample.dtm <-sample.dtm[row_sums (Sample.dtm) > 0,]
24. Library (Topicmodels)
26. K <-30
30. SEED <-2010
32. Sample_tm <-
34. List
36. VEM = LDA (Sample.dtm, k = k, control = list (seed = seed)),
38. vem_fixed = LDA (Sample.dtm, k = K,control = List (Estimate.alpha = FALSE, seed = Seed),
40. Gibbs = LDA (Sample.dtm, k = k, method = "Gibbs", control = list (seed = seed, Burnin = 1000,thin = +, iter = 1000)),
42. CTM = CTM (Sample.dtm, k = K,control = List (seed = Seed,var = List (tol = 10^-4), em = list (tol = 10^-3))
44. )

Copy Code

<ignore_js_op>

3. Sapply (Sample_tm[1:2], slot, "Alpha")
5. Sapply (Sample_tm, function (x) mean (apply (posterior (x) $$$ $topics, 1, function (z)-sum (z * log (z)))))

Copy Code

<ignore_js_op>

The alpha estimate is significantly less than the default value, which indicates that the Dirichlet distribution data is concentrated in partial data, and the document includes some topics.
Higher values indicate more uniform topic distribution

3. #最可能的主题文档
4. Topic <-topics (sample_tm[["VEM"], 1)
5. Table (Topic)
7. #每个Topic前5个Term
8. Terms <-Terms (sample_tm[["VEM"], 5)
10. TERMS[,1:10]

Copy Code

<ignore_js_op>

2. ######### number of topics in each article in auto
3. (Topics_auto <-topics (sample_tm[["VEM"]) [grep ("Auto", Csv[[1]])
6. Most_frequent_auto <-Which.max (tabulate (Topics_auto))
8. ######### 10 words that are most relevant to auto themes
9. Terms (sample_tm[["VEM"], ten) [, Most_frequent_auto]

Copy Code

<ignore_js_op>

R language-text mining topic Model Text classification