Классификация авторов британской прозы
Домашнее задание по анализу текстовых данных
20 мая 2026
knitr::opts_chunk$set(
echo = TRUE,
message = FALSE,
warning = FALSE,
fig.width = 9,
fig.height = 6
)1 Цель работы
В этой работе я анализирую корпус A Small Collection of British Fiction и строю модель, которая определяет автора фрагмента текста. Это задача многоклассовой классификации: классов больше двух, потому что в корпусе представлены разные авторы британской прозы XVIII-XIX веков.
Авторский стиль можно описать через частотность слов. Поэтому я беру тексты, делю их на равные фрагменты по 2000 слов, затем считаю частотности 500 самых частотных слов и использую эти признаки для классификации.
library(tidyverse)
library(textrecipes)
library(tidymodels)
library(tidytext)
library(stylo)
library(future)2 Метаданные корпуса
Сначала загружаю таблицу с метаданными. В файле есть авторы, названия произведений, годы первой публикации и дополнительные комментарии.
overview <- read_tsv(
"data/overview.tsv",
col_names = c(
"textID", "author", "authorID", "title",
"first_published", "author_gender", "comment"
),
skip = 1
)
overview## # A tibble: 27 × 7
## textID author authorID title first_published author_gender comment
## <dbl> <chr> <chr> <chr> <dbl> <dbl> <chr>
## 1 1 Austen, Jane JA Emma 1815 1 <NA>
## 2 2 Austen, Jane JA Pride 1813 1 <NA>
## 3 3 Austen, Jane JA Sense 1811 1 <NA>
## 4 4 Bronte, Anne AB Agne… 1847 1 <NA>
## 5 5 Bronte, Anne AB Tent… 1848 1 <NA>
## 6 6 Bronte, Charlotte CB Jane… 1847 1 <NA>
## 7 7 Bronte, Charlotte CB Prof… 1845 1 date o…
## 8 8 Bronte, Charlotte CB Vill… 1853 1 <NA>
## 9 9 Bronte, Emily EB Wuth… 1847 1 <NA>
## 10 10 Dickens, Charles CD Blea… 1852 2 serial
## # ℹ 17 more rowsПосмотрим, сколько произведений приходится на каждого автора.
overview |>
count(author) |>
arrange(n)## # A tibble: 11 × 2
## author n
## <chr> <int>
## 1 Bronte, Emily 1
## 2 Bronte, Anne 2
## 3 Fielding, Henry 2
## 4 Richardson, Samuel 2
## 5 Sterne, Laurence 2
## 6 Austen, Jane 3
## 7 Bronte, Charlotte 3
## 8 Dickens, Charles 3
## 9 Eliot, George 3
## 10 Thackeray, William Makepeace 3
## 11 Trollope, Antony 3overview |>
count(author) |>
ggplot(aes(reorder(author, n), n, fill = author)) +
geom_col(show.legend = FALSE) +
xlab(NULL) +
ylab("Number of novels") +
scale_fill_viridis_d() +
theme_light() +
coord_flip()
В корпусе есть авторы с одним, двумя и тремя произведениями. Для интерпретации это нужно учитывать: если у автора меньше исходных текстов, модель все равно получает много учебных примеров после деления романов на фрагменты.
Также посмотрим, как тексты распределены по времени.
overview |>
mutate(author_gender = as.factor(author_gender)) |>
ggplot(aes(first_published, reorder(author, first_published), color = author_gender)) +
geom_point(size = 3) +
xlab("Year of first publication") +
ylab(NULL) +
labs(color = "Gender code") +
theme_light()
Корпус охватывает большой период: от Генри Филдинга и Самюэля Ричардсона в XVIII веке до авторов викторианской прозы XIX века. Поэтому модель может частично улавливать не только индивидуальный стиль, но и различия между литературными периодами.
3 Подготовка текстов
Загружаю тексты через пакет {stylo}. Затем делю каждый
роман на фрагменты по 2000 слов. Это нужно для того, чтобы модель
обучалась не на целых романах, а на большом количестве сопоставимых
фрагментов.
corpus <- load.corpus.and.parse(corpus.dir = "data/british_fiction/british_fiction")
corpus_samples <- make.samples(
corpus,
sample.size = 2000,
sampling = "normal.sampling",
sample.overlap = 0,
sampling.with.replacement = FALSE
)
corpus_samples_clean <- corpus_samplesДля признаков я выбираю 500 самых частотных слов. Такой подход хорошо подходит для стилометрии: частые слова часто включают служебную лексику и устойчивые авторские привычки, а не только имена персонажей или темы произведений.
mfw <- make.frequency.list(corpus_samples_clean)[1:500]
corpus_tf <- stylo::make.table.of.frequencies(corpus_samples_clean, mfw) |>
as.data.frame.matrix() |>
rownames_to_column("id") |>
as_tibble()
corpus_tf <- corpus_tf |>
separate(id, into = c("author", "title", NA), sep = "_")
corpus_tf## # A tibble: 3,253 × 502
## author title the and to of i a `in` that he it
## <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 ABronte Agnes 5.4 4.85 3.55 3.1 1 1.4 1.5 0.9 1.25 0.65
## 2 ABronte Agnes 3.2 3.85 4.65 1.95 3.2 2.35 1.2 0.9 0.15 1.05
## 3 ABronte Agnes 4.7 4.4 2.7 1.85 3.75 2.45 1.3 0.8 0.25 1
## 4 ABronte Agnes 3.05 4.5 3.8 2 3.3 2.1 1.1 1.2 1.7 1.7
## 5 ABronte Agnes 4.15 4.1 4.8 2.35 3.55 1.5 2.35 0.7 1.05 1.2
## 6 ABronte Agnes 3.5 3.55 3.5 2.5 4 1.7 1 1.15 0.1 0.85
## 7 ABronte Agnes 4.3 4.65 2.9 2.5 3.3 1.6 2.15 1.2 0.5 0.9
## 8 ABronte Agnes 4.15 3.55 2.85 2.65 2.5 2.3 1.3 1.1 1.7 1
## 9 ABronte Agnes 2.55 3.55 3.75 1.9 3.95 1.15 1.3 0.95 0.35 1.25
## 10 ABronte Agnes 4.4 4.6 3.15 2.8 3.25 2.8 1.6 1.1 0.1 0.7
## # ℹ 3,243 more rows
## # ℹ 490 more variables: you <dbl>, was <dbl>, her <dbl>, his <dbl>, as <dbl>,
## # my <dbl>, `for` <dbl>, not <dbl>, she <dbl>, with <dbl>, had <dbl>,
## # be <dbl>, but <dbl>, have <dbl>, me <dbl>, is <dbl>, at <dbl>, s <dbl>,
## # him <dbl>, so <dbl>, on <dbl>, said <dbl>, this <dbl>, which <dbl>,
## # by <dbl>, all <dbl>, mr <dbl>, would <dbl>, `if` <dbl>, from <dbl>,
## # will <dbl>, what <dbl>, your <dbl>, no <dbl>, or <dbl>, when <dbl>, …4 Разведывательный анализ
После деления на фрагменты количество наблюдений сильно увеличилось. Проверим, сколько фрагментов есть у каждого автора.
corpus_tf |>
count(author) |>
arrange(n)## # A tibble: 11 × 2
## author n
## <chr> <int>
## 1 EBronte 59
## 2 Sterne 115
## 3 ABronte 118
## 4 Austen 201
## 5 CBronte 236
## 6 Fielding 244
## 7 Trollope 377
## 8 Eliot 379
## 9 Thackeray 401
## 10 Dickens 414
## 11 Richardson 709corpus_tf |>
count(author) |>
ggplot(aes(reorder(author, n), n, fill = author)) +
geom_col(show.legend = FALSE) +
xlab(NULL) +
ylab("Number of 2000-word samples") +
scale_fill_viridis_d() +
theme_light() +
coord_flip()
Больше всего фрагментов у Ричардсона, потому что его тексты в корпусе самые длинные. Меньше всего фрагментов у Эмили Бронте, так как в корпусе представлен только один ее роман. Это может влиять на качество классификации по отдельным авторам.
Чтобы посмотреть на структуру данных, применяю PCA. Это не модель классификации, а способ увидеть многомерные данные на двумерном графике.
corpus_top <- corpus_tf |>
add_count(author) |>
filter(n > 5) |>
select(-n, -title)
set.seed(06042025)
data_split <- corpus_top |>
mutate(author = as.factor(author)) |>
initial_split(strata = author)
data_train <- training(data_split)
data_test <- testing(data_split)
set.seed(06042025)
folds <- vfold_cv(data_train, strata = author, v = 5)base_rec <- recipe(author ~ ., data = data_train) |>
step_zv(all_predictors()) |>
step_normalize(all_predictors())
pca_rec <- base_rec |>
step_pca(all_predictors(), num_comp = 7)
pca_trained <- pca_rec |>
prep(data_train)
pca_trained |>
juice() |>
ggplot(aes(PC1, PC2, color = author)) +
geom_point(alpha = 0.7) +
theme_light()
На графике видно, что авторы частично пересекаются, но некоторые группы все же образуют собственные области. Значит, частотности слов дают информацию об авторском стиле.
5 Модели классификации
Дальше я использую {tidymodels}. Для сравнения беру
четыре модели из урока:
- ridge-регрессию;
- lasso-регрессию;
- линейный SVM;
- метод ближайших соседей.
Каждую модель проверяю в двух вариантах: с исходными частотными признаками и с PCA-признаками.
ridge_spec <- multinom_reg(penalty = tune(), mixture = 0) |>
set_mode("classification") |>
set_engine("glmnet")
lasso_spec <- multinom_reg(penalty = tune(), mixture = 1) |>
set_mode("classification") |>
set_engine("glmnet")
svm_spec <- svm_linear(cost = tune()) |>
set_mode("classification") |>
set_engine("LiblineaR")
knn_spec <- nearest_neighbor(neighbors = 5) |>
set_engine("kknn") |>
set_mode("classification")
wflow_set <- workflow_set(
preproc = list(
base = base_rec,
pca = pca_rec
),
models = list(
ridge = ridge_spec,
lasso = lasso_spec,
svm = svm_spec,
knn = knn_spec
),
cross = TRUE
)
wflow_set## # A workflow set/tibble: 8 × 4
## wflow_id info option result
## <chr> <list> <list> <list>
## 1 base_ridge <tibble [1 × 4]> <opts[0]> <list [0]>
## 2 base_lasso <tibble [1 × 4]> <opts[0]> <list [0]>
## 3 base_svm <tibble [1 × 4]> <opts[0]> <list [0]>
## 4 base_knn <tibble [1 × 4]> <opts[0]> <list [0]>
## 5 pca_ridge <tibble [1 × 4]> <opts[0]> <list [0]>
## 6 pca_lasso <tibble [1 × 4]> <opts[0]> <list [0]>
## 7 pca_svm <tibble [1 × 4]> <opts[0]> <list [0]>
## 8 pca_knn <tibble [1 × 4]> <opts[0]> <list [0]>6 Кросс-валидация и сравнение
Для оценки моделей использую 5-фолдную кросс-валидацию. Метрики:
accuracy и f_meas.
plan(sequential)
set.seed(180525)
train_res <- wflow_set |>
workflow_map(
verbose = TRUE,
seed = 180525,
resamples = folds,
grid = 3,
metrics = metric_set(f_meas, accuracy),
control = control_resamples(save_pred = TRUE)
)autoplot(train_res, metric = "accuracy") +
theme_light() +
theme(legend.position = "none") +
geom_text(
aes(y = mean - 2 * std_err, label = wflow_id),
angle = 90,
hjust = 1.5
) +
coord_cartesian(ylim = c(-0.3, NA))
rank_results(train_res, select_best = TRUE) |>
print()## # A tibble: 16 × 9
## wflow_id .config .metric mean std_err n preprocessor model rank
## <chr> <chr> <chr> <dbl> <dbl> <int> <chr> <chr> <int>
## 1 base_ridge pre0_mod1_po… accura… 0.997 0.00104 5 recipe mult… 1
## 2 base_ridge pre0_mod1_po… f_meas 0.994 0.00260 5 recipe mult… 1
## 3 base_svm pre0_mod1_po… accura… 0.993 0.00211 5 recipe svm_… 2
## 4 base_svm pre0_mod1_po… f_meas 0.988 0.00378 5 recipe svm_… 2
## 5 base_lasso pre0_mod1_po… accura… 0.990 0.00173 5 recipe mult… 3
## 6 base_lasso pre0_mod1_po… f_meas 0.984 0.00580 5 recipe mult… 3
## 7 pca_ridge pre0_mod1_po… accura… 0.864 0.00746 5 recipe mult… 4
## 8 pca_ridge pre0_mod1_po… f_meas 0.884 0.00639 5 recipe mult… 4
## 9 base_knn pre0_mod0_po… accura… 0.867 0.00764 5 recipe near… 5
## 10 base_knn pre0_mod0_po… f_meas 0.827 0.00791 5 recipe near… 5
## 11 pca_knn pre0_mod0_po… accura… 0.879 0.00372 5 recipe near… 6
## 12 pca_knn pre0_mod0_po… f_meas 0.814 0.00634 5 recipe near… 6
## 13 pca_svm pre0_mod1_po… accura… 0.880 0.00713 5 recipe svm_… 7
## 14 pca_svm pre0_mod1_po… f_meas 0.808 0.0184 5 recipe svm_… 7
## 15 pca_lasso pre0_mod1_po… accura… 0.895 0.00140 5 recipe mult… 8
## 16 pca_lasso pre0_mod1_po… f_meas 0.808 0.0100 5 recipe mult… 8Лучше всего работает модель base_ridge, то есть
ridge-регрессия на исходных частотных признаках. В данных много
связанных между собой частотных признаков, а регуляризация помогает
модели не переобучаться.
PCA не улучшает лучшие модели. Вероятно, при сокращении пространства до 7 компонент теряется часть информации, которая была полезна для точного различения авторов.
autoplot(train_res, id = "base_ridge") +
theme_light()
7 Проверка лучшей модели
Финализирую лучшую модель и проверяю ее на тестовой выборке, которая не участвовала в обучении.
best_results <- train_res |>
extract_workflow_set_result("base_ridge") |>
select_best(metric = "accuracy")
print(best_results)## # A tibble: 1 × 2
## penalty .config
## <dbl> <chr>
## 1 1.07e-10 pre0_mod1_post0ridge_res <- train_res |>
extract_workflow("base_ridge") |>
finalize_workflow(best_results) |>
last_fit(
split = data_split,
metrics = metric_set(f_meas, accuracy, roc_auc)
)
collect_metrics(ridge_res) |>
print()## # A tibble: 3 × 4
## .metric .estimator .estimate .config
## <chr> <chr> <dbl> <chr>
## 1 f_meas macro 0.995 pre0_mod0_post0
## 2 accuracy multiclass 0.996 pre0_mod0_post0
## 3 roc_auc hand_till 1.000 pre0_mod0_post0Результат на тестовой выборке получился высоким. Частотные признаки хорошо подходят для задачи авторской атрибуции в этом корпусе.
collect_predictions(ridge_res) |>
conf_mat(truth = author, estimate = .pred_class) |>
autoplot(type = "heatmap") +
scale_fill_gradient(low = "white", high = "#233857") +
theme(
panel.grid.major = element_line(colour = "#233857"),
axis.text = element_text(color = "#233857"),
axis.title = element_text(color = "#233857"),
plot.title = element_text(color = "#233857"),
axis.text.x = element_text(angle = 90)
)
По матрице ошибок видно, что модель почти всегда правильно определяет автора. Ошибок мало, поэтому основные значения находятся на диагонали.
collect_predictions(ridge_res) |>
roc_curve(truth = author, .pred_ABronte:.pred_Trollope) |>
ggplot(aes(1 - specificity, sensitivity, color = .level)) +
geom_abline(slope = 1, color = "gray50", lty = 2, alpha = 0.8) +
geom_path(linewidth = 1.2, alpha = 0.7) +
labs(color = NULL) +
theme_light()
ROC-кривые также говорят о хорошем качестве модели: линии проходят близко к верхнему левому углу.
8 Интерпретация признаков
Теперь посмотрим, какие слова сильнее всего связаны с каждым автором в финальной модели. Для этого беру коэффициенты ridge-регрессии.
final_model <- extract_fit_parsnip(ridge_res)
top_terms <- tidy(final_model) |>
filter(term != "(Intercept)") |>
group_by(class) |>
slice_max(abs(estimate), n = 10) |>
ungroup() |>
mutate(term = fct_reorder(term, abs(estimate)))
top_terms |>
print()## # A tibble: 110 × 4
## class term estimate penalty
## <chr> <fct> <dbl> <dbl>
## 1 ABronte but 0.221 1.07e-10
## 2 ABronte and 0.131 1.07e-10
## 3 ABronte or 0.119 1.07e-10
## 4 ABronte replied 0.109 1.07e-10
## 5 ABronte arthur 0.102 1.07e-10
## 6 ABronte which -0.0995 1.07e-10
## 7 ABronte too 0.0969 1.07e-10
## 8 ABronte them 0.0936 1.07e-10
## 9 ABronte few 0.0902 1.07e-10
## 10 ABronte out -0.0899 1.07e-10
## # ℹ 100 more rowstop_terms |>
ggplot(aes(x = estimate, y = term, fill = class)) +
geom_col(show.legend = FALSE, alpha = 0.85) +
facet_wrap(~ class, scales = "free_y", nrow = 4) +
scale_fill_brewer(palette = "Paired") +
labs(
title = "Most important features for each author",
x = "Coefficient",
y = "Feature"
) +
theme_minimal()
Среди важных признаков есть не только содержательные слова, но и частые служебные слова. Для стилометрии это ожидаемо: модель часто различает авторов по частотным привычкам, а не только по темам и именам персонажей.
9 Выводы
В этой работе я построил модель многоклассовой классификации для корпуса британской прозы. Сначала тексты были разделены на равные фрагменты, затем для каждого фрагмента были посчитаны частоты 500 самых частотных слов. Такой дизайн признаков подходит для анализа авторского стиля, потому что частотные слова хорошо отражают устойчивые речевые привычки.
Разведывательный анализ показал, что корпус несбалансирован: у разных авторов разное число произведений и фрагментов. Особенно много фрагментов у Ричардсона, а меньше всего у Эмили Бронте. PCA показал частичное разделение авторов, но также заметное пересечение между некоторыми группами.
По итогам кросс-валидации лучшей оказалась ridge-регрессия с исходными частотными признаками. Модели с PCA в целом уступали лучшим моделям без PCA, потому что при снижении размерности часть различающей информации, вероятно, терялась.
Финальная модель показала высокое качество на тестовой выборке. Даже простые частотные признаки могут хорошо работать для задачи авторской атрибуции, если тексты достаточно длинные и корпус подготовлен одинаково.