Что расскажут новости РНФ за 10 лет?

Автор

Анастасия Орлова

Дата публикации

24.12.2024

Аннотация
В этом году Российский научный фонд отметил десятилетие.

РНФ является одним из наиболее значимых институтов поддержки отечественной науки. Фонд проводит конкурсный отбор научных и научно-технических программ и проектов в сфере фундаментальных и поисковых исследований – исследований, направленных на получение новых знаний об основных закономерностях строения, функционирования и развития человека, общества и окружающей среды. Формально Фонд был учрежден в конце 2013 года, с этого периода на сайте РНФ было опубликовано более 5 000 новостей. Данные хорошо размечены и находятся в открытом доступе. Любой желающий может собрать из них свой датасет и проанализировать информацию, опубликованную на сайте.

Новости на сайте РНФ разделены на пять основных рубрик:

Каждая новость отнесена к определенной категории: биология , гуманитарные науки, инженерные науки, интервью, математика, медицина, молодежные группы, науки о Земле, новости программы, новости Фонда, прикладные проекты, сельское хозяйство, СМИ о Фонде, спецпроект, физика и космос, химия и материалы.

Разноплановая информация, объединенная общей тематикой, отлично подходит для латентно-семантического анализа (LSA). На собранных данных можно проанализирвоать семантические связи между словами, найти схожие документы, а также проследить связи между темами в контексте их развития и/или угасания.

Для работы нам понадобятся следующие библиотеки:

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.5.1     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.1
✔ purrr     1.0.2     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter()         masks stats::filter()
✖ readr::guess_encoding() masks rvest::guess_encoding()
✖ dplyr::lag()            masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
Loading required package: Matrix


Attaching package: 'Matrix'


The following objects are masked from 'package:tidyr':

    expand, pack, unpack

1 Подготовка данных

Данные собраны при помощи веб-скрапера (Selector Gadget).
Датасет формируем из заголовкой новостей, ссылок на них, а также категорий и дат публикаций.

Для начала загрузим ссылку и HTML-код страницы.

url <- "https://rscf.ru/news/"
html = read_html(url)

Собираем заголовки новостей.

news <- html |> 
  html_elements(".news-title")

news_text <- tibble(
  href = news |>
    html_text())

news_text
# A tibble: 18 × 1
   href                                                                         
   <chr>                                                                        
 1 "Усилители из стекла с висмутом повысят пропускную способность интернета в 5…
 2 "Отечественные OLED-структуры и микродисплеи на их основе будут ярче и стаби…
 3 "Высоковольтные полупроводниковые приборы в несколько раз превзойдут зарубеж…
 4 "Ученые запустят производство особо чистого хлороводорода для микроэлектрони…
 5 "Высокочистый арсенид галлия позволит создать полностью отечественные лазерн…
 6 "Физики пересмотрели законы образования снежинок, дождевых капель и колец Са…
 7 "Солнечно-слепые приемники изображений помогут следить за радиационными загр…
 8 "Встроенные датчики температуры защитят изделия микроэлектроники от аномальн…
 9 "Оптические приемники и передатчики данных сделают легче и в 5 – 20 раз быст…
10 "Ирина Алексеенко: «Успешный прикладной проект помогут сделать люди, думающи…
11 "Серебряные нанонити позволят создать оптически прозрачные токопроводящие эл…
12 "Терагерцовые квантово-каскадные лазеры сделают дешевле для широкого внедрен…
13 "«Спектрофотометр в кювете» создали в СПбГУ"                                 
14 "«Отпечатки пальцев» на белке помогли уловить опасный грибной токсин "       
15 "Физики узнали, как анизотропия и анапольное состояние влияют на фактор Парс…
16 "Искусственный интеллект поможет создать новые радиационно-стойкие материалы…
17 "Создана крупнейшая в мире база данных о температуре рек в Арктике"          
18 "Грантополучатели, попечители и эксперты РНФ вновь отмечены Научной премией …

Собираем ссылки новостей.

news_link <- tibble(
  href = news |> 
    html_attr("href"))

news_link
# A tibble: 18 × 1
   href                                                                         
   <chr>                                                                        
 1 /news/engineering-sciences/usiliteli-iz-stekla-s-vismutom-povysyat-propusknu…
 2 /news/applied_projects/otechestvennye-oled-struktury-i-mikrodisplei-na-ikh-o…
 3 /news/applied_projects/vysokovoltnye-poluprovodnikovye-pribory-v-neskolko-ra…
 4 /news/applied_projects/uchenye-zapustyat-proizvodstvo-osobo-chistogo-khlorov…
 5 /news/applied_projects/vysokochistyy-arsenid-galliya-pozvolit-sozdat-polnost…
 6 /news/maths/fiziki-peresmotreli-zakony-obrazovaniya-snezhinok-dozhdevykh-kap…
 7 /news/applied_projects/solnechno-slepye-priemniki-izobrazheniy-pomogut-sledi…
 8 /news/applied_projects/vstroennye-datchiki-temperatury-zashchityat-izdeliya-…
 9 /news/applied_projects/opticheskie-priemniki-i-peredatchiki-dannykh-sdelayut…
10 /news/interview/irina-alekseenko-uspeshnyy-prikladnoy-proekt-pomogut-sdelat-…
11 /news/applied_projects/serebryanye-nanoniti-pozvolyat-sozdat-opticheski-proz…
12 /news/applied_projects/teragertsovye-kvantovo-kaskadnye-lazery-sdelayut-desh…
13 /news/presidential-program/spektrofotometr-v-kyuvete-sozdali-v-spbgu/        
14 /news/agriculture/otpechatki-paltsev-na-belke-pomogli-ulovit-opasnyy-gribnoy…
15 /news/presidential-program/fiziki-uznali-kak-anizotropiya-i-anapolnoe-sostoy…
16 /news/physics/iskusstvennyy-intellekt-pomozhet-sozdat-novye-radiatsionno-sto…
17 /news/earth-sciences/sozdana-krupneyshaya-v-mire-baza-dannykh-o-temperature-…
18 /news/found/grantopoluchateli-popechiteli-i-eksperty-rnf-vnov-otmecheny-nauc…

Собираем даты публикации новостей.

news_date <- html |> 
  html_elements(".news-date")

news_all_date <- tibble(
  class = news_date |> 
    html_text())

news_all_date
# A tibble: 18 × 1
   class                                                  
   <chr>                                                  
 1 "\r\n            23 декабря, 2024                     "
 2 "\r\n            23 декабря, 2024                     "
 3 "\r\n            23 декабря, 2024                     "
 4 "\r\n            23 декабря, 2024                     "
 5 "\r\n            23 декабря, 2024                     "
 6 "\r\n            23 декабря, 2024                     "
 7 "\r\n            23 декабря, 2024                     "
 8 "\r\n            22 декабря, 2024                     "
 9 "\r\n            20 декабря, 2024                     "
