Классификация текстов британской литературы

Подготовка и очистка корпуса

Перед началом работы загрузим все библиотеки, необходимые для работы.

library(tidyverse)
library(textrecipes)
library(tidymodels)
library(tidytext)
library(stylo)
library(stopwords)
library(stringr)
library(learntidymodels)
library(embed)
library(baguette)
library(discrim) 
library(future)

Загрузим корпус и проведем предварительную обработку текстов: удалим из них названия текстов, имена авторов (они обычно находятся на месте 1-2 элементов вектора, но, поскольку издания отличаются друг от друга, некоторые заголовки и имена удаляем, отследив их положение вручную), а также структурную разметку — номера глав и томов.

corpus <- load.corpus(corpus.dir = "british_fiction")

corpus <- lapply(corpus, function(x) x[-c(1, 2)])
corpus[["Austen_Emma.txt"]] <- corpus[["Austen_Emma.txt"]][-1]
corpus[["Thackeray_Barry.txt"]] <- corpus[["Thackeray_Barry.txt"]][-1]
corpus[["Trollope_Phineas.txt"]] <- corpus[["Trollope_Phineas.txt"]][-1:-2]
corpus[["Trollope_Prime.txt"]] <- corpus[["Trollope_Prime.txt"]][-1]

corpus <- lapply(corpus, function(x) {
  str_remove_all(x, "(?i)chapter\\s*[-:]?\\s*(?:\\d+|[ivxlcdm]+)\\.?")
})
corpus <- lapply(corpus, function(x) {
  str_remove_all(x, "PREFACE")
})
corpus <- lapply(corpus, function(x) {
  str_remove_all(x, "VOLUME\\s*[-:]?\\s*(?:[IVXLCDMivxlcdm]+)\\.?")
})

Всего в нашем корпусе 27 текстов, а авторов — 11. Уже сейчас виден перекос в данных: некоторые авторы (а именно Эмили Бронте) представлены всего одним текстом, в то время как остальные — минимум 2-мя или 3-мя.

Количественные лингвистические измерения. Разведывательный анализ данных.

Прежде, чем приступить к количественным исследованиям, токенизируем текст. При токенизации мы не будем удалять всю пунктуацию из текстов: мы оставим дефисы внутри слов, а также апострофы, чтобы избежать в дальнейшем того, что в токены попадают сокращения по типу “s”, “t”, “m” и т.д.

corpus_tokenized <- lapply(corpus, txt.to.words.ext, corpus.lang = "English.contr")

Подсчет стоп-слов у авторов

Для начала посмотрим, какие стоп-слова чаще всего употребляют авторы.

stop_words <- stopwords(language = "en", source = "snowball")

mfsw_all <- make.frequency.list(corpus_tokenized)
mfsw <- mfsw_all[mfsw_all %in% stop_words][1:50]

raw <- stylo::make.table.of.frequencies(corpus_tokenized, mfsw)
class(raw) <- "matrix" # отдельно перезаписываем класс, поскольку make.table.of.frequencies конкретно здесь не справляется с этим
stopwords_tf <- as.data.frame(raw) |>
  rownames_to_column("id") |>
  as_tibble()

# убираем названия текстов, оставляя только авторов
stopwords_tf <- stopwords_tf |> 
  separate(id, into = c("author", "title", NA), sep = "_") |> 
  select(-title)

# вычисляем среднюю частоту стоп-слов по текстам
stopwords_tf |> 
  pivot_longer(cols = -author, names_to = "word", values_to = "freq") |>
  group_by(author, word) |>
  summarise(freq = mean(freq), .groups = "drop") |>
  group_by(author) |>
  slice_max(freq, n = 10) |>
  ungroup() |>
  ggplot(aes(reorder_within(word, freq, author), freq, fill = word)) +
  geom_col(show.legend = FALSE) + 
  facet_wrap(~author, scales = "free_y") +
  scale_x_reordered() +
  coord_flip() +
  labs(x = NULL, y = "Средняя частота стоп-слов") +
  theme_light()

