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)
#Вообще непонятно почему не работает

3 Сокращение по схожести с начала

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")