Данные представляют из себя комментарии пользователей пабликов «Леонардо ДайВинчик» 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 независимы.
# эта штука ругается на память
# 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("Борщ")
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 оказались независимыми, так же как и на данных паблика ДайВинчик, однако на выборке данных из Борща эта зависимость существует.
Возрастная группа автора и выбор формы оказались независимы на всем наборе данных.
Таким образом, можем сделать выводы о том, что данные исследования удалось подтвердить только частично.