Интересно здесь взглянуть на употребление личных местоимений. По ним, к примеру, видно, что две сестры Бронте, Шарлотта и Эмили, и Сэмуэл Ричардсон предпочитали писать от 1-го лица (или же часто употреблять местоимение i в репликах героев), судя по тому, что местоимение i у них попадает в топ-3 стоп-слов. Другое интересное наблюдение: местоимение her появляется в топ-10 только у 3-х авторов из 11, и все они писательницы — Джейн Остин, Эмили Бронте и Джордж Элиот. Впрочем, у некоторых писателей в топ не попадают никакие местоимения 3 лица: у Энн и Шарлотты Бронте, Чарльза Диккенса, Сэмуэла Ричардсона и Лоренса Стерна.

Подсчет n-грамм

Теперь посмотрим, какие n-граммы чаще всего встречаются в корпусах текстов. Для этого предварительно удалим стоп-слова, а также зададим не биграммы, а триграммы: так, возможно, в топ попадут не только коллокации по типу “ms/mrs/mr + имя персонажа”.

no_stopwords <- lapply(corpus_tokenized, function(x) x[!x %in% stop_words])
n_grams <- lapply(no_stopwords, make.ngrams, ngram.size = 3)
file_names <- names(n_grams)
authors <- sapply(file_names, function(x) sub("_.*", "", x))
unique_authors <- unique(authors)

trigram_table <- imap_dfr(unique_authors, function(author, i) {
  indices <- which(authors == author)
  combined_ngrams <- unlist(n_grams[indices])
  freq <- table(combined_ngrams)
  top20 <- sort(freq, decreasing = TRUE)[1:20]
  tibble(
    author = author,
    trigram = names(top20),
    count = as.integer(top20)
  )
})

А теперь взглянем на триграммы отдельных авторов.

trigram_table |> filter(author == 'Sterne')

# A tibble: 20 × 3
   author trigram              count
   <chr>  <chr>                <int>
 1 Sterne said uncle toby        149
 2 Sterne quoth uncle toby       108
 3 Sterne cried uncle toby        42
 4 Sterne replied uncle toby      41
 5 Sterne trim said uncle         38
 6 Sterne quoth dr slop           21
 7 Sterne fille de chambre        20
 8 Sterne trim quoth uncle        19
 9 Sterne replied dr slop         18
10 Sterne uncle toby corporal     17
11 Sterne uncle toby trim         17
12 Sterne continued uncle toby    16
13 Sterne added uncle toby        15
14 Sterne bou bou bou             15
15 Sterne count de b              15
16 Sterne father uncle toby       15
17 Sterne monsieur le count       15
18 Sterne please honour said      13
19 Sterne uncle toby looking      13
20 Sterne honour said corporal    12

trigram_table |> filter(author == 'Austen')

# A tibble: 20 × 3
   author trigram              count
   <chr>  <chr>                <int>
 1 Austen mr frank churchill      45
 2 Austen mr john knightley       28
 3 Austen mrs john dashwood       24
 4 Austen dear miss woodhouse     23
 5 Austen said mr knightley       20
 6 Austen miss de bourgh          18
 7 Austen mr mrs weston           16
 8 Austen said mrs bennet         15
 9 Austen said mrs jennings       15
10 Austen lady catherine de       14
11 Austen mrs john knightley      14
12 Austen oh miss woodhouse       14
13 Austen catherine de bourgh     13
14 Austen said mrs weston         13
15 Austen mr mrs gardiner         11
16 Austen poor miss taylor        11
17 Austen said mr woodhouse       11
18 Austen without saying word     11
19 Austen colonel mrs campbell    10
20 Austen dare say shall          10

trigram_table |> filter(author == 'Thackeray')

# A tibble: 20 × 3
   author    trigram                 count
   <chr>     <chr>                   <int>
 1 Thackeray sir francis clavering      68
 2 Thackeray mrs o dowd                 53
 3 Thackeray sir pitt crawley           40
 4 Thackeray mr arthur pendennis        38
 5 Thackeray pall mall gazette          36
 6 Thackeray mrs bute crawley           31
 7 Thackeray aide de camp               29
 8 Thackeray mrs rawdon crawley         22
 9 Thackeray said old gentleman         21
