Многоклассовая классификация произведений британских авторов

Сегодня наша задача – на основе корпуса A Small Collection of British Fiction (28 произведений британской прозы конца XVIII — XIX веков) проанализировать стилистические особенности авторов и классифицировать тексты по авторам.

---

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

library(tidyverse)
library(textrecipes)
library(tidymodels)
library(tidytext)
library(glmnet)
library(stylo)

corpus <- load.corpus.and.parse(
  corpus.dir = "A_Small_Collection_of_British_Fiction-master/corpus"
)

slicing input text into tokens...

turning words into features, e.g. char n-grams (if applicable)...

Далее разделяем тексты на фрагменты по 2000 слов и извлекаем необходимые метаданные.

samples <- make.samples(
  corpus,
  sample.size = 2000,
  sampling = "normal.sampling",
  sample.overlap = 0,
  sampling.with.replacement = FALSE
)

samples_tbl <- tibble(
  id = names(samples),
  text = purrr::map_chr(samples, paste, collapse = " ")
)

samples_tbl <- samples_tbl |>
  separate(id,
           into = c("author", "title", "sample"),
           sep = "_",
           extra = "merge") |>
  filter(sample != "1") |>
  mutate(
    author = as.factor(author),
    work = paste(author, title, sep = "_")
  )

samples_tbl <- samples_tbl |>
  filter(author != "EBronte")

Отдельно стоит отметить, что из нашего анализа пришлось исключить Эмили Бронте, так как в корпусе представлено только одно (1) ее произведение, поэтому мы не можем обеспечить корректное определение авторства в данном случае, ведь части одного текста окажутся как в обучающей, так и в тестовой выборках.

---

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

works_tbl <- samples_tbl |>
  distinct(author, title, work)

set.seed(20260530)

test_works <- works_tbl |>
  group_by(author) |>
  slice_sample(n = 1) |>
  ungroup()

train_works <- works_tbl |>
  anti_join(test_works, by = "work")

data_train <- samples_tbl |>
  semi_join(train_works, by = "work")

data_test <- samples_tbl |>
  semi_join(test_works, by = "work")

data_train <- data_train |> mutate(author = factor(author))
data_test  <- data_test  |> mutate(author = factor(author))

data_split <- initial_split(
  bind_rows(data_train, data_test),
  strata = author
)

data_train <- training(data_split)
data_test  <- testing(data_split)

В непосредственно рецепт мы отправим токенизацию, удаление стоп-слов, отбор наиболее информативных токенов в размере 1000 единиц, преобразование текстов в матрицу признаков с помощью TF-IDF и стандартизацию признаков.

folds <- vfold_cv(
  data_train,
  v = 5,
  strata = author
)

base_rec <- recipe(author ~ text, data = data_train) |>
  step_tokenize(text) |>
  step_stopwords(text) |>
  step_tokenfilter(text, max_tokens = 1000) |>
  step_tfidf(text) |>
  step_zv(all_predictors()) |>
  step_normalize(all_predictors())

Для решения задачи будем использовать логистическую регрессию с Ridge-регуляризацией, чтобы уменьшить риск переобучения.

ridge_spec <- multinom_reg(
  penalty = tune(),
  mixture = 0
) |>
  set_engine("glmnet") |>
  set_mode("classification")

ridge_wflow <- workflow() |>
  add_recipe(base_rec) |>
  add_model(ridge_spec)

ridge_res <- ridge_wflow |>
  tune_grid(
    resamples = folds,
    grid = 4,
    metrics = metric_set(accuracy, f_meas)
  )

Затем переобучим модель с учетом выбранных ЛУЧШИХ параметрах и протестируем ее на отложенных данных.

collect_metrics(ridge_res)

# A tibble: 8 × 7
   penalty .metric  .estimator  mean     n    std_err .config        
     <dbl> <chr>    <chr>      <dbl> <int>      <dbl> <chr>          
1 1.29e-10 accuracy multiclass 0.998     5 0.00000421 pre0_mod1_post0
2 1.29e-10 f_meas   macro      0.996     5 0.000532   pre0_mod1_post0
3 2.33e- 7 accuracy multiclass 0.998     5 0.00000421 pre0_mod2_post0
4 2.33e- 7 f_meas   macro      0.996     5 0.000532   pre0_mod2_post0
5 4.70e- 4 accuracy multiclass 0.998     5 0.00000421 pre0_mod3_post0
6 4.70e- 4 f_meas   macro      0.996     5 0.000532   pre0_mod3_post0
7 9.11e- 1 accuracy multiclass 0.984     5 0.00204    pre0_mod4_post0
8 9.11e- 1 f_meas   macro      0.972     5 0.00254    pre0_mod4_post0

autoplot(ridge_res) + theme_light()

best_params <- select_best(ridge_res, metric = "accuracy")

final_ridge <- finalize_workflow(
  ridge_wflow,
  best_params
)

Для наглядного анализа результатов построим матрицу ошибок для определяемых авторов текстов.

final_fit <- final_ridge |>
  last_fit(split = data_split)

collect_metrics(final_fit)

# A tibble: 3 × 4
  .metric     .estimator .estimate .config        
  <chr>       <chr>          <dbl> <chr>          
1 accuracy    multiclass   0.999   pre0_mod0_post0
2 roc_auc     hand_till    1       pre0_mod0_post0
3 brier_class multiclass   0.00562 pre0_mod0_post0

collect_predictions(final_fit) |>
  conf_mat(truth = author, estimate = .pred_class) |>
  autoplot(type = "heatmap")

final_model <- extract_fit_parsnip(final_fit)

top_terms <- tidy(final_model) |>
  filter(term != "(Intercept)") |>
  group_by(class) |>
  slice_max(abs(estimate), n = 10) |>
  ungroup()

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

top_terms |>
  ggplot(aes(
    x = estimate,
    y = reorder(term, estimate),
    fill = class
  )) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~class, scales = "free") +
  theme_light()

Что мы можем сказать о полученных результатах?

Во-первых, высокая точность классификации частично объясняется высоким уровнем стилистического различия авторов в корпусе и использованием TF-IDF признаков, которые усиливают различия в частотной лексике. Мы дополнительно проверили отсутствие утечки на уровне произведений чтобы результаты отражали именно структурированную различимость авторского стиля.

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