【乾貨】--手把手教你完成文本情感分類

感謝關注天善智能，走好數據之路↑↑↑

歡迎關注天善智能，我們是專註於商業智能BI，人工智慧AI，大數據分析與挖掘領域的垂直社區，學習，問答、求職一站式搞定！

本文作者：天善智能社區專家劉順祥

天善智能社區地址：https://www.hellobi.com/

前言

2017年12月9日，參加了天善組織的線下沙龍活動，在沙龍中自己分享了如何藉助於R語言完成情感分析的案例，考慮的其他網友沒能夠參與到活動現場，這裡作一個簡單的分享。

在文本分析中，最基礎的工作就是如何完成句子、段落或文章的分詞，當然這一步也是非常重要的，因為這會直接影響後面文檔詞條矩陣的構造和模型的有效性。一般而言，在做分詞和清洗時需要完成如下三個步驟：

• 創建一個自定義詞庫，並根據這個詞庫實現正確的分詞；
• 刪除分詞中的停止詞（無用詞）；
• 刪除其他無用詞（如字母、數字等）；

首先我們以電視劇《獵場》中的一句台詞為例，完成上面三個步驟的任務：

# 載入第三方包

library(jiebaR)

# 台詞

sentence <-滾出去！我沒有時間聽一個牢里混出來的人渣，在這裡跟我講該怎麼樣不該怎麼樣！你以為西裝往身上一套，我就看不到你骨子裡的寒酸，剪剪頭、吹吹風，就能掩藏住心裡的猥瑣？你差得還遠，你這種人我見得多了，但還沒有見到過敢對我指手畫腳的。消失，快從我面前消失！

# 設置動力和引擎

engine <- worker()

# 查看引擎配置

engine

在分詞之前，需要跟大家介紹兩個函數，它們分別是：

• worker()—為分詞提供動力和引擎
• segment()—為分詞提供戰鬥機

首先來看一下默認的分詞引擎【worker()】都有哪些配置：

從上圖的結果中，我們可知引擎所選擇的分詞方法是混合法（即最大概率法和隱馬爾科夫方法）；中文編碼為UTF-8；分詞最大長度為20個詞；一次性可以讀取最大10W行記錄；同時也提供了超過58W的詞庫。通過這些默認的配置就可以完成句子的分詞，下面我們來看看這段台詞的分詞效果：

# 分詞

cuts <- segment(sentence, engine)

cuts

分詞結果如上所示，但是你會發現有一些詞是切得不正確的，例如「剪剪頭」切成了「剪剪」和「頭」、「吹吹風」切成了「吹吹」和「風」。按理來說，這些應該作為一個整體被切割，但卻被切分開了了。為了避免這種錯誤的產生，需要用戶提供正確切詞的詞庫，然後通過修改worker()函數或使用new_user_word()函數來完成自定義詞庫的調用：

# 自定義詞庫--方法一

engine2 <- worker(user =C:/Program Files/R/R-3.3.1/library/jiebaRD/dict/my_dict.txt)

segment(sentence, engine2)

# 自定義詞庫--方法二

new_user_word(engine, c(剪剪頭,吹吹風,見到過))

cuts2 <- segment(sentence, engine)

cuts2

第一種方法就是創建詞庫my_dict文件，並將這個文件路徑傳遞給worker函數；第二種方法使用new_user_word，指定幾個自定義詞。通過這兩種方法，都可以實現正確的切詞操作，如下圖所示：

詞已經按照我們預期的效果完成切割了，但是分詞結果中還是存在一些沒有意義的停用詞（如「的」、「我」、「他」等），為了避免這些停用詞對後面建模的影響，需要將這些詞刪除。這裡也通過兩種方法實現，具體見下方的代碼：

# 停止詞的處理--方法一

engine3 <- worker(user =C:/Program Files/R/R-3.3.1/library/jiebaRD/dict/my_dict.txt,

stop_word =C:/Program Files/R/R-3.3.1/library/jiebaRD/dict/stop_words.txt)

segment(sentence, engine3)

# 停止詞的處理--方法二

cuts3 <- filter_segment(cuts2, filter_words = c(我,的,聽,在,你,就,能,還,對,

人,從,但,講,跟,這種,一個,身上))

cuts3

第一種方法就是創建停止詞詞庫stop_words文件，並將這個文件路徑傳遞給worker函數；第二種方法使用filter_segment函數，過濾掉指定的那些停止詞。通過這兩種方法，都可以實現停止詞的刪除，如下圖所示。