10 Thackeray sir francis clavering^s    19
11 Thackeray let us go                  16
12 Thackeray said sir pitt              15
13 Thackeray god bless soul             14
14 Thackeray great gaunt street         14
15 Thackeray major o dowd               14
16 Thackeray miss crawley said          14
17 Thackeray miss rebecca sharp         14
18 Thackeray mrs major o                14
19 Thackeray five pound note            13
20 Thackeray lady o dowd                13

Как и ожидалось, большинство триграмм — это имена в сочетании с вежливым обращением и/или глаголом говорения. Впрочем, иногда мы видим тут что-то интересное: Стерн часто употребляет уже устаревший глагол “quoth” и довольно часто пишет в корпусе загадочное сочетание “bou bou bou”; Остин часто перед именем ставит какой-нибудь эпитет — “dear”, “poor”, а иногда и просто частицу “oh”; а Теккерей в то же время нередко пишет выражение “god bless soul”.

Подсчет средней длины предложений

И наконец взглянем на то, насколько пространными предложениями выражаются авторы.

sent_length <- imap_dfr(corpus, ~ tibble(
  author = str_extract(.y, "^[^_]+"), 
  text = paste(.x, collapse = " ")
)) |>
  group_by(author) |>
  summarise(text = paste(text, collapse = " "), .groups = "drop") |>
  mutate(
    sentences = str_split(text, "(?<=[.!?])\\s+"),
    avg_sent_length = map_dbl(sentences, ~ mean(str_count(.x, "\\w+"), na.rm = TRUE))
  ) |>
  select(author, avg_sent_length)

# построим график для наглядности
sent_length |> 
  ggplot(aes(reorder(author, avg_sent_length), avg_sent_length, fill = author)) +
  geom_col(show.legend = FALSE) +
  xlab(NULL) +
  ylab(NULL) +
  scale_fill_viridis_d() + 
  theme_light() +
  coord_flip()

Длиннее всего предложения у авторов XVIII в., причем довольно значительно — 40 и больше слов на предложение в среднем. Выбивается тут Ричардсон, возможно, потому, что в корпусе содержатся его эпистолярные романы, которые в силу жанра как будто могли подтолкнуть к выбору более коротких фраз. Удивительно коротко на их фоне пишет Диккенс, который улетел в конец графика: меньше 20 слов на предложение. Здесь, вероятно, сыграла роль его изначальная профессия. Диккенс изначально был репортером, журналистом, и, вполне вероятно, этот факт отразился на его стиле и в таком аспекте.

Подготовка датасета, создание выборок

corpus_samples <- make.samples(corpus_tokenized, 
                               sample.size = 2000, 
                               sampling = "normal.sampling", # здесь была идея воспользоваться random,sampling, чтобы избежать перекоса в данных, но с ним, к сожалению, модели работают ужасно
                               sample.overlap = 0,
                               sampling.with.replacement = FALSE)

mfw <- make.frequency.list(corpus_samples)[1:500]

corpus_tf <- stylo::make.table.of.frequencies(corpus_samples, mfw) |> 
  as.data.frame.matrix() |> 
  rownames_to_column("id") |> 
  as_tibble()

corpus_tf <- corpus_tf |> 
  separate(id, into = c("author", "title", NA), sep = "_") |> 
  select(-title)

corpus_tf |> 
  count(author) |> 
  ggplot(aes(reorder(author, n), n, fill = author)) +
  geom_col(show.legend = FALSE) +
  xlab(NULL) +
  ylab(NULL) +
  scale_fill_viridis_d() + 
  theme_light() +
  coord_flip()

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

set.seed(06042025)
data_split <- corpus_tf |> 
  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 = 10) # количество фолдов задаем по умолчанию

Подготовка рецепта

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 = 10) # поскольку авторов у нас 11, попробуем задать 10 компонент

base_trained <- base_rec |>
  prep(data_train) 

base_trained |> 
  bake(new_data = NULL)

