Предмет исследования: распределение предлогов “про” и “о/об” в речи.
Материал исследования: примеры из Национального Корпуса Русского Языка.

Факторы, которые рассматриваются как возможно влияющие на выбор предлога (независимые переменнные):

*Жанр для письменных текстов в НКРЯ уже задан как дихотомия “художественных текстов” и “нехудожественных текстов”; в устном корпусе под “художественными” мы понимали жанры “театральная речь” и “речь кино”, под “нехудожественными” — жанры “устная публичная речь” и “устная непубличная речь”. Жанры “авторское чтение” и “художественное чтение” было решено не учитывать, так как тексты этих жанров — это фактически озвученная письменная, а не устная речь.

У каждой из первых четырех переменных два значения (уровня), и следовательно, при работе с каждым из рассмотренных корней было задано 16 комбинаций параметров поиска. Из выдачи были взяты все примеры, если их было 50 или меньше; если примеров в выдаче было больше 50, забирались первые 50 подходящих примеров.

Рассмотренные лексемы:

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

В результате получен 5151 пример. Для каждого примера указано, какой предлог был использован. Данные представлены в файле prepositions.csv и проиллюстрированы в графиках.

library(randomForest)
library(tidyverse)
library(caret)

data <- read.csv("prepositions.csv", head = TRUE, sep = ";", encoding = "UTF-8")
data <- data[, -c(7,8)]
data %>%
  ggplot(aes(register, fill = preposition)) +
  geom_bar(position = "dodge") +
  facet_wrap(~root) +
  labs(x = "Регистр", y = "Общее число примеров") +
  theme_bw() +
  guides(fill = guide_legend(title = "Предлог"))

# data %>%
#   ggplot(aes(genre, fill = preposition)) +
#   geom_bar(position = "dodge") +
#   facet_wrap(~root) +
#   labs(x = "Жанр текста", y = "Общее число примеров") +
#   theme_bw() +
#   guides(fill = guide_legend(title = "Предлог"))
# data %>%
#   ggplot(aes(date_of_creation, fill = preposition)) +
#   geom_bar(position = "dodge") +
#   facet_wrap(~root) +
#   labs(x = "Время создания текста", y = "Общее число примеров") +
#   theme_bw() +
#   guides(fill = guide_legend(title = "Предлог"))
# data %>%
#   ggplot(aes(head_pos, fill = preposition)) +
#   geom_bar(position = "dodge") +
#   facet_wrap(~root) +
#   labs(x = "Часть речи вершины", y = "Общее число примеров") +
#   theme_bw() +
#   guides(fill = guide_legend(title = "Предлог"))

Нагляднее представить изменение соотношения предлогов в зависимости от значений параметров можно по графикам, показывающим не абсолютное количество использованных “про” и “о/об”, а проценты от общего числа примеров:

data %>% 
  count(root, genre, head_pos, date_of_creation, register, preposition) %>% 
  spread(key = preposition, value = n) %>%
  mutate(sum = `о/об`+`про`,
        `о/об_%` = `о/об`/sum*100,
        `про_%` = `про`/sum*100) %>% 
  select(-c(`о/об`, `про`, sum)) %>% 
  gather(key = preposition, value = percent, `о/об_%`:`про_%`) %>% 
  na.omit() -> data_pct
data_pct %>% 
  filter(root == "говор") %>%  
  ggplot(aes(preposition, percent, fill = preposition)) +  
  geom_bar(stat = "identity") +
  facet_grid(genre + head_pos ~ date_of_creation + register) +
  labs(x = "Предлог", y = " ") +
  theme_bw() +
  guides(fill = FALSE)

# data_pct %>% 
#   filter(root == "знат") %>% 
#   ggplot(aes(preposition, percent, fill = preposition)) +  
#   geom_bar(stat = "identity") +
#   facet_grid(genre + head_pos ~ date_of_creation + register) +
#   labs(x = "Предлог", y = " ") +
#   theme_bw() +
#   guides(fill = FALSE)
# data_pct %>% 
#   filter(root == "прос") %>% 
#   ggplot(aes(preposition, percent, fill = preposition)) +  
#   geom_bar(stat = "identity") +
#   facet_grid(genre + head_pos ~ date_of_creation + register) +
#   labs(x = "Предлог", y = " ") +
#   theme_bw() +
#   guides(fill = FALSE)
# data_pct %>% 
#   filter(root == "помн") %>% 
#   ggplot(aes(preposition, percent, fill = preposition)) +  
#   geom_bar(stat = "identity") +
#   facet_grid(genre + head_pos ~ date_of_creation + register) +
#   labs(x = "Предлог", y = " ") +
#   theme_bw() +
#   guides(fill = FALSE)
# data_pct %>% 
#   filter(root == "шут") %>% 
#   ggplot(aes(preposition, percent, fill = preposition)) +  
#   geom_bar(stat = "identity") +
#   facet_grid(genre + head_pos ~ date_of_creation + register) +
#   labs(x = "Предлог", y = " ") +
#   theme_bw() +
#   guides(fill = FALSE)
# data_pct %>% 
#   filter(root == "сказ") %>% 
#   ggplot(aes(preposition, percent, fill = preposition)) +  
#   geom_bar(stat = "identity") +
#   facet_grid(genre + head_pos ~ date_of_creation + register) +
#   labs(x = "Предлог", y = " ") +
#   theme_bw() +
#   guides(fill = FALSE)
# data_pct %>% 
#   filter(root == "пис") %>% 
#   ggplot(aes(preposition, percent, fill = preposition)) +  
#   geom_bar(stat = "identity") +
#   facet_grid(genre + head_pos ~ date_of_creation + register) +
#   labs(x = "Предлог", y = " ") +
#   theme_bw() +
#   guides(fill = FALSE)
# data_pct %>% 
#   filter(root == "сужд") %>% 
#   ggplot(aes(preposition, percent, fill = preposition)) +  
#   geom_bar(stat = "identity") +
#   facet_grid(genre + head_pos ~ date_of_creation + register) +
#   labs(x = "Предлог", y = " ") +
#   theme_bw() +
#   guides(fill = FALSE)
# data_pct %>% 
#   filter(root == "слыш") %>% 
#   ggplot(aes(preposition, percent, fill = preposition)) +  
#   geom_bar(stat = "identity") +
#   facet_grid(genre + head_pos ~ date_of_creation + register) +
#   labs(x = "Предлог", y = " ") +
#   theme_bw() +
#   guides(fill = FALSE)
# data_pct %>% 
#   filter(root == "пе") %>% 
#   ggplot(aes(preposition, percent, fill = preposition)) +  
#   geom_bar(stat = "identity") +
#   facet_grid(genre + head_pos ~ date_of_creation + register) +
#   labs(x = "Предлог", y = " ") +
#   theme_bw() +
#   guides(fill = FALSE)

