Данные

Данные представляют из себя комментарии пользователей пабликов «Леонардо ДайВинчик» https://vk.com/dayvinchik и «БОРЩ» https://vk.com/borsch, в которых были обнаружены этикетные формулы благодарности: пасиб(о), благодарю, спс, мерси.

С помощью модели RuBERT-Base-ru-sentiment-RuSentiment комментарии были размечены на позитивную, негативную и нейтральную тональности. Была выбрана эта модель, так как она дает одни из лучших показателей среди моделей для определения тональности на русском языке (https://huggingface.co/sismetanin/rubert-ru-sentiment-rusentiment), а также была обучена именно на материалах постов из ВК, что делает ее еще более применимой для наших данных.

Контекст исследования:

Слово “спасибо” может употребляться с целью выражения благодарности, неодобрения, сарказма, пренебрежения мнением оппонента и т.д. [1] В данной работе мы хотим понять от каких лингвистических и металингвистических категорий (пол автора комментария, название паблика, тональность комментария) зависит выбор разговорной формулы балгодарности.

Регулярная (не)вежливость в интернет-коммуникации: к вопросу о дискурсивном сдвиге в использовании этикетных формул (https://cyberleninka.ru/article/n/regulyarnaya-ne-vezhlivost-v-internet-kommunikatsii-k-voprosu-o-diskursivnom-sdvige-v-ispolzovanii-etiketnyh-formul-blagodarnosti/viewer)

Набор полей

sex – пол (1 - женский, 2 - мужской)
ages – возраст (дата рождения) age_label – возрастная категория (1 - <18, 2 - 18-30, 3 - 30+ ) sentiment – тональность (0 - нейтральная, 1 - позитивная, 2 - негативная) public – паблик, откуда был взят комментарий (1 - ДайВинчик, 2 - Борщ) label – формула благодарности

dv <- read.csv('https://raw.githubusercontent.com/vydra-v-getrax/andan_r/main/borshch.csv')
bor <- read.csv('https://raw.githubusercontent.com/vydra-v-getrax/andan_r/main/dayvinchik.csv')

dv$public <- 1
bor$public <- 2
df <- data.frame(rbind(dv[, c("Unnamed..0" ,"sex", "ages", "возраст.лейбл", "sentiment", "label", "public")], bor[, c("Unnamed..0" ,"sex", "ages", "возраст.лейбл", "sentiment", "label", "public")]))

colnames(df)[1] <- "index"
colnames(df)[4] <- "age_label"

# write.csv(df, "df.csv", row.names=FALSE)
df <- read.csv('https://raw.githubusercontent.com/vydra-v-getrax/andan_r/main/df.csv')
df <- df[df$label %in% c('спс', 'мерси', 'благо', 'пасибо'), ]
df <- df[df$sex %in% c('1', '2'), ]

df <- transform(df, sex=as.numeric(sex))

df <- df %>% mutate(across(where(is.character), as.factor) )
str(df)
## 'data.frame':    430 obs. of  7 variables:
##  $ index    : int  0 1 2 3 4 5 6 7 8 9 ...
##  $ sex      : num  2 2 1 2 1 1 2 2 2 2 ...
##  $ ages     : Factor w/ 286 levels "","1.1.1901",..: 214 142 188 63 274 53 214 214 152 47 ...
##  $ age_label: int  NA NA 1 2 NA 1 NA NA 1 2 ...
##  $ sentiment: int  1 0 0 1 1 0 0 0 0 0 ...
##  $ label    : Factor w/ 4 levels "благо","мерси",..: 4 1 4 3 4 3 4 4 1 4 ...
##  $ public   : int  1 1 1 1 1 1 1 1 1 1 ...

Распределение целевой переменной - label.

ggplot(data = df, 
       aes(x = label)) + 
  geom_histogram(stat = "count") +
  stat_count(binwidth = 1, 
             geom = 'text', 
             color = 'white', 
             aes(label = after_stat(count)),
           position = position_stack(vjust = 0.5)) +
  ggtitle("Употребление формул благодарности") + 
  aes(fill = label, "alpha"=0.5)+
  theme_classic()

Согласно графику чаще всего встречается группа “благо”, которая включает в себя следующие словоформы: благодарю, благодарствую, благодарен(а), далее сопоставимая по частоте употребления группа “спс” (сяп, спс) и наконец с большим отрывом почти в полтора раза следует группа “пасибо” (пасибо, пасибки, посиба и т.д.) Словоформы из группы “мерси” (мерси, сенкс, сенк ю, сенк) встретились лишь 6 раз на всю выборку, поэтому при анализе мы сосредоточимся на первых трех группах.

df$label_num <- dplyr::case_when(
  df$label == '"благо"' ~ 0, 
  df$label == '"пасибо"'~ 1,
  df$label == '"спс"' ~ 2)

df$age_text <- dplyr::case_when(
  df$age_label == 1 ~ '0-18 лет', 
  df$age_label == 2~ '18-30 лет',
  df$age_label == 3 ~ '>30 лет')

df$sex_text <- dplyr::case_when(
  df$sex == 1 ~ 'женщины', 
  df$sex == 2 ~ 'мужчины')

df$public_text <- dplyr::case_when(
  df$public == 1 ~ 'Борщ', 
  df$public == 2 ~ 'Дайвинчик')

df$sentiment_text <- dplyr::case_when(
  df$sentiment == 0 ~ 'нейтральный', 
  df$sentiment == 1 ~ 'позитивный', 
  df$sentiment == 2 ~ 'негативный')

(ftab.Survived.sex <- ftable(xtabs(~public_text+sex_text,data=df), col.vars=1))
##          public_text Борщ Дайвинчик
## sex_text                           
## женщины                78        23
## мужчины               188       141
(ftab.Survived.age <- ftable(xtabs(~public_text+age_text,data=df), col.vars=1))
##           public_text Борщ Дайвинчик
## age_text                            
## >30 лет                 18        31
## 0-18 лет                56         1
## 18-30 лет               80        46
(ftab.Survived.label <- ftable(xtabs(~public_text+label,data=df), col.vars=1))
##        public_text Борщ Дайвинчик
## label                            
## благо               118        77
## мерси                 2         4
## пасибо               41        18
## спс                 105        65
(ftab.Survived.sentiment <- ftable(xtabs(~public_text+sentiment_text,data=df), col.vars=1))
##                public_text Борщ Дайвинчик
## sentiment_text                           
## негативный                   29        48
## нейтральный                 123        60
## позитивный                  114        56
rbind(table(df$label, df$public_text),
      table(df$sex_text, df$public_text), 
      table(df$sentiment_text, df$public_text))
##             Борщ Дайвинчик
## благо        118        77
## мерси          2         4
## пасибо        41        18
## спс          105        65
## женщины       78        23
## мужчины      188       141
## негативный    29        48
## нейтральный  123        60
## позитивный   114        56

Гипотеза

Выбор варианта слова «спасибо» зависит от нескольких переменных: тип паблика, возраст + пол автора, тональность комментария.

Нулевая гипотеза: значение переменной label не зависит от указанных переменных Альтернативная: значение переменной label зависит от нескольких переменных

(или можно разбить на отдельные гипотезы по каждой переменной)

Переменные

Посмотрим на значения переменных.

# функция для отрисовки одинаковых графиков
draw_pie_count <- function(data, title_input, group_labels) {
  data <- data %>% 
    arrange(desc(group)) %>%
    mutate(prop = value / sum(data$value) *100) %>%
    mutate(ypos = cumsum(prop)- 0.5*prop )

# Basic piechart
plot1 <- ggplot(data, aes(x="", y=prop, fill=group)) +
  geom_bar(stat="identity", width=1, color="white") +
  coord_polar("y", start=0) +
  theme_void() + 
  theme(legend.position="right") +
  
  # geom_text(aes(y = ypos, label = group), color = "black", size=4) +
  scale_fill_brewer(palette="PiYG", labels=group_labels, name="Группы") +
  ggtitle(title_input)
return(plot1)
}

age_cnt <- data.frame(table(df$age_label))
colnames(age_cnt) <- c("group", "value")

gender_cnt <- data.frame(table(df$sex))
colnames(gender_cnt) <- c("group", "value")

sent_cnt <-  data.frame(table(df$sentiment))
colnames(sent_cnt) <- c("group", "value")

plot_grid(draw_pie_count(age_cnt, "Возраст", c("< 18", "18-30", "30+")),
          draw_pie_count(gender_cnt, "Пол", c("женский", "мужской")), 
          draw_pie_count(sent_cnt, "Тональность", c("нейтральный", "позитивный", "негативный")), labels = "AUTO")

Как и ожидалось самыми распространнеными оказались возрастные группы от 0 до 18-ти и от 18 до 30-ти лет, что объясняется характером данных (паблики ВК). Также интересно отметить, что женщины оставили комментарий содержащий благодарственную форму лишь в четверти случаев от общего числа. Анализ тональности продемонстрировал, что наиболее редкая категория из представленных это негативные комментарии, а количество нейтральных и позитивных комментариев сопоставимо.

Посмотрим на значения целевой переменной внутри каждого из пабликов:

dv_cnt <- data.frame(table(df[df$public == 1, ]$label))
colnames(dv_cnt) <- c("group", "value")

bor_cnt <- data.frame(table(df[df$public == 2, ]$label))
colnames(bor_cnt) <- c("group", "value")


plot_grid(draw_pie_count(dv_cnt, "ДайВинчик", c("благо", "мерси", "пасибо", "спс")),
          draw_pie_count(bor_cnt, "Борщ",  c("благо", "мерси", "пасибо", "спс")), labels = "AUTO")

Корреляции

Сначала посчитаем корреляцию Пирсона между всеми интересующим нас переменными. Кажется, что корреляции с label не наблюдается, наибольшего значения ~ 0.2 она достигает с age_label и sentiment.

df <- transform(df, sex=as.numeric(sex))

# это не работает нормально
df <- transform(df, label=as.factor(label))
df <- transform(df, label=as.numeric(label))

# возьмем только заполненные значения 
df$label_f <- replace(df$label, df$label == "благо", 1)
df$label_f <- replace(df$label_f, df$label == "мерси", 2)
df$label_f <- replace(df$label_f, df$label == "пасибо", 3)
df$label_f <- replace(df$label_f, df$label == "спс", 4)

df_short<- df[df$sex %in% c(1, 2)&df$age_label %in% c(1, 2, 3), ]
df <- transform(df, label_f=as.numeric(label_f))
cor(df_short[, c("age_label", "sex", "public", "label")])
##             age_label        sex      public        label
## age_label  1.00000000 0.21174553 0.441834469 -0.073202557
## sex        0.21174553 1.00000000 0.139267357  0.021692343
## public     0.44183447 0.13926736 1.000000000  0.008717027
## label     -0.07320256 0.02169234 0.008717027  1.000000000
# Посмотрим на корреляцию
corrplot(cor(df_short[, c("age_label", "sex", "public", "sentiment", "label")]), method = 'color')

## Регрессия

Далее изучим линейную зависимость интересующего нас главного критерия label со всеми остальными.

model <- lm(label_f ~ ., data=df_short[, c("age_label", "sex", "public", "sentiment", "label_f")])
summary(model)
## 
## Call:
## lm(formula = label_f ~ ., data = df_short[, c("age_label", "sex", 
##     "public", "sentiment", "label_f")])
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -1.7744 -1.4471  0.4197  1.4152  1.8204 
## 
## Coefficients:
##             Estimate Std. Error t value Pr(>|t|)    
## (Intercept)   2.6026     0.4624   5.629 5.33e-08 ***
## age_label    -0.2031     0.1536  -1.322    0.187    
## sex           0.1073     0.2209   0.486    0.627    
## public        0.1602     0.2168   0.739    0.461    
## sentiment    -0.1422     0.1262  -1.127    0.261    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.395 on 227 degrees of freedom
## Multiple R-squared:  0.01424,    Adjusted R-squared:  -0.003127 
## F-statistic:  0.82 on 4 and 227 DF,  p-value: 0.5136

Посмотрим на график линейной зависимости: значения корреляции все еще очень низкие, но интересно, что она отрицательная у age_label.

plot_summs(model)

## 1. Пол и лейбл

Нулевая гипотеза: целевая переменная (label) и пол автора независимы. Если p-value меньше уровня значимости (пусть будет 0.05), то нулевая гипотеза отвергается.

fisher.test(table(df$sex, df$label))
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$sex, df$label)
## p-value = 0.4864
## alternative hypothesis: two.sided
chisq.test(table(df$sex, df$label))
## 
##  Pearson's Chi-squared test
## 
## data:  table(df$sex, df$label)
## X-squared = 2.3952, df = 3, p-value = 0.4945
fem <- df %>%
  filter(sex == 1)
male <- df %>%
  filter(sex == 2)

Согласно тесту, p-value, оно больше уровня значимости, нулевая гипотеза не отвергается => label И sex независимы.

По отдельным пабликам В паблике дайвинчик label и sex независимы

fisher.test(table(df[df$public == 1, "sex"], df[df$public == 1, "label"]))
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df[df$public == 1, "sex"], df[df$public == 1, "label"])
## p-value = 0.3651
## alternative hypothesis: two.sided
chisq.test(table(df[df$public == 1, "sex"], df[df$public == 1, "label"]))
## 
##  Pearson's Chi-squared test
## 
## data:  table(df[df$public == 1, "sex"], df[df$public == 1, "label"])
## X-squared = 2.6227, df = 3, p-value = 0.4535
fem <- df[df$public == 1, ] %>%
  filter(sex == 1)
