Как определить перекрывающуюся последовательность слов в двух текстах

Это не совсем то, о чем вы просили, но вы можете использовать пакет {stringdist} для оценки «расстояния» между двумя текстами, которое обычно интерпретируется как количество символов, которые вам придется изменить в строке, чтобы станет равным ссылочной строке. Таким образом, разница между словами «друг» и «дружественный» будет равна 2.

Таким образом, вы сможете проверить, какие тексты имеют меньше отличий от справочного текста, возможно, это означает, что они были скопированы прямо из исходного материала.

# https://github.com/markvanderloo/stringdist
install.packages('stringdist')

library(stringdist)

base_text <- "she grew up in the united states.Her father was"

text_1 <- "She grew up in the United States. Her father was"
text_2 <- "I learned that she grew up in the united states.Her father was"
text_3 <- "The main character was born in the USA, his father being"
text_4 <- "My favourite animals are raccoons, they are so silly and cute"
text_5 <- "I didn't understand this assignment so I'm just answering gibberish"
text_6 <- "she grew up in the united states.Her father was"

test_texts <- c(text_1, text_2, text_3, text_4, text_5, text_6)

# calculate string distance using default method
distances <- stringdist(base_text, test_texts)

# texts that are only x or less edits away from the original text
possible_copied_texts <- test_texts[distances <= 25]

possible_copied_texts

#[1] "She grew up in the United States. Her father was"              
#[2] "I learned that she grew up in the united states.Her father was"
#[3] "she grew up in the united states.Her father was"        

Если этот метод не работает для вашего варианта использования, вы можете использовать stringdist с методом Самая длинная общая подстрока (method='lcs'), который определяется как «самая длинная строка, которую можно получить путем объединения символов из a и b, сохраняя при этом порядок персонажи нетронуты». Таким образом мы можем определить, есть ли вставленный внутри более длинных текстов текст, даже если он слегка изменен:

library(stringdist)

base_text_2 <- "this sentence means plagiarism therefore something bad will occur"

text_7 <- "random string with no words from the base text"
text_8 <- "cat dog pig chicken duck this sentence means plagiarism therefore something bad will occur food pizza sandwich pineapple"
text_9 <- "this pretty long sentence does in fact mean that I have not plagiarized any text, instead I'm writing all by myself"
text_10 <- "what so you mean you are doubting this text? you can't actually think that this sentence means plagiarism therefore something bad will occur, even if it does use words straight from the plagiarism sentence"
text_11 <- "totally normal text"
text_12 <- "this sentence means plagiarism therefore something bad will occur"
text_13 <- "this sentence does not mean plagiarism and therefore something bad not will occur"
# here, strings 8, 10, and 12 contain the base text in them, and string 13 contains a slightly modified version of the base text which would still be plagiarism

# create a vector with the strings
test_texts_2 <- c(text_7, 
                  text_8, 
                  text_9, 
                  text_10,
                  text_11,
                  text_12,
                  text_13)

# but we will also add filler text before and after every string, so that they become longer
filler <- "lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt"
test_texts_3 <- paste(filler, test_texts_2, filler)

# perform strins distance calculation with the  longest common substring method
distances_lcs <- stringdist(base_text_2, test_texts_3, method = "lcs")

# we get the distances substrazcted from the length of every string, then we substract the lenght of the base text so that strings with the base text become zero
distance_lcs_results <- nchar(test_texts_3) - distances_lcs - nchar(base_text_2)

# strings with a value of 0 means the exact text is present in the text
distance_lcs_results
#> [1] -38   0 -24   0 -44   0  -2

# subset the vector so that we can confirm that the strings that contain the text were detected
test_texts_2[distance_lcs_results == 0]
#> [1] "cat dog pig chicken duck this sentence means plagiarism therefore something bad will occur food pizza sandwich pineapple"                                                                                     
#> [2] "what so you mean you are doubting this text? you can't actually think that this sentence means plagiarism therefore something bad will occur, even if it does use words straight from the plagiarism sentence"
#> [3] "this sentence means plagiarism therefore something bad will occur"

# but we can also get close matches, strings containing text that are not the same, but similar, to the base texts
test_texts_2[abs(distance_lcs_results) < 20]
#> [1] "cat dog pig chicken duck this sentence means plagiarism therefore something bad will occur food pizza sandwich pineapple"                                                                                     
#> [2] "what so you mean you are doubting this text? you can't actually think that this sentence means plagiarism therefore something bad will occur, even if it does use words straight from the plagiarism sentence"
#> [3] "this sentence means plagiarism therefore something bad will occur"                                                                                                                                            
#> [4] "this sentence does not mean plagiarism and therefore something bad not will occur"

Вы можете использовать оба метода (или несколько!), чтобы создать переменную оценки, а затем принять решение на основе нескольких показателей плагиата.

^{Created on 2024-07-24 with reprex v2.1.0}

Используя данные @Bastián Olea Herrera:

library(tm)
library(slam)

text <- list("she grew up in the united states.Her father was",
             "She grew up in the United States. Her father was",
             "I learned that she grew up in the united states.Her father was",
             "The main character was born in the USA, his father being",
             "My favourite animals are raccoons, they are so silly and cute",
             "I didn't understand this assignment so I'm just answering gibberish",
             "she grew up in the united states.Her father was"
)

