rm(list = ls())
date()
## [1] "Sun Feb 20 21:04:21 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
#Библиотеки
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)
#Чтение текстов
Texts <- readtext("../AllTexts/Out"
#, docvarsfrom = "filenames" # повторяет информацию из doc_id
, dvsep = "[/]"
)
# Data <- select(Data, doc_id, text, Group = docvar3) #Можно сразу переименовать
# Разбиваем по абзацам на три столбца
Data <- Texts$text %>%
str_split_fixed("[\n]", n = 3) %>%
as.data.frame()
Texts$Source <- Data$V1
Texts$Caption <- Data$V2
# Разбиваем по фразе Похожие
Data <- Data$V3 %>%
str_split(fixed("Похожие сообщения ("), simplify = TRUE) %>%
as.data.frame()
#Data$text <- Data2$V1
Texts$Similar <- Data$V2
# Вектор с Автор + АвторЫ
Texts$Author <- Data$V1 %>%
str_extract("(?<=Автор(:|ы:) )[^\n]+")
#Удаляю строку про авторов после их выделения
Texts$text <- Data$V1 %>%
str_replace("(^Автор(:|ы:) )[^\n]+[\n]"
, "")
rm(Data)
“doc_id” Название исходного файла “text” Текст “Source” Название источника “Caption” Заголовок “Similar” Списк повторов текста “Author” Автор или авторы
#Создание корпуса и первичная токенизация, DFM
Corpus <- corpus(Texts)
Tokens <- tokens(Corpus
, what = "fasterword"
, remove_url = TRUE
, include_docvars = FALSE
, verbose = TRUE)
## Creating a tokens object from a corpus input...
## ...starting tokenization
## ...0001_Аргументы_.txt to 1178_Федеральны.txt
## ...87,129 unique types
## ...removing separators, URLs
## ...complete, elapsed time: 1.5 seconds.
## Finished constructing tokens from 1,178 documents.
DFM <- dfm(Tokens)
Corpus %>%
summary(n = 1000) %>%
extract(2:4) %>%
summary()
## Types Tokens Sentences
## Min. : 34.0 Min. : 38.0 Min. : 1.00
## 1st Qu.: 189.0 1st Qu.: 293.0 1st Qu.: 12.00
## Median : 315.5 Median : 524.5 Median : 23.00
## Mean : 442.0 Mean : 840.1 Mean : 38.88
## 3rd Qu.: 580.0 3rd Qu.:1080.5 3rd Qu.: 50.00
## Max. :3227.0 Max. :9837.0 Max. :640.00
Статистика по токенам, (уже без веб адресов).
Length <- ntoken(Tokens)
summary(Length)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 25.0 242.2 444.0 686.7 890.8 7698.0
ggplot(mapping = aes(Length)) +
geom_histogram(binwidth = 20) +
theme_classic()#+
# scale_x_continuous(limits = c(0, 3000), n.breaks = 20)
Самые короткие тексты
Length %>%
sort() %>%
head(15)
## 1125_Спутник_Но.txt 1126_Спутник_Но.txt 0177_Официальны.txt 0934_MOSOBR_TV_.txt
## 25 31 32 34
## 1143_Грязинские.txt 1124_Спутник_Но.txt 0172_Радио_Росс.txt 0185_Радио_Росс.txt
## 35 37 41 45
## 1040_Янаульские.txt 0369_Seldon_New.txt 1127_Официальны.txt 0937_ГИС_Новост.txt
## 50 51 59 63
## 1115_Seldon_New.txt 1102_Администра.txt 0636_Псковская_.txt
## 63 69 73
1033_Клуб_Учите.txt 0673_Общественн.txt 0691_Общественн.txt 3999 4127 4138 0365_Учительска.txt 0263_ТВ2__tv2_t.txt 0896_РИА_Новост.txt 4239 4589 4619 0894_РИА_Новост.txt 0374_РИА_Новост.txt 1063_Качество_о.txt 4630 4642 4714 0301_РИА_Катюша.txt 0924_Промышленн.txt 0563_Новая_газе.txt 4716 5448 6073 0436_Психологич.txt 1022_БезФормата.txt 1006_Учебно_мет.txt 7698 9011 13414
Самые длинные тексты
Length %>%
sort() %>%
tail(50)
## 0982_Orion_int_.txt 0149_Forbes_ru_.txt 0114_РИА_PrimaM.txt 1076_Контакт___.txt
## 2192 2196 2207 2259
## 0182_Tadviser_r.txt 0315_Правда_Сев.txt 0350_Индустрия_.txt 1054_Авант_Парт.txt
## 2314 2317 2332 2338
## 0175_Учительска.txt 0325_Учительска.txt 0386_Вести_обра.txt 0629_Национальн.txt
## 2405 2410 2418 2480
## 0725_Informio_r.txt 0349_Национальн.txt 0064_Огонёк__Мо.txt 0652_Босс__boss.txt
## 2493 2544 2569 2624
## 0684_Культура_В.txt 0775_Новая_Ладо.txt 0903_News_Life_.txt 0176_РИА_Катюша.txt
## 2632 2634 2652 2668
## 0663_Городская_.txt 0281_Fonar_tv__.txt 0727_Федеральны.txt 0178_Учительска.txt
## 2772 2804 2805 2836
## 0224_Ulpressa_r.txt 0225_Ulpressa_r.txt 0018_ТАСС__Моск.txt 0215_РИА_Катюша.txt
## 2874 2874 2888 2908
## 0468_Наша_Плане.txt 0085_VTimes__vt.txt 0660_Национальн.txt 0188_РуАН__ru_a.txt
## 2913 2929 2934 3019
## 0168_Учительска.txt 0207_Учительска.txt 1079_Страховое_.txt 0987_Russkieves.txt
## 3119 3182 3186 3202
## 0222_Сноб__snob.txt 0249_РИА_Катюша.txt 0980_Seldon_New.txt 0214_Учительска.txt
## 3228 3229 3365 3488
## 0601_Координаци.txt 0417_Change_org.txt 1033_Клуб_Учите.txt 0365_Учительска.txt
## 3934 3993 3999 4239
## 0263_ТВ2__tv2_t.txt 1063_Качество_о.txt 0301_РИА_Катюша.txt 0924_Промышленн.txt
## 4589 4714 4716 5448
## 0563_Новая_газе.txt 0436_Психологич.txt
## 6073 7698
Подредактировал следующие очень длинные тексты:
текст номер 1006, 0894, 0374, 0896 - Сократил и еще несколько. Что-то из РИА отредактировал, но не скопировал. Текст номер 1022 и 0673, 0691 - дайджест заметок с именем сотрудника про перснализацию. оставил только одну заметку.
редактировал исходники
Вывод коротких текстов (меньше 50 слов)
corpus_subset(Corpus, ntoken(Corpus) < 50) %>%
as.character()
## 0177_Официальны.txt
## "Учащиеся 76 школ Вологодской области будут осваивать основные образовательные программы с помощью Школьной цифровой платформы, разработанной в рамках реализации программы \"Цифровая платформа персонализированного образования для школы\" Благотворительного фонда Сбербанка \"Вклад в будущее\". \nhttps://belozer.ru/uchashhiesya-shkol-vologodskoj-oblasti-poluchat-komplekty-smartboksov-ot-sberbanka-dlya-podklyucheniya-k-shkolnoj-tsifrovoj-platforme/\n"
## 0934_MOSOBR_TV_.txt
## "Почему конвергентное образование на данный момент возможно только в формате эксперимента? Какие изменения происходят в МЭШ и как они способствуют персонализации образования? О современной школе и современном учителе беседовали с ректором МГПУ Игорем Реморенко. \nhttp://mosobr.tv/programs/release/9153"
## 1124_Спутник_Но.txt
## "Учащиеся 14 школ Курганской области будут осваивать основные образовательные программы с помощью Школьной цифровой платформы (ШЦП), разработанной в рамках реализации программы \"Цифровая платформа персонализированного образования для школы\" Благотворительного фонда Сбербанка \"Вклад в будущее\".Сбербанк, правительство региона и автономная \nhttps://news.sputnik.ru/obschestvo/c4ef218b6985ca8f6c9db5bc701d7e330f501622\n"
## 1125_Спутник_Но.txt
## "Новый учебный год будет однозначно отличаться от всех предшествующих. Всем еще памятна весенняя ситуация, когда школьников и студентов отправили на дистанционное обучение в период пандемии. \nhttps://news.sputnik.ru/progress/e053998cc2fbb714ba7f25561b00303ac774b06a"
## 1126_Спутник_Но.txt
## "Выучили ли школы уроки прошлого карантина, не сбоит ли техника, готовы ли к продолжению дистанта учителя. Об этом \"РГ\" рассказала директор центра социализации и персонализации образования детей ФИРО РАНХиГС Наталья Тарасова \nhttps://news.sputnik.ru/obschestvo/b866b16a1b7197c7f2274e10ad49eb046d368661"
## 1143_Грязинские.txt
## "Учащиеся 37 школ области будут осваивать основные образовательные программы с помощью Школьной цифровой платформы (ШЦП), разработанной в рамках реализации программы \"Цифровая платформа персонализированного образования для школы\". \nВсе материалы свежего выпуска читайте в печатной версии издания. \nhttp://grizv.ru/archives/27058"
Максимум предложений
Corpus %>%
summary(n = 1000) %>%
extract(1:4) %>%
arrange(desc(Sentences)) %>%
head(30)
## Text Types Tokens Sentences
## 1 0436_Психологич.txt 3227 9837 640
## 2 0563_Новая_газе.txt 2663 7404 450
## 3 0263_ТВ2__tv2_t.txt 1710 5876 308
## 4 0924_Промышленн.txt 2495 6427 305
## 5 0365_Учительска.txt 1731 5163 243
## 6 0222_Сноб__snob.txt 1521 3925 231
## 7 0980_Seldon_New.txt 1651 4035 212
## 8 0660_Национальн.txt 1568 3445 206
## 9 0350_Индустрия_.txt 1174 2797 198
## 10 0301_РИА_Катюша.txt 2258 5836 190
## 11 0214_Учительска.txt 1722 4239 187
## 12 0775_Новая_Ладо.txt 1530 3182 186
## 13 0085_VTimes__vt.txt 1440 3473 181
## 14 0417_Change_org.txt 2008 4886 179
## 15 0629_Национальн.txt 1218 2921 179
## 16 0725_Informio_r.txt 1227 2936 179
## 17 0168_Учительска.txt 1619 3780 171
## 18 0415_Учительска.txt 1032 2377 165
## 19 0601_Координаци.txt 1908 4868 163
## 20 0249_РИА_Катюша.txt 1734 3882 160
## 21 0987_Russkieves.txt 1719 3860 158
## 22 0684_Культура_В.txt 1353 3098 155
## 23 0064_Огонёк__Мо.txt 1345 3072 152
## 24 0385_Искусствен.txt 1161 2439 151
## 25 0386_Вести_обра.txt 1343 3043 149
## 26 0663_Городская_.txt 1504 3293 147
## 27 0315_Правда_Сев.txt 1169 2770 146
## 28 0325_Учительска.txt 1487 2898 146
## 29 0224_Ulpressa_r.txt 1428 3416 145
## 30 0225_Ulpressa_r.txt 1428 3416 145
0374_РИА_Новост.txt – Отредактировано - оставлено одно 0894_РИА_Новост.txt - Список собыйтй, отредактирова - оставил два 0896_РИА_Новост.txt - Список собыйтй, отредактирова - оставил одно
#Первое сокращение - Удаление точных повторов
Тексты, которые повторялись - дословно
Repeated <- DFM %>%
as.matrix() %>%
duplicated(MARGIN = 1)
sum(Repeated)
## [1] 65
names(Tokens)[Repeated]
## [1] "0225_Ulpressa_r.txt" "0401_Пресс_рели.txt" "0625_Пресс_рели.txt"
## [4] "0644_Тамбовский.txt" "0645_ИФУР_РАНХи.txt" "0686_РАНХиГС__s.txt"
## [7] "0687_Южно_Росси.txt" "0696_Поволжский.txt" "0697_Уральский_.txt"
## [10] "0701_Вперед__vp.txt" "0720_Уральский_.txt" "0726_Федеральны.txt"
## [13] "0729_Федеральны.txt" "0746_Мурманский.txt" "0747_Нижегородс.txt"
## [16] "0748_Челябински.txt" "0761_Федеральны.txt" "0764_Федеральны.txt"
## [19] "0787_Московский.txt" "0788_Пермский_ф.txt" "0789_Новгородск.txt"
## [22] "0793_Федеральны.txt" "0814_Воронежски.txt" "0815_Смоленский.txt"
## [25] "0816_Липецкий_ф.txt" "0817_Астраханск.txt" "0826_Воронежски.txt"
## [28] "0849_Выборгский.txt" "0850_Владимирск.txt" "0862_Новости_ба.txt"
## [31] "0868_Карельский.txt" "0869_Дзержински.txt" "0870_Чебоксарск.txt"
## [34] "0871_Брянский_ф.txt" "0872_Дальневост.txt" "0873_Омский_фил.txt"
## [37] "0874_Волгоградс.txt" "0877_Клён__klen.txt" "0901_Брянский_ф.txt"
## [40] "0902_Advis_ru__.txt" "0910_Ивановский.txt" "0911_Ульяновски.txt"
## [43] "0912_Тульский_ф.txt" "0913_Балаковски.txt" "0914_Калужский_.txt"
## [46] "0915_РАНХИГС_Во.txt" "0916_Северо_кав.txt" "0940_Самарский_.txt"
## [49] "0981_Дальневост.txt" "1008_Тамбовский.txt" "1009_Самарский_.txt"
## [52] "1010_Ульяновски.txt" "1011_Чебоксарск.txt" "1012_ИФУР_РАНХи.txt"
## [55] "1039_Эхо_Медиа_.txt" "1072_Красноарме.txt" "1083_МБОУ_Немце.txt"
## [58] "1101_Звезда___с.txt" "1115_Seldon_New.txt" "1155_Федеральны.txt"
## [61] "1166_Тольятинск.txt" "1167_Ставрополь.txt" "1168_Кировский_.txt"
## [64] "1169_Среднерусс.txt" "1170_Казанский_.txt"
Corpus2 <- corpus_subset(Corpus, subset = !Repeated)
Tokens2 <- tokens(Corpus2
, what = "fasterword"
, remove_url = TRUE
, include_docvars = FALSE
, verbose = TRUE)
## Creating a tokens object from a corpus input...
## ...starting tokenization
## ...0001_Аргументы_.txt to 1178_Федеральны.txt
## ...87,065 unique types
## ...removing separators, URLs
## ...complete, elapsed time: 1.26 seconds.
## Finished constructing tokens from 1,113 documents.
DFM2 <- dfm(Tokens2)
##Статистика по сокращенному корпусу
Corpus2 %>%
summary(n = 1000) %>%
extract(2:4) %>%
summary()
## Types Tokens Sentences
## Min. : 34.0 Min. : 38.0 Min. : 1.00
## 1st Qu.: 188.0 1st Qu.: 289.8 1st Qu.: 12.00
## Median : 310.5 Median : 518.0 Median : 23.00
## Mean : 443.8 Mean : 846.2 Mean : 38.95
## 3rd Qu.: 603.2 3rd Qu.:1121.2 3rd Qu.: 53.00
## Max. :3227.0 Max. :9837.0 Max. :640.00
Статистика по токенам, (без вебардесов)
Length2 <- ntoken(Tokens2)
summary(Length2)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 25.0 233.0 428.0 687.8 908.0 7698.0
ggplot(mapping = aes(Length2)) +
geom_histogram(binwidth = 20) +
theme_classic()#+
# scale_x_continuous(limits = c(0, 3000), n.breaks = 20)
Cosine <- DFM2 %>%
textstat_simil(margin = "documents", method = "cosine")
Cosine %>%
.[lower.tri(.)] %>%
hist(breaks = 100)
Cosine %>%
as.list(sorted = TRUE, n = 1) %>% #специальный метод для объекта dist class object
unlist() %>%
sort(decreasing = TRUE) %>%
head(25) %>%
extract(c(TRUE, FALSE))
## 0478_Инвест_Фор.txt.1047_Геоинформм.txt 0394_Кабардино_.txt.0931_Кабардино_.txt
## 0.9998720 0.9997868
## 0448_РАНХиГС__r.txt.0978_Портал_соц.txt 0430_РАНХиГС__r.txt.0806_Федеральны.txt
## 0.9997786 0.9997537
## 0538_Московский.txt.0710_Московский.txt 0534_Лариса_Ник.txt.0909_Комитет_Го.txt
## 0.9997504 0.9996050
## 0352_Время__tim.txt.1051_Время___Ки.txt 0428_Деловой_кв.txt.0955_Деловой_кв.txt
## 0.9995994 0.9995895
## 0956_News_Life_.txt.1021_Новгород__.txt 0220_РАНХиГС__r.txt.1007_Тольятинск.txt
## 0.9995839 0.9995372
## 0485_РАНХиГС__r.txt.0728_Федеральны.txt 0662_СГДУ__surg.txt.0802_Форум_Доно.txt
## 0.9995336 0.9995257
## 0356_Издательст.txt.0667_Пресс_рели.txt
## 0.9995200
# C[C < 0.92 & C > 0.90]
После просмотра текстов решено, что граница похожести лежит в районе коэфициента 0,91
# CosineTri <- Cosine
# CosineTri[lower.tri(CosineTri, diag = TRUE)] <- NA
#
# Similar <- apply(CosineTri, MARGIN = 1, FUN = max, na.rm = TRUE) > 0.91
#
# sum(Similar)
# Corpus3 <- corpus_subset(x = Corpus2, subset = Simolar)
#Вообще непонятно почему не работает
Cosine3 <- DFM %>%
textstat_simil(margin = "documents", method = "cosine")
Cosine3 %>%
.[lower.tri(.)] %>%
hist(breaks = 100)
Cosine3 %>%
as.list(sorted = TRUE, n = 1) %>% #специальный метод для объекта dist class object
unlist() %>%
sort(decreasing = TRUE) %>%
head(25) %>%
extract(c(TRUE, FALSE))
## 0143_LipetskMed.txt.0701_Вперед__vp.txt 0152_Петрозавод.txt.1039_Эхо_Медиа_.txt
## 1 1
## 0213_Content_Re.txt.0625_Пресс_рели.txt 0225_Ulpressa_r.txt.0224_Ulpressa_r.txt
## 1 1
## 0401_Пресс_рели.txt.0356_Издательст.txt 0456_РАНХиГС__r.txt.0644_Тамбовский.txt
## 1 1
## 0503_РАНХиГС__r.txt.0761_Федеральны.txt 0524_Официальны.txt.0902_Advis_ru__.txt
## 1 1
## 0625_Пресс_рели.txt.0213_Content_Re.txt 0645_ИФУР_РАНХи.txt.0456_РАНХиГС__r.txt
## 1 1
## 0687_Южно_Росси.txt.0456_РАНХиГС__r.txt 0696_Поволжский.txt.0456_РАНХиГС__r.txt
## 1 1
## 0701_Вперед__vp.txt.0143_LipetskMed.txt
## 1
Создаю вектор для удаления
CosineTri3 <- Cosine3
CosineTri3[lower.tri(CosineTri3, diag = TRUE)] <- NA
Similar3 <- apply(CosineTri3, MARGIN = 1, FUN = max, na.rm = TRUE) > 0.91
## Warning in FUN(newX[, i], ...): no non-missing arguments to max; returning -Inf
length(Similar3)
## [1] 1178
sum(Similar3)
## [1] 302
Создание корпуса, Токенов, DFM
Texts3 <- Texts[!Similar3, ]
Corpus3 <- corpus(Texts3)
Tokens3 <- tokens(Corpus3
, what = "fasterword"
, remove_url = TRUE
, include_docvars = FALSE
, verbose = TRUE)
## Creating a tokens object from a corpus input...
## ...starting tokenization
## ...0002_Мои_года__.txt to 1178_Федеральны.txt
## ...84,562 unique types
## ...removing separators, URLs
## ...complete, elapsed time: 1.09 seconds.
## Finished constructing tokens from 876 documents.
DFM3 <- dfm(Tokens3)
Corpus3 %>%
summary(n = 1000) %>%
extract(2:4) %>%
summary()
## Types Tokens Sentences
## Min. : 28.0 Min. : 29.0 Min. : 1.00
## 1st Qu.: 170.8 1st Qu.: 260.0 1st Qu.: 11.00
## Median : 285.5 Median : 486.5 Median : 20.00
## Mean : 417.9 Mean : 797.7 Mean : 37.15
## 3rd Qu.: 537.0 3rd Qu.: 997.2 3rd Qu.: 46.25
## Max. :3227.0 Max. :9837.0 Max. :640.00
Статистика по токенам, (уже без веб адресов).
Length <- ntoken(Tokens3)
summary(Length)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 25.0 215.8 407.0 663.5 828.5 7698.0
ggplot(mapping = aes(Length)) +
geom_histogram(binwidth = 20) +
theme_classic()#+
# scale_x_continuous(limits = c(0, 3000), n.breaks = 20)
save(Corpus, file = "Corpus.RData")
save(Texts3, file = "Texts3.RData")