male <- df[df$public == 1, ] %>%
  filter(sex == 2)
fisher.test(table(df[df$public == 2, "sex"], df[df$public == 2, "label"]))
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df[df$public == 2, "sex"], df[df$public == 2, "label"])
## p-value = 0.008683
## alternative hypothesis: two.sided
chisq.test(table(df[df$public == 2, "sex"], df[df$public == 2, "label"]))
## 
##  Pearson's Chi-squared test
## 
## data:  table(df[df$public == 2, "sex"], df[df$public == 2, "label"])
## X-squared = 11.617, df = 3, p-value = 0.008816
fem <- df[df$public == 2, ] %>%
  filter(sex == 1)
male <- df[df$public == 2, ] %>%
  filter(sex == 2)

В паблике Борщ они зависимы.

##2. Проверим зависимость от возраста

fisher.test(table(df$age_label, df$label))
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$age_label, df$label)
## p-value = 0.1557
## alternative hypothesis: two.sided
chisq.test(table(df$age_label, df$label))
## Warning in chisq.test(table(df$age_label, df$label)): аппроксимация на основе
## хи-квадрат может быть неправильной
## 
##  Pearson's Chi-squared test
## 
## data:  table(df$age_label, df$label)
## X-squared = NaN, df = 6, p-value = NA
age1 <- df %>%
  filter(age_label == 1)
