Paper繪圖 - R語言文本數據挖掘——文本相似度的聚類分析－鑽石舞台

1 文本相似度的計算

1.1文本之間可以通過計算相似度，來評價文本之間的相關性，下方我們創建幾個文本用於進行評價

# 創建4個文本text_1 <- "Acute liver failure is an uncommon and dramatic clinical syndrome with a high risk of mortality."text_2 <- "Previous treatmentsexisted some limitations of poor bioavailability and targeting the efficiency of drugs."text_3 <- "Previous treatmentsexisted some limitations of poor bioavailability"text_4 <- "Previous treatments existed some limitations of poor bioavailabil"# 計算各個文本之間的相似度# 如果是兩個文本，則直接進行計算adist(text_1,text_2)# 如果是多個文本，則需要c()adist(c(text_1,text_2,text_3,text_4))

1.2 也可以使用sringdist函數，該函數可以選擇更多地計算方法（"osa", "lv", "dl", "hamming", "lcs", "qgram", "cosine", "jaccard", "jw", "soundex"），在method參數進行設置

library(stringdist)stringdist(text_1,text_2, method = "lv")

1.3 除了距離的計算，stringsim函數還可以進行相似性的計算：即先計算距離，然後除以最大距離得到數值A，最後用1減去A即為相似度。越接近於1，表明文本相似性越大，反之則相反。

stringsim(text_1,text_2, method = "lv")

1.4 如果是數值型的數據，可以使用dist函數進行，由於dist函數一般是對數據的行進行統計，因此需要使用t()函數進行轉置數據。結果的含義就是x到y的距離是多少。

# 創建一個數據框data <- iris[1:10,1:4]# 計算距離dist(t(data))

1.5 更加豐富的距離計算方法，可以使用apcluster包進行

# install.packages("apcluster")library(apcluster)corSimMat(t(data))

1.6 corSimMat()函數默認的方法是person方法，備選方法也包括spearman和kendall

corSimMat(t(data), method = "spearman")corSimMat(t(data), method = "kendall")

2 文本的聚類: 劃分聚類法

2.1 聚類方法一般分為兩種，劃分聚類法和層次聚類法。劃分聚類法的方法包括k-means，kmedoids。層次聚類法包括合成法和分割法。首先進行數據前的準備，我們使用樣本數據：首先進行讀取樣本數據，使用unnest_tokens()進行將文本單詞分割，使用adist()進行計算單詞之間的距離

library(tidyverse)library(tidytext)library(readtext)path <- system.file("extdata/", package = "readtext")csv_data <- readtext(paste0(path,"/csv/inaugCorpus.csv"), text_field = "texts")%>% # 將text列的句子分割成單個的單詞 unnest_tokens(output = text1, input = text)# 計算單詞之間的距離矩陣d <- adist(csv_data$text1)# 數據差異太大，進行標準化處理d_scale <- scale(d)

2.2 在聚類之前，首先得確定聚類的個數，這裡可以使用fviz_nbclust()函數，通過可視化進行確定，這裡的參數可以選擇"silhouette" (for average silhouette width)，"wss" (for total within sum of square) and "gap_stat" (for gap statistics)。wss為最小化損失函數的計算方法。運行時間會比較長，可能得一個多小時。最後查看結果，我們發現，當k的值為3時，就很難有效地減少損失函數，所以我們定k=3。

# 可視化聚類的個數fviz_nbclust(d,kmeans,method = "wss")

2.3 下來我們直接進行聚類

km_res <- kmeans(d,centers = 3)

2.4 通過cbind()函數進行查看字符串的分類

# 查看字符串的分類cbind(class = km_res$cluster, string = csv_data$text1)

2.5 對上述分類的字符串進行PCA可視化，可以發現，聚類效果不是特別好，沒有分開，可能是我們用了的文本數據的問題導致的。

