How Many Words Do You Need to Know to Watch Friends?

Data Collection

The script of every episode of Friends is available at https://fangj.github.io/friends/. I used rvest to download every file, and parsed the scripts into individual lines. I only wanted to have to do this once, so I saved the results to a CSV file so that subsequent analyses wouldn’t have to redownload all of the data.

library(tidyverse)
library(rvest)

pages <- read_html("https://fangj.github.io/friends/") %>%
  html_nodes("a") %>%
  html_attr("href")

pages <- str_c("https://fangj.github.io/friends/", pages)

parse_episode <- function(url) {
  read_html(url) %>%
    html_nodes("p:not([align=center])") %>%
    .[-1] %>%
    html_text() %>%
    enframe(name = NULL, value = "line") %>%
    mutate(
      url = url,
      episode = str_extract(url, "\\d{4}"), # extract episode number
      character = str_extract(line, "^(\\w+):"), # extract character name
      character = str_replace_all(character, ":$", ""),
      line = str_replace_all(line, "^\\w+: ", ""),
    ) %>%
    filter(line != "")
}

friends_raw <- pages %>% map(parse_episode) %>%
  bind_rows()

write_csv(friends_raw, "./friends.csv")

This yields a raw dataset with the lines from every episode:

head(friends_raw, n = 10) %>%
  select(episode, character, line) %>%
  gt::gt()

Cleaning

First, there are some lines that give stage directions which we want to filter out of the dataset, since we are only interested in spoken words. There are also directions given sometimes within a character’s line, which we want to filter.

friends <- friends_raw %>%
  mutate(
    line = str_replace_all(line, "[\u0091\u0092]", "'"),
    line = str_replace_all(line, "\u0097", "-"),
    line = str_replace_all(line, "\\([\\w\n [[:punct:]]]+\\)", ""),
    line = str_replace_all(line, "\\[[\\w\n [[:punct:]]]+\\]", ""),
    line = str_trim(line)
  ) %>%
  filter(line != "")

head(friends, n = 10) %>%
  select(episode, character, line) %>%
  gt::gt()

Now we transform our data from a set of lines from every script into a format that is more useful for analysis. Using tidytext, we generate a new table that has every word from the corpus and how many times it was used. We also calculate cumulative sums and proportions.

# Counts how many times each word
# appears, sorts by number of appearances,
# and adds cumulative proportions
add_cumulative_stats <- function(x) {
  x %>%
    count(word, sort = TRUE) %>%
    mutate(cumsum = cumsum(n),
           cumprop = cumsum / sum(n),
           index = 1:n())
}

library(tidytext)

words <- friends %>%
  unnest_tokens(word, line)

word_counts <- add_cumulative_stats(words)

word_counts %>%
  head(n = 10) %>%
  gt::gt()

From the cumulative proportions in the table we can see that knowing the top 10 words covers around 20% of all the words in the dataset.

This is a good start, but it’s not quite what we want. Right now the data includes grammatical variations of the same word as different words. For example, “age” and “ages” really represent the same word, but the graph above includes them as two separate words. As such, the data we have so far overestimates the number of unique words that appear in Friends.

Lemmatizing algorithms try to map every grammatical variation of a word to a “stem”. For example, the words “go”, “going”, and “went” should map to the stem “go”. Stemming algorithms are related, but work by removing suffixes from the ends of words. A stemming algorithm wouldn’t know to map “went” to “go”; for that, we need lemmatization, which uses dictionaries to reverse the inflected forms of words to its grammatical root. The package textstem provides a lemmatize_words function in R.

library(textstem)

word_lemmas <- words %>%
  mutate(word = lemmatize_words(word))

word_lemma_counts <- add_cumulative_stats(word_lemmas)

There are 11,852 words after lemmatization, compared to 15,134 before.

word_lemma_counts %>%
  head(n = 10) %>%
  gt::gt()

The top 10 words are the same, but the cumulative proportions have changed since there are fewer words overall. Now knowing the top 10 words covers about 23% of all words.

A helper function helps compute how many words we need to know to cover a certain percentage of the total:

# How many words do you need to know prop% of all words?
words_for_prop <- function(x, prop) {
  x %>% filter(cumprop > prop) %>% pull(index) %>% first()
}

words_for_prop_result <- tibble(
  prop = c(0.98, 0.95, 0.9, 0.5),
  words = map_int(prop, function(x) words_for_prop(word_lemma_counts, x))
)

words_for_prop_result %>%
  gt() %>%
  fmt_percent(columns = vars(prop), decimals = 0) %>%
  fmt_number(columns = vars(words), use_seps = TRUE, decimals = 0) %>%
  cols_label(prop = "Cumulative percentage", words = "Number of words")

Using the helper function, we can make a graph of the cumulative distribution of words with cutoffs at 50%, 90%, and 95%:

word_lemma_counts %>%
  ggplot(aes(x = index, y = cumprop * 100)) +
  geom_line(color = "#2980b9", size = 1) +
  geom_segment(aes(x = words, xend = words, y = 0, yend = prop * 100), lty = 2, data = words_for_prop_result, color = "#2c3e50") +
  geom_segment(aes(x = 0, xend = words, y = prop * 100, yend = prop * 100), lty = 2, data = words_for_prop_result, color = "#2c3e50") +
  geom_point(aes(x = words, y = prop * 100), data = words_for_prop_result, color = "white", size = 3) +
  geom_point(aes(x = words, y = prop * 100), data = words_for_prop_result, color = "#2c3e50", size = 2) +
  labs(x = "Words ordered by frequency", y = "Cumulative percentage") +
  cowplot::theme_cowplot() +
  scale_y_continuous(labels = function(x) paste0(x, "%"), breaks = c(0, 25, 50, 75, words_for_prop_result$prop * 100), expand = c(0.01, 0.01)) +
  scale_x_continuous(breaks = c(words_for_prop_result$words, 7500, 10000), expand = c(0.01, 0.01)) +
  my_theme +
  ggtitle("You need to know around 750 words to know 90%\nof all the words used in Friends") +
  labs(caption = "Analysis: Herb Susmann, transcripts: https://fangj.github.io/friends/")

Appendix: top 750 words

word_lemma_counts %>%
  mutate(`cumulative proportion` = scales::percent_format(0.01)(cumprop)) %>%
  select(index, n, word, `cumulative proportion`) %>%
  head(n = 750) %>%
  reactable()