age2 <- df %>%
  filter(age_label == 2)
age3 <- df %>%
  filter(age_label == 3)

По этому тесту, p-value больше уровня значимости, нулевая гипотеза не отвергается => label И age независимы.

По отдельным пабликам Дайвинчик:

fisher.test(table(df[df$public == 1, "age_label"], df[df$public == 1, "label"]))
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df[df$public == 1, "age_label"], df[df$public == 1, "label"])
## p-value = 0.1559
## alternative hypothesis: two.sided
chisq.test(table(df[df$public == 1, "age_label"], df[df$public == 1, "label"]))
## Warning in chisq.test(table(df[df$public == 1, "age_label"], df[df$public == :
## аппроксимация на основе хи-квадрат может быть неправильной
## 
##  Pearson's Chi-squared test
## 
## data:  table(df[df$public == 1, "age_label"], df[df$public == 1, "label"])
## X-squared = NaN, df = 6, p-value = NA

P-value больше уровня значимости, нулевая гипотеза не отвергается => label И age независимы.

Борщ:

fisher.test(table(df[df$public == 2, "age_label"], df[df$public == 2, "label"]))
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df[df$public == 2, "age_label"], df[df$public == 2, "label"])
## p-value = 0.1535
## alternative hypothesis: two.sided
chisq.test(table(df[df$public == 2, "age_label"], df[df$public == 2, "label"]))
## Warning in chisq.test(table(df[df$public == 2, "age_label"], df[df$public == :
## аппроксимация на основе хи-квадрат может быть неправильной
## 
##  Pearson's Chi-squared test
## 
## data:  table(df[df$public == 2, "age_label"], df[df$public == 2, "label"])
## X-squared = NaN, df = 6, p-value = NA