# A tibble: 2,413 × 501
       the   and     to       of      i      a    `in`    that      he     was
     <dbl> <dbl>  <dbl>    <dbl>  <dbl>  <dbl>   <dbl>   <dbl>   <dbl>   <dbl>
 1  1.05   2.16   0.592  0.893   -1.02  -1.27  -0.0752 -0.859  -0.0367  1.10  
 2  0.263  1.90  -0.410 -0.00319  0.544 -0.598  1.07   -0.556  -0.965   0.0152
 3  0.0647 2.10  -0.267  0.818   -0.185  0.548 -0.202  -1.67   -1.23    0.377 
 4  0.0250 0.543 -0.195 -0.00319  0.289 -0.311 -0.456   0.0489 -0.368   0.468 
 5  0.580  1.26  -0.481  0.146    1.35  -0.502 -0.709  -1.06    1.36    1.19  
 6  0.0250 0.478  0.949 -0.600    0.945 -0.598 -1.60   -1.06   -0.766   0.558 
 7 -1.28   0.867  0.305 -0.899    1.38  -0.216 -1.47    0.0489  0.162  -0.618 
 8  0.936  1.64   1.59   0.0715   0.836 -1.27  -0.456  -0.758   0.825   0.468 
 9 -1.28   0.802  0.949 -1.12     0.471 -0.311 -0.456  -0.455   0.692  -0.980 
10 -1.04   1.19   0.806 -0.526    1.82  -0.884 -1.85    0.351   1.16   -0.890 
# ℹ 2,403 more rows
# ℹ 491 more variables: it <dbl>, you <dbl>, her <dbl>, his <dbl>, as <dbl>,
#   my <dbl>, `for` <dbl>, not <dbl>, with <dbl>, had <dbl>, she <dbl>,
#   be <dbl>, but <dbl>, have <dbl>, me <dbl>, is <dbl>, at <dbl>, him <dbl>,
#   so <dbl>, on <dbl>, said <dbl>, this <dbl>, which <dbl>, by <dbl>,
#   all <dbl>, would <dbl>, mr <dbl>, `if` <dbl>, from <dbl>, will <dbl>,
#   what <dbl>, your <dbl>, no <dbl>, or <dbl>, when <dbl>, been <dbl>, …

Снижение размерности

PCA

Снизим размерность наших данных разнымии способами, проведем EDA также через PCA и другие методы и посмотрим, как хорошо авторы расходятся по измерениям. Смотреть по всем сочетаниям измерений мы не будем, взглянем только на некоторые из них.

pca_trained <- pca_rec |>
  prep(data_train) 

pca_trained |> 
  juice()

# A tibble: 2,413 × 11
   author   PC01   PC02   PC03   PC04   PC05    PC06   PC07   PC08   PC09   PC10
   <fct>   <dbl>  <dbl>  <dbl>  <dbl>  <dbl>   <dbl>  <dbl>  <dbl>  <dbl>  <dbl>
 1 ABron… -0.955  5.38  -0.188 -1.93  -0.264  1.69   -1.54  -2.09   3.27   2.12 
 2 ABron… -3.11   0.272 -1.29  -3.17   0.137  1.22   -0.608 -0.739  1.48  -0.278
 3 ABron… -0.509  3.12   1.60  -4.80  -0.665  3.43   -1.85  -0.920  0.576  2.18 
 4 ABron…  0.554 -0.959  0.945 -2.81   0.618  3.13   -1.15   0.285  0.395  2.39 
 5 ABron… -2.83  -3.02   1.11  -2.19  -2.66  -0.0617  1.47  -0.659  3.33   0.963
 6 ABron… -0.920 -1.67  -3.27  -1.97  -3.01   0.473   0.426  1.09   0.114  2.49 
 7 ABron…  5.07  -4.98   1.55   1.96  -0.466  1.12    2.70   1.35   0.111  2.57 
 8 ABron… -3.62  -0.152 -2.92  -3.20  -1.01  -2.29    1.01   0.265 -0.220 -1.30 
 9 ABron…  4.07  -2.50   1.62   1.40   1.52   2.68    0.766 -0.631  1.13   2.73 