由於台詞中不包含數字、字母等字元，這裡就不說明如何刪除這些內容了，但後面的評論數據例子中是含有這些字元的，那邊會有代碼說明。接下來需要說一說如何構造文檔-詞條矩陣了，先來看下面這個圖：

圖中的行就代表一個個文檔，列就代表一個個詞，矩陣中的值就代表每一個詞在某個文檔中出現的頻數。由於不同文檔的長度不一致，如果使用簡單的頻數作為矩陣的值是不理想的。故考慮使用詞頻-逆文檔頻率（TFIDF）作為矩陣中的值，其公式如下圖所示：

具體計算的結果，可以查看下面的這個文檔-詞條矩陣圖：

在R語言中，構建這個矩陣就太簡單了，只需調用tm包中的DocumentTermMatrix()函數即可。下面我們就以某酒店的評論數據為例，來構建這個文檔-詞條矩陣。

# 導入所需的開發包

library(readxl)

library(jiebaR)

library(plyr)

library(stringr)

library(tm)l

ibrary

(pROC)

library(ggplot2)

library(klaR)

library(randomForest)

# 讀取評論數據

evaluation <- read_excel(path = file.choose(),sheet =2)

# 查看數據類型

str(evaluation)

# 轉換數據類型

evaluation$Emotion <- factor(evaluation$Emotion)

# 分詞(自定義詞和停止詞的處理)

engine <- worker(user =C:UsersAdministratorDesktopHelloBIall_words.txt,

stop_word =C:UsersAdministratorDesktopHelloBImystopwords.txt)

cuts <- llply(evaluation$Content, segment, engine)

#剔除文本中的數字和字母

Content <- lapply(cuts,str_replace_all,[0-9a-zA-Z],)

# 檢查是否有空字元創，如有則刪除

idx <- which(Content ==)

Content2 <- Content[-idx]

# 刪除含空字元的元素結果

Content3 <- llply(Content2,function(x) x[!x ==])

# 將切詞的評論轉換為語料

content_corpus <- Corpus(VectorSource(Content3))

# 創建文檔-詞條矩陣

dtm <- DocumentTermMatrix(x = content_corpus,

control =list(weighting = weightTfIdf,

wordLengths = c(2,Inf)))

dtm

# 控制稀疏度

dtm_remove <- removeSparseTerms(x = dtm, sparse =0.95)

dtm_remove

# 查看變數名

dtm_remove$dimnames$Terms

# 轉換為數據框

df_dtm <- as.data.frame(as.matrix(dtm_remove))

head(df_dtm)

這張圖反映的是最初的文檔-詞條矩陣，顯示713個文檔，1264個詞條，而且這個矩陣的稀疏度為100%。為了降低矩陣的係數度，通過removeSparseTerms()函數設定稀疏度，如下圖所示，此時的詞條數就壓縮到了13個，即13個變數。

接下來，還需要將這個矩陣轉換為數據框，因為分類演算法（如貝葉斯、隨機森林等）不接受上面生成的矩陣類型。有了下面這個數據框，我們就可以將數據集拆分為兩部分，一部分用於分類器的構造，另一部分用於驗證分類器的效果好壞。

在構建貝葉斯模型之前，還需要簡單介紹一下樸素貝葉斯的理論知識，這樣有助於對演算法的理解。貝葉斯演算法核心是計算條件概率，而此處條件概率的計算又依賴於兩個前提假設，即連續變數服從正態分布和各解釋變數之間是互相獨立的。首先來看一下這個條件概率公式，其可以寫成下面這個形式：

很顯然，要求得每個樣本下的條件概率最大值，只需求解分子的最大化即可。根據解釋變數之間互相獨立的假設，還可以將分子轉換為下面這個公式：

而下面這個公式的概率是很好求的，在已知某分類的情況下，計算每個變數取值的概率（當X變數離散時，用變數值的頻率代替條件概率；當X變數連續時，用變數的正態概率密度值代替條件概率）。OK，原理很簡單，在R語言中，通過調用klaR包中的NaiveBayes()函數就可以實現貝葉斯分類器的構建了。函數語法如下：

NaiveBayes(x, grouping, prior, usekernel = FALSE, fL = 0, …)

