The Great Library Heist

Solutions

library(tidyverse)
library(tidytext)
library(topicmodels)
library(kableExtra)
dta <- readRDS(here::here("data/heist_books.rds"))

The crime

Case briefing

Late last night, someone broke into the library and went mad!

• An unknown number of books were taken from their shelves.
• Their spines were cut and every page torn loose.
• The pieces were shuffled together and dumped into a single evidence box.
• The covers and title pages are gone.
• Nobody knows which scrap came from which book, how many books were taken, or what the books are.

Your assignment

You have no witnesses and no confession. All you have is the words the books left behind. Your goal is to:

1. Work out how many books were stolen.
2. Return every scrap to its book.
3. Name each book.

Rules of the investigation

Rules

• Your research team is your detective squad.
• Every claim needs evidence you produced in R.
• You must keep your own evidence log (quarto file). You’ll be asked to divide up the work later and everyone should be at the same point. Write notes in here as well, you’ll turn it in at the end of the investigation.
• No outside tips. No search engines or chatbots on the scraps. That’s tampering with evidence.
• You can talk to the tech team (aka google, your notes or our helper page) to ask for help with code functions.
• This is a friendly competition, no rules against helping other squads. But… there has to be a winner.

The evidence box will self destruct in T-1 hour.

Clues

• The lead detectives (Dr. D and Amy) have 6 clues available for you during this investigation.
• Clue #1 is already provided in these instructions. Bring your answer and your code to one of the lead detectives.
• If it’s right, you get a lead for your next step, and the next Clue.
• Each Clue correctly solved earns your squad 1 point toward your homework grade.
• First team to correctly name the books gets a bonus point.
• An answer without cold hard code evidence to back it doesn’t count.

The investigation

Phase 0: Name your squad

Sign your squad into the crime scene by logging your name with the lead investigators.

Phase 1: Secure the scene

Before touching anything, take inventory of the evidence box.

• What is a single row? What columns came with it?
• How are scraps labeled?

ImportantClue #1

How many exhibits are in the evidence box, and what are the fewest and the most scraps any one exhibit holds? What part of a book do you think an exhibit is?

Key: Clue 1 Reasonable code includes:

(exhibit_sizes <- dta |> count(exhibit))

# A tibble: 159 × 2
   exhibit     n
   <chr>   <int>
 1 EX-103    223
 2 EX-118    438
 3 EX-139    278
 4 EX-140     84
 5 EX-159    370
 6 EX-170    483
 7 EX-176    353
 8 EX-178    342
 9 EX-182    263
10 EX-183    416
# ℹ 149 more rows

nrow(exhibit_sizes)

[1] 159

exhibit_sizes |> arrange(n) |> head(3)

# A tibble: 3 × 2
  exhibit     n
  <chr>   <int>
1 EX-742     39
2 EX-628     60
3 EX-573     64

exhibit_sizes |> arrange(desc(n)) |> head(3)

# A tibble: 3 × 2
  exhibit     n
  <chr>   <int>
1 EX-313    655
2 EX-989    593
3 EX-201    586

Clue #1 answer: 159 exhibits, holding from 39 to 655 scraps each. Accept any reasonable guess for what an exhibit is (a chapter, a section, a stack of pages).

Lead: An exhibit is one chapter of one book. Every scrap in an exhibit comes from the same book.

Phase 2: Dust for prints

A whole scrap is too big to compare. Break the evidence into the smallest pieces that still carry a fingerprint: individual words.

• Split every line so each row holds one word, still tagged with its exhibit number.
• Some filler words appear everywhere (“the,” “and,” “of”). They don’t provide us information, so clear them out.

ImportantClue #2

After the filler is cleared, which word appears most often in the whole box, and how many times?

Key: Clue 2. Choices made: lowercase (unnest_tokens() default), tidytext::stop_words as the filler list.

tidy_words <- dta |>
  unnest_tokens(word, text) |>
  anti_join(stop_words, by = "word")

word_totals <- tidy_words |> count(word, sort = TRUE)
head(word_totals, 10)

# A tibble: 10 × 2
   word           n
   <chr>      <int>
 1 time        1027
 2 night        706
 3 joe          688
 4 day          647
 5 captain      636
 6 looked       617
 7 hand         593
 8 _nautilus_   507
 9 eyes         502
10 miss         447

Clue #2 answer: “time” is used 1027 times.

Lead: Count each word within each exhibit, not across the whole box. Then rearrange the counts into a grid: one row per exhibit, one column per word, the count in each cell. This grid is the format a profiler needs.

