Session 5: Word embeddings

This notebook represents words as numerical vectors, finds similar words, and explores word-vector arithmetic. It can run independently of the topic-modeling notebook. It preserves the original notebook’s author-gender filtering so that Word2Vec is trained on the same subset of articles as in the source workflow.

Setup and data

Install the required packages once if necessary:

install.packages(c("word2vec", "dplyr", "readr"))

library(word2vec)
library(dplyr)

Attaching package: 'dplyr'

The following objects are masked from 'package:stats':

    filter, lag

The following objects are masked from 'package:base':

    intersect, setdiff, setequal, union

library(readr)

# Support running from either the project folder or the Session_8 folder.
data_candidates <- c("../../Data/S5_pass_to_R.csv", "Data/S5_pass_to_R.csv")
data_file <- data_candidates[file.exists(data_candidates)][1]
if (is.na(data_file)) {
  stop("Cannot find S5_pass_to_R.csv. Set data_file to its location.")
}
df <- read_csv(data_file)

Rows: 2080 Columns: 3

── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
chr (2): text, author
dbl (1): doc_id

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

stopifnot(all(c("text", "author") %in% names(df)))
cat("Articles loaded:", nrow(df), "\n")

Articles loaded: 2080 

The data is a collection of WSJ articles from 2008, with one article per row. Only the retained articles’ text is passed into Word2Vec.

Train word embeddings

Word2Vec learns from words appearing in nearby contexts. Here we retain the original example’s skip-gram model, 25 dimensions, 10 training iterations, and minimum word count of 5. We use one thread to reduce run-to-run variability. Word spelling and case matter when looking up a word.

set.seed(420)
w2v <- word2vec(
  x = df$text,
  dim = 25,
  type = "skip-gram",
  iter = 10,
  min_count = 5,
  threads = 1
)
embeddings <- as.matrix(w2v)
cat("Vocabulary size:", nrow(embeddings), "\n")

Vocabulary size: 15982 

cat("Dimensions per word:", ncol(embeddings), "\n")

Dimensions per word: 25 

embeddings[seq_len(min(5, nrow(embeddings))), 1:5, drop = FALSE]

         [,1]      [,2]       [,3]        [,4]        [,5]
127 1.0471439 0.1482290 -0.9696144 -0.06138757  0.78077549
135 0.8499867 0.3766892 -0.4424438  0.40870512 -0.06939038
155 1.4078770 0.4225004 -1.7015808  0.60066700  0.85233474
157 1.2070613 0.3403103 -1.6833649 -0.62221533  0.87710488
162 1.4141073 0.3697149 -0.3112086  0.50140256  1.28740203

Each row is a word and each column is a learned coordinate. Individual coordinates do not have predefined labels such as “finance” or “technology”.

Find similar words

The nearest words are those whose vectors are most similar to a query vector. These results reflect patterns in this training sample, rather than a dictionary definition of synonyms. Words excluded by the minimum count cannot be queried.

show_nearest <- function(model, vocabulary, queries, top_n = 5) {
  available <- queries[queries %in% vocabulary]
  missing <- setdiff(queries, available)
  if (length(missing)) {
    cat("Not in this model's vocabulary:", paste(missing, collapse = ", "), "\n")
  }
  if (length(available)) {
    print(predict(model, newdata = available, type = "nearest", top_n = top_n))
  }
}
show_nearest(w2v, rownames(embeddings), c("WSJ", "King"))

$WSJ
  term1     term2 similarity rank
1   WSJ    Editor  0.9838734    1
2   WSJ   Letters  0.9829346    2
3   WSJ       See  0.9772296    3
4   WSJ Threshold  0.9505247    4
5   WSJ        ed  0.9425592    5

$King
  term1    term2 similarity rank
1  King       Jr  0.9335802    1
2  King   Stefan  0.9161370    2
3  King Fernando  0.9108415    3
4  King    Grace  0.9100209    4
5  King   Claude  0.9059697    5

Word-vector arithmetic

The original example asks whether the relationship between Xbox and Microsoft can be transferred to Sony: Xbox - Microsoft + Sony. A successful analogy might return a Sony gaming product, but a small corpus may not learn this relationship well. The code reports the actual nearest words without assuming the analogy succeeds.

show_analogy <- function(model, vectors) {
  words <- c("Xbox", "Microsoft", "Sony")
  missing <- setdiff(words, rownames(vectors))
  if (length(missing)) {
    cat("Analogy skipped; missing words:", paste(missing, collapse = ", "), "\n")
  } else {
    vector <- vectors["Xbox", ] - vectors["Microsoft", ] + vectors["Sony", ]
    print(predict(model, newdata = vector, type = "nearest", top_n = 10))
  }
}
show_analogy(w2v, embeddings)

          term similarity rank
1      console  0.9996341    1
2     Portable  0.9929214    2
3  PlayStation  0.9889998    3
4     consoles  0.9848762    4
5           DS  0.9717980    5
6         Live  0.9654137    6
7      segment  0.9631830    7
8          Wii  0.9482903    8
9    Macintosh  0.9433517    9
10        Sony  0.9429674   10

Optional: use pretrained Google News vectors

The original lesson also uses a model trained on a much larger corpus. This section is disabled by default, so the notebook runs with just the supplied CSV. To enable it, obtain and decompress GoogleNews-vectors-negative300.bin using the download link supplied in the original lesson. Set its path below and change run_pretrained to TRUE. Loading the full model and converting it to a matrix requires substantial memory.

run_pretrained <- FALSE
word2vec_file <- "../Data/GoogleNews-vectors-negative300.bin"

if (!file.exists(word2vec_file)) stop("Set word2vec_file to the downloaded .bin file.")
model_w2v <- read.word2vec(file = word2vec_file, normalize = TRUE)
embeddings2 <- as.matrix(model_w2v)
show_nearest(model_w2v, rownames(embeddings2), c("WSJ", "King"))
show_analogy(model_w2v, embeddings2)

Compare the nearest words and the analogy results with those from the WSJ model. The models differ in training corpus and dimensionality, so differences cannot be attributed to corpus size alone.