DataImport
2024-07-18
rm(list = ls())
date()
## [1] "Mon Sep 2 23:00:34 2024"
sessionInfo()
## R version 4.4.1 (2024-06-14)
## Platform: x86_64-apple-darwin20
## Running under: macOS Ventura 13.6.9
##
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/4.4-x86_64/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.4-x86_64/Resources/lib/libRlapack.dylib; LAPACK version 3.12.0
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## time zone: Europe/Moscow
## tzcode source: internal
##
## attached base packages:
## [1] stats graphics grDevices datasets utils methods base
##
## loaded via a namespace (and not attached):
## [1] digest_0.6.36 R6_2.5.1 fastmap_1.2.0 xfun_0.45
## [5] cachem_1.1.0 knitr_1.48 htmltools_0.5.8.1 rmarkdown_2.27
## [9] lifecycle_1.0.4 cli_3.6.3 sass_0.4.9 renv_1.0.7
## [13] jquerylib_0.1.4 compiler_4.4.1 rstudioapi_0.16.0 tools_4.4.1
## [17] evaluate_0.24.0 bslib_0.7.0 yaml_2.3.9 jsonlite_1.8.8
## [21] rlang_1.1.4Библиотеки
library(readtext)
library(stringr)
library(quanteda)
library(dplyr)
# library(reticulate)
# py_config()#Чтение текстов из файлов
Data <- readtext("../Texts/Out"
, docvarsfrom = "filenames"
, dvsep = "[_]")
Data <- select(Data, doc_id, text, Sample = docvar1
, Subject = docvar3
, Image = docvar5) #сразу переименовываю теги и выбираю нужные
Data$Subject <- paste0(substr(Data$Sample, 1, 3), Data$Subject) # Добавляю буквы к номеру испытуемых, чтобы все имена были уникальными
Data$Sample <- as.factor(Data$Sample)
Data$Image <- as.factor(Data$Image)
levels(Data$Image) <- c("1" = "picture_1", "2" = "picture_2", "3" = "picture_3")
# Проверка результатов
str(Data)## Classes 'readtext' and 'data.frame': 165 obs. of 5 variables:
## $ doc_id : chr "Clinical_Испытуемый_1_Картинка_1.txt" "Clinical_Испытуемый_1_Картинка_2.txt" "Clinical_Испытуемый_1_Картинка_3.txt" "Clinical_Испытуемый_10_Картинка_1.txt" ...
## $ text : chr "Романтичные чувства, красивые персонажи. Я считаю, что мужчина считает, что он должен выполнить долг, от чего г"| __truncated__ "Что связывает этих людей, кто они друг другу, могу сказать, что сюда подходит много вариантов. Если поискать ко"| __truncated__ "Это мать и дочь. Дочка недовольна, у нее в руках кукла и мама закидывает на куклу. Дочка расстроена. У меня ест"| __truncated__ "Девушка обнимает своего мужчину. У женщины чувства любви, заботы, внимания к мужчине. Мужчина печальный. До это"| __truncated__ ...
## $ Sample : Factor w/ 2 levels "Clinical","Control": 1 1 1 1 1 1 1 1 1 1 ...
## $ Subject: chr "Cli1" "Cli1" "Cli1" "Cli10" ...
## $ Image : Factor w/ 3 levels "picture_1","picture_2",..: 1 2 3 1 2 3 1 2 3 1 ...head(Data)## readtext object consisting of 6 documents and 3 docvars.
## # A data frame: 6 × 5
## doc_id text Sample Subject Image
## * <chr> <chr> <fct> <chr> <fct>
## 1 Clinical_Испытуемый_1_Картинка_1.txt "\"Романтичны\"..." Clini… Cli1 pict…
## 2 Clinical_Испытуемый_1_Картинка_2.txt "\"Что связыв\"..." Clini… Cli1 pict…
## 3 Clinical_Испытуемый_1_Картинка_3.txt "\"Это мать и\"..." Clini… Cli1 pict…
## 4 Clinical_Испытуемый_10_Картинка_1.txt "\"Девушка об\"..." Clini… Cli10 pict…
## 5 Clinical_Испытуемый_10_Картинка_2.txt "\"Женщина с \"..." Clini… Cli10 pict…
## 6 Clinical_Испытуемый_10_Картинка_3.txt "\"Мать с доч\"..." Clini… Cli10 pict…#Проверка массива
Количество получившихся текстов
table(Data$Image, Data$Sample)##
## Clinical Control
## picture_1 25 30
## picture_2 25 30
## picture_3 25 30Количество абзацев в каждом тексте.
str_count(Data$text, "\n") # Количество абзацев в текстах, чтобы проверить разделение## [1] 0 0 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 1 0
## [38] 0 0 1 0 0 0 0 0 0 2 0 0 0 0 0 0 1 0 0 0 0 0 0 2 0 0 0 0 1 2 0 0 0 0 0 2 0
## [75] 0 1 1 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1 4 0 0 1 0
## [112] 0 0 0 0 1 0 0 0 0 0 0 0 1 1 0 0 0 0 0 0 0 0 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0
## [149] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0hist(str_count(Data$text, "\n")) 
which(str_count(Data$text, "\n") > 2)## [1] 107Data$doc_id[21]## [1] "Clinical_Испытуемый_15_Картинка_3.txt"Data$doc_id[106]## [1] "Control_Испытуемый_18_Картинка_1.txt"В тексте по клинической группе Испытуемый 16 Картинка 1 отсутствовал номер картинки. Сделать файл txt c исправлением
#Создание корпуса с исходными текстам
types: Количество уникальных слов в каждом документе. tokens: Общее количество слов в каждом документе. sentences: Количество предложений в каждом документе.
Corpus <- corpus(Data)
Corpus |>
summary(n = 10000) |>
select(-Text) |>
summary()## Types Tokens Sentences Sample
## Min. : 18.00 Min. : 21.0 Min. : 1.000 Clinical:75
## 1st Qu.: 47.00 1st Qu.: 64.0 1st Qu.: 1.000 Control :90
## Median : 66.00 Median : 90.0 Median : 4.000
## Mean : 70.15 Mean :104.9 Mean : 4.612
## 3rd Qu.: 83.00 3rd Qu.:121.0 3rd Qu.: 6.000
## Max. :204.00 Max. :332.0 Max. :18.000
## Subject Image
## Length:165 picture_1:55
## Class :character picture_2:55
## Mode :character picture_3:55
##
##
## Как-то странно на предложения делит. Может мне это и не важно??
#Стемминг текстов
Функция для стемминга. Вывод версии программы 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 глагол
Стемминг
t <- Sys.time()
Data_S <- Data
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 3.803353 mins#Создание корпуса со стеммингом
Corpus_S <- corpus(Data_S)
Corpus_S |>
summary(n = 1000) |>
select(-1) |>
summary()## Types Tokens Sentences Sample
## Min. : 13.00 Min. : 20.00 Min. :1.000 Clinical:75
## 1st Qu.: 41.00 1st Qu.: 58.00 1st Qu.:1.000 Control :90
## Median : 59.00 Median : 88.00 Median :1.000
## Mean : 60.36 Mean : 94.86 Mean :1.158
## 3rd Qu.: 72.00 3rd Qu.:115.00 3rd Qu.:1.000
## Max. :162.00 Max. :282.00 Max. :4.000
## Subject Image
## Length:165 picture_1:55
## Class :character picture_2:55
## Mode :character picture_3:55
##
##
## Пример текста:
as.character(Corpus)[1]## Clinical_Испытуемый_1_Картинка_1.txt
## "Романтичные чувства, красивые персонажи. Я считаю, что мужчина считает, что он должен выполнить долг, от чего глобального до малого, его зовёт моральный долг. А женщина волнуется за него, сдерживает, просит его быть осторожным, волнуется."as.character(Corpus_S)[1]## Clinical_Испытуемый_1_Картинка_1.txt
## "романтичный_A чувство_S красивый_A персонаж_S __D я_SPRO считать_V что_CONJ мужчина_S считать_V что_CONJ он_SPRO должный_A выполнять_V долг_S от_PR что_SPRO глобальный_A до_PR малый_A он_SPRO звать_V моральный_A долг_S __D а_CONJ женщина_S волноваться_V за_PR он_SPRO сдерживать_V просить_V он_SPRO быть_V осторожный_A волноваться_V __D"#Токенизация
Tokens_S <- tokens(Corpus_S, what = "fastestword")
#what = "fastestword" токенезирует по пробелам
Tokens_S <- tokens_remove(Tokens_S, "__D")Сохранение объектов на диск
save(Corpus, file = "Corpus.RData")
save(Corpus_S, file = "Corpus_S.RData")
#save(Tokens_S, file = "Tokens_S.RData")