10 "\r\n            20 декабря, 2024                     "
11 "\r\n            20 декабря, 2024                     "
12 "\r\n            20 декабря, 2024                     "
13 "\r\n            20 декабря, 2024                     "
14 "\r\n            20 декабря, 2024                     "
15 "\r\n            19 декабря, 2024                     "
16 "\r\n            19 декабря, 2024                     "
17 "\r\n            19 декабря, 2024                     "
18 "\r\n            19 декабря, 2024                     "

Собираем категории новостей.

news_category <- html |> 
  html_elements(".news-category")

news_all_category <- tibble(
  class = news_category |> 
    html_text())

news_all_category
# A tibble: 18 × 1
   class             
   <chr>             
 1 Инженерные науки  
 2 Прикладные проекты
 3 Прикладные проекты
 4 Прикладные проекты
 5 Прикладные проекты
 6 Математика        
 7 Прикладные проекты
 8 Прикладные проекты
 9 Прикладные проекты
10 Интервью          
11 Прикладные проекты
12 Прикладные проекты
13 Химия и материалы 
14 Сельское хозяйство
15 Физика и космос   
16 Физика и космос   
17 Науки о Земле     
18 Новости Фонда     

Теперь нам необходимо напсиать цикл для сбора новостей со всех 299 страниц новостей сайта.

Инициализируем строки для хранения данных

all_news_text <- c()
all_news_links <- c()
all_news_date <- c()
all_category <- c()

Пишем цикл, который будет проходиться по всем страницам и вытягивать из каждой новости заголовок, дату публикации, ссылку и категорию.

for (i in 1:299) {
  url <- paste0("https://rscf.ru/news/?PAGEN_2=", i)
  html <- read_html(url)
  news <- html |> 
    html_elements(".news-title")
  news_date <- html |> 
    html_elements(".news-date")
  news_all_date <- news_date |> 
    html_text()
  news_category <- html |> 
    html_elements(".news-category")
  news_all_category <- news_category |> 
      html_text()
  news_text <- news |>
    html_text(trim = TRUE)
  news_link <- news |> 
    html_attr("href")
  all_news_text <- c(all_news_text, news_text)
  all_news_links <- c(all_news_links, news_link)
  all_news_date <- c(all_news_date, news_all_date)
  all_category <- c(all_category, news_all_category)
}

Загружаем данные в таблицу.

final_news_data <- tibble(
  title = all_news_text,
  link = all_news_links,
  date = all_news_date,
  category = all_category)

print(final_news_data)
# A tibble: 5,375 × 4
   title                                                    link  date  category
   <chr>                                                    <chr> <chr> <chr>   
 1 Усилители из стекла с висмутом повысят пропускную спосо… /new… "\r\… Инженер…
 2 Отечественные OLED-структуры и микродисплеи на их основ… /new… "\r\… Приклад…
 3 Высоковольтные полупроводниковые приборы в несколько ра… /new… "\r\… Приклад…
 4 Ученые запустят производство особо чистого хлороводород… /new… "\r\… Приклад…
 5 Высокочистый арсенид галлия позволит создать полностью … /new… "\r\… Приклад…
 6 Физики пересмотрели законы образования снежинок, дождев… /new… "\r\… Математ…
 7 Солнечно-слепые приемники изображений помогут следить з… /new… "\r\… Приклад…
 8 Встроенные датчики температуры защитят изделия микроэле… /new… "\r\… Приклад…
 9 Оптические приемники и передатчики данных сделают легче… /new… "\r\… Приклад…
10 Ирина Алексеенко: «Успешный прикладной проект помогут с… /new… "\r\… Интервью
# ℹ 5,365 more rows

Добавляем протокол доступа к полученным ссылкам (это понадобится для дальнейшей загрузки полного текста каждой новости).

final_news_data_link <- final_news_data |> 
  mutate(full_link = paste0("https://rscf.ru", link)) |> 
  select(-link)

print(final_news_data_link)
# A tibble: 5,375 × 4
   title                                                date  category full_link
   <chr>                                                <chr> <chr>    <chr>    
 1 Усилители из стекла с висмутом повысят пропускную с… "\r\… Инженер… https://…
 2 Отечественные OLED-структуры и микродисплеи на их о… "\r\… Приклад… https://…
 3 Высоковольтные полупроводниковые приборы в нескольк… "\r\… Приклад… https://…
 4 Ученые запустят производство особо чистого хлоровод… "\r\… Приклад… https://…
 5 Высокочистый арсенид галлия позволит создать полнос… "\r\… Приклад… https://…
 6 Физики пересмотрели законы образования снежинок, до… "\r\… Математ… https://…
 7 Солнечно-слепые приемники изображений помогут следи… "\r\… Приклад… https://…
 8 Встроенные датчики температуры защитят изделия микр… "\r\… Приклад… https://…
 9 Оптические приемники и передатчики данных сделают л… "\r\… Приклад… https://…
10 Ирина Алексеенко: «Успешный прикладной проект помог… "\r\… Интервью https://…
# ℹ 5,365 more rows

Приводим даты к единому формату (оставляем только год, отбрасываем день и месяц, так как эта информация не нужна для аналитики).

final_news_data_link$date <- sub(".*,\\s*(\\d{4})", "\\1", final_news_data_link$date)

final_news_data_link
# A tibble: 5,375 × 4
   title                                                date  category full_link
   <chr>                                                <chr> <chr>    <chr>    
 1 Усилители из стекла с висмутом повысят пропускную с… "202… Инженер… https://…
 2 Отечественные OLED-структуры и микродисплеи на их о… "202… Приклад… https://…
 3 Высоковольтные полупроводниковые приборы в нескольк… "202… Приклад… https://…
 4 Ученые запустят производство особо чистого хлоровод… "202… Приклад… https://…
 5 Высокочистый арсенид галлия позволит создать полнос… "202… Приклад… https://…
 6 Физики пересмотрели законы образования снежинок, до… "202… Математ… https://…
 7 Солнечно-слепые приемники изображений помогут следи… "202… Приклад… https://…
 8 Встроенные датчики температуры защитят изделия микр… "202… Приклад… https://…
 9 Оптические приемники и передатчики данных сделают л… "202… Приклад… https://…
10 Ирина Алексеенко: «Успешный прикладной проект помог… "202… Интервью https://…
# ℹ 5,365 more rows

Добавляем в id сокращенное название документа (doc). В дальнейшем это позволит проще ориентироваться в привязке слов к документу.

final_news_data_link <- final_news_data_link |> 
  mutate(id = paste0(row_number(), "_doc")) |> 
  select(id, date, category, title, full_link)

