iT邦幫忙

2023 iThome 鐵人賽

DAY 17
0
AI & Data

用R語言玩轉文字探勘系列 第 17

[Day 17] 利用R語言找關鍵字

  • 分享至 

  • xImage
  •  

文件關鍵字

關鍵字的重要性

前面先註明一下,本文大幅參考An Evaluation on Feature Selection for Text Clustering寫作而成。

找到文件中的關鍵字很重要,也是很日常的情境,為什麼呢?

舉例來說,在讀一篇網路文章前,我們通常會先看標題,產生興趣便會點擊。你可能會被標題中的關鍵字吸引,這個關鍵字可能是常見的誘餌式標題(clickbait title),例如「富二代拋棄繼承,關鍵竟是『這個』!」你太想知道「這個」是什麼,因此點擊。你也可能是被主題關鍵字吸引,例如「大選民調出爐,柯文哲排第幾?」你關心民調結果,也想知道柯文哲表現,所以跑去看全文。

這是一種看文章列表的閱讀方式,但也有些人是按照文章類型決定是否閱讀,例如點開新聞首頁之後,優先選擇科技類型(section)的文章,因此文章類型就是重點。

上面兩種情境說明了關鍵字的重要性,第一種是單篇文章的關鍵字,例如人名、事件,第二種乍看之下與關鍵字沒關係,因為我們關注的是文章類型。不過,哪些文章容易吸引到你?除了「政治」這種很大的類型以外,還有沒有其他子類型同樣能吸引你?舉例來說,你不是所有政治文章通吃,你特別關注選舉相關文章,這樣一來,你關注的類型就是會是選舉。因此,文章類別也會是重點。

將文件分類(監督式學習),或者分群(非監督式學習),在文字探勘和資訊檢索(information retrieval)都很重要。其中,屬於後者的文件分群(text clustering)是一個常見任務,當我們搜尋關鍵字,搜尋引擎排序結果,或者是生成文章關鍵字的時候,都是這個技術派上用場的好時機。

總的來說,找關鍵字不只是單純想看文章中有哪些關鍵字而已,還有更高一層的任務-判斷文章類別。有些關鍵字指標並不直觀,它反映出的概念不像詞彙頻率那樣,僅止於「找出文章重點」而已,還能夠進一步確認文章類別。

關鍵字指標

D代表文件的集合也就是所有文件,M代表特徵的維度也就是有幾個變數,N則代表資料集中有多少篇文件。

Information Gain

監督式方法。以新聞為例,每篇文章都有不同類別,而每個類別都有對應的詞彙(特徵),資訊增益/獲利(information gain)可以讓我們知道,某個詞彙的出現與否,能不能幫助我們判斷文章屬於哪個類別。

用比較多術語的講法,資訊茲增益衡量了觀察到某個詞彙,類別變量的熵(entrophy)減少的量,它可以比較在A類別中那個詞彙的常見程度,以及B類別那個詞彙的常見程度。

假設我們有「詞彙一」和「詞彙二」,若「詞彙一」使類別變數的熵減少得更多,代表「詞彙一」比「詞彙二」更適合分類文件,因此我們可以說「詞彙一」更「有價值」或「更有用」。

你可以參考這篇stackoverflow介紹資訊增益的文章

χ2 statistic

監督式方法。卡方統計(Chi-square statistic,縮寫為 chi statistic)是一種衡量兩個離散變量之間關聯性的統計方法。在文本分群的脈絡底下中,這兩個變數通常是「詞彙(或特徵)的存在與否」和「文件類別」。

當我們說「卡方統計量衡量詞彙和類別之間的關聯性」時,意思是我們想知道某一詞語的出現是否與某一特定類別的文件有強烈關聯。換句話說,當某一詞語在某一類別的文件中出現的頻率遠高於其他類別時,這一詞語和該類別之間的卡方統計量就會很高。

Document Frequency

非監督式方法。這個方法會比你想的更簡單,就是去數某個詞彙出現在多少文件中,他可以說是選擇詞彙的最簡單方法之一,而且就算文件量變大,他的計算複雜度也不會變成平方、立方,而是單純的線性成長。

文件分群

在文字探勘的特徵工程(feature engineering)時,會利用不同指標,找出在語料中重要的關鍵字,這裡的重要既涵蓋了我們熟知「這個關鍵字有代表性」,例如某篇政治類型文章的關鍵字是總統大選,同時也涵蓋了「分類上這個關鍵字有代表性」,例如政治類型的文章常見選舉、娛樂類型的文章時常出現演唱會。

前面介紹過DTM和DFM,在分群文件時,會將原始文章轉換成詞袋模型(bag-of-words models)。不過,它也會面臨維度太高、資料儲存太過稀疏以及失去語意的幾個挑戰。維度太高,指的就是單詞作為特徵的數量太多,資料儲存稀疏則是前面提過的,很多詞彙在文章中都沒有出現過,失去語意倒不會影響效能,這種省略反而對效能有意。但因為前面兩個因素,讓分群文件的效能減低。

