Візуалізація результатів перевірки статистичних гіпотез

Поговоримо про перевірку статистичних гіпотез за допомогою тесту Краскала-Уолліса та критерію Манна-Уітні. Якщо точніше, ми поговоримо про візуалізацію результатів перевірки гіпотез. Ідею підглянула в С. Дембіцького, де для представлення відмінностей між групами застосовується багатовимірне шкалювання: http://soc-research.info/blog/index_files/assdg.html. Але не будемо забігати наперед, про все по черзі.

Для аналізу обрали масив ESS, 6 хвилю (Україна)1.

# Бібліотеки, які нам знадобляться
library("foreign")
library("kableExtra")
library("ggrepel")
library("ggplot2")
library("igraph")
library("ggraph")
# Завантажуємо масив ESS
dataESS <- read.spss("ESS6UA.sav", to.data.frame = T)

Мене (чомусь) зацікавили 4 ознаки: приналежність до релігійної течії (rlgblg), відчуття щастя (happy), стать (gndr), схильність допомогати близьким (prhlppl).

# Приналежність до релігійної течії
rlgblg <- dataESS$rlgblg
# "Так" - належить до певної регійної течії, "Ні" - не належить
levels(rlgblg) <- c("Так", "Ні")

# Відчуття щастя
happy <- cut(as.numeric(dataESS$happy), c(1, 4, 7, 11), c("Ні", "Нрм", "Так"), include.lowest = T)
# "Ні" - не вважає себе щасливим, "Так" - вважає себе щасливим, "Нрм" - ні щасливий, ні не щасливий

# Стать (Ч - Чоловіча, Ж - Жіноча)
gndr <- dataESS$gndr
levels(gndr) <- c("Ч", "Ж")

# Схильність допомагати близьким
help <- as.numeric(dataESS$prhlppl) - 1

На основі перших трьох ознак створено одну, яка вказує на приналежність респондента до групи (group). Всього маємо 12 груп. Отриману змінну впорядковано за середнім значенням ознаки, яка характеризує схильність допомагати близьким, від найбільшого середнього значення до найменшого.

# Створюємо змінну group
group <- paste(rlgblg, happy, gndr, sep = ".")
group[grepl("NA", group)] <- NA

# Впорядковуємо змінну group за середнім значенням ознаки help
level <- names(sort(tapply(help, group, mean, na.rm = T), decreasing = T))
group <- factor(group, levels = level)

Тепер дізнаємося, чи наявні відмінності між групами за схильністю допомагати близьким. Застосуємо тест Краскала-Уолліса.

# Тест Краскала-Уолліса
kruskal.test(help ~ group)
## 
##  Kruskal-Wallis rank sum test
## 
## data:  help by group
## Kruskal-Wallis chi-squared = 89.609, df = 11, p-value = 1.989e-14

Як бачимо, відмінності між групами наявні, однак між якими – невідомо. Для того, щоб про це дізнатися, варто здійснити попарне порівняння груп за допомогою критерію Манна-Уітні. Для усунення ефекту множинних порівнянь використали метод Беньяміні-Хохберга. Частка хибних відхилень гіпотез встановлена на рівні 0,05.

# Критерій Манна-Уітні + метод Беньяміні-Хохберга
p_val <- pairwise.wilcox.test(help, group, 
                              p.adjust.method = "BH", 
                              exact = F)[["p.value"]]

# Наявність стат. знач. відмінностей між групами позначаємо як 1, а відсутність - як 0
p_val <- ifelse(p_val <= 0.05, 1, 0)

# Визначаємо кількість попарних порівнянь та статистично значущих відмінностей
p <- rbind(sum(!is.na(p_val == F)),
           sum(p_val == 1, na.rm = T))
rownames(p) <- c("Всього порівнянь", "Кількість статистично значущих відмінностей")

p %>%
  kbl(align = "c") %>%
  kable_classic() %>%
  kable_styling(full_width = F)
Всього порівнянь 66
Кількість статистично значущих відмінностей 28

