【譯文】用R語言做網頁爬蟲和文本分析-Part3

作者 Florent Buisson

譯者 錢亦欣

在第一部分 中，我們從goodreads網站爬取了評論數據. 並在第二部分完成了探索性數據分析，同時還生成了一些新變數. 現在可以上主菜了：機器學習！（此處應有BGM）

準備工作

先來載入包並讀入數據

library(data.table)nlibrary(dplyr)nlibrary(caret)nlibrary(RTextTools)nlibrary(xgboost)nlibrary(ROCR)nnsetwd("C:/Users/Florent/Desktop/Data_analysis_applications/GoodReads_TextMining")ndata <- read.csv("GoodReadsCleanData.csv", stringsAsFactors = FALSE)n

目前，數據集包含如下變數：

review.idnbooknratingnreviewnreview.lengthnmean.sentimentnmedian.sentimentncount.afinn.positivencount.afinn.negativencount.bing.negativencount.bing.positiven

方便起見，本例把1-5星的評級簡化為二分變數，4或5星為1，星以下為0。這樣我們就可以在這個數據集上訓練分類器了，並且兩個類比例也比較均衡。

set.seed(1234)n# Creating the outcome valuendata$good.read <- 0ndata$good.read[data$rating == 4 | data$rating == 5] <- 1n

數據集中的好評佔了約85%，差評約15%，是個非常典型的非平衡數據集。我們在劃分訓練集和測試集的時候就不能採用簡單抽樣了，我們要用caret包中的『createDatePartITion（）』函數進行分層抽樣來保證劃分的兩部分依舊保留有之前的比例結構。

trainIdx <- createDataPartition(data$good.read, n p = .75, n list = FALSE, n times = 1)ntrain <- data[trainIdx, ]ntest <- data[-trainIdx, ]n

構造文獻-檢索詞矩陣(DTM)

我們的目標是將評論中每個詞的詞頻作為機器學習演算法的輸入特徵，為此，我們要從統計每條評論中每個單詞的出現次數開始。幸運的是，現在已經有現成的工具可以為我們返迴文獻-檢索詞矩陣了。這個矩陣的行代表評論，列代表一個詞，而矩陣的每個元素則表示該次在這條評論中的出現次數。

一個典型的DTM長這樣：

我們並不希望把每個單詞都統計頻率，因為很多生僻詞對預測而言沒什麼用，只是徒增DTM的大小。所以DTM中只包含出現頻率高於某一水平（比如1%）的詞，通過設定函數中的sparsity參數就能達成這一目的，此處sparsity = 1-0.01 = 0.99.

然而問題來了，我們的前提假定是在差評中出現的詞在好評中往往不會出現（至少頻率差別很大），反之亦然。可如果我們只保留出現頻率大於1%的詞，由於差評整體只佔15%，那麼一個貶義詞要被納入DTM，它出現的頻率至少是『1%/15% = 6.67%』。這個門限值實在太高了，並不可行。

相對的解決方案就是對於訓練集創建兩個不同的DTM，分別統計褒義詞和貶義詞，再將兩者整合到一起。這樣一來，兩邊的門限值就都是1%了。

# 創建貶義詞的DTMnsparsity <- .99nbad.dtm <- create_matrix(train$review[train$good.read == 0], n language = "english", n removeStopwords = FALSE, n removeNumbers = TRUE, n stemWords = FALSE, n removeSparseTerms = sparsity) n# 把DTM轉換為數據框nbad.dtm.df <- as.data.frame(as.matrix(bad.dtm), n row.names = train$review.id[train$good.read == 0])nn# 創建褒義詞的DTMngood.dtm <- create_matrix(train$review[train$good.read == 1], n language = "english",n removeStopwords = FALSE, n removeNumbers = TRUE, n stemWords = FALSE, n removeSparseTerms = sparsity) nngood.dtm.df <- data.table(as.matrix(good.dtm), n row.names = train$review.id[train$good.read == 1])nn# 合併兩個數據框ntrain.dtm.df <- bind_rows(bad.dtm.df, good.dtm.df)ntrain.dtm.df$review.id <- c(train$review.id[train$good.read == 0],n train$review.id[train$good.read == 1])ntrain.dtm.df <- arrange(train.dtm.df, review.id)ntrain.dtm.df$good.read <- train$good.readn

我們也希望在分析中用上之前整合的變數，比如評論長度、情感均值和中位數等等，為此我們將DTM和訓練集以評論id為主鍵再次合併。我們還需要把所有NA值轉變為0，因為它們表示這些詞在評論中沒有出現。

