library(baguette)
library(discrim)
library(embed)
library(future)
library(readtext)
library(stopwords)
library(stylo)
library(textrecipes)
library(tidymodels)
library(tidytext)
library(tidyverse)
library(udpipe)A Small Collection of British Fiction
Компьютерный анализ текстов, модуль 4
α’. Импорт необходимых библиотек и предобработка корпуса
Для начала импортирую необходимые библиотеки:
α’.0. Начало всех начал
После этого перехожу к корпусу, который я извлёк из zip-архива. На данном этапе я выполнил ручную предобработку корпуса (которая, надеюсь, оправдана в учебных целях). В частности, из произведений я удалил все оглавления и остальные элементы книги, которые не относятся к её основному тексту. Это чаще всего предисловия, но, грубо говоря, я решил оставить только главы.
В этой связи, например, особое внимание на себя обращает исходный файл с текстом «Клариссы, или Истории молодой леди» Сэмюэля Ричардсона, в котором содержание не только в начале: содердание приводится перед началом каждого тома произведения (коих 9).
α’.1. Главы, томы, книги не попали…
Второй этап предобработки. Отсмотр и удаление содержаний - это, конечно, дело хорошее, но ещё мне бы хотелось избавиться от строк, указующих на нумерацию пассажей в рамках файла, будь то том, книга, глава или письмо. Собственно говоря, это сущности, которые я обнаружил при первичном отсмотре файлов
Да, содержания можно бы было удалить тоде автоматически, но, например содержание «Клариссы,…» представляет собою больше, чем просто нумерация писем: это в том числе и достаточно развёрнутое описание писем, которое может занимать, как видно по скриншоту выше, более одной строки.
Задаю регулярное выражение, которое необходимо для отслеживания строк упомянутого типа:
pattern <- regex(
'^\\s*(volume|chapter|book|letter)\\s+(\\d+|[IVXLCDM]+).*$',
ignore_case = TRUE
)Далее ввожу новую функцию для очистки одного файла:
clear_txt <- function(input_file, output_file = NULL) {
# прочитать строки
lines <- read_lines(input_file, skip_empty_rows = FALSE)
# фильтрация строк-заголовков
cleared_lines <- lines[!str_detect(lines, pattern)]
# задать имя выходного файла
if (is.null(output_file)) {
output_file <- str_replace(input_file, '\\.txt$', '_cleared.txt')
}
# запись результата
write_lines(cleared_lines, output_file)
invisible(cleared_lines)
}Обработка всех файлов разом:
process_all_txts <- function(directory, output_dir) {
files <- list.files(path = directory, pattern = '\\.txt$', full.names = TRUE)
for (f in files) {
out_file <- file.path(output_dir, basename(f) |>
str_replace('\\.txt$', '_cleared.txt'))
clear_txt(f, out_file)
}
}Запускаю функцию с указанием директорий:
# исходная папка
initial_dir <- './british_fiction'
# выходная папка создаётся заранее
target_dir <- './british_fiction_cleared'
process_all_txts(initial_dir, target_dir)α’.2. Λημματίζω τους λόγους (‘Лемматизирую слова’)
Приступаю к лемматизации за помощью udpipe. Я использую модель для английского языка. Поскольку в данном задании я работаю над коллекциею текстов, написать функцию тоже представляется целесообразно. Для начала скачиваю модель: я взял english-ewt.
# скачать модель в рабочую директорию
# udpipe_download_model(language = 'english-ewt')
# загрузить модель
english_ewt <- udpipe_load_model(file = 'english-ewt-ud-2.5-191206.udpipe')Следующий этап - написание функции для лемматизации корпуса.
lemmatise_txt <- function(input_path, output_path) {
# чтение строк из одного файла
text_lines <- read_lines(input_path)
text <- paste(text_lines, collapse = '\n')
# UDPipe-аннотация
annotation <- udpipe_annotate(english_ewt, x = text, doc_id = basename(input_path))
annotation_df <- as.data.frame(annotation)
# оставить только не-пунктуационные токены
df_words <- annotation_df[annotation_df$upos != 'PUNCT',]
# соединить леммы пробелами
result <- paste(df_words$lemma, collapse = ' ')
# запись результата за помощью write_lines()
write_lines(result, output_path, na = '')
}После этого я начинаю путешествие длинною в примерно полтора-два часа: лемматизация всех тектовых файлов (произведения всё-таки немаленькие) через udpipe - предприятие времязатратное. Тем не менее я уповаю на то, что лемматизация текстов (хотя английский - это не тот язык, для которого эта операция существенна) что-то да привнесёт в данный анализ…
input_dir <- './british_fiction_cleared'
output_dir <- './british_fiction_lemmatised'
txt_files <- list.files(input_dir, pattern = '\\.txt$', full.names = TRUE)
for (f in txt_files) {
base_name <- tools::file_path_sans_ext(basename(f))
out_file <- file.path(output_dir, paste0(base_name, '_lemmatised.txt'))
lemmatise_txt(f, out_file)
}
Скриншот сделан до изменения кода выше. Выведение текста мне служило лишь сигналом, что всё работает и что процесс лемматизации не прекратился.
Ознакомиться с итоговыми файлами можно по ссылке.
β’. Извлечение лигвистических признаков
В этой работе я работаю над биграммами.
texts <- readtext('./british_fiction_lemmatised/*.txt',
docvarsfrom = 'filenames',
dvsep = '_')Для дальнейшей работы сохраняю сам текст (text), а также авторов (docvar1) и краткое название произведений (docvar2). После этого делаю из них колонку doc_id.
texts_df <- texts |>
select(docvar1, docvar2, text)
texts_df <- texts_df |>
unite('doc_id', docvar1, docvar2, sep = '_', remove = TRUE)Для более точного подсчёта биграмм приведу к нижнему регистру все слова в текстах:
texts_df <- texts_df |>
mutate(text = str_to_lower(text))
head(texts_df, 5)readtext object consisting of 5 documents and 1 docvar.
# A data frame: 5 × 3
docvar1 docvar2 text
* <chr> <chr> <chr>
1 ABronte Agnes "\"agnes grey\"..."
2 ABronte Tenant "\"the tena n\"..."
3 Austen Emma "\"emma emma \"..."
4 Austen Pride "\"pride and \"..."
5 Austen Sense "\"sense and \"..."Список всех биграмм лемматизированных текстов оформляю через unnest_tokens:
bigrams_df <- texts_df |>
unnest_tokens(bigram, text, token = 'ngrams', n = 2) |>
separate(bigram, into = c('word1', 'word2'), sep = ' ')Чтобы получить список более-менее осмысленных биграмм, я предлагаю воспользоваться стоп-словами. Если в биграмме хотя бы одно слово является стоп-словом, её предлагается исключать из первичнго анализа.
en_stopwords <- stopwords(language = 'en', source = 'stopwords-iso')Фильтрация датасета с биграммами по стоп-словам:
bigrams_df_filtered <- bigrams_df |>
filter(!word1 %in% en_stopwords,
!word2 %in% en_stopwords)Для каждого произведения при выводе, допустим, топ-30 биграмм отображаются в первую очередь имена собственные и наименования значимых мест, что, пожалуй, достаточно ожидаемо. Тем не менее отдельные частотные коллокации тоже имеют место быть, ср. fall asleep в «Джейн Эйр» ниже.
top30_per_doc <- bigrams_df_filtered |>
unite('bigram', word1, word2, sep = ' ', remove = TRUE) |>
count(doc_id, bigram) |>
group_by(doc_id) |>
slice_max(n, n = 30, with_ties = FALSE) |>
ungroup()Для «Джейн Эйр» Шарлотты Бронте:
top30_per_doc |>
filter(doc_id == 'CBronte_Jane') |>
head(10)# A tibble: 10 × 3
doc_id bigram n
<chr> <chr> <int>
1 CBronte_Jane jane eyre 38
2 CBronte_Jane thornfield hall 33
3 CBronte_Jane grace poole 21
4 CBronte_Jane helen burns 20
5 CBronte_Jane colonel dent 16
6 CBronte_Jane moor house 16
7 CBronte_Jane john reed 10
8 CBronte_Jane fall asleep 9
9 CBronte_Jane jane jane 9
10 CBronte_Jane john rivers 8Для «Клариссы,…» Сэмюэля Ричардсона:
top30_per_doc |>
filter(doc_id == 'Richardson_Clarissa') |>
head(10)# A tibble: 10 × 3
doc_id bigram n
<chr> <chr> <int>
1 Richardson_Clarissa clarissa harlowe 449
2 Richardson_Clarissa lady betty 225
3 Richardson_Clarissa john belford 179
4 Richardson_Clarissa belford esq 168
5 Richardson_Clarissa captain tomlinson 125
6 Richardson_Clarissa cousin morden 107
7 Richardson_Clarissa uncle antony 101
8 Richardson_Clarissa anna howe 94
9 Richardson_Clarissa uncle harlowe 93
10 Richardson_Clarissa lady sarah 84Продолжение смотреть здесь.