P-value больше уровня значимости, нулевая гипотеза не отвергается => label И age независимы.

3. Проверим зависимость от тональности комментария

# эта штука ругается на память
# fisher.test(table(df$sentiment, df$label))

chisq.test(table(df$sentiment, df$label))
## Warning in chisq.test(table(df$sentiment, df$label)): аппроксимация на основе
## хи-квадрат может быть неправильной
## 
##  Pearson's Chi-squared test
## 
## data:  table(df$sentiment, df$label)
## X-squared = 30.005, df = 6, p-value = 3.922e-05

Согласно тесту хи-квадрат, p-value меньше уровня значимости, значит нулевая гипотеза отвергается => label и sentiment зависимы.

По отдельным пабликам

Дайвинчик:

fisher.test(table(df[df$public == 1, "sentiment"], df[df$public == 1, "label"]))
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df[df$public == 1, "sentiment"], df[df$public == 1, "label"])
## p-value = 3.208e-05
## alternative hypothesis: two.sided
chisq.test(table(df[df$public == 1, "sentiment"], df[df$public == 1, "label"]))
## Warning in chisq.test(table(df[df$public == 1, "sentiment"], df[df$public == :
## аппроксимация на основе хи-квадрат может быть неправильной
## 
##  Pearson's Chi-squared test
## 
## data:  table(df[df$public == 1, "sentiment"], df[df$public == 1, "label"])
## X-squared = 27.858, df = 6, p-value = 9.991e-05