Виявлено 28 статистично значущих відмінностей між групами. Звісно, результати можна представити у вигляді дуже великої таблиці😮 Однак для зручності їх, мабуть, краще візуалізувати. Перший спосіб – застосування багатовимірного шкалювання. Для цього слід побудувати матрицю близькостей. Вона міститиме значення 0 та 1. 0 вказує на те, що відмінностей між групами немає, а 1 – на те, що вони є.

# Визначаємо кількість рядків і стовпчиків матриці близькостей 
dim <- nrow(p_val) + 1

# Створюємо матрицю близькостей
m_mds <- matrix(rep(0, dim^2), nrow = dim,
                dimnames = list(level, level))
m_mds[lower.tri(m_mds)] <- p_val[!is.na(p_val)]
m_mds[upper.tri(m_mds)] <- t(p_val)[!is.na(t(p_val))]

Тепер використаємо багатовимірне шкалювання та візуалізуємо отримані результати.

# Багатовимірне шкалювання
ms <- as.data.frame(cmdscale(m_mds, 2))
ms[,c(1, 2)] <- -ms[,c(2, 1)]

# Створюємо функцію, що дозволить нам малювати стрілки
curve <- function(x1, y1, x2, y2, curvature = 0) {
geom_curve(aes(x = x1, y = y1, xend = x2, yend = y2),
           linetype = 2, 
           arrow = arrow(type = "closed", length = unit(0.1, "inches")),
           curvature = curvature)
}

# Візуалізуємо
ggplot(ms, aes(x = V1, y = V2)) +
  xlim(c(-0.75, 0.5)) +
  ylim(c(-0.5, 0.75)) +
  geom_point(size = 3) +
  geom_label_repel(aes(label = level), 
                   size = 3.5, 
                   color = "grey30",
                   nudge_x = c(-0.02, rep(0, 8), -0.02, 0, -0.02),
                   nudge_y = c(rep(0.02, 5), rep(-0.02, 3), rep(0.02, 2), rep(-0.02, 2))) +
  geom_hline(aes(yintercept = 0.1)) +
  curve(x1 = ms["Так.Так.Ж", 1], y1 = ms["Так.Так.Ж", 2], 
        x2 = 0.1, y2 = 0.1,
        curvature = -0.3) +
  curve(x1 = ms["Так.Так.Ж", 1], y1 = ms["Так.Так.Ж", 2], 
        x2 = ms["Ні.Так.Ч", 1], y2 = ms["Ні.Так.Ч", 2],
        curvature = 0.32) +
  curve(x1 = ms["Ні.Так.Ж", 1], y1 = ms["Ні.Так.Ж", 2], 
        x2 = ms["Ні.Так.Ж", 1], y2 = 0.1) +
  geom_hline(aes(yintercept = -0.25)) +
  curve(x1 = ms["Так.Так.Ч", 1], y1 = ms["Так.Так.Ч", 2], 
        x2 = ms["Так.Так.Ч", 1], y2 = -0.25) +
  geom_segment(aes(x = -0.25, y = -0.5, xend = -0.25, yend = -0.08)) +
  curve(x1 = ms["Ні.Так.Ч", 1], y1 = ms["Ні.Так.Ч", 2], 
        x2 = -0.25, y2 = -0.13,
        curvature = -0.2) +
  curve(x1 = ms["Так.Нрм.Ж", 1], y1 = ms["Так.Нрм.Ж", 2], 
        x2 = -0.25, y2 = -0.4, 
        curvature = -0.82) +
  curve(x1 = ms["Ні.Нрм.Ж", 1], y1 = ms["Ні.Нрм.Ж", 2], 
        x2 = ms["Ні.Ні.Ж", 1], y2 = ms["Ні.Ні.Ж", 2], 
        curvature = 0.5) +
  curve(x1 = ms["Так.Нрм.Ч", 1], y1 = ms["Так.Нрм.Ч", 2], 
        x2 = ms["Ні.Ні.Ж", 1], y2 = ms["Ні.Ні.Ж", 2],
        curvature = 0.2) +
  xlab(" ") +
  ylab("Менша схильність допомагати - Більша схильність допомагати")

