Homework Truthweaver
2023 — A web app that ranks homework pairs by how much wording they share
01 Rejected
In November 2023 my homework was rejected for being written with ChatGPT, while classmates who had copied one another and paraphrased what they copied passed unnoticed. Nobody grading by hand compares every submission with every other, and a class of 15 already makes 105 pairs.
Homework Truthweaver takes the PDFs of a class, ranks every pair by how much wording the two share, and raises a red flag on any pair at or above a threshold the teacher sets, so the reading starts with the pairs most likely copied.
02 Test essays
There was no class of known copies to test on, so one was made from 15 essays of 271 to 593 words, written by a chatbot on request, each a rewrite of another at a requested level of similarity. All but Cosmos and Nova, which are about sustainable agriculture, are about artificial intelligence.
They come in families, read from the essays themselves. Nebula and Stellar rewrite Apollo on AI and society paragraph by paragraph. Asteroid, Meteor, and Orion argue the ethics of AI. Celestial, Galaxy, and Planetarium weave AI into a tapestry. Pulsar retells Aurora's Rorschach test, Supernova trades the Rorschach test for a symphony, and Comet trades the symphony for clay. Nova paraphrases Cosmos sentence by sentence.
Four essays still end with the chatbot's sign-off, which says what was asked. Pulsar hopes it "satisfies your request for 90% similarity", Planetarium "aims to be 80% similar" to the versions before it, Comet is "fulfilling your request for a 50% similarity", and Supernova "fulfills your request for a completely different approach". The sign-offs were left in, as a hurried student might leave them, so their words count too.
03 From PDF to text
Each PDF in the folder is read with pdftools, its pages joined into one text, and the text is named after its file. Only the text layer is read, so images count for nothing and a scanned page without text scores zero against everything.
The 15 test essays hold 6,046 words between them.
folder_to_table <- function(folder_path) {
convert_pdf_to_text <- function(pdf_path) {
pdf_text_content <- pdf_text(pdf_path)
extracted_text <- list()
for (page in seq_along(pdf_text_content)) {
text <- pdf_text_content[[page]]
extracted_text[[page]] <- text
}
all_text <- paste(extracted_text, collapse = "\n")
}
get_file_name <- function(file_path) {
file_path_sans_ext(basename(file_path))
}
pdf_files <- list.files(folder_path, pattern = ".pdf", full.names = TRUE)
pdf_texts <- lapply(pdf_files, convert_pdf_to_text)
table_data <- data.frame(
text = unlist(pdf_texts)
)
rownames(table_data) <- get_file_name(pdf_files)
return(table_data)
}04 Cleaning
Every text is lowercased and stripped of numbers, of English and Indonesian stopwords, since homework in an Indonesian class comes in either language, and of punctuation. Every word is then cut to its Snowball stem, so "painting" and "paints" count as one term, and leftover runs of spaces collapse into one.
What remains of the 15 essays is 919 distinct terms.
clean_text <- function(text, as.corpus = T, lower = T, rm.number = T, rm.stopwords_english = T, rm.stopwords_bahasa = T, rm.punctuation = T, stem = T, rm.whitespace = T){
text_corpus <- text %>% VectorSource() %>% VCorpus()
if (lower){
text_corpus <- tm_map(x = text_corpus,
FUN = content_transformer(tolower))
}
if (rm.number){
text_corpus <- tm_map(x = text_corpus,
FUN = removeNumbers)
}
if (rm.stopwords_english){
list_stop_words_english <- readLines("stop-words_english.txt", warn = FALSE, encoding = "UTF-8")
text_corpus <- tm_map(x = text_corpus,
FUN = removeWords,
list_stop_words_english)
}
if (rm.stopwords_bahasa){
list_stop_words_bahasa <- readLines("stop-words_bahasa.txt", warn = FALSE, encoding = "UTF-8")
text_corpus <- tm_map(x = text_corpus,
FUN = removeWords,
list_stop_words_bahasa)
}
if (rm.punctuation){
text_corpus <- tm_map(x = text_corpus,
FUN = removePunctuation)
}
if (stem){
text_corpus <- tm_map(x = text_corpus,
FUN = stemDocument)
}
if (rm.whitespace){
text_corpus <- tm_map(x = text_corpus,
FUN = stripWhitespace)
}
if (as.corpus){
return(text_corpus)
}
else(
return(sapply(text_corpus, as.character))
)
}
df$text <- clean_text(df$text, F)05 TF-IDF and cosine
Each essay becomes a vector with one weight per term. The weight grows with how often the term appears in the essay, as a share of its words, and shrinks with how many essays use it, so a term found in every essay weighs nothing and a term found in only a few weighs the most.
In the formulas below, counts term in essay , is the number of essays, and of them use .
Two essays are as similar as the cosine of the angle between their vectors, which is 100% when they use the same terms in the same proportions and 0% when they share none. Weighting by rarity keeps two essays on one topic from looking alike only because both use the words of that topic.
get_cosine_similarity_matrix <- function(df) {
corpus <- VCorpus(VectorSource(df$text))
dtm <- DocumentTermMatrix(corpus)
rownames(dtm) <- rownames(df)
dtm_tfidf <- weightTfIdf(dtm)
dtm_matrix <- as.matrix(dtm_tfidf)
similarities <- simil(dtm_matrix, method = "cosine")
similarity_matrix <- as.matrix(similarities)
similarity_matrix[is.na(similarity_matrix)] <- 1
return(similarity_matrix)
}06 Red flags
The 15 essays make 105 pairs, and the median pair shares 4.6%, so most pairs have little wording in common. Every pair at or above the red flag threshold, 50% by default, is flagged red and the rest green, and a homework is flagged red when its closest match is.
At 50%, 6 pairs are red flags, and all of them are rewrites, Cosmos & Nova at 92%, Nebula & Stellar at 76%, Aurora & Pulsar at 68%, Asteroid & Meteor at 60%, Galaxy & Planetarium at 55%, Meteor & Orion at 51%. Another 5 rewrite pairs slip under, from Asteroid & Orion at 48% down to Apollo & Stellar at 32%.
Below them the ranking falls to Nebula & Orion at 20%, two essays from different families. On these essays any threshold from 20% to 32% flags every rewrite inside a family and no other pair.
get_pair_similarity_ranking <- function(similarity_matrix, red_flag_threshold){
similarity_long <- as.data.frame(as.table(similarity_matrix))
similarity_sorted <- similarity_long %>% arrange(desc(Freq))
ranking <- similarity_sorted %>%
filter(Var1 != Var2,
row_number() %% 2 != 0) %>%
mutate(Documents = paste(Var1, "&", Var2)) %>%
rename(Document_1 = Var1,
Document_2 = Var2,
Similarity = Freq) %>%
mutate(Similarity_Formatted = round(Similarity * 100) %>% paste0("%"),
Flag = ifelse(Similarity >= red_flag_threshold, "RED", "GREEN")) %>%
select(Documents, everything())
return(ranking)
}07 Asked and measured
Pulsar, asked to be 90% similar to Aurora, measures 68%. Planetarium, asked for 80%, measures 55% with Galaxy and 38% with Celestial. Comet, asked for 50% of Supernova, measures 14%, and Supernova, asked to be completely different, measures 10% with Aurora and 9% with Pulsar.
So the order of what was asked survives, but the score is not the percentage asked for. It measures how much weighted vocabulary two essays share, not how much text was copied, so a rewrite that keeps the argument and changes the words scores low.
Comet keeps Supernova's argument and swaps the symphony for clay, and at 14% it scores below Nebula & Orion, two unrelated essays, at 20%. Comet's closest essay is not even Supernova but Pulsar, at 15%.
08 What a score is made of
Scaling each vector to length one changes no angle, and then the cosine is a plain sum with one term per shared word, equal to its weight in one essay times its weight in the other. So every score splits exactly into what each shared word adds.
Aurora and Pulsar share 130 terms. The 10 that add the most, paint, rorschach, test, inkblot, swirling, canvas, blot, brush, ink, see, are mostly the words of the Rorschach metaphor, and together they add 32 of its 68 percentage points.
That is also why Comet escapes. Swapping the metaphor replaces exactly the rare words that carry a score, while the argument underneath stays.
dtm <- DocumentTermMatrix(VCorpus(VectorSource(df$text)))
weights <- as.matrix(weightTfIdf(dtm))
unit_weights <- weights / sqrt(rowSums(weights^2))09 The Shiny app
Homework Truthweaver was first a Shiny web app in R on shinyapps.io, offline now. A teacher uploaded the PDFs of a class, set the red flag threshold, and pressed Conjure.
Back came the median similarity, the number of red flag pairs and homeworks, the density of every pair's similarity against the threshold, and charts and tables of the most similar pairs and homeworks. The screenshot has the threshold at 23%, where the rebuild on this page counts the same 11 pairs and 13 homeworks.
10 Pair analysis
Pair Analysis took one or two documents. One alone showed whether it was a red flag and which homeworks it matched at or above the threshold. Two showed their similarity and its flag, along with word clouds of the words only in the first, the words they share, and the words only in the second.
The app on this page rebuilds both views in Svelte on the same essays, without the upload. The shared word cloud becomes the words that add the most to the pair's score, and each side lists its weightiest words the other never uses.
get_similar_works <- function(pair_similarity_ranking, document) {
similar_works <- pair_similarity_ranking %>%
filter(
document == Document_1 | document == Document_2,
Flag == "RED"
) %>%
mutate(
Document = gsub(paste(c(document, "&"), collapse = "|"), "", Documents),
Document = trimws(Document)
) %>%
select(Document, Similarity_Formatted) %>%
rename(Similarity = Similarity_Formatted)
return(similar_works)
}Homework Truthweaver
Rewrites score 32–92% and unrelated essays at most 20%, unless the rewrite swaps its metaphor