想解決問題,通常會使用抽取特徵(feature extraction)或者選擇特徵(feature selection)的方式處理。抽取特徵,就是把原本的變數拼湊組合,變成新的變數,因此叫做抽取。選擇特徵,則是從原本滿山滿海的變數中,選取出重要的。

以詞彙為變數、分出文件類型的例子來說,先介紹抽取特徵,你可以想像在三維空間(或者二維)中,把每一個詞彙都投射(project)到一個點點上,所以他們都會有座標,這時候我們可以從原點開始、到點點為止,變成一個有方向性的直,也就是向量;組合好幾個向量之後,就可以得到新的特徵了!不過這也會有缺點,新的向量(特徵)沒有很明確直觀的意義,也算一個挑戰。常見的主成分分析就是一個抽取特徵的具體案例。

至於選擇特徵很單純,就是留下那些可以代表文章類型的字,例如「你」、「我」,對決定文章類型沒有太大幫助,所以就可以刪掉。不過,到底要怎麼挑選詞彙呢?這就是本章重點!

利用關鍵字輔助分群

library(tidyverse)
library(jiebaR)
library(tidytext)

df_index_pts <- read_rds("/Users/macuser/Documents/GitHub/text-mining/data/df_index_pts_daily.rds")
df_main_pts <- read_rds("/Users/macuser/Documents/GitHub/text-mining/data/df_main_pts_daily.rds")


### segment
cutter <- worker("tag", stop_word = "data/停用詞-繁體中文.txt")
vector_word <- c("中華民國", "李登輝", "蔣中正", "蔣經國", "李登輝", "陳水扁", "馬英九")
new_user_word(cutter, words = vector_word)

## [1] TRUE

# reg_space <- "%E3%80%80" %>% curl::curl_escape()
df_stop <- read_table("data/停用詞-繁體中文.txt", col_names = F) %>% rename(stopword = 1)

## 
## ── Column specification ───────────────────────────────────────────────────────────────────────────────────────────────────────
## cols(
##   X1 = col_character()
## )

### text part
df_main_pts_clean <- df_main_pts %>% 
  mutate(text = str_replace_all(text, "台灣|臺灣", "臺灣")) %>%
  mutate(text = str_remove_all(text, "\\n|\\r|\\t|:| | ")) %>%
  mutate(text = str_remove_all(text, "(|)")) %>%
  # mutate(text = str_remove_all(text, reg_space)) %>%
  mutate(text = str_remove_all(text, "[a-zA-Z0-9]+")) %>%
  mutate(text_segment = purrr::map(text, function(x)segment(x, cutter))) %>%
  mutate(text_POS = purrr::map(text_segment, function(x)names(x))) %>%
  unnest(c(text_segment, text_POS)) %>%
  select(-text, everything(), text)

sparse_matrix_pts <- 
  df_main_pts_clean %>% count(link, text_segment, sort = TRUE) %>%
  anti_join(df_stop, by = c("text_segment" = "stopword")) %>%
  cast_sparse(link, text_segment, n)

kfit <- kmeans(sparse_matrix_pts, centers = 10)

res_cluster <- enframe(kfit$cluster, value = "cluster")
res_cluster %>% rename(link = name) %>% left_join(df_index_pts) %>%
  select(title, category, cluster) %>%
  count(category, cluster) %>% 
  arrange(cluster) %>%
  pivot_wider(names_from = cluster, values_from = n, values_fill = list(n = 0))

## Joining with `by = join_by(link)`

## # A tibble: 10 × 11
##    category   `1`   `2`   `3`   `4`   `5`   `6`   `7`   `8`   `9`  `10`
##    <chr>    <int> <int> <int> <int> <int> <int> <int> <int> <int> <int>
##  1 文教科技     1     0     0     0     0     1    87     1    40     0
##  2 地方         0     1    11     0     0     0   239     1     0     0
##  3 政治         0    19     0     0    83     0    50     0     0     2
##  4 生活         0    20    39     0     1     2   150    15     1     5
##  5 產經         0     1     0     0     2     0    57     1     0     6
##  6 社會         0     1     0     0     2     0   175     0     0     1
##  7 全球         0     0     0     1    27    15   322     5     0     0
##  8 兩岸         0     0     0     0    17     0    16     0     0     0
##  9 環境         0     0     0     0     0     4    26     0     0     1
## 10 社福人權     0     0     0     0     0     5    44     0     0     2

res_cluster %>% rename(link = name) %>% left_join(df_index_pts) %>% count(cluster)

## Joining with `by = join_by(link)`

## # A tibble: 10 × 2
##    cluster     n
##      <int> <int>
##  1       1     1
##  2       2    42
##  3       3    50
##  4       4     1
##  5       5   132
##  6       6    27
##  7       7  1166
##  8       8    23
##  9       9    41
## 10      10    17

sparse_matrix_pts <- 
  df_main_pts_clean %>% count(link, text_segment, sort = TRUE) %>%
  anti_join(df_stop, by = c("text_segment" = "stopword")) %>%
  cast_sparse(link, text_segment, n)