Phase 3: Build the evidence board

Pin every exhibit to the wall and record how often each word shows up in it.

ImportantClue #3

How many rows and columns does your evidence board have, and what percent of its cells are empty?

Key: Clue 3

word_counts <- tidy_words |> count(exhibit, word)

heist_dtm <- word_counts |> cast_dtm(exhibit, word, n)
heist_dtm

<<DocumentTermMatrix (documents: 159, terms: 19640)>>
Non-/sparse entries: 106994/3015766
Sparsity           : 97%
Maximal term length: 19
Weighting          : term frequency (tf)

Clue #3 Answer: 159 rows, 19,380 columns, 97% sparsity.

Lead: the profiler is the topic model from class, LDA(). The grid goes in, along with the number of sources. The seed goes in control, and each squad member should use a different seed (but consistently across runs). Run it several times, each with a different number of sources, and compare the runs.

Phase 4: Call in the profiler, size up the crew

You need an expert who has never seen these books.

• The profiler assumes each exhibit is a blend of a fixed number of hidden sources, each with its own favorite vocabulary.
• It works out both from the evidence board alone.
• It needs one thing from you: how many sources to look for. Nobody knows that yet.
• Run the profiler several times, each with a different number of sources.
• The profiler is slow and can get side tracked. Divide the work across your squad to check for consistency in profiler results.
• Ensure reproducibility so your profile can be reproduced in court.

ImportantClue #4

How many books were vandalized? Defend your number with evidence comparing at least three different proposed sources and two different profilers.

Key: Clue 4. The minimum Clue #4 asks for: 3, 4 and 5 sources, each fit with two different seeds. This assumes 4 books, so shift the range if the book list changes.

lda3a <- LDA(heist_dtm, k = 3, control = list(seed = 1234))
lda3b <- LDA(heist_dtm, k = 3, control = list(seed = 4321))

lda4a <- LDA(heist_dtm, k = 4, control = list(seed = 1234))
lda4b <- LDA(heist_dtm, k = 4, control = list(seed = 4321))

lda5a <- LDA(heist_dtm, k = 5, control = list(seed = 1234))
lda5b <- LDA(heist_dtm, k = 5, control = list(seed = 4321))

Top 8 words per source, for each run:

tidy(lda3a, matrix = "beta") |>
  group_by(topic) |>
  slice_max(beta, n = 8) |>
  summarize(top_words = paste(term, collapse = ", ")) 

# A tibble: 3 × 2
  topic top_words                                                
  <int> <chr>                                                    
1     1 time, night, van, helsing, day, dear, hand, door         
2     2 captain, _nautilus_, sea, nemo, ned, water, conseil, land
3     3 joe, miss, time, pip, looked, herbert, don’t, hand       

tidy(lda3b, matrix = "beta") |>
  group_by(topic) |>
  slice_max(beta, n = 8) |>
  summarize(top_words = paste(term, collapse = ", ")) 

# A tibble: 3 × 2
  topic top_words                                                
  <int> <chr>                                                    
1     1 time, night, van, helsing, day, door, hand, eyes         
2     2 joe, miss, time, looked, don’t, pip, herbert, hand       
3     3 captain, _nautilus_, sea, nemo, ned, conseil, water, land

tidy(lda4a, matrix = "beta") |>
  group_by(topic) |>
  slice_max(beta, n = 8) |>
  summarize(top_words = paste(term, collapse = ", ")) 

# A tibble: 4 × 2
  topic top_words                                                
  <int> <chr>                                                    
1     1 time, van, helsing, night, dear, lucy, hand, day         
2     2 captain, _nautilus_, sea, nemo, ned, conseil, land, water
3     3 joe, miss, time, pip, looked, herbert, don’t, hand       
4     4 people, time, martians, night, black, road, water, heard 

tidy(lda4b, matrix = "beta") |>
  group_by(topic) |>
  slice_max(beta, n = 8) |>
  summarize(top_words = paste(term, collapse = ", ")) 

# A tibble: 4 × 2
  topic top_words                                                 
  <int> <chr>                                                     
1     1 people, martians, time, black, road, night, brother, water
2     2 joe, miss, time, pip, looked, don’t, herbert, hand        
3     3 captain, _nautilus_, sea, nemo, ned, conseil, water, land 
4     4 time, van, night, helsing, dear, lucy, hand, day          

tidy(lda5a, matrix = "beta") |>
  group_by(topic) |>
  slice_max(beta, n = 8) |>
  summarize(top_words = paste(term, collapse = ", "))

