Classification

hometask

-Что это, Холмс? -Это английская литература, мой дорогой Ватсон!

В рамках задания по многоклассовой классификации мы работаем с небольшим корпусом английский романов XVIII-XIX веков. Это не моя прямая область специализации. Но тем интереснее изучить их “дальним чтением”. Среди авторов у нас сёстры Бронте, Джейн Остин, Чарльз Диккенс, Уильям Теккерей, Джордж Элиот (Мэри Энн Эванс), Генри Филдинг, Сэмюэл Ричардсон, Лоренс Стерн и Энтони Троллоп. Для начала загрузим необходимые библиотеки.

library(tidyverse)
library(textrecipes)
library(tidymodels)
library(tidytext)
library(stylo)
library(stopwords)
library(embed)
library(future)
library(baguette)
library(discrim)
library(earth)
library(mda)

Чтобы прочитать весь корпус воспользуемся функцией load.corpus.and.parse() из пакета stylo. Она также выполняет предварительную обработку текста (токенизация + деление на n-граммы; без указания значения у аргумента ngram.size по умолчанию стоит 1, т.е. делит на слова). Затем делим тексты романов на более мелкие отрывки (длиной в 2000 слов)

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

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

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

Другой важный аспект - будем ли удалять стоп-слова?
Я решил, что ход работы пойдет по 2 путям: с удалением стоп-слов и без, а потом сравним. Дальше в тексте будут строчки кода из варианта без их удаления. Со вторым вариантом можно ознакомится в моем репозитории

Во втором варианте я взял 1000 частотных токенов вместо 500 как в первом. Более трети из этих тысячи токенов пришлось на стоп-слова (374), а с учетом имен и фамилий героев произведений почти половина (или же 456) была удалена.

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

#1 вариант
mfw <- make.frequency.list(corpus_samples)[1:500]
names <- c('lovelace', 'jones', 'tom', 'george', 'phineas', 'john', 'maggie', 
           'arthur', 'laura', 'adam', 'jane', 'harlowe', 'howe')
mfw_tibble <- as_tibble(mfw)
mfw_tibble <- mfw_tibble |>  
  filter(!value %in% names)
mfw_cleaned <- mfw_tibble |> 
  pull(value)

#2 вариант
mfw_1 <- make.frequency.list(corpus_samples, head = 1000)
names1 <- c('lovelace', 'jones', 'tom', 'george', 'phineas', 'john', 'maggie', 
           'arthur', 'laura', 'adam', 'jane', 'harlowe', 'toby', 'howe', 'crawley',
           'lydgate', 'dorothea', 'pendennis', 'mary', 'joseph', 'belford',
           'sophia', 'emma', 'clarissa', 'pamela', 'micawber', 'peggotty', 'adams',
           'hetty', 'lucy', 'tulliver', 'elinor', 'elizabeth', 'jack', 'casaubon', 
           'james', 'amelia', 'osborne', 'violet', 'richard', 'fred', 'fanny',
           'bulstrode', 'rosamond', 'marianne', 'harriet', 'solmes', 'rose')
other <- c('ll', 've', 'em', 'de', 'st')

stopwords <- stop_words$word

mfw_tibble1 <- as_tibble(mfw_1)
mfw_tibble1 <- mfw_tibble1 |>  
  filter(!value %in% stopwords) |>  
  filter(!value %in% names1)
mfw_cleaned1 <- mfw_tibble1 |> 
  pull(value)

После фильтрации создаем матрицу частотностей

#Составляем матрицу с частотностями
corpus_tf <- stylo::make.table.of.frequencies(corpus_samples, mfw_cleaned) |> 
  as.data.frame.matrix() |> 
  rownames_to_column("id") |> 
  as_tibble()

#Делим колонку id, чтобы получить имя автора
corpus_tf <- corpus_tf |> 
  separate(id, into = c("author", "title", NA), sep = "_") 
corpus_tf

#Смотрим распределение полчившихся отрывков по авторам
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()

corpus_tf |> 
  count(author) |> 
  arrange(n)

#Удаляем колонку title
corpus_tf <- corpus_tf |>  
  select(-title) 

Деление отрывков по авторам

Корпус у нас несбалансированный, значит нужно аккуратно относится к такой метрике как accuracy (каламбур).

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

set.seed(01062025)
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(01062025)
folds <- vfold_cv(data_train, strata = author, v = 5)
folds

Прописываем рецепты

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 = tune())

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

Провожу разведывательный анализ

base_trained <- base_rec |>
  prep(data_train) 

base_trained

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

pls_trained |> 
  juice() 

pls_trained |> 
  juice() |> 
  ggplot(aes(PLS1, PLS2, color = author)) +
  geom_point() +
  theme_light()

base_trained |> 
  step_umap(all_numeric_predictors(), outcome = "author", num_comp = 5) |> 
  prep() |> 
  juice() |> 
  ggplot(aes(UMAP1, UMAP2, color = author)) +
  geom_point(alpha = 0.5) +
  theme_light()

pls_trained

base_trained |> step_umap

В качестве числа компонентов указал 5. В принципе, при указании другого числа он не меняется, поэтому отсановил свой выбор на нём.

