Stemming
Petr Ya
2/19/2022
rm(list = ls())
date()## [1] "Mon Feb 21 15:35:07 2022"sessionInfo()## R version 4.1.2 (2021-11-01)
## Platform: x86_64-apple-darwin17.0 (64-bit)
## Running under: macOS Big Sur 10.16
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.1/Resources/lib/libRlapack.dylib
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## attached base packages:
## [1] stats graphics grDevices utils datasets methods base
##
## loaded via a namespace (and not attached):
## [1] digest_0.6.29 R6_2.5.1 jsonlite_1.7.3 magrittr_2.0.1
## [5] evaluate_0.14 rlang_0.4.12 stringi_1.7.6 jquerylib_0.1.4
## [9] bslib_0.3.1 rmarkdown_2.11 tools_4.1.2 stringr_1.4.0
## [13] xfun_0.29 yaml_2.2.1 fastmap_1.1.0 compiler_4.1.2
## [17] htmltools_0.5.2 knitr_1.37 sass_0.4.0Библиотеки и загрузка объектов
load(file = "Texts3.RData")library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union# library(readtext)
library(quanteda)## Package version: 3.2.0
## Unicode version: 13.0
## ICU version: 69.1## Parallel computing: 4 of 4 threads used.## See https://quanteda.io for tutorials and examples. library(stringr)
library(quanteda.textstats)
# library(ggplot2)
library(magrittr)#Создание функции стемминга
Вывод версии программы Mystem
system2("./Mystem/mystem", args = "-v") #Вывод версии программы Mystem
mystem <- function(doc, arg, format = "") { # Можно вствить формат вывода
# " --format xml" и " -- format json"
sdoc <- system2("./Mystem/mystem"
, args = paste0("-", arg, format)
, stdout = TRUE
# TRUE (capture the output
# in a character vector)
, input = doc)
sdoc
}-n Построчный режим; каждое слово печатается на новой строке. -c Копировать весь ввод на вывод. То есть, не только слова, но и межсловные промежутки. Опция необходима для возврата к полному представлению текста. В случае построчного вывода (когда задана опция n) межсловные промежутки вытягиваются в одну строку, символы перевода строки заменяются на /или . Пробел для большей видимости заменяется на подчеркивание. Символ заменяется на \, подчеркивание на _. Таким образом можно однозначно восстановить исходный текст. -w Печатать только словарные слова. -l Не печатать исходные словоформы, только леммы и граммемы. -i Печатать грамматическую информацию, расшифровка ниже. -g Склеивать информацию словоформ при одной лемме (только при включенной опции -i). -s Печатать маркер конца предложения (только при включенной опции -c). -e Кодировка ввода/вывода. Возможные варианты: cp866, cp1251, koi8-r, utf-8 (по умолчанию). -d Применить контекстное снятие омонимии. –eng-gr Печатать английские обозначения граммем. –filter-gram Строить разборы только с указанными граммемами. –fixlist Использовать файл с пользовательским словарём. –format Формат вывода.Возможные варианты: text, xml, json. Значение по умолчанию — text. –generate-all Генерировать все возможные гипотезы для несловарных слов. –weight Печатать бесконтекстную вероятность леммы.
Части речи
A прилагательное ADV наречие ADVPRO местоименное наречие ANUM числительное-прилагательное APRO местоимение-прилагательное COM часть композита - сложного слова CONJ союз INTJ междометие NUM числительное PART частица PR предлог S существительное SPRO местоимение-существительное V глагол
Стемминг
# aTime <- Sys.time()
# Data_S <- Data
# for (i in 1:length(Data$text)) {
# Data$text[i] <- str_replace_all(Data$text[i], "\n", " ")
# Data_S$text[i] <- paste(paste(mystem(Data$text[i], "cligsd"), collapse = "{\\s}"), "{\\s}") %>%
# # Майстем выдает по абзацам - склеиваю абзацы
# # добавляю маркеры конца предложения + маркер в конце текстов
# # ### !!! похоже работает не так.
# # ### Замена паттерна для склейки ничего не меняет.
# str_extract_all("([{])(([\\\\а-яa-z]+))([^{}]+)([}])") %>%
# # Открывающая скобка, один слеш (нужно написать четыре) или буква русская или латинская, один или несколько любых символов кроме скобок, закрывающая скобка
# unlist(.) %>%
# str_replace("([{])([а-я?-]+)([=])([[:alpha:]]+)([=,])([[:graph:]]*?)()([}])"
# , "\\2_\\4") %>%
# str_replace("([{])([:graph:]*)([}])", "\\2") %>%
# str_c(collapse = " ")
#
# }
# Sys.time() - aTime
# #Data_S$text[1]
# # добавляю конце предложения в разбивку абзацев. Майстем по обзацам выдаёт и нужно объединять
# # # . Точка позволяет вствить в другое место pipe operatorСтемминг2
t <- Sys.time()
Data_S <- Texts3
for (i in 1:length(Data_S$text)) {
Data_S$text[i] <- str_replace_all(Data_S$text[i], "\n", " ") #убираю абзацы
# mystem выдаёт текст по абзацам
Data_S$text[i] <- (mystem(Data_S$text[i], "cligsd")) %>%
paste("{\\s}") %>%
str_extract_all("([{])(([\\\\а-яa-z]+))([^{}]+)([}])") %>%
# Открывающая скобка, один слеш (нужно написать четыре) или буква русская или латинская, один или несколько любых символов кроме скобок, закрывающая скобка
unlist(.) %>%
str_replace("([{])([а-я?-]+)([=])([[:alpha:]]+)([=,])([[:graph:]]*?)()([}])"
, "\\2_\\4") %>%
str_replace(fixed("{\\s}"), "__D") %>% #знак конца предложения
str_c(collapse = " ")
}
Sys.time() - t## Time difference of 17.28892 mins__D - конец предложения
Убираю знаки абзацев из текста. Они могут быть случайными или это стихи и эпиграфы, разбивающие предложения
Статистика по новому корпусу
Создание нового корпуса
Corpus_S <- corpus(Data_S)Статистика по новому корпусу
# CorpusSummary_S <- summary(Corpus_S, n = 10000)
# #CorpusSummary
# table(CorpusSummary_S$Group)
# summary(CorpusSummary_S[-1])
Corpus_S %>%
summary(n = 1000) %>%
extract(2:4) %>%
summary()## Types Tokens Sentences
## Min. : 34.0 Min. : 52.0 Min. : 1.00
## 1st Qu.: 149.0 1st Qu.: 287.5 1st Qu.: 14.00
## Median : 238.0 Median : 484.5 Median : 22.00
## Mean : 315.7 Mean : 763.5 Mean : 26.94
## 3rd Qu.: 411.2 3rd Qu.: 948.0 3rd Qu.: 33.00
## Max. :1769.0 Max. :8734.0 Max. :387.00Количество предложений в тексте после стемминга - это нераспознанные слова, которые идут с вопросительным знаком.
Настоящие предложения отделены символами __D
textstat_summary(Corpus_S) %>%
arrange(desc(sents)) %>%
head(25)## document chars sents tokens types puncts numbers symbols urls
## 1 0436_Психологич.txt 78110 387 8734 1769 1118 0 0 0
## 2 1078_Московский.txt 23833 166 2810 808 531 0 0 0
## 3 1063_Качество_о.txt 47983 138 5130 1352 190 0 3 0
## 4 0207_Учительска.txt 32792 123 3521 1031 131 0 0 0
## 5 0888_Viperson_r.txt 15568 120 1938 678 368 0 0 0
## 6 1079_Страховое_.txt 33019 112 3446 1177 225 0 0 0
## 7 0149_Forbes_ru_.txt 22242 107 2500 948 163 0 0 0
## 8 1033_Клуб_Учите.txt 45354 107 3996 711 145 0 0 0
## 9 0924_Промышленн.txt 56535 104 5829 1469 115 0 0 0
## 10 0563_Новая_газе.txt 61171 100 6628 1613 120 0 0 0
## 11 0851_Федеральны.txt 20246 99 2101 650 143 0 0 0
## 12 0987_Russkieves.txt 32375 99 3469 1159 158 0 0 0
## 13 1158_Bipkro_ru_.txt 5719 99 832 270 215 0 0 0
## 14 1134_Федеральны.txt 15788 98 1726 674 139 0 0 0
## 15 0450_РАНХиГС__r.txt 6944 89 865 224 145 0 0 0
## 16 0601_Координаци.txt 39993 86 4136 1198 145 0 0 0
## 17 0716_Открытое_о.txt 10919 85 1328 329 159 0 0 0
## 18 0992_Кугарчинск.txt 15236 85 1746 680 111 0 0 0
## 19 0903_News_Life_.txt 26674 84 2895 1133 131 0 0 0
## 20 0099_Реальное_в.txt 13002 83 1566 582 133 0 0 0
## 21 0727_Федеральны.txt 27915 82 2990 778 147 0 0 0
## 22 0820_Форум_Доно.txt 7290 81 865 397 140 0 0 0
## 23 0386_Вести_обра.txt 24418 80 2711 958 133 0 0 0
## 24 0980_Seldon_New.txt 30928 80 3600 1070 205 0 0 0
## 25 0663_Городская_.txt 28973 79 3073 952 147 0 0 0
## tags emojis
## 1 0 0
## 2 0 0
## 3 0 0
## 4 0 0
## 5 0 0
## 6 0 0
## 7 0 0
## 8 0 0
## 9 0 0
## 10 0 0
## 11 0 0
## 12 0 0
## 13 0 0
## 14 0 0
## 15 0 0
## 16 0 0
## 17 0 0
## 18 0 0
## 19 0 0
## 20 0 0
## 21 0 0
## 22 0 0
## 23 0 0
## 24 0 0
## 25 0 0Нераспознанные слова - английские из интернет адресов. Надо, наверное, чистить. Они в фигурных скобках - не сложно будет удалить.
Токенизация, очистка и DFM
Corpus_S %>%
tokens(what = "fastestword") %>%
tokens_remove("^[{]", valuetype = "regex") %>% # удаление слов,
# которые начинаются с фигурной скобки
textstat_summary() %>%
extract(4:5) %>%
summary()## tokens types
## Min. : 27.0 Min. : 26.0
## 1st Qu.: 219.5 1st Qu.: 134.0
## Median : 413.0 Median : 220.0
## Mean : 674.5 Mean : 300.1
## 3rd Qu.: 845.0 3rd Qu.: 395.0
## Max. :7230.0 Max. :1617.0Corpus_S %>%
tokens(what = "fastestword") %>%
#tokens_remove("^[{]", valuetype = "regex") %>%
textstat_summary() %>%
extract(4:5) %>%
summary()## tokens types
## Min. : 32.0 Min. : 31.0
## 1st Qu.: 230.0 1st Qu.: 144.0
## Median : 424.0 Median : 233.5
## Mean : 686.8 Mean : 311.0
## 3rd Qu.: 857.0 3rd Qu.: 405.5
## Max. :7474.0 Max. :1762.0можно не очищать от неопознанных слов, которые в фигурных скобках. они не имеют признака части речи и не пойдут в DFM
# DFM_S <- Corpus_S %>%
# tokens(what = "fastestword") %>%
# tokens_remove("^[{]", valuetype = "regex") %>%
# dfm()Таблица слов с удаленным признаком части речи
Tokens_S <- tokens(Corpus_S
, what = "fasterword"
, include_docvars = FALSE
, verbose = TRUE)## Creating a tokens object from a corpus input...## ...starting tokenization## ...0002_Мои_года__.txt to 1178_Федеральны.txt## ...22,457 unique types## ...removing separators## ...complete, elapsed time: 0.574 seconds.## Finished constructing tokens from 876 documents.Words <- data.frame(W1 = types(Tokens_S)
, W2 = str_replace(types(Tokens_S)
, "([[:alpha:]]+)(_[[:alpha:]]+)"
, "\\1")
, stringsAsFactors = FALSE)DFM <- Tokens_S %>%
tokens_keep(pattern = c("*_S", "*_V", "*_A", "*_ADV")) %>%
tokens_replace(Words$W1, Words$W2, valuetype = "fixed") %>%
dfm() %>%
dfm_trim(min_docfreq = 2)
# Оставляем слова которые встрчаются больше чем в одном тексте
# Только существительные, глаголы и прилагательные и наречияСамые частые слова:
topfeatures(DFM, n = 20)## образование быть школа образовательный ребенок
## 6263 5094 4419 3605 3274
## год цифровой обучение программа учитель
## 3271 3233 2894 2481 2396
## платформа проект новый развитие работа
## 2395 2286 2237 2153 1782
## сбербанк педагог система технология мочь
## 1496 1478 1467 1382 1373plot(topfeatures(DFM, n = 100))
Слова, которые встречаются в самом большом числе текстов
Stat <- DFM %>%
textstat_frequency() %>%
arrange(desc(docfreq)) %>%
head(20)
Stat ## feature frequency rank docfreq group
## 1 образование 6263 1 875 all
## 4 образовательный 3605 4 725 all
## 2 быть 5094 2 719 all
## 3 школа 4419 3 693 all
## 6 год 3271 6 648 all
## 9 программа 2481 9 646 all
## 8 обучение 2894 8 643 all
## 14 развитие 2153 14 635 all
## 7 цифровой 3233 7 633 all
## 13 новый 2237 13 627 all
## 5 ребенок 3274 5 597 all
## 12 проект 2286 12 567 all
## 15 работа 1782 15 566 all
## 11 платформа 2395 11 565 all
## 34 персонализировать 1024 34 546 all
## 10 учитель 2396 10 512 all
## 24 становиться 1287 24 501 all
## 22 возможность 1344 22 500 all
## 32 получать 1119 32 500 all
## 27 также 1227 27 498 allplot(Stat$docfreq) 
Удаляем Четыре самых частых слова
DFM <- dfm_remove(DFM, names(topfeatures(DFM))[1:4])Сохраняю объект на диск
save(Corpus_S, file = "Corpus_S.RData")
save(DFM, file = "DFM.RData")