Что такое Дельта Берроуза (Burrows 2002) и как она работает? Для корпуса текстов рассчитывается частотность набора наиболее частотных слов или n-грамм (последовательности n символов подряд).

В стилометрических исследованиях принято брать для сравнения относительную, а не абсолютную частотность; Берроуз идет еще дальше, предлагая использовать так называемые z-scores, то есть стандартизированные оценки, показывающие разброс значений относительно средних. Z-score вычисляется по формуле: Ζ =(x-mu)/sd, где случайная величина x – это значение частотности, mu – математическое ожидание (среднее), а sd – стандартное отклонение.

Иными словами, z-score показывает, на сколько стандартных отклонений x отстоит от ожидаемого. Зная z-scores для известного автора/текста, можно сравнить их с z-scores спорного текста; искомая дистанция Delta вычисляется как сумма взятых по модулю разниц между z-score у двух сравниваемых текстов, поделенная на количество слов.

В качестве примера допустим, что мы знаем, что Платон является автором «Федона» и «Пира», а Исократ – «Елены» и «Бузириса», и намерены выяснить, кто из них является “наименее неправдоподобным” кандидатом на авторство “Менона.”

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

Сначала необходимо вычислить относительную частотность слова в тексте, затем ее среднее значение по корпусу и стандартное отклонение.

library(stylo) 
## загружаем и делим на слова тексты, считаем относительную частотность
my_corpus <- load.corpus.and.parse(files = c("Helen.txt", "Busiris.txt", "Phaedo.txt", "Symposium.txt", "Meno.txt"), corpus.dir = getwd(), markup.type= "plain", corpus.lang = "Other", sampling = "no.sampling", preserve.case = FALSE, encoding = "UTF-8")

## список самых частотных слов
mfw <- make.frequency.list(my_corpus, relative = TRUE, value =FALSE)
mfw <- mfw[1:10]
mfw
##  [1] "ὁ"     "καί"   "εἰμί"  "δέ"    "οὗτος" "αὐτός" "ἐγώ"   "οὐ"    "ὅς"   
## [10] "μέν"
## считаем относ. частотность для каждого слова в каждом тексте
freq_all <- as.data.frame.matrix(as.table(make.table.of.frequencies(my_corpus, mfw)))
freq_all
##                   ὁ      καί     εἰμί       δέ    οὗτος    αὐτός       ἐγώ
## Helen     14.910164 4.612497 1.743095 3.405739 1.528560 2.225798 0.3754358
## Busiris   15.029112 4.439592 1.491994 2.947598 1.491994 2.074236 0.5458515
## Phaedo     9.667812 6.153494 3.033219 2.158076 2.071019 1.938144 1.7227950
## Symposium  9.077372 6.488746 2.766165 2.250730 1.912834 1.311494 1.8727450
## Meno       6.393627 4.657338 4.187519 2.052906 2.706567 1.572873 2.1754673
##                 οὐ       ὅς       μέν
## Helen     1.072674 1.153124 2.0648968
## Busiris   1.273654 1.382824 2.2561863
## Phaedo    1.438717 1.457045 0.9667812
## Symposium 1.305767 1.007961 1.0766852
## Meno      2.369523 1.215402 1.1745481
## считаем стандартизированные значения; из каждого значения в столбце вычитается среднее, разница делится на стандартное отклонение (в R для этого есть специальная функция)
scaled_fr <- scale(freq_all)
scaled_fr
##                    ὁ        καί       εἰμί         δέ       οὗτος      αὐτός
## Helen      1.0208956 -0.6782233 -0.8325785  1.4348629 -0.83759543  1.0698048
## Busiris    1.0520761 -0.8564859 -1.0645324  0.6548152 -0.91163971  0.6657523
## Phaedo    -0.3533065  0.9105295  0.3591726 -0.6894564  0.26086462  0.3029429
## Symposium -0.5080812  1.2561717  0.1124815 -0.5316991 -0.05945434 -1.3676579
## Meno      -1.2115840 -0.6319920  1.4254567 -0.8685226  1.54782485 -0.6708421
##                  ἐγώ         οὐ         ὅς        μέν
## Helen     -1.1744624 -0.8260487 -0.5011093  0.9220628
## Busiris   -0.9666305 -0.4301930  0.7757476  1.2386814
## Phaedo     0.4687200 -0.1050793  1.1883269 -0.8955155
## Symposium  0.6515928 -0.3669412 -1.3080460 -0.7136047
## Meno       1.0207801  1.7282622 -0.1549193 -0.5516241
## attr(,"scaled:center")
##         ὁ       καί      εἰμί        δέ     οὗτος     αὐτός       ἐγώ        οὐ 
## 11.015617  5.270333  2.644398  2.563010  1.942195  1.824509  1.338459  1.492067 
##        ὅς       μέν 
##  1.243271  1.507820 
## attr(,"scaled:scale")
##         ὁ       καί      εἰμί        δέ     οὗτος     αὐτός       ἐγώ        οὐ 
## 3.8148329 0.9699413 1.0825449 0.5873238 0.4938364 0.3751047 0.8199693 0.5077101 
##        ὅς       μέν 
## 0.1798946 0.6041641
## отрицательное значение z-score указывает, что слово используется реже среднего, положительное – что чаще