# A tibble: 5 × 2
  topic top_words                                                
  <int> <chr>                                                    
1     1 van, time, helsing, night, dear, lucy, hand, mina        
2     2 captain, _nautilus_, sea, nemo, ned, conseil, land, water
3     3 joe, miss, pip, time, looked, don’t, wemmick, havisham   
4     4 time, night, herbert, found, looked, round, day, heard   
5     5 people, martians, black, time, night, road, pit, smoke   

tidy(lda5b, matrix = "beta") |>
  group_by(topic) |>
  slice_max(beta, n = 8) |>
  summarize(top_words = paste(term, collapse = ", ")) 

# A tibble: 5 × 2
  topic top_words                                                 
  <int> <chr>                                                     
1     1 martians, people, black, time, road, night, brother, water
2     2 joe, miss, time, pip, looked, herbert, havisham, estella  
3     3 captain, _nautilus_, sea, nemo, ned, conseil, land, water 
4     4 time, van, helsing, night, lucy, dear, poor, day          
5     5 wemmick, jaggers, time, door, looked, night, don’t, found 

Clue #4 Answer: There are 4 books. With more than 4 sources, one book’s vocabulary is split across sources. Judge a squad’s comparison of runs, not just its number.

Lead: All of the books are public-domain novels from the 1800s. Sometimes a source mixes vocabularies from more than one book. The four vandalized books are among these eight suspects:

Title	Author	Year	Known for
Dracula	Bram Stoker	1897	Gothic horror
Frankenstein	Mary Shelley	1818	A scientist’s creation
Great Expectations	Charles Dickens	1861	A Victorian coming-of-age story
Jane Eyre	Charlotte Brontë	1847	A governess at a mysterious manor
Moby-Dick	Herman Melville	1851	A whale hunt
Treasure Island	Robert Louis Stevenson	1883	Pirates and buried treasure
Twenty Thousand Leagues under the Sea	Jules Verne	1870	An undersea voyage
The war of the worlds	H. G. Wells	1898	An alien invasion

Phase 5: Interrogate the suspects

Using your chosen number, the profiler scores every word under every source: how strongly that word belongs there.

• Pull out each source’s top 10 words.
• Plot all sources side by side.
• Look for places, objects, and activities. What kind of story does each vocabulary tell?

ImportantClue #5

Name every vandalized book. Cite the words that convinced you.

Key: Clue 5

heist_lda <- lda4a   # the run with the true number of books

top_words <- tidy(heist_lda, matrix = "beta") |>
  group_by(topic) |>
  slice_max(beta, n = 10) |>
  ungroup() |>
  arrange(topic, desc(beta))

top_words |>
  mutate(term = reorder_within(term, beta, topic)) |>
  ggplot(aes(beta, term, fill = factor(topic))) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ topic, scales = "free") +
  scale_y_reordered()

# the book behind each source, in source order (seed 1234)
source_names <- c("Dracula", "Twenty Thousand Leagues under the Sea",
                  "Great Expectations", "The war of the worlds")

Clue #5 answer: The correct titles are: “Dracula”, “Twenty Thousand Leagues under the Sea”, “Great Expectations”, “The war of the worlds”.

Lead: Each exhibit could be attributed to multiple sources. Explore the share of the exhibit that comes from each source. Using functions like slice_max() within each exhibit could be helpful here.

Lead: Here is some code to help you name your sources:

 mutate(book = factor(topic, levels = 1:4,
                       labels = c("Title for source 1",
                                  "Title for source 2",
                                  "Title for source 3",
                                  "Title for source 4")))

Lead: To get the exhibits with the top X strongest matches you would use code similar to the following:

bestX  <- best_match |> arrange(desc(gamma)) |> select(document) |> slice(1:X)

Phase 6: Attribute the exhibits to the most likely source

The profiler also scores every exhibit: what share of it seems to come from each source.

• For each exhibit, find the source with the largest share. That’s your best match.

ImportantClue #6

Plot the shares of the five best-matched and five worst-matched exhibits. Which exhibits are hardest to place, and which sources are they split between?

Key: Clue 6

heist_gamma <- tidy(heist_lda, matrix = "gamma")

# each exhibit's best-matching source
best_match <- heist_gamma |>
  group_by(document) |>
  slice_max(gamma) |>
  ungroup()

# the lead's naming code, filled in with the correct names
best_match <- best_match |>
  mutate(book = factor(topic, levels = 1:4, labels = source_names))

# the 5 strongest  matches 
best5  <- best_match |> arrange(desc(gamma)) |> select(document) |> slice(1:5)