На первом графике большинство классов пересекаются за исключение Ричардсона, Филдинга и Теккерея. Через Джейн Остин они плавно переходят в “остальных”. В каком-то смысле, отображено время жизни авторов: от более ранних, живших в начале XVIII века до писателей Викторианской эпохи (если провести линию от точки (-10, 10) до точки (10, -10)).

На втором графике видим, что почти все авторы разошлись по отдельным кластерам.

Прописываем модели и методы

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

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

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

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

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

Создаем воркфлоу. У нас 20 моделей (4 рецепта*5моделей), и у каждой по три варианта гиперпараметров.

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,
                fda = fda_spec),  
  cross = TRUE
)

wflow_set

#Параллелим вычисления
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)

Визуализируем полученные оценки моделей на графике

#Визуализируем полученные оценки моделей на графике
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))

Вариант без удаления стоп-слов

Вариант без стоп-слов

В обоих случаях лучше себя показала модель base_ridge.График строился на основе метрики accuracy, но и f-means у этой модели выше, чем у других. Так что остановимся на ней.

#Выбираем лучшую и дообучаем
rank_results(train_res, select_best = TRUE) |> 
  print()

best_results <- 
  train_res |> 
  extract_workflow_set_result("base_ridge") |> 
  select_best(metric = "accuracy")

print(best_results)

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

Строим confusion matrix

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

Без удаления стоп-слов

С удаленными стоп-словами

Модель со стоп-словами справилась лучше. Она неправильно классифицировала 2 отрывка, тогда как другая - 16.

Построим ROC-кривую

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.5, alpha = 0.7) +
  labs(color = NULL) +
  theme_light()

Без удаления стоп-слов

С удаленными стоп-словами

На этих графиках тоже видно, что модель без удаления стоп-слов справилась лучше.

Так в чём смысл было удалять стоп-слова и создавать вторую модель? Да, эта модель немного хуже (но не очень сильно). Однако она была построена на словах, несущих смысловую нагрузку. Стоп-слова позволяют нам увидеть стилистику, некоторые особенности построения предложений и т.д., тогда как “значительные” слова - темы, семантику и прочее. Поэтому визуализируем топ-7 слов для каждого автора в 2 моделях.

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

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) +
  labs(
    title = "Наиболее важные признаки для каждого автора",
    x = "Коэффициент",
    y = "Признак"
  ) +
  theme_minimal() 

Без удаления стоп-слов

С удаленными стоп-словами

Интерпретация. Мы идём по следу

1. Моё личное наблюдение. У Эмилии Бронте часто встречаются сокращения. Согласно представленным на графиках выше результатам она чаще других пишет ll, m и ve вместо will, am, have. Это может объясняться рядом причин: её авторская стилистика; особенности редактуры загруженного варианта текста; выброс, поскольку она представлена одним романом (“Грозовой перевал”, соотвественно)

2. У Стерна встречается слово de. Вероятно, это приставка французских дворянских фамилий, поскольку “Сентиментальное путешествие по ФРАНЦИИ и Италии”. Также часто встречается слово “природа”. Для произведений Стерна характерны описания пейзажей как фона для душевных переживаний героя. Пейзаж начинает играть важную роль в повествовании.

3. У Филдинга, который творил в начале-середине XVIII века, встречается устаревшая форма глагола have - hath. Здесь два варианта: живо предание давно минувших дней; авторская стилизация под старину. У другого автора того же периода - Сэмюэля Ричардсона - также встречается “устаревшее слово” - thou.

4. Ричардсон писал любовные романы, но довольно специфические - они были наполнены морализаторством и чопорностью. Поэтому не мудренно, что модель вывела слово sex (пол), поскольку он писал много о межполовых отношениях. Другой важной чертой отношений между мужчиной и женщиной были письма (разумеется, любовные), поэтому встречаются letter и обращение dear.

5. У Эмилии Бронте встречается часто будущее время (в форме ll), тогда как у других will не проявляется. Это странно. Мне кажется, что многое в “Грозовом перевале” о прошлом (что-то из верии “до тех пор как” - till, но я не претендую правоту). Возможно, в этом проявляется тема “времени”. Это лишь шаткое предположение, нужно взглянуть глазами профессионала.

6. У Диккенса часто встречается “голова”. Не уверен, но это может быть остаток от токенизации должностей руководителей/вышестоящих чинов, что укладывается в логику социально ориентированных романов Диккенса (отношения “низы-верхи”).

7. Интересно, что у Остин много наречий: soon, perfectly, directly. Она концентрируется на действии. Наверное, через описание действий/поступков/намерений/движений Остин раскрывает характеры героев. Но не уверен.

8. Больше глаголов, связанных с говорением (replied, answered, declared, determined), встречается в работах женской половины корпуса (Остин, А. Бронте, Э. Бронте, Элиот), чем в мужских (Филдинг, Троллоп). Другими словами, у женщин-писательниц больше диалогов.

9. Филдинг, видимо, любит сложные конструкции: много подчинительных союзов (which, then) и вводных слов таких как therefore. А Троллоп предпочитает что-то “продолжительное”, одновременность действий, параллельность (союз also и вспомагательный глагол been)

10. Местоимение “я” встречается на графике только у Элиот. Вероятно, для неё характерно описание от первого лица. Или же, другой вариант, речь её персонажей в диалогах и монологах строится вокруг их самих, они больше говорят о себе, чем о других.