10 ABron…  4.86  -6.91  -0.161  0.258 -1.18  -0.584  -0.640  0.642  0.453  2.86 
# ℹ 2,403 more rows

pca_trained

pca_trained |> 
  juice() |> 
  ggplot(aes(PC01, PC02, color = author)) +
  geom_point() + 
  theme_light()

pca_trained |> 
  juice() |> 
  ggplot(aes(PC03, PC04, color = author)) +
  geom_point() + 
  theme_light()

pca_trained |> 
  juice() |> 
  ggplot(aes(PC08, PC09, color = author)) +
  geom_point() + 
  theme_light()

Ожидаемо, лучше всего выделяются те авторы, у которых больше текстов.

PLS

Проверим то же самое и через PLS. Результат, кажется, уже лучше.

pls_trained <- base_trained |> 
  step_pls(all_numeric_predictors(), outcome = "author", num_comp = 10) |> 
  prep() 

pls_trained |> 
  juice() 

# A tibble: 2,413 × 11
   author    PLS01  PLS02  PLS03  PLS04   PLS05   PLS06  PLS07  PLS08  PLS09
   <fct>     <dbl>  <dbl>  <dbl>  <dbl>   <dbl>   <dbl>  <dbl>  <dbl>  <dbl>
 1 ABronte -0.174   2.28  -2.14  -1.52   0.0606 -0.700   2.35   0.132 -0.604
 2 ABronte -2.49    0.942  1.75  -2.42   0.881   0.995   2.09   0.459 -1.60 
 3 ABronte -0.0933 -0.823 -0.155 -4.33   1.09   -2.36    3.04  -0.508  0.663
 4 ABronte  0.181  -1.60   1.92  -2.29   0.307  -1.34    1.65  -0.294 -0.832
 5 ABronte -2.98   -2.36   1.64  -2.08   2.54    1.23    1.02  -0.632 -2.96 
 6 ABronte -0.462   1.93   2.71  -1.65   3.38   -0.0663  2.04  -2.05  -4.07 
 7 ABronte  3.44   -3.27   1.86  -0.200  0.980   1.76   -0.642 -1.45  -3.92 
 8 ABronte -2.57    2.35   2.01  -1.52   2.32    1.00    1.71  -1.37  -1.89 
 9 ABronte  3.00   -2.73   1.14  -0.897 -0.993   0.229   0.700 -1.09  -4.19 
10 ABronte  3.40   -2.77   4.44   0.520  3.51    0.479   0.514 -1.95  -5.62 
# ℹ 2,403 more rows
# ℹ 1 more variable: PLS10 <dbl>

pls_trained |> 
  juice() |> 
  ggplot(aes(PLS03, PLS04, color = author)) +
  geom_point() +
  theme_light()

UMAP

Наконец, проверим и через UMAP, который тоже добавим в рецепт. Здесь тоже хорошо кучкуются авторы с большим количеством текстов.

base_trained |> 
  step_umap(all_numeric_predictors(), outcome = "author", num_comp = 10) |> 
  prep() |> 
  juice() |> 
  ggplot(aes(UMAP01, UMAP02, color = author)) +
  geom_point(alpha = 0.5) +
  theme_light()

pls_rec <- base_rec |> 
  step_pls(all_numeric_predictors(), outcome = "author", num_comp = tune())

umap_rec <- base_rec |> 
  step_umap(all_numeric_predictors(), 
            outcome = "author",
            num_comp = tune(),
            neighbors = tune(),
            min_dist = tune()
  )

Модели

Добавляем в рецепт еще ряд моделей: 1. Lasso — L1-регуляризация 2. Ridge — L2-регуляризация 3. SVM — метод опорных векторов 4. MLP — однослойная нейронная сеть 5. FDA — расширение линейного дискриминантного анализа 6. KNN — метод k-ближайших соседей

Позже мы выясниим, какая же из них лучше справляется с классификацией текстов.

# Lasso 
lasso_spec <- multinom_reg(penalty = tune(), mixture = 1) |> 
  set_mode("classification") |> 
  set_engine("glmnet")

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