kfit <- kmeans(sparse_matrix_pts, centers = 10)

res_cluster <- enframe(kfit$cluster, value = "cluster")
res_cluster %>% rename(link = name) %>% left_join(df_index_pts) %>%
  select(title, category, cluster) %>%
  count(category, cluster) %>% 
  arrange(cluster) %>%
  pivot_wider(names_from = cluster, values_from = n, values_fill = list(n = 0))

## Joining with `by = join_by(link)`

## # A tibble: 10 × 11
##    category   `1`   `2`   `3`   `4`   `5`   `6`   `7`   `8`   `9`  `10`
##    <chr>    <int> <int> <int> <int> <int> <int> <int> <int> <int> <int>
##  1 全球        23     0     0     9     8     0     0   329     0     1
##  2 兩岸        11     0     0     0     0     0     0    22     0     0
##  3 政治        81     0     0     2     0    19     0    52     0     0
##  4 生活         1     1     0     0     2    20     0   168    41     0
##  5 產經         2     0     0     0     0     1     0    64     0     0
##  6 社會         2     0     0     0     0     1     0   176     0     0
##  7 文教科技     0    40     1     0     1     0     0    88     0     0
##  8 環境         0     0     0     1     4     0     0    26     0     0
##  9 地方         0     0     0     0     0     1     0   240    11     0
## 10 社福人權     0     0     0     0     0     0     5    46     0     0

res_cluster %>% rename(link = name) %>% left_join(df_index_pts) %>% count(cluster)

## Joining with `by = join_by(link)`

## # A tibble: 10 × 2
##    cluster     n
##      <int> <int>
##  1       1   120
##  2       2    41
##  3       3     1
##  4       4    12
##  5       5    15
##  6       6    42
##  7       7     5
##  8       8  1211
##  9       9    52
## 10      10     1

df_word_count_pts <- df_main_pts_clean %>% count(link, text_segment, sort = TRUE) %>%
  anti_join(df_stop, by = c("text_segment" = "stopword"))

df_word_tfidf_pts <- df_word_count_pts %>%
  bind_tf_idf(text_segment, link, n)

sparse_matrixp_tfidf_pts <- 
  df_word_tfidf_pts %>%
  cast_sparse(link, text_segment, tf_idf)

kfit_tfidf <- kmeans(sparse_matrixp_tfidf_pts, centers = 10)

res_cluster_tfidf <- enframe(kfit_tfidf$cluster, value = "cluster")
res_cluster_tfidf %>% rename(link = name) %>% left_join(df_index_pts) %>%
  select(title, category, cluster) %>%
  count(category, cluster) %>% 
  arrange(cluster) %>%
  pivot_wider(names_from = cluster, values_from = n, values_fill = list(n = 0))

## Joining with `by = join_by(link)`

## # A tibble: 10 × 11
##    category   `1`   `2`   `3`   `4`   `5`   `6`   `7`   `8`   `9`  `10`
##    <chr>    <int> <int> <int> <int> <int> <int> <int> <int> <int> <int>
##  1 文教科技    62     0     1     0    67     0     0     0     0     0
##  2 生活         2     1     3     0   194    24     2     1     6     0
##  3 產經         0     5     0     0    39     1     0     0     0    22
##  4 社福人權     0     2     0     0    49     0     0     0     0     0
##  5 全球         0     0     0     9   344     0     0     1    16     0
##  6 兩岸         0     0     0     0    33     0     0     0     0     0
##  7 地方         0     0     0     0   247     1     0     0     4     0
##  8 政治         0     0     0     0   133    21     0     0     0     0
##  9 環境         0     0     0     0    24     0     0     0     7     0
## 10 社會         0     0     0     0   178     1     0     0     0     0

res_cluster %>% rename(link = name) %>% left_join(df_index_pts) %>% count(cluster)

## Joining with `by = join_by(link)`

## # A tibble: 10 × 2
##    cluster     n
##      <int> <int>
##  1       1   120
##  2       2    41
##  3       3     1
##  4       4    12
##  5       5    15
##  6       6    42
##  7       7     5
##  8       8  1211
##  9       9    52
## 10      10     1

res_cluster_tfidf %>% rename(link = name) %>% left_join(df_index_pts) %>% count(cluster)

## Joining with `by = join_by(link)`

## # A tibble: 10 × 2
##    cluster     n
##      <int> <int>
##  1       1    64
##  2       2     8
##  3       3     4
##  4       4     9
##  5       5  1308
##  6       6    48
##  7       7     2
##  8       8     2
##  9       9    33
## 10      10    22

上一篇
[Day 16] 利用R語言計算詞頻
下一篇
[Day 18] 利用R語言找詞彙關係 - bigram篇
系列文
用R語言玩轉文字探勘30
圖片
  直播研討會
圖片
{{ item.channelVendor }} {{ item.webinarstarted }} |
{{ formatDate(item.duration) }}
直播中

尚未有邦友留言

立即登入留言