中文文本探勘初探：TF-IDF in R Language

這次的筆記是一個最基礎的文本探勘，用R語言寫從向量提取、TF-IDF、到query相關文件排序，只要約50行，非常方便！

1. 使用到的Library

中文文本探勘用到的包有點多，不過意思就是都可以偷懶不用自己實作^^

• tm : 主要的 text mining 套件
• tmcn : tm的中文包
• rJava : 給Rwordseg連到java的包
• Rwordseg : 分詞包
• SnowballC、slam : 輔助包，一樣必須匯入

library("tm")
library("tmcn")
library("rJava")
library("Rwordseg")
library("SnowballC")
library("slam")

2. 測試資料

10個範例文件，一個query = c(台, 北, 府)

# import data
docs = data.frame(
  c("立找洗字人草鞋墩庄"),
  c("北投保北投莊"),
  c("邰北府淡水縣正堂"),
  c("仝立找洗字人林"),
  c("邰北縣奎府"),
  c("立杜賣盡根絕田契字"),
  c("仝立合約開鑿圳路字"),
  c("立仝換斷田契字"),
  c("立典大租契字竹塹社"),
  c("邰灣布政使司"))
colnames(docs) <- c(1:ncol(docs))

# query
q = c("邰","北","府")
insertWords(q)
q.num = c(1,1,1)

3. 斷詞、轉 TermDocumentMatrix

轉成corpus，用segmentCN斷詞，wordLengths可以調整斷詞的詞彙最大最小值，很方便！

# corpus to tdm
d.corpus <- Corpus(VectorSource(docs))
d.corpus <- tm_map(d.corpus, segmentCN, nature = TRUE)
d.corpus <- Corpus(VectorSource(d.corpus))
tdm <- TermDocumentMatrix(d.corpus, control = list(wordLengths = c(1,1)))
inspect(tdm)

inspect(tdm) 可以看到完成的term document matrix~

4. TF-IDF 計算

最簡單的詞頻分析就屬TF-IDF了！

某一特定文件內的高詞語頻率，以及該詞語在整個文件集合中的低文件頻率，可以產生出高權重的TF-IDF。因此，TF-IDF傾向於過濾掉常見的詞語，保留重要的詞語。

• TF :  該詞在文件d中的出現次數 / 在文件d中所有字詞的出現次數和
• IDF : log(語料庫中的文件總數 / 包含詞語 t 的文件數目)

wiki - TF-IDF
https://zh.wikipedia.org/zh-tw/TF-IDF

# tf-idf computation
tf <- apply(tdm, 2, sum) # term frequency
idf <- function(word_doc){ log2( (length(word_doc)+1) / nnzero(word_doc) ) }
idf <- apply(tdm, 1, idf)
doc.tfidf <- as.matrix(tdm)
for(i in 1:nrow(tdm)){
    for(j in 1:ncol(tdm)){
        doc.tfidf[i,j] <- (doc.tfidf[i,j] / tf[j]) * idf[i]
    }
}

5. 把matrix和query長度調成一致

簡單處理矩陣大小和query一致，當矩陣很大、query長度很小時，對計算量縮減有很大幫助。

# get short doc matrix
all.term <- rownames(doc.tfidf)
loc <- which(all.term %in% q)
s.tdm <- doc.tfidf[loc,]

6. 餘弦相似度排序

想減少計算量可以改用內積 (餘弦是有正規化的內積)

# result : cos similarity ranking
cos.sim <- function(x, y){ x%*%y / sqrt(x%*%x * y%*%y) }
doc.cos <- apply(s.tdm, 2, cos.sim, y = q.num)
doc.cos[order(doc.cos, decreasing = TRUE)]

答案如下，和感覺滿一致的 : )

1. 邰北府淡水縣正堂
2. 邰北縣奎府
3. 北投保北投莊
4. 邰灣布政使司

所有程式碼整合：

library("tm")
library("tmcn")
library("rJava")
library("Rwordseg")
library("SnowballC")
library("slam")
library("Matrix")
library("Rcpp")

# import data
docs = data.frame(
  c("立找洗字人草鞋墩庄"),
  c("北投保北投莊"),
  c("邰北府淡水縣正堂"),
  c("仝立找洗字人林"),
  c("邰北縣奎府"),
  c("立杜賣盡根絕田契字"),
  c("仝立合約開鑿圳路字"),
  c("立仝換斷田契字"),
  c("立典大租契字竹塹社"),
  c("邰灣布政使司"))
colnames(docs) <- c(1:ncol(docs))

# query
q = c("邰","北","府")
insertWords(q)
q.num = c(1,1,1)

# corpus to tdm
d.corpus <- Corpus(VectorSource(docs))
d.corpus <- tm_map(d.corpus, segmentCN, nature = TRUE)
d.corpus <- Corpus(VectorSource(d.corpus))
tdm <- TermDocumentMatrix(d.corpus, control = list(wordLengths = c(1,1)))
inspect(tdm)

# tf-idf computation
tf <- apply(tdm, 2, sum) # term frequency
idf <- function(word_doc){ log2( (length(word_doc)+1) / nnzero(word_doc) ) }
idf <- apply(tdm, 1, idf)
doc.tfidf <- as.matrix(tdm)
for(i in 1:nrow(tdm)){
    for(j in 1:ncol(tdm)){
        doc.tfidf[i,j] <- (doc.tfidf[i,j] / tf[j]) * idf[i]
    }
}

# get short doc matrix
all.term <- rownames(doc.tfidf)
loc <- which(all.term %in% q)
s.tdm <- doc.tfidf[loc,]

# result : cos similarity ranking
cos.sim <- function(x, y){ x%*%y / sqrt(x%*%x * y%*%y) }
doc.cos <- apply(s.tdm, 2, cos.sim, y = q.num)
doc.cos[order(doc.cos, decreasing = TRUE)]

References

用R進行中文 text Mining
http://rstudio-pubs-static.s3.amazonaws.com/12422_b2b48bb2da7942acaca5ace45bd8c60c.html