train.dtm.df <- train %>%n select(-c(book, rating, review, good.read)) %>%n inner_join(train.dtm.df, by = "review.id") %>%n select(-review.id)nntrain.dtm.df[is.na(train.dtm.df)] <- 0nn# 創建測試集的DTMntest.dtm <- create_matrix(test$review, n language = "english", n removeStopwords = FALSE, n removeNumbers = TRUE, n stemWords = FALSE, n removeSparseTerms = sparsity) ntest.dtm.df <- data.table(as.matrix(test.dtm))ntest.dtm.df$review.id <- test$review.idntest.dtm.df$good.read <- test$good.readnntest.dtm.df <- test %>%n select(-c(book, rating, review, good.read)) %>%n inner_join(test.dtm.df, by = "review.id") %>%n select(-review.id)n

問題由來了，我們要確保測試集和訓練集有一樣的列，但顯而易見，測試集的一些詞在訓練集里肯定沒出現，不過我們對此無能為力。好在data.table對象在按行合併時會默認保留所有的列，那些缺失的值就會被認為是NA，那麼我們只要對訓練集添加一個輔助行，讓它的列增多，再把該輔助行刪除，就能使其和測試集保持列一致了。之後，再通過篩選，使得測試集只保留和訓練集一樣的列，也即刪去那些只在測試集中出現的列。

test.dtm.df <- head(bind_rows(test.dtm.df, train.dtm.df[1, ]), -1)ntest.dtm.df <- test.dtm.df %>% n select(one_of(colnames(train.dtm.df)))ntest.dtm.df[is.na(test.dtm.df)] <- 0n

至此，準備工作就差不多了，掄模型吧！

機器學習

我們將使用XGboost（本文在此跪拜下天奇大神，感謝你拯救了我的數模），因為它輸出的結果最好（我也適用了隨機森林和支持向量機，但它們的精度太不穩定了）。

我們先計算下基準精度，也就是預測所有測試樣本為訓練集中頻率高的那一類，然後再上模型。

baseline.acc <- sum(test$good.read == "1") / nrow(test)nnXGB.train <- as.matrix(select(train.dtm.df, -good.read),n dimnames = dimnames(train.dtm.df))nXGB.test <- as.matrix(select(test.dtm.df, -good.read),n dimnames=dimnames(test.dtm.df))nXGB.model <- xgboost(data = XGB.train, n label = train.dtm.df$good.read,n nrounds = 400, n objective = "binary:logistic")nnXGB.predict <- predict(XGB.model, XGB.test)nnXGB.results <- data.frame(good.read = test$good.read,n pred = XGB.predict)n

XGboost演算法會給出一個預測概率，所以我們需要制定一個門限值作為兩個類別的劃分界點。為此，我們將繪製出ROC（Receiver Operating Characteristic）曲線，該曲線縱軸是真陰性比率，橫軸是假陰性比率。

ROCR.pred <- prediction(XGB.results$pred, XGB.results$good.read)nROCR.perf <- performance(ROCR.pred, tnr,fnr) nplot(ROCR.perf, colorize = TRUE)n

看起來不錯！圖中顯示如果以0.8作為門限值（紅線以上部分），我們能分對50%以上的負樣本（真陰性比率）同時只把少於10%的正樣本誤分類（假陰性比率）。

XGB.table <- table(true = XGB.results$good.read, n pred = as.integer(XGB.results$pred >= 0.80))nXGB.tablenXGB.acc <- sum(diag(XGB.table)) / nrow(test)n

我們整體的精度是87%，因此我們擊敗了基準精度（一直預測測試樣本為正類，分類正確率是83.4%），能夠捕捉61.5%的差評。對於一個黑箱演算法而言不算壞，畢竟我們沒做任何的參數優化或者特徵工程！

未來的分析方向

如果要做更深入的分析，以XGboost的特徵相對重要性為切入點是個不錯的方向。

### XGboost中的特徵分析nnames <- colnames(test.dtm.df)nimportance.matrix <- xgb.importance(names, model = XGB.model)nxgb.plot.importance(importance.matrix[1:20, ])n

如圖，諸如『colleen』或者『you之類的詞看起來用處不大，全局來看，最優解釋效力是那些貶義詞。而評論長度和通過bing詞典統計的貶義詞頻書也進入了重要特徵的前10名。

基於此，有如下方式可以提升模型：

• 使用片語 (如「did not like」) , 相比單詞片語能更好地刻畫褒貶意義。「was very disappointed」 和「was not disappointed」的意義簡然不同, 而將其拆分為單詞分析可能不會捕捉到其中差異。

• 調整XGBoost演算法的參數

• 關注那些被誤分類的差評, 以此決定添加哪些特徵.

結論

本系列我們介紹了很多內容：從網頁數據抓取到情感分析再到利用機器學習模型做預測。通過這個練習我得到的主要結論是通過一些簡單易用的工具，我們能快速地完成一些很有意義的分析流程。

完整代碼可以參看我的github.

註：原文刊載於Datescience+網站

原文地址：GoodReads: Machine Learning (Part 3)

推薦閱讀：