P-value меньше уровня значимости, значит нулевая гипотеза отвергается => label и sentiment зависимы.

fisher.test(table(df[df$public == 2, "sentiment"], df[df$public == 2, "label"]))
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df[df$public == 2, "sentiment"], df[df$public == 2, "label"])
## p-value = 0.02992
## alternative hypothesis: two.sided
chisq.test(table(df[df$public == 2, "sentiment"], df[df$public == 2, "label"]))
## Warning in chisq.test(table(df[df$public == 2, "sentiment"], df[df$public == :
## аппроксимация на основе хи-квадрат может быть неправильной
## 
##  Pearson's Chi-squared test
## 
## data:  table(df[df$public == 2, "sentiment"], df[df$public == 2, "label"])
## X-squared = 12.655, df = 6, p-value = 0.04886

У Борща согласно тесту Фишера p-value меньше уровня значимости, значит нулевая гипотеза отвергается => label и sentiment зависимы.

Однако по хи-квадрату переменные независимы.

Посмотрим на то, как распределены значения тональности ДайВинчик:

df$sent_f <- as.factor(df$sentiment_text)


ggplot(df[df$public == 1, ], 
       aes(df[df$public == 1, "label"])) +
  geom_bar(aes(fill=df[df$public == 1, "sent_f"])) +
  ggtitle("Дайвинчик")

Борщ:

ggplot(df[df$public == 2, ], 
       aes(df[df$public == 2, "label"])) +
  geom_bar(aes(fill=df[df$public == 2, "sent_f"])) +
  ggtitle("Борщ")

4. Проверим зависимость переменных label и public, чтобы в целом рассмотреть зависимость от типа паблика

fisher.test(table(df$label, df$public))
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$label, df$public)
## p-value = 0.3103
## alternative hypothesis: two.sided
chisq.test(table(df$label, df$public))
## Warning in chisq.test(table(df$label, df$public)): аппроксимация на основе
## хи-квадрат может быть неправильной
## 
##  Pearson's Chi-squared test
## 
## data:  table(df$label, df$public)
## X-squared = 3.6766, df = 3, p-value = 0.2986

P-value обоих тестов (Фишера и хи-квадрат) больше уровня значимости, значит нулевая гипотеза не отвергается => label и public независимы.

# Вся выборка (тональность)
(ftab.Survived.lab2 <- ftable(xtabs(~label + sentiment_text,data=df), col.vars=1))
##                label   1   2   3   4
## sentiment_text                      
## негативный            30   0  13  34
## нейтральный           62   4  33  84
## позитивный           103   2  13  52
#Дайвинчик (тональность)
(ftab.Survived.lab2 <- ftable(xtabs(~label + sentiment_text,data=df[df$public == 2,]), col.vars=1))
##                label  1  2  3  4
## sentiment_text                  
## негативный           20  0  4 24
## нейтральный          22  2  8 28
## позитивный           35  2  6 13
# Борщ (пол)
(ftable(xtabs(~label + sex_text,data=df[df$public == 1,]), col.vars=1))
##          label  1  2  3  4
## sex_text                  
## женщины        29  1 13 35
## мужчины        89  1 28 70

Выводы

Таким образом, мы рассмотрели зависимость выбора формулы благодарности в комментариях пабликов ВК от нескольких параметров: пола и возраста автора комментария, тональности комментария и характера паблика.

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

Наши гипотезы частично подтвердились.

Мы показали зависимость выбора формы от тональности комментария на всей выборке и на данных паблика ДайВинчик. При этом в рамках паблика Борщ переменные тональности и формы являются независимыми.

Гипотеза о зависимости между полом говорящего и выбором формы подтвердилась только частично. На всей выборке данных переменные sex и label оказались независимыми, так же как и на данных паблика ДайВинчик, однако на выборке данных из Борща эта зависимость существует.

Возрастная группа автора и выбор формы оказались независимы на всем наборе данных.

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