heist_gamma |>
  inner_join(best5, by = "document") |>
  ggplot(aes(gamma, document, fill = factor(topic))) +
  geom_col() +
  labs(x = "share of the exhibit", y = "exhibit", fill = "source")

# the 5 worst  matches 
worst5 <- best_match |> arrange(gamma) |> select(document) |> slice(1:5)

heist_gamma |>
  inner_join(worst5, by = "document") |> 
  ggplot(aes(gamma, document, fill = factor(topic))) +
  geom_col() +
  labs(x = "share of the exhibit", y = "exhibit", fill = "source")

Clue #6 answer: Look for bars that are pretty evenly split between 2 or 3 sources.

Lead: An evidence key that has the correct book for each exhibit has been provided for you in Jupyterhub under heist_answer_key.rds. One way to open this key is to use the following code:

heist_key <- readRDS(here::here("data/heist_answer_key.rds"))

Lead: You can attach exhibit’s true book by using a left_join by c(document = "exhibit").

Lead: An exhibit is wrongly classified when the book it was returned to differs from its true book (the off-diagonal cells of a two-way table).

Lead: To view the full scrap text you can use:

  knitr::kable(col.names = "Scrap", align = "l") |>
  column_spec(1, width = "35em")

Phase 7: The reveal

You have the evidence key: the true book for every exhibit.

• What percent of exhibits did you get correct?
• Pick an exhibit that was returned to the wrong book. Filter the evidence box for that exhibit and read some of its scraps.
• Why do you think the profiler put it with the other book?

Key: Phase 7

checked <- best_match |>
  left_join(heist_key, by = c(document = "exhibit"))

# assess correctness: true book (rows) by the book each exhibit was returned to (columns)
table(checked$title, checked$book)

                                       
                                        Dracula
  Dracula                                    24
  Great Expectations                          1
  The war of the worlds                       0
  Twenty Thousand Leagues under the Sea       0
                                       
                                        Twenty Thousand Leagues under the Sea
  Dracula                                                                   0
  Great Expectations                                                        0
  The war of the worlds                                                     0
  Twenty Thousand Leagues under the Sea                                    46
                                       
                                        Great Expectations
  Dracula                                                0
  Great Expectations                                    57
  The war of the worlds                                  0
  Twenty Thousand Leagues under the Sea                  0
                                       
                                        The war of the worlds
  Dracula                                                   3
  Great Expectations                                        1
  The war of the worlds                                    27
  Twenty Thousand Leagues under the Sea                     0

wrong_exhibits <- checked |> filter(title != book)
wrong_exhibits

# A tibble: 5 × 6
  document topic gamma book                  title              chapter
  <chr>    <int> <dbl> <fct>                 <chr>                <int>
1 EX-246       4 0.661 The war of the worlds Great Expectations      54
2 EX-607       4 0.786 The war of the worlds Dracula                  7
3 EX-694       4 0.755 The war of the worlds Dracula                  1
4 EX-807       1 0.530 Dracula               Great Expectations      56
5 EX-826       4 0.592 The war of the worlds Dracula                  6

Read one misassigned exhibit: filter the evidence box for it and look at some of its scraps.

wrong_exhibits$document[1]

[1] "EX-246"

dta |>
  filter(exhibit == wrong_exhibits$document[1]) |>
  select(text) |>
  head(10) |>
  knitr::kable(col.names = "Scrap", align = "l") |>
  column_spec(1, width = "35em")

Scrap
we were rising and falling in a troubled wake of water. The look-out
“But for your face I should think you were a little despondent,” said
charge was the least anxious of the party. It was very likely that the
come, and Magwitch could go, and nobody’s head would be troubled about
had led accounted for it) that he was the least anxious of any of us.
cordially, and neither Herbert’s eyes nor mine were quite dry, when I
No. I had thought about that, while we had been there side by side. No.
the last o’ many times, and I don’t ask no more.”
be much heightened when he heard that it had stockings on. Probably, it
accord that grace to my two friends.

Answer: 5 exhibits misattributed. For the reading, accept any explanation grounded in the scraps they read, such as scraps with few distinctive words, or names, places or events that also fit the other book.

Case Closed - Report out

By end of week the following should be submitted to our weekly Google folder.

1. Your most completed quarto file for the team. It does not have to render, but it should contain the majority of the evidence and findings. One file per team only. Be sure your team name is in the file name.

2. A personal reflection on the activity.

• How far did your squad get?
• What did you learn and what challenges did you encounter?
• How did your squad work through obstacles?
• How did you contribute to your squads success? What skillsets did you provide?