Препроцессинг данных

Данные были разделены на два сабсета - тренировочный (75%) и тестовый (25%) - с помощью метода стратифицированной выборки. Тестовый сабсет использовался при проверке обобщающей способности моделей.

#table(data$preposition)/sum(table(data$preposition)) #процентное соотношение предлогов 'о/об' и 'про'  
set.seed(123)
dataR <- data[order(runif(nrow(data))),]
data_split <- createDataPartition(y = dataR$preposition, p = 0.75, list = FALSE)
#head(data_split)
trainSet <- dataR[data_split, ]
testSet <- dataR[-data_split, ]
head(trainSet)

Логистическая регрессия

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

fit <- glm(preposition ~ ., data = trainSet, family = "binomial")
summary(fit)

Call:
glm(formula = preposition ~ ., family = "binomial", data = trainSet)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-1.7684  -0.5782  -0.3793  -0.1874   3.0390  

Coefficients:
                             Estimate Std. Error z value Pr(>|z|)    
(Intercept)                 -1.942501   0.178827 -10.862  < 2e-16 ***
genrenonfiction             -0.551943   0.098399  -5.609 2.03e-08 ***
registerwritten             -0.521263   0.108399  -4.809 1.52e-06 ***
date_of_creationbefore 1950 -0.891741   0.117472  -7.591 3.17e-14 ***
head_posV                    1.126598   0.108261  10.406  < 2e-16 ***
rootзнат                     0.227708   0.207427   1.098  0.27230    
rootпе                       2.144540   0.190094  11.281  < 2e-16 ***
rootпис                      0.002653   0.220135   0.012  0.99039    
rootпомн                    -0.402096   0.232081  -1.733  0.08317 .  
rootпрос                     0.759767   0.192715   3.942 8.07e-05 ***
rootсказ                     0.568335   0.193774   2.933  0.00336 ** 
rootслыш                    -0.175711   0.226043  -0.777  0.43696    
rootсужд                    -2.144164   0.475893  -4.506 6.62e-06 ***
rootшут                      2.158246   0.250032   8.632  < 2e-16 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 3397.0  on 3863  degrees of freedom
Residual deviance: 2780.6  on 3850  degrees of freedom
AIC: 2808.6

Number of Fisher Scoring iterations: 7

Как видно, бОльшую часть признаков алгоритм считает значимыми для предсказания предлога. Проиллюстрируем его предсказательные возможности с помощью violin plots:

rd <- data.frame(p = predict(fit, newdata = testSet, type = "response"), prep = testSet$preposition, rt = testSet$root, hp = testSet$head_pos, gnr = testSet$genre, rgstr = testSet$register, dt = testSet$date_of_creation)
rd %>% 
  arrange(p) %>% 
  ggplot(aes(prep, p, fill = rt)) +
  geom_violin() +
  facet_wrap(~rt) +
  labs(x = "", y = "") +
  theme_bw() +
  guides(fill = FALSE)

rd %>% 
  arrange(p) %>% 
  ggplot(aes(prep, p, fill = hp)) +
  geom_violin() +
  facet_wrap(~hp) +
  labs(x = "", y = "") +
  theme_bw() +
  guides(fill = FALSE)

rd %>% 
  arrange(p) %>% 
  ggplot(aes(prep, p, fill = gnr)) +
  geom_violin() +
  facet_wrap(~gnr) +
  labs(x = "", y = "") +
  theme_bw() +
  guides(fill = FALSE)

rd %>% 
  arrange(p) %>% 
  ggplot(aes(prep, p, fill = rgstr)) +
  geom_violin() +
  facet_wrap(~rgstr) +
  labs(x = "", y = "") +
  theme_bw() +
  guides(fill = FALSE)

rd %>% 
  arrange(p) %>% 
  ggplot(aes(prep, p, fill = dt)) +
  geom_violin() +
  facet_wrap(~dt) +
  labs(x = "", y = "") +
  theme_bw() +
  guides(fill = FALSE)