final_news_data_link
# A tibble: 5,375 × 5
   id     date                        category           title         full_link
   <chr>  <chr>                       <chr>              <chr>         <chr>    
 1 1_doc  "2024                     " Инженерные науки   Усилители из… https://…
 2 2_doc  "2024                     " Прикладные проекты Отечественны… https://…
 3 3_doc  "2024                     " Прикладные проекты Высоковольтн… https://…
 4 4_doc  "2024                     " Прикладные проекты Ученые запус… https://…
 5 5_doc  "2024                     " Прикладные проекты Высокочистый… https://…
 6 6_doc  "2024                     " Математика         Физики перес… https://…
 7 7_doc  "2024                     " Прикладные проекты Солнечно-сле… https://…
 8 8_doc  "2024                     " Прикладные проекты Встроенные д… https://…
 9 9_doc  "2024                     " Прикладные проекты Оптические п… https://…
10 10_doc "2024                     " Интервью           Ирина Алексе… https://…
# ℹ 5,365 more rows

2 Промежуточный разведовательный анализ

На этом этапе можно посмотреть общее количество новостей в разрезе по годам и категориям.

category_stat<- final_news_data_link |> 
  group_by(date, category) |> 
  summarise(count = n()) |>   
  ungroup() |> 
  filter(category != "ru", category != "")

Визуализируем полученные данные.

ggplot(category_stat, aes(x = date, y = count, fill = category)) +
  geom_bar(stat = "identity", position = "dodge",  color = "black") +
  labs(title = "Распределение новостей по категориям и годам",
       x = "Год",
       y = "Количество новостей") +
  theme_minimal() +
  theme(legend.title = element_blank())

Согласно данным на графике, тематическая рубрикация на сайте новостей РНФ изначально была довольно узкой. В 2013 году новостей практически нет (Фонд был создан зимой 2013 года). До 2018 года заметен значительный перекос в сторону рубрики “Новости фонда”. На мой взгляд, это связано с тем, что новости на сайте изначально носили преимущественно информационный характер. Например, в датасете за этот период обнаружены поздравительные тексты, рекомендации к оформлению научных статей, рекомендации к заполнению заявок, информация о победителях премий и т.д. Таким образом, можно предположить, что новости размещались в целях донесения информации, связанной с организационными или обновлениями и/или требования Фонда.

Полезно “приблизить” график и лучше ознакомиться с категориями новостей с 2018 по 2024 год.

category_stat_2018 <- final_news_data_link |> 
  group_by(date, category) |> 
  summarise(count = n()) |> 
  ungroup() |> 
  filter(date >= 2018) |> 
  filter(category != "ru", category != "")

Визуализируем полученные данные.

ggplot(category_stat_2018, aes(x = date, y = count, fill = category)) +
  geom_bar(stat = "identity", position = "dodge", color = "black") +
  labs(title = "Распределение новостей по категориям и годам",
       x = "Год",
       y = "Количество новостей") +
  theme_minimal() +
  theme(legend.title = element_blank())

C 2018 года наблюдается увеличение категорий (рубрик) новостей.
В 2018 году также наблюдается аномальное количество новостей в разделе “СМИ о Фонде”.
В последние 3 года наблюдается рост интереса к химии и материалам. Далее следуют биология и физика и космос. Примечательно, что все гуманитарные науки объединены в один кластер, т.е. мы не найдем отдельных разделов для философии и филологии. В то же время биология и химия представлены в отдельных категориях, а не объеденены в “естественные науки”. На мой взгляд, это подчеркивает отношение Фонда к химии, биологии и физике как к приоритетным областям развития науки.

3 Извлечение полного текста новостей

Перейдем к заключительному этапу сбора данных. Нам необходимо извлечь полные тексты новостей.

Проверяем извлечение текста на одной ссылке.

urls <- final_news_data_link |>
pull(full_link)
 text <- read_html(urls[1]) |>
   html_elements("p , .news-detail-intro") |>
 html_text2()

 text[1]
[1] "\r Ученые из Москвы и Нижнего Новгорода создали усилитель для длин волн телекоммуникационного диапазона. Это устройство размером с ноутбук состоит из стекла с добавками висмута. Когда лазерное излучение проходит сквозь такой световод, оно становится более сфокусированным. Благодаря этому передаваемый сигнал усиливается: диапазон длин волн здесь в пять раз больше, чем в современных устройствах."

Пишем функцию для извлечения полного текста каждой новости.

get_text <- function(url) {
 read_html(url) |> 
    html_elements("p , .news-detail-intro") |> 
    html_text2() |> 
    paste(collapse= " ")
    }

Применяем функцию, вытаскивая текст по заранее подготовленным ссылкам. Полученные данные преобразовываем в таблицу.

rnf_text <- map(urls, get_text)
rnf_text <- rnf_text|>
flatten_chr() |>
as_tibble()
rnf_text

Загружаем подготовленные данные, чтобы обойти прямую загрузку из Интернета.

load("/Users/nastasyaorlova/Desktop/data/rnf_text_.RData")

Соеденяем текст с имеющейся таблицей.

rnf_news <- final_news_data_link |> 
  bind_cols(rnf_text) 

rnf_news
# A tibble: 5,375 × 6
   id     date                        category         title full_link full_text
   <chr>  <chr>                       <chr>            <chr> <chr>     <chr>    
 1 1_doc  "2024                     " Инженерные науки Усил… https://… "\r Учен…
 2 2_doc  "2024                     " Прикладные прое… Отеч… https://… "Ученые …
 3 3_doc  "2024                     " Прикладные прое… Высо… https://… "\r Учен…
 4 4_doc  "2024                     " Прикладные прое… Учен… https://… "\r Кома…
 5 5_doc  "2024                     " Прикладные прое… Высо… https://… "\r Хими…
 6 6_doc  "2024                     " Математика       Физи… https://… "\r Иссл…
 7 7_doc  "2024                     " Прикладные прое… Солн… https://… "\r Иссл…
 8 8_doc  "2024                     " Прикладные прое… Встр… https://… "\r Учен…
 9 9_doc  "2024                     " Прикладные прое… Опти… https://… "\r Учен…
10 10_doc "2024                     " Интервью         Ирин… https://… "\r В 20…
# ℹ 5,365 more rows

4 Подготовка текста новостей

В некоторых случаях извлеченный текст оказался некорректным. Например, вместо кириллических символов в нескольких текстах отображались символы, сигнализирующие о технической ошибке при извлечении текста(ÐÑоÐ). Также из датасета были удалены новости, состоящие из одного предложения. Как правило, в этих новостях была размещена сопроводительная информация к файлам в формате pdf. На этих основаниях было удалено более 60 текстов. Дополнительно были удалены тексты, содержащие пустые теги или тег “ru”. Это сократило корпус еше на 3 текста.

