В этом отчёте я анализирую корпус A Small Collection of British
Fiction (28 произведений британской прозы конца XVIII–XIX вв.) и
показываю, как на его основе можно построить признаки для задачи
классификации произведений по авторам в рамках фреймворка
{tidymodels}.[web:1][web:12][web:15]
Цель — выделить количественные характеристики авторского стиля (долю
служебных слов, длину предложений, длину слов) и подготовить текст к
обучению моделей классификации.[web:1][web:10][web:15]
library(tidyverse)
library(tidytext)
library(readr)
library(stringr)
library(fs)
library(glue)
theme_set(theme_minimal(base_size = 13))zip_url <- "https://github.com/locusclassicus/text_analysis_2024/raw/refs/heads/main/files/british_fiction.zip"
data_dir <- "data_british_fiction"
dir_create(data_dir)
zip_file <- file.path(data_dir, "british_fiction.zip")
if (!file_exists(zip_file)) {
download.file(zip_url, destfile = zip_file, mode = "wb")
}
unzip(zip_file, exdir = data_dir)
text_files <- dir_ls(data_dir, recurse = TRUE, regexp = "\\.txt$")
head(text_files)## data_british_fiction/british_fiction/ABronte_Agnes.txt
## data_british_fiction/british_fiction/ABronte_Tenant.txt
## data_british_fiction/british_fiction/Austen_Emma.txt
## data_british_fiction/british_fiction/Austen_Pride.txt
## data_british_fiction/british_fiction/Austen_Sense.txt
## data_british_fiction/british_fiction/CBronte_Jane.txtlength(text_files)## [1] 27texts <- map_df(text_files, function(path) {
fname <- path_file(path)
parts <- str_split(fname, "_", n = 2)[][3]
author_guess <- parts[3]
title_guess <- ifelse(length(parts) > 1, str_remove(parts, "\\.txt$"), fname)[4]
tibble(
file = path,
filename = fname,
author = author_guess,
title = title_guess,
text = read_file(path)
)
})
british <- texts %>%
mutate(doc_id = row_number())
british %>%
select(doc_id, author, title, filename) %>%
arrange(author, title) %>%
head(10)## # A tibble: 10 × 4
## doc_id author title filename
## <int> <list> <chr> <chr>
## 1 1 <NULL> <NA> ABronte_Agnes.txt
## 2 2 <NULL> <NA> ABronte_Tenant.txt
## 3 3 <NULL> <NA> Austen_Emma.txt
## 4 4 <NULL> <NA> Austen_Pride.txt
## 5 5 <NULL> <NA> Austen_Sense.txt
## 6 6 <NULL> <NA> CBronte_Jane.txt
## 7 7 <NULL> <NA> CBronte_Professor.txt
## 8 8 <NULL> <NA> CBronte_Villette.txt
## 9 9 <NULL> <NA> Dickens_Bleak.txt
## 10 10 <NULL> <NA> Dickens_David.txtdata("stop_words") # английский стоп-лист из tidytext
tidy_tokens <- british %>%
select(doc_id, author, title, text) %>%
unnest_tokens(word, text) %>%
filter(!str_detect(word, "^[0-9]+$")) %>%
filter(str_length(word) > 1)
tidy_tokens %>%
count(author) %>%
arrange(desc(n))## # A tibble: 1 × 2
## author n
## <list> <int>
## 1 <NULL> 6172994tidy_tokens <- tidy_tokens %>%
left_join(stop_words, by = "word") %>%
mutate(is_stop = !is.na(lexicon))
stop_by_doc <- tidy_tokens %>%
group_by(doc_id, author, title) %>%
summarise(
n_tokens = n(),
n_stop = sum(is_stop, na.rm = TRUE),
stop_ratio = n_stop / n_tokens,
.groups = "drop"
)
stop_by_doc %>%
arrange(desc(n_tokens)) %>%
head(10)## # A tibble: 10 × 6
## doc_id author title n_tokens n_stop stop_ratio
## <int> <list> <chr> <int> <int> <dbl>
## 1 18 <NULL> <NA> 1990990 1699886 0.854
## 2 19 <NULL> <NA> 897590 774447 0.863
## 3 10 <NULL> <NA> 715396 607004 0.848
## 4 9 <NULL> <NA> 715090 603734 0.844
## 5 23 <NULL> <NA> 714849 588717 0.824
## 6 17 <NULL> <NA> 712146 600568 0.843
## 7 14 <NULL> <NA> 650065 548798 0.844
## 8 24 <NULL> <NA> 609892 497487 0.816
## 9 27 <NULL> <NA> 606392 531174 0.876
## 10 26 <NULL> <NA> 558846 486452 0.870sentences <- british %>%
select(doc_id, author, title, text) %>%
mutate(sentence = str_split(text, "(?<=[.!?])\\s+")) %>%
unnest(sentence)
sent_stats <- sentences %>%
mutate(
n_words = str_count(sentence, "\\S+")
) %>%
group_by(doc_id) %>%
summarise(
avg_sent_len = mean(n_words, na.rm = TRUE),
median_sent_len = median(n_words, na.rm = TRUE),
.groups = "drop"
)
sent_stats %>% head(10)## # A tibble: 10 × 3
## doc_id avg_sent_len median_sent_len
## <int> <dbl> <dbl>
## 1 1 34.6 27
## 2 2 29.9 22
## 3 3 20.6 14
## 4 4 21.0 16
## 5 5 26.8 21
## 6 6 24.2 19
## 7 7 31.5 24
## 8 8 22.0 17
## 9 9 18.5 14
## 10 10 19.8 15token_stats <- tidy_tokens %>%
group_by(doc_id) %>%
summarise(
n_tokens = n(),
vocab_size = n_distinct(word),
avg_word_len = mean(str_length(word), na.rm = TRUE),
.groups = "drop"
)
token_stats %>% head(10)## # A tibble: 10 × 4
## doc_id n_tokens vocab_size avg_word_len
## <int> <int> <int> <dbl>
## 1 1 138561 6752 3.74
## 2 2 340359 10240 3.71
## 3 3 332161 7345 3.73
## 4 4 254072 6351 3.79
## 5 5 249665 6368 3.78
## 6 6 366049 12743 3.72
## 7 7 171359 9707 3.82
## 8 8 375112 14837 3.81
## 9 9 715090 15295 3.70
## 10 10 715396 14262 3.69doc_features <- british %>%
select(doc_id, author, title) %>%
distinct() %>%
left_join(stop_by_doc, by = c("doc_id", "author", "title")) %>%
left_join(sent_stats, by = "doc_id") %>%
left_join(token_stats, by = "doc_id")
glimpse(doc_features)## Rows: 27
## Columns: 11
## $ doc_id <int> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16,…
## $ author <list> <NULL>, <NULL>, <NULL>, <NULL>, <NULL>, <NULL>, <NULL…
## $ title <chr> NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, NA…
## $ n_tokens.x <int> 138561, 340359, 332161, 254072, 249665, 366049, 171359…
## $ n_stop <int> 117497, 289135, 285384, 217257, 213378, 301872, 138901…
## $ stop_ratio <dbl> 0.8479803, 0.8495001, 0.8591737, 0.8551001, 0.8546572,…
## $ avg_sent_len <dbl> 34.62187, 29.90712, 20.61330, 21.04140, 26.80827, 24.1…
## $ median_sent_len <dbl> 27, 22, 14, 16, 21, 19, 24, 17, 14, 15, 14, 17, 22, 18…
## $ n_tokens.y <int> 138561, 340359, 332161, 254072, 249665, 366049, 171359…
## $ vocab_size <int> 6752, 10240, 7345, 6351, 6368, 12743, 9707, 14837, 152…
## $ avg_word_len <dbl> 3.736297, 3.708752, 3.734036, 3.789158, 3.780221, 3.71…# Средняя доля стоп-слов по авторам
stop_summary <- stop_by_doc %>%
group_by(author) %>%
summarise(
mean_stop_ratio = mean(stop_ratio, na.rm = TRUE),
.groups = "drop"
) %>%
arrange(desc(mean_stop_ratio))
stop_summary## # A tibble: 1 × 2
## author mean_stop_ratio
## <list> <dbl>
## 1 <NULL> 0.841# Средняя длина предложений по авторам
sent_summary <- sent_stats %>%
left_join(british %>% select(doc_id, author), by = "doc_id") %>%
group_by(author) %>%
summarise(
mean_sent_len = mean(avg_sent_len, na.rm = TRUE),
.groups = "drop"
) %>%
arrange(desc(mean_sent_len))
sent_summary## # A tibble: 1 × 2
## author mean_sent_len
## <list> <dbl>
## 1 <NULL> 26.0# Средняя длина слова по авторам
wordlen_summary <- token_stats %>%
left_join(british %>% select(doc_id, author), by = "doc_id") %>%
group_by(author) %>%
summarise(
mean_word_len = mean(avg_word_len, na.rm = TRUE),
.groups = "drop"
) %>%
arrange(desc(mean_word_len))
wordlen_summary## # A tibble: 1 × 2
## author mean_word_len
## <list> <dbl>
## 1 <NULL> 3.72В качестве целевой переменной выступает автор произведения
(author), а в качестве признаков — текст, доля стоп-слов,
средняя длина предложения и средняя длина слова, соединённые в таблице
doc_features.[web:1][web:6][web:15]
Эти данные можно разделить на обучающую и тестовую выборки с помощью
initial_split() и далее использовать в рецепте
{textrecipes} (токенизация, удаление стоп-слов, tf–idf), а затем
подавать в модели многоклассовой логистической регрессии или случайного
леса в фреймворке {tidymodels}.[web:7][web:10][web:15][web:26]
Из-за несовместимости текущих версий пакетов {parsnip} и {workflows}
с многоуровневой классификацией в моей установке R код обучения моделей
через multinom_reg() и rand_forest() не
запускается, поэтому в этом отчёте я ограничиваюсь подготовкой признаков
и табличным разведывательным анализом, но подробно описываю, какие
модели и как могли бы быть обучены на подготовленных
данных.[web:73][web:78]
Тем не менее количественные показатели (доля стоп-слов, длина
предложений и слов) уже демонстрируют различия между авторами и задают
основу для дальнейшей автоматической атрибуции
авторства.[web:1][web:6][web:7]