• x指定需要處理的數據，可以是數據框形式，也可以是矩陣形式；
• grouping為每個觀測樣本指定所屬類別；
• prior可為各個類別指定先驗概率，默認情況下用各個類別的樣本比例作為先驗概率；
• usekernel指定密度估計的方法（在無法判斷數據的分布時，採用密度密度估計方法），默認情況下使用標準的密度估計，設為TRUE時，則使用核密度估 計方法；
• fL指定是否進行拉普拉斯修正，默認情況下不對數據進行修正，當數據量較小時，可以設置該參數為1，即進行拉普拉斯修正。

接下來，進入貝葉斯分類器的實戰部分，包含模型的構建、測試集的預測和模型的驗證，具體代碼如下：

# 拆分為訓練集和測試集

set.seed(1)

index<-sample(

1:nrow(df_dtm),size=0.75*nrow(df_dtm))

train <- df_dtm[index,]

test<- df_dtm[-index,]

# 貝葉斯分類器

bayes <- NaiveBayes(x = train,grouping= evaluation$Emotion[-idx][index], fL =1)

# 預測

pred_bayes <- predict(bayes, newdata =test)

Freq_bayes <-table(pred_bayes$class, evaluation$Emotion[-idx][-index])

# 混淆矩陣

Freq_bayes

# 準確率

sum(diag(Freq_bayes))/sum(Freq_bayes)

#ROC曲線

roc_bayes <- roc(evaluation$Emotion[-idx][-index],factor(pred_bayes$class,ordered =T))

Specificity <- roc_bayes$specificities

Sensitivity <- roc_bayes$sensitivities

# 繪製ROC曲線

p<- ggplot(data=NULL,mapping= aes(x=1-Specificity, y = Sensitivity))

p+ geom_line(colour =

red,size=1) +

coord_cartesian(xlim =c(

0,1), ylim =c(0,1)) +

geom_abline(intercept =

0, slope =1)+

annotate(

text, x =0.5, y =0.25, label=paste(AUC=,round(roc_curve$auc,2)))+

labs(x =

1-Specificity,y =Sensitivity, title =ROC Curve) +

theme(plot.title = element_text(hjust =

0.5, face =bold, colour =brown))

結果如上圖所示，模型的準確率為77%（即混淆矩陣中主對角線數值之和除以4個元素之和）；ROC曲線下的面積也達到了0.79（理想的AUC在0.8以上）。相對來說，模型的效果還是比較理想的。為了比較，我們再使用一個集成演算法（隨機森林），看看集成演算法是否比單一的貝葉斯演算法要好一些。

# 隨機森林

rf <- randomForest(x = train, y = evaluation$Emotion[-idx][index])

pred_rf <- predict(rf, newdata =test)

# 混淆矩陣

Freq_rf <- table(pred_rf,evaluation$Emotion[-idx][-index])

Freq_rf

# 準確率

sum(diag(Freq_rf))/sum(Freq_rf)

#ROC曲線

roc_rf <- roc(evaluation$Emotion[-idx][-index],factor(pred_rf,ordered =T))

Specificity <- roc_rf$specificities

Sensitivity <- roc_rf$sensitivities

# 繪製ROC曲線

p <- ggplot(data =NULL, mapping = aes(x=1-Specificity, y = Sensitivity))

p + geom_line(colour =red, size =1) +

coord_cartesian(xlim = c(0,1), ylim = c(0,1)) +

geom_abline(intercept =0, slope =1)+

annotate(text, x =0.5, y =0.25, label=paste(AUC=,round(roc_rf$auc,2)))+

labs(x =1-Specificity,y =Sensitivity, title =ROC Curve) +

theme(plot.title = element_text(hjust =0.5, face =bold, colour =brown))

很顯然，集成演算法要比貝葉斯演算法要優秀一些，模型的準確率超過80%，而且AUC值也達到了0.82。

結語

OK，關於使用R語言完成文本情感分類的實戰我們就分享到這裡。如果你有任何問題，歡迎在留言區域表達你的疑問。同時，也歡迎各位朋友繼續轉發與分享文中的內容，讓更多的人學習和進步。

原文地址：【乾貨】--手把手教你完成文本情感分類

免費課程推薦：Hellobi Live | 手把手教你做文本挖掘

歡迎關注天善智能，我們是專註於商業智能BI，人工智慧AI，大數據分析與挖掘領域的垂直社區，學習，問答、求職一站式搞定！

天善智能社區地址：https://www.hellobi.com/