詞嵌入模型

詞嵌入模型簡介

想像一下，你有一堆文字，比如說一篇文章、一個推文或一個評論。你的目標是讓電腦理解這些文字中的意義或情感，但問題是，電腦不懂語言，它只懂數字。那該怎麼辦？

這就是「詞嵌入」派上用場的時候。詞嵌入其實就是一種把文字或詞語轉換成數字（更確切地說，是數字向量）的技術。

詞嵌入模型，或稱詞向量模型，英文是 word embeddings，前面說它是一種將「文字」轉換為「向量」的技術，聽起來很簡單，但當初發想這個概念的人實在是天才，因為將文字化為向量之後，在數值化的同時，還能保留詞彙之間的關係，換句話說，這些數字不只告訴你詞是什麼，還能告訴你這個詞「感覺」像什麼。這樣很厲害的點在於，詞嵌入模型不像前面提過的 one-hot encodings 一樣缺乏詞義、僅代表「有」或「沒有」，所以很驚人。

我們倒退回去 one-hot encodings 一下，每個詞彙通常會用一個 ID 表示，例如「狗」的 ID 是 001、「狗」的 ID 是 002。這種表示方式很好懂，所以之前都會用，但它的問題在於，沒辦法「理解」詞彙之間的語義，所以我們不會知道其實貓跟狗相似、巴黎跟倫敦也相似。

詞嵌入模型的出現，就解決了上面的問題。透過學習大量語料庫中的詞語上下文，將單詞映射（mapping）到一個連續的向量空間中。在這個向量空間中，相似的單詞將會被映射到接近的向量。例如巴黎跟倫敦的向量可能會比較接近，但巴黎跟狗的向量可能會比較遠。我們會說，詞嵌入模型掌握到了上下文（context）的概念，不再只是單純的詞彙與數值的轉換而已。

歸結一下，詞嵌入模型的優點包含：提高文字處理的效率和準確性、將文字轉換為可以進行數學運算的向量、更好地理解文字的語義。具體應用包含文本分類、語言翻譯、相似文章推薦等。舉例來說，以前很紅的Yahoo知識+（不知道現在還有沒有人記得）在做相似問答推薦的時候，就有利用詞嵌入模型掌握到的相似性（similarity），拿來推薦相似的問題。

詞嵌入模型演算法有word2vec、GloVe、FastText、ELMo等，在R語言裡面基本上都有對應的套件。

詞嵌入模型 - word2vec

word2vec 有兩種主要的演算法：Skip-gram 和 Continuous Bag-of-Words(CBOW)。

其中，Skip-gram 模型的目標是給定一個詞，我們希望預測它周圍的「上下文」詞是哪些。舉例來講說，如果我們有一句話「狗喜歡玩球」，並且我們專注於詞「喜歡」，那麼「狗」和「玩球」就是它的上下文。

在訓練過程中，模型會看過數百萬甚至數億的這種「詞-上下文」配對，然後試圖調整自己的參數，讓自己對這些配對的預測越來越準確。最終，每個詞會被轉換成一個多維的向量，這個向量捕捉了詞的語義資訊，像是它和哪些詞會出現在一起，或者它一般出現在什麼樣的語境中。

這個方法特別有用，因為一旦我們有了這些詞向量，就可以用它們做各種有趣的事，比如找同義詞、反義詞，或者甚至解題（像是「國王 - 男人 + 女人 = ?」，答案通常會是「女王」），類似還有首都與國家的關係，這些都是當年開發者寫論文時，提出的經典案例，震懾無數人，包含我也是。

library(tidyverse)
library(jiebaR)
library(word2vec)

df_article <- read_rds("data/df_main_pts_daily.rds")
df_article_clean <- df_article %>% mutate(text = str_remove_all(text, " |\\n|\\r|\\t")) %>% select(id, text)

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

## [1] TRUE

### text part
df_speech_seg <-
  df_article_clean %>% 
  mutate(text = str_replace_all(text, "台灣|臺灣", "臺灣")) %>%
  mutate(text = str_replace_all(text, "台北", "臺北")) %>%
  mutate(text = str_replace_all(text, "台南", "臺南")) %>%
  mutate(text = str_replace_all(text, "台東", "臺東")) %>%
  mutate(text = str_replace_all(text, "台中", "臺中")) %>%
  mutate(text = str_remove_all(text, "\\n|\\r|\\t|:| |　")) %>%
  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)

df_speech_word <- df_speech_seg %>% 
  group_by(id) %>% summarise(text = str_c(text_segment, collapse = " ")) %>% ungroup()

model <- word2vec(x = df_speech_word$text, type = "skip-gram", dim = 30, iter = 20)
embedding <- as.matrix(model)

predict(model, c("冠軍"), type = "nearest", top_n = 5)

## $冠軍
##   term1  term2 similarity rank
## 1  冠軍   勇奪  0.8726106    1
## 2  冠軍   名將  0.8717875    2
## 3  冠軍   身穿  0.8679892    3
## 4  冠軍   奪冠  0.8586430    4
## 5  冠軍 女子組  0.8558021    5

predict(model, c("金牌"), type = "nearest", top_n = 5)

## $金牌
##   term1 term2 similarity rank
## 1  金牌  銀牌  0.9740679    1
## 2  金牌  銅牌  0.9640620    2
## 3  金牌  亞運  0.9637836    3
## 4  金牌  奪銀  0.9597933    4
## 5  金牌  賽場  0.9541985    5

predict(model, c("臺北"), type = "nearest", top_n = 5)

## $臺北
##   term1 term2 similarity rank
## 1  臺北  市長  0.8864887    1
## 2  臺北    蔣  0.8475839    2
## 3  臺北  萬安  0.8460474    3
## 4  臺北  新北  0.8398754    4
## 5  臺北    北  0.8328343    5

predict(model, c("臺灣"), type = "nearest", top_n = 5)

## $臺灣
##   term1    term2 similarity rank
## 1  臺灣 中華民國  0.9085380    1
## 2  臺灣     接納  0.8776224    2
## 3  臺灣     斷交  0.8717421    3
## 4  臺灣     恩史  0.8489305    4
## 5  臺灣     國際  0.8459195    5

library(uwot)
library(ggrepel)

viz <- umap(embedding, n_neighbors = 15, n_threads = 2)

df <- tibble(word = rownames(embedding), 
             x = viz[, 1], y = viz[, 2]) %>% head(20)

ggplot(df, aes(x = x, y = y, label = word)) + 
  geom_text_repel(family = "Noto Sans TC Medium") + theme_void() + 
  labs(title = "word2vec - adjectives in 2D using UMAP") +
  theme(text = element_text(family = "Noto Sans TC Medium"))