## дистанция Манхэттена измеряет разницу между двумя векторами и суммирует ее абсолютные значения: Σ|ai – bi|
my_dist <- dist(scaled_fr, method = "manhattan") 
my_dist
##               Helen   Busiris    Phaedo Symposium
## Busiris    3.896705                              
## Phaedo    14.015514 11.782929                    
## Symposium 14.318364 14.639493  6.018803          
## Meno      17.535629 17.164378  9.979434 10.325058
## разделив эту дистанцию на количество слов, получаем искомое значение Δ
my_delta <- my_dist/10
my_delta
##               Helen   Busiris    Phaedo Symposium
## Busiris   0.3896705                              
## Phaedo    1.4015514 1.1782929                    
## Symposium 1.4318364 1.4639493 0.6018803          
## Meno      1.7535629 1.7164378 0.9979434 1.0325058

Исходя из этих расчётов, ближайшим к “Менону” текстом оказывается “Федон”; атрибуция Платону верна. Те же вычисления можно выполнить быстрее, используя функцию dist.delta() в библиотеке Stylo (Eder, Rybicki, and Kestemont 2016).

dist.delta(freq_all)
##               Helen   Busiris    Phaedo Symposium
## Busiris   0.3896705                              
## Phaedo    1.4015514 1.1782929                    
## Symposium 1.4318364 1.4639493 0.6018803          
## Meno      1.7535629 1.7164378 0.9979434 1.0325058

Так же можно вычислить дельту Аргамона (Argamon 2008), дельту Эдера (Eder 2015) и другие. Все они дают в нашем случае тот же результат, хотя и с разными цифрами.

dist.eder(freq_all)
##               Helen   Busiris    Phaedo Symposium
## Busiris    2.048259                              
## Phaedo     9.081771  8.106461                    
## Symposium  9.713135  9.503938  3.072181          
## Meno      11.609021 11.192111  6.555797  7.057347
dist.simple(freq_all)
##               Helen   Busiris    Phaedo Symposium
## Busiris   0.7361132                              
## Phaedo    3.6358373 3.3692525                    
## Symposium 3.7616366 3.6992501 0.9459651          
## Meno      4.8762217 4.7566022 2.2957457 2.3428803
dist.argamon(freq_all)
##               Helen   Busiris    Phaedo Symposium
## Busiris   0.1671608                              
## Phaedo    0.4638738 0.4162786                    
## Symposium 0.4925312 0.5032676 0.3080530          
## Meno      0.6143752 0.5848989 0.3532428 0.3853368
dist.wurzburg(freq_all)
##               Helen   Busiris    Phaedo Symposium
## Busiris   0.1599790                              
## Phaedo    1.6515234 1.4553796                    
## Symposium 1.5178236 1.7231643 0.8628168          
## Meno      1.7932134 1.7435491 0.7479603 0.7885505

Кроме того, Stylo позволяет использовать различные способы вычисления расстояний для машинной классификации с учителем (Delta, SVM, K-NN и др.). Для этого создается обучающая выборка (training set), в которой представлены несколько кандидатов на авторство, каждый из которых может быть представлен несколькими текстами; на этом этапе алгоритм запоминает представленные классы; на втором этапе новые тексты (test set) распределяются по этим классам.

Мы можем протестировать минимальную длину отрывка, необходимую для корректной классификации с учителем и узнать, что 10 mfw на отрывке в 100 слов даже для очень разных текстов – это не очень хорошая идея. Ну, мы это и так знали 🙂 Чем длиннее текст – тем надежнее атрибуция! Но мы же просто смотрим, как это работает?