Стрілки та лінії вказують на наявність відмінностей між групами. Лінії використовували для того, щоб показати відмінності однієї групи від кількох інших. Чим вище знаходиться група на координатній площині, тим, як правило, більша схильність допомагати близьким. Виняток – пара Так.Нрм.Ч (чоловіки, що належать певної релігійної течії, не є ні щасливими, ні не щасливими) та Ні.Ні.Ж (жінки, що не належать до певної релігійної течії і не відчувають себе щасливими). Останні менш схильні допомагати близьким. А, наприклад, представники групи Так.Так.Ж (жінки, які почувають себе щасливими та належать до певної релігійної течії) більш схильні допомагати близьким, ніж Ні.Так.Ч (чоловіки, які почувають себе щасливими і не належать до тієї чи іншої релігійної течії). У свою чергу, Ні.Так.Ч мають більшу схильність допомагати близьким, ніж групи Ні.Ні.Ж і Так.Ні.Ж.

Недолік цього способу візуалізації – необхідність самостійно малювати лінії та стрілки, які б показували відмінності між групами. Тож застосуємо другий спосіб. Представимо відмінності між групами у вигляді графу. Для початку створимо орієнтований граф, де вершинами будуть групи, а ребра свідчитимуть про наявність відмінностей між ними.

# Матриця суміжності для створення графу
m_graph <- matrix(rep(0, dim^2), nrow = dim,
                  dimnames = list(level, level))
m_graph[upper.tri(m_graph)] <- m_mds[upper.tri(m_mds)]

# Створюємо орієнтований граф
net <- graph_from_adjacency_matrix(m_graph)

Тепер візуалізуємо його.

# Візуалізуємо граф
ggraph(net, layout = "sugiyama") +
  theme_gray() +
  xlim(0, 12.5) +
  geom_edge_bend(color = "gray60", 
                 strength = -0.1)  +
  geom_node_point(size = 3, 
                  color = c(rep("darkred", 3), rep("purple4", 6), "darkblue", "purple4", "darkblue")) +
  geom_node_text(aes(label = level), 
                 size = 3.5, 
                 fontface = "bold", 
                 color = c(rep("darkred", 3), rep("purple4", 6), "darkblue", "purple4", "darkblue"),
                 position = position_nudge(x = c(rep(0, 3), -0.8, rep(0, 8)), 
                                           y = c(rep(0.09, 3), -0.09, rep(-0.07, 8))), 
                 angle = c(rep(30, 8), rep(0, 2), 30, 0)) +
  xlab(" ") + 
  ylab("Менша схильність допомагати - Більша схильність допомагати")

Для візуалізації відмінностей між групами у вигляді графу використали розміщення Сугіями (різновид ієрархічного розміщення). Відсутність ребра свідчить про відсутність статистично значущої відмінності між групами. Зокрема, між групами, які знаходяться на одному “щаблі”, статистично значущої відмінності немає. Три групи знаходяться вгорі (позначені червоним). Вони більш схильні допомагати близьким, ніж хоча б одна з груп, позначених фіолетовим кольором. Також вони більш схильні допомагати близьким, ніж групи, позначені синім кольором. Серед груп фіолетового кольору 4 мають меншу схильність допомагати близьким, ніж хоча б одна з груп, що знаходяться вгорі. Разом з тим вони більш схильні допомагати близьким, ніж хоча б одна з груп синього кольору. Три інші групи фіолетового кольору теж мають меншу схильність допомагати близьким, аніж групи (хоча б одна) червоного кольору. Але статистично значущої відмінності між ними та групами синього кольору немає. Недолік цього способу візуалізації – забагато стрілок, які до того ж перетинаються. Через це зображення може не дуже добре сприйматися.

Отже, я представила два способи візуалізації результатів перевірки статистичних гіпотез. Перший запропонований не мною, описаний у матеріалі С. Дембіцького, посилання на який я надавала вище. Другий спосіб – моя ідея😉 Не ідеально, але як варіант – чому б і ні?


  1. Масив ESS можна завантажити за посиланням: https://drive.google.com/file/d/1K8wQtdHTKAoAAxbrojh4ZIES7rqSoEW-/view?usp=sharing (варто клікнути на посилання правою кнопкою миші та обрати пункт “Відкрити посилання у новій вкладці”)↩︎