rnf_news_without_doc <- rnf_news |> 
  filter(str_trim(full_text) != "") |> 
  filter(!(id %in% c("3988_doc", "3984_doc", "598_doc",
                         "4001_doc", "2392_doc", "4864_doc",
                         "3694_doc", "3955_doc", "2209_doc",
                     "1915_doc", "5093_doc", "1306_doc",
                     "5271_doc", "4297_doc", "3127_doc",
                     "3977_doc", "5119_doc", "3966_doc",
                     "4294_doc", "3978_doc", "605_doc",
                     "803_doc", "1313_doc", "1305_doc",
                     "1335_doc", "1394_doc", "1524_doc", "1572_doc","1734_doc", "1752_doc", "1734_doc", "1752_doc",
"1828_doc", "1922_doc", "1975_doc", "2076_doc",
"2216_doc", "2298_doc", "2389_doc", "2399_doc",
"2936_doc", "3134_doc", "3701_doc", "3962_doc",
"3985_doc", "3987_doc", "3991_doc", "3995_doc",
"4003_doc", "4008_doc", "4304_doc", "4434_doc",
"4575_doc", "4669_doc", "4696_doc", "4793_doc", "4811_doc",
"4871_doc", "4931_doc", "4927_doc", "5100_doc", "5126_doc", "5156_doc", "5278_doc"))) |> 
  filter(category != "ru", category != "")

Вычищаю данные.

news_prepare <- rnf_news_without_doc |>
  mutate(full_text = str_replace_all(full_text, "[»«]", " ")) |> 
  mutate(full_text = str_remove_all(full_text, "\\d")) |> 
  select(id, full_text, category)

news_prepare 
# A tibble: 5,274 × 3
   id     full_text                                                     category
   <chr>  <chr>                                                         <chr>   
 1 1_doc  "\r Ученые из Москвы и Нижнего Новгорода создали усилитель д… Инженер…
 2 2_doc  "Ученые ИСПМ РАН намерены синтезировать более эффективные и … Приклад…
 3 3_doc  "\r Ученые ФТИ им. А.Ф. Иоффе РАН усовершенствуют высоковоль… Приклад…
 4 4_doc  "\r Команда исследователей из ООО  Силтрон  совместно с АО  … Приклад…
 5 5_doc  "\r Химики Лаборатории технологии высокочистых материалов Ни… Приклад…
 6 6_doc  "\r Исследователи из Сколтеха вывели новые математические ур… Математ…
 7 7_doc  "\r Исследователи Московского института электронной техники … Приклад…
 8 8_doc  "\r Ученые и инженеры Института радиотехники и электроники и… Приклад…
 9 9_doc  "\r Ученые Томского государственного университета систем упр… Приклад…
10 10_doc "\r В  году успешно завершилась первая фаза клинических иссл… Интервью
# ℹ 5,264 more rows

Датасет готов к лемматизации!

5 Лемматизация текста

Лемматизирую текст, а не токенизирую, так как собираюсь использовать летно-семантический анализ при котором сходство лучше искать между леммами, а не словоформами.

udpipe_download_model(language = "russian-syntagrus")
russian_syntagrus <- udpipe_load_model(file = "russian-syntagrus-ud-2.5-191206.udpipe")
lemmatization <- udpipe_annotate(russian_syntagrus, news_prepare$full_text, 
                                 doc_id = news_prepare$id)

Преобразовываю полученные данные в таблицу.

lemmatization <- as_tibble(lemmatization)

lemmatization 

Загружаем подготовленные данные, чтобы обойти утомительный процесс лемматизации.

load("/Users/nastasyaorlova/Desktop/data/lemmatization.RData")

6 Подготовка лемматизированного текста

Формирую список стоп-слов. Я сформировала список из наибольшего количества стоп-слов, так как в случае выбора одного или двух источников (я пробовала каждый по отдельности), остаются слова, не влияющие на тематику (день, вчера). Ресурс “nltk” не добавил в существующий список ни одного нового слова, в связи с чем я его не применяла.

stopwords_ru <- c(
  stopwords("ru", source = "snowball"),
  stopwords("ru", source = "marimo"),
  stopwords("ru", source  = "stopwords-iso")
)

stopwords_ru <- sort(unique(stopwords_ru))

length(stopwords_ru)
[1] 715