# PCA可視化展現分類結果fviz_cluster(km_res,#分析結果 data = d,#原始的數據 ellipse.type = "euclid",#分類橢圓 repel = TRUE, #防止標籤重疊 ggtheme = theme_minimal()#繪圖主題 )

2.6 k-means 方法是比較簡單的一個方法，但是一些還是會有一些缺陷。如k值需要首先確定；聚類結果不穩定（嘗試nstart參數來解決）；對於離群值非常敏感。

2.7 k-medoids方法可以改善k-means方法的第三個缺點。k-means是使用均值來更新質心，而k-medoids是使用樣本相似度來選定質心。前者是通過計算均值形成的假想點，後者是分屬同一類別中心位置的實際存在的點。這裡得安裝cluster包進行聚類的k值分析，結果發現最佳的k值為2。

2.8 然後我們可以使用pam函數進行聚類分析

pam_res <- pam(d,2)cbind(class = pam_res$clustering, string = csv_data$text1)

2.9 按照前面的方法進行可視化一下

fviz_cluster(pam_res, ellipse.type = "euclid", repel = TRUE, ggtheme = theme_classic())

2.10 如果想要自動化確定k值呢？可以使用fpc包的pamk函數。通過自定義K的取值範圍，最終會計算出最佳的聚類結果。

library(pacman)p_load(fpc)pamk(d,krange = 1:5)

2.11 此外還包括cluster包的clara函數(解決pam對計算機要求高的問題)，首先進行可視化獲取最佳聚類數值，然後查看聚類結果

# 首先進行可視化聚類數值分析fviz_nbclust(d,clara,method = "silhouette")+ theme_classic()# 聚類分析clara_res <- clara(d,2,samples=50, pamLike = TRUE)# 顯示聚類結果cbind(class=clara_res$clustering, string = csv_data$text1)# 可視化聚類展示fviz_cluster(clara_res, ellipse.type = "euclid", repel = TRUE, ggtheme = theme_classic())

3 文本的聚類: 層次聚類法

3.1 層次聚類法也就是根據樣本之間的距離進行合成或者分離。比如合成法，將每個樣本看成是單獨的個體，然後計算兩兩之間的距離，將距離最小的合併在一起，此時會出現一個新的個體。然後再計算新的個體與其他個體之間的距離，以此類推，直到將所有的個體都進行合成即結束。而分割法是反向操作。cluster包中的agnes函數和diana函數可以進行合成法和分割法。

library(tidyverse)library(tidytext)library(readtext)# 考慮到數據太大運行時間太長# 我們重新選擇doc_id==inaugCorpus.csv.1來進行演示path <- system.file("extdata/", package = "readtext")csv_data <- readtext(paste0(path,"/csv/inaugCorpus.csv"), text_field = "texts")%>% # 將text列的句子分割成單個的單詞 unnest_tokens(output = text1, input = text)%>% # 也就是使用filter函數進行篩選即可 filter(doc_id == "inaugCorpus.csv.1") csv_data_del_stopword <- csv_data$text1%>% tokenize_words(stopwords = stop_words$word)%>% unlist()%>% na.omit()# 計算字符串之間的距離矩陣d <- adist(csv_data_del_stopword)# 加載clusterlibrary(cluster)# 為矩陣命名rownames(d) <- csv_data_del_stopword# 聚類分析res_agnes <- agnes(d)# 聚類結果res_agnes# 進行分類cluster_split <- cutree(res_agnes,k=3)# 如果要看某一類rownames(d)[cluster_split ==1]# 不進行分類的可視化效果fviz_dend(res_agnes)# 進行分類的可視化效果fviz_dend(res_agnes, k = 3, cex = 0.3, k_colors = c("red","green","blue","black","yellow"), color_labels_by_k = TRUE, rect = TRUE)# PCA可視化分析fviz_cluster(list(data = d,cluster = cluster_split), palette = c("red","blue","green"), ellipse.type = "convex", repel = TRUE, show.clust.cent = FALSE, ggtheme = theme_minimal())