# SVM
svm_spec <- svm_linear(cost = tune()) |> 
  set_mode("classification") |> 
  set_engine("LiblineaR")

# MLP
mlp_spec <- mlp(hidden_units = tune(),
                penalty = tune(),
                epochs = tune()) |> 
  set_engine("nnet") |> 
  set_mode("classification")

# FDA
fda_spec <- discrim_flexible(prod_degree = tune()) |> 
  set_engine("earth")

# KNN
knn_spec <- nearest_neighbor(neighbors = 5) |> 
  set_engine("kknn") |> 
  set_mode("classification")

Создание воркфлоу и запуск моделей

wflow_set <- workflow_set(  
  preproc = list(base = base_rec,
                 pca = pca_rec,
                 pls = pls_rec,
                 umap = umap_rec),  
  models = list(svm = svm_spec,
                lasso = lasso_spec,
                ridge = ridge_spec,
                mlp = mlp_spec,
                #bagging = bagging_spec,
                fda = fda_spec,
                #rda = rda_spec,
                knn = knn_spec),  
  cross = TRUE
)

parallel::detectCores()

[1] 8

plan(multisession, workers = 5)

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)
  )

plan(sequential)

Оценка лучших моделей

Выведем на экран показатели моделей и отберем из них лучшую, чтобы финализировать воркфлоу.

rank_results(train_res, select_best = TRUE) |> 
  print()

# A tibble: 48 × 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.00103    10 recipe       mult…     1
 2 base_ridge pre0_mod1_po… f_meas  0.995 0.00156    10 recipe       mult…     1
 3 base_svm   pre0_mod1_po… accura… 0.993 0.00235    10 recipe       svm_…     2
 4 base_svm   pre0_mod1_po… f_meas  0.992 0.00243    10 recipe       svm_…     2
 5 base_lasso pre0_mod1_po… accura… 0.989 0.00178    10 recipe       mult…     3
 6 base_lasso pre0_mod1_po… f_meas  0.985 0.00343    10 recipe       mult…     3
 7 pca_lasso  pre0_mod1_po… accura… 0.947 0.00239    10 recipe       mult…     4
 8 pca_lasso  pre0_mod1_po… f_meas  0.904 0.00676    10 recipe       mult…     4
 9 pca_mlp    pre0_mod3_po… accura… 0.942 0.00725    10 recipe       mlp       5
10 pca_mlp    pre0_mod3_po… f_meas  0.896 0.0153     10 recipe       mlp       5
# ℹ 38 more rows

autoplot(train_res, id = "base_ridge") +
  theme_light()

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_post0

А теперь взглянем, как работает модель на тестовой выборке.

ridge_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.988 pre0_mod0_post0
2 accuracy multiclass     0.994 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))

Модель неправильно распознала 3 отрывка. Видимо, Филдинг перепутался с Теккерем скорее случайно, учитывая, что они жили в разные столетия. Однако 1 отрывок Эмили Бронте ошибочно определился как отрывок Шарлотты, что уже не выглядит таким случайным результатом, если учесть, что Шарлотта редактировала тексты сестры. Последняя ошибка тоже интересная — Диккенс и Элиот были знакомы между собой и с творчеством друг друга. Впрочем, домыслы о том, могли ли они как-то влиять на стиль друг друга, лучше оставить литературоведам.

И напоследок посмотрим на самые важные признаки для авторов.

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 = reorder_within(term, abs(estimate), class))

top_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_y_reordered() +
  scale_fill_manual(values = colorRampPalette(RColorBrewer::brewer.pal(8, "Dark2"))(11)) +
  labs(
    x = "Коэффициент",
    y = "Признак"
  ) +
  theme_minimal()

Выводы

Для решения задачи классификации британских авторов были использованы 6 различных моделей, из которых лучше всего справилась SVM, и 3 метода снижения размерности. Метрики f_meas, accuracy и roc_auc, хотя и не равны единицы, но крайне близки к ней после использования модели на тестовых данных. Из всех отрывков модель допустила 3 ошибки, причем, вероятно, ошибки эти могли быть не случайными, а вызванными схожестью стилей этих авторов.