<p><div><div><div><div data-show-faces="false" data-height="21" data-width="100" data-layout="button_count" data-send="true" data-href="https://www.r-bloggers.com/tidy-word-vectors-take-2/"></div></div><div></div></div><div></div></div>
<div>
(This article was first published on <strong><a href="https://juliasilge.com/blog/word-vectors-take-two/"> Rstats on Julia Silge</a></strong>, and kindly contributed to <a rel="nofollow" href="https://www.r-bloggers.com/">R-bloggers)</a> </div>
<p>A few weeks ago, I wrote a post about finding <a rel="nofollow" href="https://juliasilge.com/blog/tidy-word-vectors/" target="_blank">word vectors using tidy data principles</a>, based on an approach outlined by Chris Moody on the <a rel="nofollow" href="http://multithreaded.stitchfix.com/blog/2017/10/18/stop-using-word2vec/" target="_blank">StitchFix tech blog</a>. I’ve been pondering how to improve this approach, and whether it would be nice to wrap up some of these functions in a package, so here is an update!</p>
<p>Like in my previous post, let’s download half a million posts from the <a rel="nofollow" href="https://cloud.google.com/bigquery/public-data/hacker-news" target="_blank">Hacker News corpus</a> using the <a rel="nofollow" href="https://cran.r-project.org/package=bigrquery" target="_blank">bigrquery</a> package.</p>
<pre><code>library(bigrquery)
library(tidyverse)

sql &lt;- &quot;#legacySQL
SELECT
  stories.title AS title,
  stories.text AS text
FROM
  [bigquery-public-data:hacker_news.full] AS stories
WHERE
  stories.deleted IS NULL
LIMIT
  500000&quot;

hacker_news_raw &lt;- query_exec(sql, project = project, max_pages = Inf)</code></pre>
<p>And then let’s clean the text and make a data frame containing only the text, plus an ID to identify each “document”, i.e., post.</p>
<pre><code>library(stringr)

hacker_news_text &lt;- hacker_news_raw %>%
    as_tibble() %>%
    mutate(title = na_if(title, &quot;&quot;),
           text = coalesce(title, text)) %>%
    select(-title) %>%
    mutate(text = str_replace_all(text, &quot;'|&quot;|/&quot;, &quot;'&quot;),   ## weird encoding
           text = str_replace_all(text, &quot;&lt;a(.*?)>&quot;, &quot; &quot;),               ## links 
           text = str_replace_all(text, &quot;>|&lt;|&amp;&quot;, &quot; &quot;),        ## html yuck
           text = str_replace_all(text, &quot;&amp;#[:digit:]+;&quot;, &quot; &quot;),          ## html yuck
           text = str_replace_all(text, &quot;&lt;[^>]*>&quot;, &quot; &quot;),                ## mmmmm, more html yuck
           postID = row_number())</code></pre>
<div>
<h2>Sliding windows</h2>
<p>Starting from here is where my approach has changed a bit. Instead of using the <code>unnest_tokens()</code> function a total of three times to find the skipgrams, here I only use <code>unnest_tokens()</code> once, and then use a function <code>slide_windows()</code> to identify the skipgram windows.</p>
<pre><code>slide_windows &lt;- function(tbl, doc_var, window_size) {
    # each word gets a skipgram (window_size words) starting on the first
    # e.g. skipgram 1 starts on word 1, skipgram 2 starts on word 2
    
    each_total &lt;- tbl %>% 
        group_by(!!doc_var) %>% 
        mutate(doc_total = n(),
               each_total = pmin(doc_total, window_size, na.rm = TRUE)) %>%
        pull(each_total)
    
    rle_each &lt;- rle(each_total)
    counts &lt;- rle_each[[&quot;lengths&quot;]]
    counts[rle_each$values != window_size] &lt;- 1
    
    # each word get a skipgram window, starting on the first
    # account for documents shorter than window
    id_counts &lt;- rep(rle_each$values, counts)
    window_id &lt;- rep(seq_along(id_counts), id_counts)

    
    # within each skipgram, there are window_size many offsets
    indexer &lt;- (seq_along(rle_each[[&quot;values&quot;]]) - 1) %>%
        map2(rle_each[[&quot;values&quot;]] - 1,
             ~ seq.int(.x, .x + .y)) %>% 
        map2(counts, ~ rep(.x, .y)) %>%
        flatten_int() +
        window_id
    
    tbl[indexer, ] %>%
        bind_cols(data_frame(window_id)) %>%
        group_by(window_id) %>%
        filter(n_distinct(!!doc_var) == 1) %>%
        ungroup
}</code></pre>
<p>This allows us to get to a tidy data frame with <a rel="nofollow" href="https://en.wikipedia.org/wiki/Pointwise_mutual_information" target="_blank">PMI values</a> for each pair of words. This PMI value is what tells us whether words likely to occur together or unlikely to occur together. I also was smarter and put the <code>filter()</code> to remove very rare words before trying to identifying skipgrams. In this example, a word has to be used 20 times (overall, in the 500,000 posts) to be included.</p>
<pre><code>library(tidytext)
library(widyr)

tidy_pmi &lt;- hacker_news_text %>%
    unnest_tokens(word, text) %>%
    add_count(word) %>%
    filter(n >= 20) %>%
    select(-n) %>%
    slide_windows(quo(postID), 8) %>%
    pairwise_pmi(word, window_id)

tidy_pmi</code></pre>
<pre><code>## # A tibble: 30,853,734 x 3
##    item1 item2     pmi
##    </code></pre></div>