tdm <- VectorSource(sapply(text, \(x) gsub(".", " ", x, fixed = T), USE.NAMES = F)) |>
  SimpleCorpus() |>
  TermDocumentMatrix(
    control = list(tolower = TRUE,
                   removePunctuation = TRUE,
                   stopwords = TRUE))

cs <-  crossprod_simple_triplet_matrix(tdm)/(sqrt(col_sums(tdm^2) %*% t(col_sums(tdm^2))))
cs
#     Docs
# Docs         1         2         3         4 5 6         7
#    1 1.0000000 1.0000000 0.8944272 0.2236068 0 0 1.0000000
#    2 1.0000000 1.0000000 0.8944272 0.2236068 0 0 1.0000000
#    3 0.8944272 0.8944272 1.0000000 0.2000000 0 0 0.8944272
#    4 0.2236068 0.2236068 0.2000000 1.0000000 0 0 0.2236068
#    5 0.0000000 0.0000000 0.0000000 0.0000000 1 0 0.0000000
#    6 0.0000000 0.0000000 0.0000000 0.0000000 0 1 0.0000000
#    7 1.0000000 1.0000000 0.8944272 0.2236068 0 0 1.0000000

Это всего лишь пример, на котором вы можете основываться: tm имеет гораздо больше функций. Идея заключается в том, что вы можете построить матрицу терминов-документов и использовать ее для расчета степени сходства между документами. Вычисленная здесь оценка сходства представляет собой косинусное сходство, но есть и много других.

Если вы прочитаете документацию по ?TermDocumentMatrix, то увидите, что можно выполнять такие вещи, как процедуры обратного взвешивания, которые, например, придают больший вес необычным словам.

Первый столбец вывода сравнивает первый текст со всем текстом, второй столбец сравнивает второй текст со всем текстом и так далее. Диагональ всегда равна единице, поскольку она сравнивает текст сам с собой. Как вы можете видеть из первого столбца, второй, третий и седьмой текст очень похожи на первый.

Альтернативно вы можете извлечь самую длинную общую подстроку следующим образом (используя список text сверху). При этом первый элемент (ваш базовый текст/цифровое задание) сравнивается с оставшимся текстом (это должен быть ввод ученика):

library(PTXQC)
library(textclean)

standardize <- function(x) {
  x |>
    tolower() |>
    replace_contraction() |> 
    gsub("[[:punct:]]", " ", x = _, perl = T) |>
    replace_white()
}

std_text <- standardize(text)

lapply(std_text[-1], \(x) LCSn(c(std_text[[1]], x)))
# [[1]]
# [1] "she grew up in the united states her father was"
# 
# [[2]]
# [1] "she grew up in the united states her father was"
# 
# [[3]]
# [1] " in the u"
# 
# [[4]]
# [1] " the"
# 
# [[5]]
# [1] " un"
# 
# [[6]]
# [1] "she grew up in the united states her father was"

Сначала делается небольшая очистка текста, чтобы его стандартизировать. Я добавляю пробелы вокруг знаков препинания, чтобы решить эту проблему в вашем text_2. Это может привести к появлению избыточного пробела, но это решается с помощью replace_white().

LCSn() имеет min_LCS_length, который можно указать, чтобы игнорировать минимально перекрывающийся текст.

Примечание. PTXQC и textclean имеют достаточное количество зависимостей.

Вот подход к определению общих смежных слов с помощью tidytext в поисках дословного копирования фраз. Здесь я убираю знаки препинания (хотя бы .,;?!) и создаю n-граммы (фразы длины n) для сопоставления двух источников.

В этом случае я ищу смежные фразы из 7-10 слов. Для больших данных большой диапазон может стать ресурсоемким с точки зрения вычислений и памяти. Небольшая длина фразы позволит выявить больше ложных срабатываний из обычных фраз, тогда как длинная фраза может привести к ложным негативам (не выявляя плагиат, поэтому потребуется некоторая корректировка с учетом контекста).

library(tidyverse); library(tidytext)
tokenize <- function(str_vec, from = 7, to = 10) {
  data.frame(text = str_vec) |>
    mutate(text = text |> 
             str_replace_all("[.,;?!] ", " ") |>
             str_replace_all("[.,;?!]",  " ")) |>
    tidytext::unnest_ngrams(phrase, text, n = to, n_min = from,  to_lower = TRUE) |>
    mutate(length = str_count(phrase, "\\w+"))
}

inner_join(
  text_1 |> tokenize() |> mutate(src = "text_1"),
  text_2 |> tokenize() |> mutate(src = "text_2"),
  join_by(phrase, length)
) |>
  arrange(-length)
  

Результат

                                            phrase length  src.x  src.y
1  she grew up in the united states her father was     10 text_1 text_2
2      she grew up in the united states her father      9 text_1 text_2
3      grew up in the united states her father was      9 text_1 text_2
4             she grew up in the united states her      8 text_1 text_2
5          grew up in the united states her father      8 text_1 text_2
6           up in the united states her father was      8 text_1 text_2
7                 she grew up in the united states      7 text_1 text_2
8                 grew up in the united states her      7 text_1 text_2
9               up in the united states her father      7 text_1 text_2
10             in the united states her father was      7 text_1 text_2