sp <- size.penalize(mfw = c(10, 50, 100), sample.size.coverage = c(100, 200, 300))
sp$accuracy.scores
## $Is_Busiris
##          100  200  300
## mfw_10  0.84 0.85 0.97
## mfw_50  0.98 0.96 0.98
## mfw_100 1.00 1.00 1.00
## 
## $Is_Helen
##          100  200  300
## mfw_10  0.79 0.89 0.97
## mfw_50  0.98 0.98 1.00
## mfw_100 1.00 1.00 1.00
## 
## $Pl_Phaedo
##          100  200  300
## mfw_10  0.82 0.82 0.91
## mfw_50  0.71 0.91 0.98
## mfw_100 0.08 0.47 0.90
## 
## $Pl_Symposium
##          100  200  300
## mfw_10  0.78 0.91 0.94
## mfw_50  0.56 0.89 0.88
## mfw_100 0.13 0.54 0.83
## 
## attr(,"description")
## [1] "accuracy scores for the tested texts"
sp$confusion.matrices
## $Is_Busiris
## $Is_Busiris$mfw_10
##    100 200 300
## Is  84  85  97
## Pl  16  15   3
## 
## $Is_Busiris$mfw_50
##    100 200 300
## Is  98  96  98
## Pl   2   4   2
## 
## $Is_Busiris$mfw_100
##    100 200 300
## Is 100 100 100
## Pl   0   0   0
## 
## 
## $Is_Helen
## $Is_Helen$mfw_10
##    100 200 300
## Is  79  89  97
## Pl  21  11   3
## 
## $Is_Helen$mfw_50
##    100 200 300
## Is  98  98 100
## Pl   2   2   0
## 
## $Is_Helen$mfw_100
##    100 200 300
## Is 100 100 100
## Pl   0   0   0
## 
## 
## $Pl_Phaedo
## $Pl_Phaedo$mfw_10
##    100 200 300
## Is  18  18   9
## Pl  82  82  91
## 
## $Pl_Phaedo$mfw_50
##    100 200 300
## Is  29   9   2
## Pl  71  91  98
## 
## $Pl_Phaedo$mfw_100
##    100 200 300
## Is  92  53  10
## Pl   8  47  90
## 
## 
## $Pl_Symposium
## $Pl_Symposium$mfw_10
##    100 200 300
## Is  22   9   6
## Pl  78  91  94
## 
## $Pl_Symposium$mfw_50
##    100 200 300
## Is  44  11  12
## Pl  56  89  88
## 
## $Pl_Symposium$mfw_100
##    100 200 300
## Is  87  46  17
## Pl  13  54  83
## 
## 
## attr(,"description")
## [1] "all classification scores (raw tables)"

Попробуем теперь посчитать ту же дельту, но теперь используя обучение с учителем. Для этого нам надо сначала разделить нашу таблицу с частотами на обучающую выборку и спорный текст. Та часть в имени ряда, которая предшествует подчеркиванию _ по умолчанию берется как класс для дальнейшей классификации. То есть в нашем примере – два класса, Платон и Исократ.

fr_training_set <- freq_all[1:4, ]
rownames(fr_training_set) <- c("Is_Helen", "Is_Busiris", "Pl_Phd", "Pl_Smp")
fr_test_set <- freq_all[5, ]
fr_test_set <- rbind(fr_test_set, fr_test_set) ## duplicate our "unknown"  text 
rownames(fr_test_set) <- c("Meno", "Meno_copy")
pd <- perform.delta(training.set = fr_training_set, test.set = fr_test_set, distance = "delta", no.of.candidates = 2, z.scores.both.sets = TRUE)

Ура! “Менон” снова уходит Платону. Мы можем также посмотреть таблицу с расстояниями, которую сохраняет функция и убедиться, что они похожи на те, что мы видели раньше.

pd$y
##      Meno Meno_copy 
##      "Pl"      "Pl" 
## attr(,"description")
## [1] "classification results in a compact form"
pd$distance_table
##                 Is       Is        Pl       Pl
## Meno      1.723381 1.693512 0.9937996 1.018469
## Meno_copy 1.723381 1.693512 0.9937996 1.018469
## attr(,"description")
## [1] "raw distance table"
pd$scores
##                   1        2
## Meno      0.9937996 1.018469
## Meno_copy 0.9937996 1.018469
## attr(,"description")
## [1] "Delta scores, ordered according to candidates"

Классификацию можно проделать и с использованием другой дистанции. Результаты похожи на те, что мы получали выше.

pe <- perform.delta(training.set = fr_training_set, test.set = fr_test_set, distance = "argamon", no.of.candidates = 2, z.scores.both.sets = TRUE)
pe$y
##      Meno Meno_copy 
##      "Pl"      "Pl" 
## attr(,"description")
## [1] "classification results in a compact form"
pe$distance_table
##                  Is       Is        Pl        Pl
## Meno      0.5989031 0.570017 0.3497833 0.3760396
## Meno_copy 0.5989031 0.570017 0.3497833 0.3760396
## attr(,"description")
## [1] "raw distance table"
Argamon, Shlomo. 2008. “Interpreting Burrows’s Delta: Geometric and Probabilistic Foundations.” Literary and Linguistic Computing 23 (2): 131147.
Burrows, John. 2002. “‘Delta’: A Measure of Stylistic Difference and a Guide to Likely Authorship.” Literary and Linguistic Computing 17 (3): 267287.
Eder, Maciej. 2015. “ADHO 2015 - Sydney.” In. https://dh-abstracts.library.cmu.edu/works/2364.
Eder, Maciej, Jan Rybicki, and Mike Kestemont. 2016. “Stylometry with r: A Package for Computational Text Analysis.” The R Journal 8 (1).