Дополнительная очистка данных тексте. Очистка некорректной лемматизации упрощает работу с текстом (-ый, -е, дефис в начале слова, единичные заглавные буквы, инициалы (М.).

clean_words <- lemmatization |> 
  filter(!lemma %in% stopwords_ru) |> 
  filter(str_detect(lemma, "[\u0400-\u04FF]")) |>
  filter(!str_detect(lemma, "^[А-ЯЁ].*\\.$")) |> 
  filter(!str_detect(lemma, "^А$") & !str_detect(lemma, "^-.{1,2}$")) |>
  filter(!str_detect(lemma, "/л")) |>
  mutate(lemma = str_remove(lemma, "^-")) |>
  mutate(lemma = str_remove(lemma, "\\+")) |>
  mutate(lemma = str_remove(lemma, ",")) |>
  filter(upos != "PUNCT")

clean_words
# A tibble: 1,602,729 × 14
   doc_id paragraph_id sentence_id sentence     token_id token lemma upos  xpos 
   <chr>         <int>       <int> <chr>        <chr>    <chr> <chr> <chr> <chr>
 1 1_doc             1           1 Ученые из М… 1        Учен… учен… NOUN  <NA> 
 2 1_doc             1           1 Ученые из М… 3        Моск… Моск… PROPN <NA> 
 3 1_doc             1           1 Ученые из М… 5        Нижн… нижн… ADJ   <NA> 
 4 1_doc             1           1 Ученые из М… 6        Новг… Новг… PROPN <NA> 
 5 1_doc             1           1 Ученые из М… 7        созд… созд… VERB  <NA> 
 6 1_doc             1           1 Ученые из М… 8        усил… усил… NOUN  <NA> 
 7 1_doc             1           1 Ученые из М… 10       длин  длина NOUN  <NA> 
 8 1_doc             1           1 Ученые из М… 11       волн  волна NOUN  <NA> 
 9 1_doc             1           1 Ученые из М… 12       теле… теле… ADJ   <NA> 
10 1_doc             1           1 Ученые из М… 13       диап… диап… NOUN  <NA> 
# ℹ 1,602,719 more rows
# ℹ 5 more variables: feats <chr>, head_token_id <chr>, dep_rel <chr>,
#   deps <chr>, misc <chr>

Убираем редкие наблюдения, так как редкие наблюдения, встречающиеся менее 5 раз, не повлияют на тематику текстов.

news_lemma_rare <- clean_words |> 
  add_count(lemma) |> 
  filter(n > 5) |> 
  select(-n)

news_lemma_rare
# A tibble: 1,522,513 × 14
   doc_id paragraph_id sentence_id sentence     token_id token lemma upos  xpos 
   <chr>         <int>       <int> <chr>        <chr>    <chr> <chr> <chr> <chr>
 1 1_doc             1           1 Ученые из М… 1        Учен… учен… NOUN  <NA> 
 2 1_doc             1           1 Ученые из М… 3        Моск… Моск… PROPN <NA> 
 3 1_doc             1           1 Ученые из М… 5        Нижн… нижн… ADJ   <NA> 
 4 1_doc             1           1 Ученые из М… 6        Новг… Новг… PROPN <NA> 
 5 1_doc             1           1 Ученые из М… 7        созд… созд… VERB  <NA> 
 6 1_doc             1           1 Ученые из М… 8        усил… усил… NOUN  <NA> 
 7 1_doc             1           1 Ученые из М… 10       длин  длина NOUN  <NA> 
 8 1_doc             1           1 Ученые из М… 11       волн  волна NOUN  <NA> 
 9 1_doc             1           1 Ученые из М… 12       теле… теле… ADJ   <NA> 
10 1_doc             1           1 Ученые из М… 13       диап… диап… NOUN  <NA> 
# ℹ 1,522,503 more rows
# ℹ 5 more variables: feats <chr>, head_token_id <chr>, dep_rel <chr>,
#   deps <chr>, misc <chr>

Считаем наиболее часто встречающиесч слова, что может дать некоторое представление о полученных данных.

news_test_counts <- news_lemma_rare |> 
  group_by(lemma) |> 
  summarise(n = n()) |> 
  arrange(-n)

news_test_counts 
# A tibble: 15,762 × 2
   lemma            n
   <chr>        <int>
 1 научный      15393
 2 ученый       15200
 3 исследование 12619
 4 российский    9666
 5 проект        9052
 6 наука         8407
 7 результат     7657
 8 РНФ           6803
 9 фонд          6433
10 материал      5917
# ℹ 15,752 more rows

#Промежуточный разведывательный анализ

Составим облако слов.

pal <- brewer.pal(n = 8, name = "PuBuGn") 

wordcloud2(data = news_test_counts, 
           size = 1,                           
           color = pal,                        
           backgroundColor = "white",        
           shape = 'circle',                   
           minSize = 1)

7 Опрятный подход

Добавляем tf idf, так как вместо показателей абсолютной встречаемости при анализе больших текстовых данных применяется tf-idf.

news_counts <- news_lemma_rare |> 
  count(lemma, doc_id) |> 
  bind_tf_idf(lemma, doc_id, n) |> 
  select(-n, -tf, -idf)

news_counts
# A tibble: 931,203 × 3
   lemma    doc_id    tf_idf
   <chr>    <chr>      <dbl>
 1 D-печати 1036_doc 0.0370 
 2 D-печати 1059_doc 0.0382 
 3 D-печати 1224_doc 0.00944
 4 D-печати 1267_doc 0.00527
 5 D-печати 1332_doc 0.0303 
 6 D-печати 13_doc   0.0251 
 7 D-печати 1529_doc 0.100  
 8 D-печати 1536_doc 0.152  
 9 D-печати 1687_doc 0.0632 
10 D-печати 1770_doc 0.0175 
# ℹ 931,193 more rows

Используем специальный формат для хранения разреженных матриц.

dtm <- news_counts |> 
  cast_sparse(lemma, doc_id, tf_idf)

8 Эмбеддинги слов

50 - это наиболее оптимальное значение. Расстояние не должно быть слишком большим или маленьким .

lsa_space<- irlba::irlba(dtm, 50) 

rownames(lsa_space$u) <- rownames(dtm)
colnames(lsa_space$u) <- paste0("dim", 1:50)
word_emb <- lsa_space$u |> 
  as.data.frame() |> 
  rownames_to_column("word") |> 
  as_tibble()

word_emb
# A tibble: 15,762 × 51
   word      dim1     dim2     dim3     dim4     dim5     dim6     dim7     dim8
   <chr>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>
 1 D-печ… 7.00e-3 -5.52e-3 -8.15e-4  1.06e-2  2.72e-3 -5.12e-3  5.80e-3 -3.65e-3
 2 D-печ… 1.38e-3 -1.03e-3 -1.13e-4  2.07e-3  6.50e-5 -5.68e-4  5.52e-4  8.26e-5
 3 D-при… 1.75e-3 -1.24e-3 -2.05e-4  1.95e-3  4.66e-5 -7.04e-4  1.08e-3  1.57e-3
 4 D-стр… 4.73e-4 -4.02e-4 -6.10e-5 -5.30e-4 -1.30e-4 -2.93e-4  9.76e-5 -3.11e-4
 5 G-бел… 8.36e-4 -9.13e-4 -1.87e-4 -2.59e-3 -9.01e-4 -9.39e-4  8.15e-4  9.69e-4
 6 MXен   7.31e-4 -7.15e-4 -1.37e-4  1.45e-3 -1.60e-4 -8.61e-4  5.41e-4 -9.00e-4
 7 NV-це… 5.68e-4 -5.03e-4 -1.36e-4  1.27e-3  3.05e-5 -4.92e-4  2.62e-4  2.06e-3
 8 QR-код 4.00e-4 -3.18e-4 -6.69e-5  7.25e-4  1.69e-4 -7.18e-5  1.24e-5  8.82e-4
 9 VR-пр… 5.04e-4 -3.11e-4 -2.27e-4  4.47e-4  7.93e-5  2.20e-4 -2.13e-4  1.62e-3
10 noind… 6.13e-4 -6.33e-4 -1.38e-4  7.12e-4 -1.23e-4 -6.87e-4  2.07e-4 -2.02e-3
# ℹ 15,752 more rows
# ℹ 42 more variables: dim9 <dbl>, dim10 <dbl>, dim11 <dbl>, dim12 <dbl>,
#   dim13 <dbl>, dim14 <dbl>, dim15 <dbl>, dim16 <dbl>, dim17 <dbl>,
#   dim18 <dbl>, dim19 <dbl>, dim20 <dbl>, dim21 <dbl>, dim22 <dbl>,
#   dim23 <dbl>, dim24 <dbl>, dim25 <dbl>, dim26 <dbl>, dim27 <dbl>,
#   dim28 <dbl>, dim29 <dbl>, dim30 <dbl>, dim31 <dbl>, dim32 <dbl>,
#   dim33 <dbl>, dim34 <dbl>, dim35 <dbl>, dim36 <dbl>, dim37 <dbl>, …
word_emb <- lsa_space$u |> 
  as.data.frame() |> 
  rownames_to_column("word") |> 
  as_tibble()

word_emb
# A tibble: 15,762 × 51
   word      dim1     dim2     dim3     dim4     dim5     dim6     dim7     dim8
   <chr>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>
 1 D-печ… 7.00e-3 -5.52e-3 -8.15e-4  1.06e-2  2.72e-3 -5.12e-3  5.80e-3 -3.65e-3
 2 D-печ… 1.38e-3 -1.03e-3 -1.13e-4  2.07e-3  6.50e-5 -5.68e-4  5.52e-4  8.26e-5
 3 D-при… 1.75e-3 -1.24e-3 -2.05e-4  1.95e-3  4.66e-5 -7.04e-4  1.08e-3  1.57e-3
 4 D-стр… 4.73e-4 -4.02e-4 -6.10e-5 -5.30e-4 -1.30e-4 -2.93e-4  9.76e-5 -3.11e-4
 5 G-бел… 8.36e-4 -9.13e-4 -1.87e-4 -2.59e-3 -9.01e-4 -9.39e-4  8.15e-4  9.69e-4
 6 MXен   7.31e-4 -7.15e-4 -1.37e-4  1.45e-3 -1.60e-4 -8.61e-4  5.41e-4 -9.00e-4
 7 NV-це… 5.68e-4 -5.03e-4 -1.36e-4  1.27e-3  3.05e-5 -4.92e-4  2.62e-4  2.06e-3
 8 QR-код 4.00e-4 -3.18e-4 -6.69e-5  7.25e-4  1.69e-4 -7.18e-5  1.24e-5  8.82e-4
 9 VR-пр… 5.04e-4 -3.11e-4 -2.27e-4  4.47e-4  7.93e-5  2.20e-4 -2.13e-4  1.62e-3
10 noind… 6.13e-4 -6.33e-4 -1.38e-4  7.12e-4 -1.23e-4 -6.87e-4  2.07e-4 -2.02e-3
# ℹ 15,752 more rows
# ℹ 42 more variables: dim9 <dbl>, dim10 <dbl>, dim11 <dbl>, dim12 <dbl>,
#   dim13 <dbl>, dim14 <dbl>, dim15 <dbl>, dim16 <dbl>, dim17 <dbl>,
#   dim18 <dbl>, dim19 <dbl>, dim20 <dbl>, dim21 <dbl>, dim22 <dbl>,
#   dim23 <dbl>, dim24 <dbl>, dim25 <dbl>, dim26 <dbl>, dim27 <dbl>,
#   dim28 <dbl>, dim29 <dbl>, dim30 <dbl>, dim31 <dbl>, dim32 <dbl>,
#   dim33 <dbl>, dim34 <dbl>, dim35 <dbl>, dim36 <dbl>, dim37 <dbl>, …

Преобразовываем данные в длинный формат.

word_emb_long <- word_emb |> 
  pivot_longer(-word, names_to = "dimension", values_to = "value") |>
  mutate(dimension = as.numeric(str_remove(dimension, "dim")))

word_emb_long
# A tibble: 788,100 × 3
   word     dimension     value
   <chr>        <dbl>     <dbl>
 1 D-печати         1  0.00700 
 2 D-печати         2 -0.00552 
 3 D-печати         3 -0.000815
 4 D-печати         4  0.0106  
 5 D-печати         5  0.00272 
 6 D-печати         6 -0.00512 
 7 D-печати         7  0.00580 
 8 D-печати         8 -0.00365 
 9 D-печати         9  0.00254 
10 D-печати        10  0.00128 
# ℹ 788,090 more rows

9 Визуализация топиков

Визуализируем несколько топиков, чтобы понять, насколько они осмыслены.

word_emb_long |> 
  filter(dimension < 10) |> 
  group_by(dimension) |> 
  top_n(10, abs(value)) |> 
  ungroup() |> 
  mutate(word = reorder_within(word, value, dimension)) |> 
  ggplot(aes(word, value, fill = dimension)) +
  geom_col(alpha = 0.8, show.legend = FALSE) +
  facet_wrap(~dimension, scales = "free_y", ncol = 3) +
  scale_x_reordered() +
  coord_flip() +
  labs(
    x = NULL, 
    y = "Value",
    title = "Первые 9 главных компонент",
    subtitle = "Топ-10 слов"
  ) +
  scale_fill_viridis_c()

10 Ближайшие “соседи”

Используем эмбеддинги для поиска ближайших “соседей”.

nearest_neighbors <- function(df, feat, doc=F) {
  inner_f <- function() {
    widely(
      ~ {
        y <- .[rep(feat, nrow(.)), ]
        res <- rowSums(. * y) / 
          (sqrt(rowSums(. ^ 2)) * sqrt(sum(.[feat, ] ^ 2)))
        
        matrix(res, ncol = 1, dimnames = list(x = names(res)))
      },
      sort = TRUE
    )}
  if (doc) {
    df |> inner_f()(doc, dimension, value) }
  else {
    df |> inner_f()(word, dimension, value)
  } |> 
    select(-item2)
}

Ищем “соседей” слова.

nearest_neighbors(word_emb_long, "наука")
# A tibble: 15,762 × 2
   item1           value
   <chr>           <dbl>
 1 наука           1    
 2 общество        0.819
 3 партнер         0.816
 4 верность        0.791
 5 фотовыставка    0.790
 6 флагманский     0.782
 7 достижение      0.776
 8 спорт           0.774
 9 просвещение     0.771
10 пресс-секретарь 0.768
# ℹ 15,752 more rows

Наука ассоциируется с обществом, партнерством и просвещением.

Ищем “соседей” слова.

nearest_neighbors(word_emb_long, "событие")
# A tibble: 15,762 × 2
   item1       value
   <chr>       <dbl>
 1 событие     1    
 2 сборник     0.928
 3 знаковый    0.924
 4 осветить    0.919
 5 новость     0.912
 6 включить    0.897
 7 выпуск      0.890
 8 дайджест    0.880
 9 подготовить 0.875
10 лучший      0.825
# ℹ 15,752 more rows

События ассоциируются с выпусками дайджестов новостей. Слова “лучший” и “знаковый” напрямую связаны с дадйжестами, так как в них, как правило, публикуют самые значимые новости.

Ищем “соседей” слова.

nearest_neighbors(word_emb_long, "литература")
# A tibble: 15,762 × 2
   item1        value
   <chr>        <dbl>
 1 литература   1    
 2 преподавание 0.772
 3 легенда      0.761
 4 философ      0.751
 5 писатель     0.746
 6 занятие      0.707
 7 категория    0.685
 8 реклама      0.678
 9 нравиться    0.677
10 судебный     0.674
# ℹ 15,752 more rows

Философы и писатели в новостях РНФ идут рука об руку. “Хочешь филсофствовать - пиши романы”. Также литература часто связана с преподовательской деятельностью, что отражено в примерах. Слово “судебный” вызывает вопросы и нуждается в более детальном анализе в этом контексте.

Ищем “соседей” слова.

nearest_neighbors(word_emb_long, "грант")
# A tibble: 15,762 × 2
   item1        value
   <chr>        <dbl>
 1 грант        1    
 2 группа       0.768
 3 поддержать   0.762
 4 миллион      0.725
 5 исследование 0.719
 6 рубль        0.701
 7 отдельный    0.699
 8 победить     0.672
 9 составить    0.663
10 ежегодно     0.658
# ℹ 15,752 more rows

Гранты в текстах ассоциируются с поддержкой, исследованиями, финансированием, ежегодными заявками и исследовательскими группами. Тематика финансирования довольна предсказуема, так как основной миссией Фонда является поддержка исследований.

##Похожие документы

Готовим датасет к поиску ближайших документов.

rownames(lsa_space$v) <- colnames(dtm)
colnames(lsa_space$v) <- paste0("dim", 1:50)

doc_emb <- lsa_space$v |> 
  as.data.frame() |> 
  rownames_to_column("doc") |> 
  as_tibble()

doc_emb
# A tibble: 5,274 × 51
   doc       dim1     dim2     dim3     dim4     dim5     dim6     dim7     dim8
   <chr>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>    <dbl>
 1 1036_d… 0.0129 -0.0110  -2.73e-3  1.44e-2 -4.05e-5 -0.00247 -0.00313  0.0205 
 2 1059_d… 0.0117 -0.00751 -2.92e-4  6.36e-4 -2.30e-4  0.00209 -0.00266 -0.00678
 3 1224_d… 0.0130 -0.00790 -1.05e-3  1.92e-3 -1.83e-3 -0.00495  0.00763  0.00841
 4 1267_d… 0.0109 -0.00364  3.22e-4  6.69e-3  2.98e-3  0.00812 -0.00583 -0.00342
 5 1332_d… 0.0144 -0.0111  -2.01e-3 -1.11e-2 -5.80e-3 -0.0112   0.0107  -0.00472
 6 13_doc  0.0126 -0.00928 -1.78e-3  8.52e-3 -6.07e-4 -0.00481  0.00218  0.00206
 7 1529_d… 0.0120 -0.00890 -1.19e-3  1.54e-2 -1.73e-4 -0.00625  0.00291 -0.00817
 8 1536_d… 0.0134 -0.0113  -2.36e-3  2.22e-2 -3.49e-5 -0.0112   0.0115  -0.0105 
 9 1687_d… 0.0127 -0.00857 -1.50e-3  1.76e-2  5.79e-4 -0.00680  0.00762  0.00520
10 1770_d… 0.0146 -0.00942 -2.40e-3  1.75e-2 -1.45e-3 -0.0114   0.0103  -0.0148 
# ℹ 5,264 more rows
# ℹ 42 more variables: dim9 <dbl>, dim10 <dbl>, dim11 <dbl>, dim12 <dbl>,
#   dim13 <dbl>, dim14 <dbl>, dim15 <dbl>, dim16 <dbl>, dim17 <dbl>,
#   dim18 <dbl>, dim19 <dbl>, dim20 <dbl>, dim21 <dbl>, dim22 <dbl>,
#   dim23 <dbl>, dim24 <dbl>, dim25 <dbl>, dim26 <dbl>, dim27 <dbl>,
#   dim28 <dbl>, dim29 <dbl>, dim30 <dbl>, dim31 <dbl>, dim32 <dbl>,
#   dim33 <dbl>, dim34 <dbl>, dim35 <dbl>, dim36 <dbl>, dim37 <dbl>, …

Прееобразовываем данные в длинный формат.

doc_emb_long <- doc_emb |> 
  pivot_longer(-doc, names_to = "dimension", values_to = "value") |>
  mutate(dimension = as.numeric(str_remove(dimension, "dim")))


doc_emb_long
# A tibble: 263,700 × 3
   doc      dimension      value
   <chr>        <dbl>      <dbl>
 1 1036_doc         1  0.0129   
 2 1036_doc         2 -0.0110   
 3 1036_doc         3 -0.00273  
 4 1036_doc         4  0.0144   
 5 1036_doc         5 -0.0000405
 6 1036_doc         6 -0.00247  
 7 1036_doc         7 -0.00313  
 8 1036_doc         8  0.0205   
 9 1036_doc         9 -0.00190  
10 1036_doc        10  0.00156  
# ℹ 263,690 more rows

Ищем соседей для произвольного документа.

nearest_neighbors(doc_emb_long, "14_doc", doc = TRUE)
# A tibble: 5,274 × 3
   item1    item2 value
   <chr>    <int> <dbl>
 1 14_doc       1 1    
 2 1308_doc     1 0.754
 3 2998_doc     1 0.749
 4 3816_doc     1 0.717
 5 2192_doc     1 0.693
 6 530_doc      1 0.688
 7 1417_doc     1 0.685
 8 4102_doc     1 0.677
 9 2619_doc     1 0.662
10 4929_doc     1 0.662
# ℹ 5,264 more rows
news_nearest <- rnf_news |> 
  filter(id %in% c("14_doc", "853_doc", "2281_doc"))

news_nearest 
# A tibble: 3 × 6
  id       date                        category        title full_link full_text
  <chr>    <chr>                       <chr>           <chr> <chr>     <chr>    
1 14_doc   "2024                     " Сельское хозяй… «Отп… https://… "\r Учен…
2 853_doc  "2023                     " Математика      В Ро… https://… "\r Кома…
3 2281_doc "2021                     " Гуманитарные н… Мысл… https://… "Ученые …

Произвольно выбираем еще одну новость и ищем ее “соседей”.

nearest_neighbors(doc_emb_long, "271_doc", doc = TRUE)
# A tibble: 5,274 × 3
   item1    item2 value
   <chr>    <int> <dbl>
 1 271_doc      1 1    
 2 959_doc      1 0.821
 3 1072_doc     1 0.701
 4 304_doc      1 0.696
 5 3500_doc     1 0.683
 6 2880_doc     1 0.662
 7 82_doc       1 0.645
 8 2814_doc     1 0.641
 9 1241_doc     1 0.635
10 1365_doc     1 0.634
# ℹ 5,264 more rows
news_nearest_2 <- rnf_news |> 
  filter(id %in% c("271_doc", "1976_doc", "2725_doc", "1196_doc"))

news_nearest_2 
# A tibble: 4 × 6
  id       date                        category        title full_link full_text
  <chr>    <chr>                       <chr>           <chr> <chr>     <chr>    
1 271_doc  "2024                     " Сельское хозяй… Упак… https://… "\r Учен…
2 1196_doc "2023                     " Инженерные нау… В ЮР… https://… "\r Хими…
3 1976_doc "2022                     " Науки о Земле   В КФ… https://… "\r Рабо…
4 2725_doc "2020                     " Биология        В Ск… https://… "Ученые …

11 2D-визуализация пространства документов

Зерно можно установить любое и его необходимо установить, так как алгоритм использует псевдослучайные числа. Мне понравилась идея об установке в качестве зерна даты написания кода.

set.seed(22122024)
viz_lsa <- umap(lsa_space$v,  n_neighbors = 15, n_threads = 2)

Визуализируем.

tibble(doc = rownames(viz_lsa),
       topic = news_prepare$category,
       V1 = viz_lsa[, 1], 
       V2 = viz_lsa[, 2]) |> 
  ggplot(aes(x = V1, y = V2, label = doc, color = topic)) + 
  geom_text(size = 2, alpha = 0.8, position = position_jitter(width = 1.5, height = 1.5)) +
  theme_light()

Можжно обнаружить, что новости преимущественно слипаются в одно цельное облако, а не разбиваются на отдельные тематики. Кроме того категории новостей перемешаны между собой, так что можно сказать, что тематика документов перекликается. Встречаются кластеры, отделившиеся от общей массы, но они содержат небольшое количество документов.

Выделим такой тематический кластер документов.

 tibble(doc = rownames(viz_lsa),
       topic = news_prepare$category,
       V1 = viz_lsa[, 1], 
       V2 = viz_lsa[, 2]) |> 
  ggplot(aes(x = V1, y = V2, label = doc, color = topic)) + 
  geom_text(size = 2, alpha = 0.8, position = position_jitter(width = 1.5, height = 1.5)) +
  annotate(geom = "rect", ymin = 2, ymax = 6, xmin = -10, xmax = -6, alpha = 0.2, color = "tomato") +
  theme_light()

Приближаем интересующий нас кластер документов.

 tibble(doc = rownames(viz_lsa),
       topic = news_prepare$category,
       V1 = viz_lsa[, 1], 
       V2 = viz_lsa[, 2]) |> 
  filter(V1 > -10 & V1 < -6) |> 
  filter(V2 > 2 & V2 < 6) |> 
  ggplot(aes(x = V1, y = V2, label = doc, color = topic)) + 
  geom_text(size = 2, alpha = 0.8, position = position_jitter(width = 1.5, height = 1.5)) +
  theme_light()

Просматриваем новости из тематического кластера, выделенного на карте красным цветом.

similar_news <- news_prepare |> 
  filter(id %in% c("3916_doc", "3421_doc", "796_doc", "630_doc"))

print(str_sub(similar_news$full_text, 1, 100))
[1] "\r Ученые синтезировали ряд новых биологически активных фторированных хромонов, которые проявили знач"
[2] "\r Коллектив ученых из Института химической биологии и фундаментальной медицины СО РАН (Новосибирск) "
[3] "Специалисты Института экспериментальной медицины (Санкт-Петербург) совместно с коллегами из Государс" 
[4] "Первые отечественные препараты на основе онколитических вирусов для лечения онкологических заболеван" 

Новости медицины отделились в отдельный кластер. Что подтверждает узкую направленность представленной темы (заболевания) и присутвующий интерес, хоть и не такой проявленный как к областям биологии, химии и физики.

Посмотрим еще один тематический кластер, наиболее отдаленный

tibble(doc = rownames(viz_lsa),
       topic = news_prepare$category,
       V1 = viz_lsa[, 1], 
       V2 = viz_lsa[, 2]) |> 
  ggplot(aes(x = V1, y = V2, label = doc, color = topic)) + 
  geom_text(size = 2, alpha = 0.8, position = position_jitter(width = 1.5, height = 1.5)) +
  annotate(geom = "rect", ymin = -3, ymax = 2, xmin = -20, xmax = -15, alpha = 0.2, color = "tomato") +
  theme_light()

Приближаем документы.

tibble(doc = rownames(viz_lsa),
       topic = news_prepare$category,
       V1 = viz_lsa[, 1], 
       V2 = viz_lsa[, 2]) |> 
  filter(V1 > -20 & V1 < -15) |> 
  filter(V2 > -3 & V2 < 2) |> 
  ggplot(aes(x = V1, y = V2, label = doc, color = topic)) + 
  geom_text(size = 2, alpha = 0.8, position = position_jitter(width = 1.5, height = 1.5)) +
  theme_light()

similar_news_2 <- news_prepare |> 
  filter(id %in% c("5145_doc", "504_doc", "2736_doc", "5253_doc"))

print(str_sub(similar_news_2$full_text, 1, 100))
[1] "Совет при Президенте Российской Федерации по науке и образованию начинает прием документов на соиска" 
[2] "Совет при Президенте Российской Федерации по науке и образованию начинает прием документов на соиска" 
[3] "\r Бумажные оригиналы представлений на соискателей премии Президента Российской Федерации в области н"
[4] "\r Совет при Президенте Российской Федерации по науке и образованию начинает прием документов на соис"

Этот кластер новостей можно категоризировать как “формальный”. Он посвящен премиям Президента России. Примечательно, что в текстах встречаются буквально одни и те же формулировки, что ассоциируется с шаблонами, носящими информационный и формальный характер. В самом кластере не так много документов, что может быть связано с предварительной обработкой датасета. Как правило, такого рода объявления соодержат 1 - 2 предложения, так как необходимо максимально емко и кратко передать о сообщаемом событии, не отвлекая читателя от главного. Такие тексты были изъяты во время обработки.

Собранные данные могут быть полезны в образовательных и научных целях, благодаря этой информации можно проанализировать актуальные научные темы в разрезе по годам, а также понять какие направления развития рассматривает в качестве приориеттных РНФ. Отдельного внимания заслуживает анализ новостей из раздела “гуманитарные науки”. В дальнейшем было бы интерсено посмотреть как внешние ограничения, связанные с различными социально-политическими событиями, отражаются на приоритетных (или самых поддерживаемых) темах Фонда. В этом контектсе было бы интересно овтетить на вопрос: чем обсуловлен возникший повышенный интерес к определенной теме/людям/предметной области?

p.s.

Этот датасет - напоминание о том, что данные могут быть “живыми” и об этом лучше не забывать. Данные могут появляться на сайте даже в процессе работы с датасетом. Новостные порталы расширяются и обновляются, поэтому важно иметь слепок информации за определнный период.