date()## [1] "Mon Dec 10 10:28:02 2018"sessionInfo()## R version 3.5.1 (2018-07-02)
## Platform: x86_64-apple-darwin15.6.0 (64-bit)
## Running under: macOS 10.14.1
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/3.5/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/3.5/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] compiler_3.5.1 backports_1.1.2 magrittr_1.5 rprojroot_1.3-2
## [5] tools_3.5.1 htmltools_0.3.6 yaml_2.2.0 Rcpp_1.0.0
## [9] stringi_1.2.4 rmarkdown_1.10 knitr_1.20 stringr_1.3.1
## [13] digest_0.6.15 evaluate_0.11Требуемые библиотеки:
library(tm)## Loading required package: NLP# library(wordcloud)
# library(magrittr) #provides a new “pipe”-like operator, %>%, with which you may pipe a value forward into an expression or function call; something along the lines of x %>% f,Загружаю корпус с диска
load(file = "Txt.RData")создаю функцию стемминга
mystem <- function(doc, arg) {
sdoc <- system2("./mystem"
, args = paste0("-", arg)
, stdout = TRUE
# TRUE (capture the output
# in a character vector)
, input = doc)
sdoc
}
mystem3 <- content_transformer(mystem)
# Create content transformers, i.e., functions
# which modify the content of an R object.
# Важно переопределить название обертки функции -
# иначе ошибка "рекурсии"Провожу стемминг с аргументами “ld” l - без исходных словоформ d - контекстное снятие омонимии
Создание корпуса с грамматической информацией i - печатать грамматическую информацию g - Склеивать информацию словоформ при одной лемме (только при включенной опции -i).
s - Печатать маркер конца предложения (только при включенной опции -c) с - Копировать весь ввод на вывод. То есть, не только слова, но и межсловные промежутки. Опция необходима для возврата к полному представлению текста. В случае построчного вывода (когда задана опция n) межсловные промежутки вытягиваются в одну строку, символы перевода строки заменяются на и/или . Пробел для большей видимости заменяется на подчеркивание. Символ заменяется на \, подчеркивание на _. Таким образом можно однозначно восстановить исходный текст.
SentenceTxt <- tm_map(Txt, mystem3, "ldigcs") cleanSentenceCorpus <- function(text) {
text <- tm_map(text, content_transformer(
function(x) gsub(
"([{])([а-я?-]+)([=])([[:alpha:]]+)([=,])([[:graph:]]*?)()([}])"
, "{\\2_\\4}", x)
)
)
text <- tm_map(text, content_transformer(
function(x) gsub(
"([}])([^{}]*)([{])", " ", x)
# Найти между скобками не должно быть скобок. Вставить пробел.
)
)
text <- tm_map(text, content_transformer(
function(x) sub(
"([^{]*)([{])", "", x)
# sub() ищет только одно вхождение. Удалить всё, что перед первой скобкой
)
)
text <- tm_map(text, content_transformer(
function(x) sub(
"([}])([^{}]*)$", "", x)
# удалить всё, что после скобки, чтобы не было скобок в конце
)
)
}
SentenceTxt <- cleanSentenceCorpus(SentenceTxt)Альтернативный вариент: “([{])([а-я?-]+)([=])([[:alpha:]]+)([=,])([[:graph:]])([}])" # ([[:graph:]]?) ленивый режим задается вопросительным знаком после квантификатора (звездочки) - противоположность жадному greedly
!!! Внимание as.character(test_SentenceTxt[[1]]) - в векторе разделители предложений имеют два слеша: \s inspect(test_SentenceTxt[[1]]) - текстовое представление показывает один:
Создание общего вектора с предложениями
text <- character()
for (i in 1:length(SentenceTxt)) {
v <- as.character(SentenceTxt[[i]])
text <- c(text, unlist(strsplit(v, "\\s", fixed = TRUE)))
}Создаю корпус из предложений
SentenceCorpus <- VCorpus(VectorSource(text), readerControl = list(language = "ru"))удаеление стоп слов
removeStop <- function(text) {
tm_map(text, content_transformer(
function(x){
x <- gsub("([а-я?-]+)_CONJ\\>", "", x)
x <- gsub("([а-я?-]+)_PR\\>", "", x)
x <- gsub("([а-я?-]+)_PART\\>", "", x)
x <- gsub("([а-я?-]+)_APRO\\>", "", x)
x <- gsub("([а-я?-]+)_SPRO\\>", "", x)
x <- gsub("([а-я?-]+)_ADVPRO\\>", "", x)
x <- gsub("([а-я?-]+)_ANUM\\>", "", x)
x <- gsub("([а-я?-]+)_NUM\\>", "", x)
x <- gsub("([а-я?-]+)_INTJ\\>", "", x)
x
}
)
)
}
StopSentenceCorpus <- removeStop(SentenceCorpus)Создаем матрицу TDM
Sentence_TDM <- TermDocumentMatrix(StopSentenceCorpus)Корреляции с указанным термином выше порога существительные
findAssocs(Sentence_TDM, "человек_s", 0.2)## $человек_s
## среда_s природа_s взаимодействие_s окружающий_a
## 0.29 0.23 0.22 0.21findAssocs(Sentence_TDM, "среда_s", 0.2)## $среда_s
## окружающий_a человек_s взаимодействие_s влияние_s
## 0.51 0.29 0.25 0.25
## природный_a городской_a
## 0.22 0.21findAssocs(Sentence_TDM, "психология_s", 0.2)## $психология_s
## экологический_a стык_s инструмент_s направление_s
## 0.43 0.31 0.25 0.25
## наука_s экология_s география_s социальный_a
## 0.23 0.22 0.21 0.21
## взаимодействие_s изучать_v область_s
## 0.20 0.20 0.20findAssocs(Sentence_TDM, "природа_s", 0.2)## $природа_s
## отношение_s этический_a своеобразие_s
## 0.26 0.25 0.24
## человек_s представление_s взаимодействие_s
## 0.23 0.22 0.21
## обоснованный_a выработка_s психологически_adv
## 0.21 0.20 0.20Прилагательные
findAssocs(Sentence_TDM, "экологический_a", 0.2)## $экологический_a
## сознание_s психология_s формирование_s проблема_s своеобразие_s
## 0.52 0.43 0.24 0.23 0.20findAssocs(Sentence_TDM, "окружающий_a", 0.2)## $окружающий_a
## среда_s взаимодействие_s взаимоотношение_s человек_s
## 0.51 0.23 0.23 0.21findAssocs(Sentence_TDM, "психологический_a", 0.2)## $психологический_a
## манипулятивный?_a междисциплинарный_a манипуляция_s
## 0.26 0.24 0.22
## напряженность_s подверженность_s принуждение_s
## 0.22 0.22 0.22
## уточнение_s разбирать_v тайный_a
## 0.22 0.21 0.21
## географический_a
## 0.20findAssocs(Sentence_TDM, "социальный_a", 0.2)## $социальный_a
## географический_a служащий_a органично_adv
## 0.45 0.40 0.39
## регуляция_s культурный_a пространственный_a
## 0.35 0.31 0.31
## междисциплинарный_a жизнедеятельность_s включать_v
## 0.29 0.28 0.25
## взаимодействие_s биологический_a взаимоотношение_s
## 0.24 0.23 0.23
## духовный_a искусственный_a массовый_a
## 0.23 0.23 0.22
## психический_a отмечаться_v психология_s
## 0.22 0.21 0.21глаголы
findAssocs(Sentence_TDM, "быть_v", 0.15)## $быть_v
## больничный_a везде_adv волноваться_v завтра_adv койка_s
## 0.16 0.16 0.16 0.16 0.16
## кривой_a лайер?_s мочь_v мюллер_s преимущество_s
## 0.16 0.16 0.16 0.16 0.16
## угловой_a чукотка_s
## 0.16 0.16findAssocs(Sentence_TDM, "мочь_v", 0.15)## $мочь_v
## быть_v
## 0.16findAssocs(Sentence_TDM, "являться_v", 0.15)## $являться_v
## часть_s важный_a
## 0.17 0.16findAssocs(Sentence_TDM, "становиться_v", 0.15)## $становиться_v
## навязывать_v сотрудничать_v взаимовыгодный_a обретать_v
## 0.30 0.25 0.20 0.19
## ые?? кровь_s пингвин_s токсичный_a
## 0.18 0.17 0.17 0.17
## южный_a
## 0.17findAssocs(Sentence_TDM, "понимать_v", 0.15)## $понимать_v
## смочь_v толком_adv контактировать_v учиться_v
## 0.23 0.21 0.19 0.18
## потомок_s нужно_adv
## 0.16 0.15findAssocs(Sentence_TDM, "изучать_v", 0.15)## $изучать_v
## гуманитарный_a лабораторный_a нетрадиционный_a
## 0.24 0.20 0.20
## психология_s круг_s ориентированность_s
## 0.20 0.17 0.17
## отрасль_s социально_adv обуславливаться_v
## 0.17 0.17 0.16
## взаимоотношение_s
## 0.15findAssocs(Sentence_TDM, "начинать_v", 0.15)## $начинать_v
## заканчивать_v опоминаться_v багаж_s ждать_v исчезать_v
## 0.25 0.22 0.16 0.16 0.16
## полагаться_v рассуждение_s устранение_s
## 0.16 0.16 0.16findAssocs(Sentence_TDM, "происходить_v", 0.15)## $происходить_v
## поначалу_adv львиный_a неосознанный_a полагаться_v
## 0.20 0.16 0.16 0.16