total_episodes <- mod_data %>% 
  unite(season_ep, season, episode, remove = FALSE) %>% 
  summarise(num_episodes = n_distinct(season_ep)) %>% 
  as.integer()

total_episodes

## [1] 186

# proportion of episodes each character was in
episode_proportion <- mod_data %>% 
  unite(season_ep, season, episode, remove = FALSE) %>% 
  group_by(speaker) %>% 
  summarise(num_episodes = n_distinct(season_ep)) %>% 
  mutate(proportion = round((num_episodes / total_episodes) * 100, 1)) %>% 
  arrange(desc(num_episodes))

total_scenes <- mod_data %>% 
  unite(season_ep_scene, season, episode, scene, remove = FALSE) %>% 
  summarise(num_scenes = n_distinct(season_ep_scene)) %>% 
  as.integer()

# proportion of scenes each character was in 
scene_proportion <- mod_data %>% 
  unite(season_ep_scene, season, episode, scene, remove = FALSE) %>% 
  group_by(speaker) %>% 
  summarise(num_scenes = n_distinct(season_ep_scene)) %>% 
  mutate(proportion = round((num_scenes / total_scenes) * 100, 1)) %>% 
  arrange(desc(num_scenes))

Determining the Main Characters

For parts of my analysis, I wanted to look at the main characters, but beyond Michael, Dwight, Jim, and Pam, determining who the “main characters” are is a little challenging. There are lots of ancillary characters that lurk in the background or get their own plot lines later in the show. I defined the main characters based on % of lines for the entire series. I included a character as a main character if they had at least 1% of all the lines. Yes, this excludes characters like Nellie and Robert California who played larger roles late in the series, but I wasn’t a big fan of those seasons, so it’s ok.

line_proportion <- mod_data %>% 
  count(speaker) %>% 
  mutate(proportion = round((n / sum(n)) * 100, 1)) %>% 
  arrange(desc(n))

# define main characters based on line proportion
main_characters <- factor(line_proportion %>% 
                            filter(proportion >= 1) %>% 
                            pull(speaker) %>% 
                            fct_inorder()
                          )

Now that we have the main characters defined, we can look at the the percent of lines each character had over the 9 seasons of the show.

line_proportion_by_season <- mod_data %>% 
  group_by(season) %>% 
  count(speaker) %>% 
  mutate(proportion = round((n / sum(n)) * 100, 1)) %>% 
  arrange(season, desc(proportion))

line_proportion_over_time <- line_proportion_by_season %>% 
  filter(speaker %in% main_characters) %>% 
  ggplot(aes(x = season, y = proportion, color = speaker, label = proportion)) +
  geom_point(size = 2) +
  geom_line() +
  scale_x_continuous(breaks = seq(1, 9, 1)) +
  theme_minimal() +
  theme(legend.position = "none") +
  labs(y = "% of lines", 
       title = "% of Lines by Season") +
  theme(plot.title = element_text(hjust = 0.5)) +
  facet_wrap(~ factor(str_to_title(speaker), levels = str_to_title(main_characters)), ncol = 3) +
  geom_text(vjust = -1.2, size = 3.5) +
  ylim(0, 50) +
  scale_color_manual(values = office_colors)
  

line_proportion_over_time

Word Frequencies

I’ll start by tokenizing the text into words, removing the standard stop words (very common words that only add noise to the analysis), and plotting the most frequent words.

tidy_tokens <- mod_data %>%
  select(line = id, line_text_mod, everything(), -line_text, -actions, -deleted) %>% 
  unnest_tokens(word, line_text_mod, strip_numeric = TRUE) %>%
  mutate_at(vars(word), funs(str_replace_all(., "'s$", ""))) 

tidy_tokens_no_stop <- tidy_tokens %>% 
  anti_join(stop_words, by = "word")

Looking at the most frequent words revealed words like “yeah”, “hey”, “uh”, “um”, “huh”, “hmm”, and “ah.” I’m going to add these to the stop words and remove them from the analysis.

custom_stop_words <- bind_rows(data_frame(word = c("yeah", "hey", "uh", "um", "huh", "hmm", "ah", "umm", "uhh", "gonna", "na", "ha", "gotta"), 
                                          lexicon = c("custom")), 
                               stop_words)

tidy_tokens_no_stop <- tidy_tokens %>% 
  anti_join(custom_stop_words, by = "word")

After I removed those stop words, I was interested in looking at word frequencies by character.

“Michael” is the most frequently used word for almost all of the characters. Given he is the main character and interacts with everyone that isn’t too surprising. A lot of characters use the words “time”, “god”, “guy(s)”, “love”, and “office” frequently. The word “party” is used frequently by Angela and Phyllis because they are on the party planning committee.

These word frequencies are interesting, but we see a lot of the same words used by different characters. If we want to understand the words that are unique to each character, we can use tf-idf. The tf-idf is defined as term frequency (tf) multiplied by inverse document frequency (idf). This gives us a measure of how unique a word is to a given character. Calculating tf-idf attempts to find the words that are important (i.e., common) for a given character, but not too common across all characters.

tidy_tokens_tf_idf <- tidy_tokens %>%
  count(speaker, word, sort = TRUE) %>%
  ungroup() %>% 
  filter(speaker %in% main_characters) %>% 
  bind_tf_idf(word, speaker, n)

This is amazing and fun to see! There are so many good character nuances revealed. A lot of characters’ children show up here “Cece” (Pam), “Astrid” (Jan), “Melissa” (Stanley), “Phillip” (Angela), etc. There are also several love interests that appear. We also see that lyrics from Angela’s favorite Christmas song Little Drummer Boy bubble to the top as well as her love of cats. Pam’s work as an artist shows with the words “mural”, “paint”, and “defaced” (the mural was defaced). Kevin’s love of M&Ms is shown. “Ethics” and “ethical” indicate Holly’s work in HR. Overall, this gives us some good insight into each character’s quirks.

Now that we’ve discovered differences between characters, let’s look at similarities. How correlated are the word frequencies between each character of The Office?

frequency_by_character <- tidy_tokens_no_stop %>%
  filter(speaker %in% main_characters) %>% 
  count(speaker, word, sort = TRUE) %>% 
  group_by(speaker) %>% 
  mutate(proportion = n / sum(n)) %>% 
  select(-n) %>% 
  spread(speaker, proportion) 

cor_all <- corr.test(frequency_by_character[, -1], adjust = "none")
cor_plot <- ggcorrplot(cor_all[["r"]], 
                       hc.order = TRUE, 
                       type = "lower",
                       method = "circle",
                       colors = c("#E46726", "white", "#6D9EC1"),
                       lab = TRUE,
                       lab_size = 2.5)

cor_plot

I was a little surprised to find that the two characters who’s words are most correlated are Dwight and Pam. Michael and Jim are a close second.

Jan and Darryl had the least similar vocabularies.

Given this info, I wanted to see which words Dwight and Pam shared.

pam_dwight_words <- frequency_by_character %>% 
  select(word, pam, dwight) %>% 
  ggplot(aes(x = pam, y = dwight, color = abs(pam - dwight), label = word)) +
  geom_abline(color = "gray40", lty = 2) +
  geom_jitter(alpha = 0.1, size = 2.5, width = 0.3, height = 0.3) +
  scale_x_log10(labels = percent_format()) +
  scale_y_log10(labels = percent_format()) +
  labs(x = "Pam",
       y = "Dwight",
       title = "Word Frequncy Comparison: Dwight and Pam") +
  theme(legend.position = "none")

ggplotly(pam_dwight_words, tooltip = c("word"))