Візуалізація результатів перевірки статистичних гіпотез: продовження
Я вже писала про перевірку статистичних гіпотез за допомогою тесту Краскала-Уолліса та критерію Манна-Уітні (детальніше див. тут: https://rpubs.com/ruslana/916149). В цьому матеріалі було наведено два способи візуалізації результатів перевірки статистичних гіпотез. Перший спосіб – представлення відмінностей між групами з використанням багатовимірного шкалювання (ідея не моя, а С. Дембіцького: http://soc-research.info/blog/index_files/assdg.html). Другий спосіб – представлення відмінностей між групами у вигляді орієнтованого графу; було застосовано розміщення Сугіями. Цікаво, а чи можна обидва способи якось поєднати? Спробуємо…
Для аналізу обрали 4 ознаки з масиву ESS, 6 хвилю (Україна)1: приналежність до релігійної течії (rlgblg), відчуття щастя (happy), стать (gndr), схильність допомогати близьким (prhlppl).
# Бібліотеки, які нам знадобляться
library("foreign")
library("igraph")
library("ggraph")# Завантажуємо масив ESS
dataESS <- read.spss("ESS6UA.sav", to.data.frame = T)
## Модифікуємо обрані 4 ознаки
# Приналежність до релігійної течії
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На основі ознак rlgblg, happy і gndr створено ознаку group, що позначає приналежність респондента до певної групи. Всього таких груп 12. Змінну group впорядковано за середнім значенням ознаки help, від найбільшого середнього значення до найменшого.
# Створюємо змінну 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)# Критерій Манна-Уітні + метод Беньяміні-Хохберга
p_val <- pairwise.wilcox.test(help, group,
p.adjust.method = "BH",
exact = F)[["p.value"]]
# Наявність стат. знач. відмінностей між групами позначаємо як 1, а відсутність - як 0
p_val_rec <- ifelse(p_val <= 0.05, 1, 0)У попередньому матеріалі про візуалізацію результатів перевірки статистичних гіпотез я вже писала, що було виявлено 28 статистично значущих відмінностей між групами. Загалом, все сказане вище повторює зміст попереднього матеріалу. Але таке повторення має сенс: стає зрозуміліше, звідки взялася візуалізація, побудована нижче.
Для побудови візуалізації потрібні дві матриці: матриця суміжності для створення графу та матриця близькостей.
# Визначаємо кількість рядків і стовпчиків кожної з матриць (dim)
dim <- nrow(p_val) + 1
# Матриця близькостей
mds_m <- matrix(rep(0, dim^2), nrow = dim,
dimnames = list(level, level))
mds_m[lower.tri(mds_m)] <- p_val_rec[!is.na(p_val_rec)]
mds_m[upper.tri(mds_m)] <- t(p_val_rec)[!is.na(t(p_val_rec))]
# Матриця суміжності для створення графу
net_m <- matrix(rep(0, dim^2), nrow = dim,
dimnames = list(level, level))
net_m[upper.tri(net_m)] <- mds_m[upper.tri(mds_m)]Переходимо до створення орієнтованого графу.
# Створюємо орієнтований граф з матриці net_m
net <- graph_from_adjacency_matrix(net_m)Оскільки є ідея поєднати обидва способи візуалізації, наведені в попередньому матеріалі, для графу буде обрано розміщення mds (багатовимірне шкалювання). Для цього нам знадобиться матриця близькостей mds_m. Також оберемо кольори для вершин та ребер графу. Після цього перейдемо, безпосередньо, до створення візуалізації.
# Розміщення mds (багатовимірне шкалювання)
l <- layout_with_mds(net, dist = mds_m)
l[,c(1, 2)] <- l[,c(2, 1)]
# Обираємо кольори для вершин графу
in_degree <- degree(net, mode = "in")
out_degree <- degree(net, mode = "out")
color <- rep("gold", gorder(net))
color[in_degree == 0] <- "deepskyblue2"
color[out_degree == 0] <- "coral2"
# Групуємо ребра графу (щоб потім обрати для них відповідні кольори). Всього 3 групи: 01, 02, 03
edges <- as_edgelist(net)
col_from <- rep("gold", gsize(net))
col_from[is.na(match(edges[,1], edges[,2]))] <- "deepskyblue2"
col_to <- rep("gold", gsize(net))
col_to[is.na(match(edges[,2], edges[,1]))] <- "coral2"
edge_grp <- rep("03", gsize(net))
edge_grp[col_from == "deepskyblue2" & col_to == "gold"] <- "01"
edge_grp[col_from == "deepskyblue2" & col_to == "coral2"] <- "02"# Створюємо візуалізацію
ggraph(net, layout = l) +
theme_gray() +
xlim(-0.75, 0.5) +
ylim(-0.5, 0.75) +
geom_edge_arc(aes(colour = edge_grp),
strength = c(rep(0, 24), 0.59, rep(0, 3)),
show.legend = F,
arrow = arrow(length = unit(0.1, "inches")),
end_cap = circle(3.5, "mm"),
start_cap = circle(3.5, "mm")) +
scale_edge_colour_manual(values = c("green3", "purple3", "orange")) +
geom_node_point(size = 4,
color = color) +
geom_node_text(aes(label = level),
size = 3.2,
fontface = "bold",
position = position_nudge(x = c(rep(0, 3), 0.04, rep(0, 3), -0.08, 0.04, -0.04, rep(0, 2)),
y = c(rep(0.05, 4), 0.01, rep(-0.04, 2), 0, rep(-0.05, 4)))) +
xlab(" ") +
ylab("Менша схильність допомагати - Більша схильність допомагати")
Трохи про отриману візуалізацію. Наявність ребра свідчить про наявність статистично значущої відмінності між групами. Ребра мають вигляд стрілок, що йдуть від груп з вищою схильністю допомагати близьким до груп з нижчою схильністю допомагати близьким. Блакитним кольором позначено групи (вершини), що мають, в цілому, найбільшу схильність допомагати близьким. Дещо нижчу схильність допомагати близьким демонструють групи, зафарбовані жовтим кольором, а найнижчу – групи, позначені червоним кольором. Ребра також було позначено кольором. Фіолетовий колір мають ребра, що характеризують наявність відмінностей між групами, зафарбованими у блакитний і червоний кольори. Зеленим кольором позначено ребра, які стосуються відмінностей між групами, зафарбованими у блакитний і жовтий кольори. Оранжевий колір мають ребра, які стосуються відмінностей між групами, зафарбованими у жовтий і червоний кольори.
Насправді зафарбовувати вершини і ребра графа необов’язково. Однак, як на мене, так візуалізація краще сприймається. Адже ребер у створеному графі чимало і вони перетинаються.
P. S. Не можу не згадати про ще один варіант візуалізації, запропонований Кирилом Захаровим. Нижче код для створення графу та його візуалізації.
# Будуємо матрицю graph_m, яка включає значення p.value
graph_m <- matrix(rep(0, dim^2), nrow = dim)
graph_m[upper.tri(graph_m)] <- t(p_val)[!lower.tri(p_val)]
colnames(graph_m) <- c(colnames(p_val)[1], rownames(p_val))
# Створюємо зважений орієнтований граф з матриці graph_m
net2 <- graph_from_adjacency_matrix(graph_m, weighted = T)
# Створюємо візуалізацію
set.seed(2)
ggraph(net2, layout = layout_with_fr(net2, weights = E(net2)$weight)) +
geom_edge_link(aes(alpha = weight, width = weight)) +
scale_edge_width(range = c(0.01, 0.5)) +
geom_node_point(size = 4, color = color) +
geom_node_text(aes(label = level),
size = 3.2,
fontface = "bold") +
xlab(" ") +
ylab(" ") +
theme(legend.position = "none")
Чим більше значення p.value, тим менша прозорість ребра. p.value характеризує ступінь схожості груп: чим більше його значення, тим більшою мірою групи схожі між собою за схильністю допомогати близьким. Групи, які демонструють найвищу готовність допомагати близьким, знаходяться у правій частині графіка, позначені блакитним кольором. А групи, зафарбовані у червоний колір, знаходяться лівіше, характеризуються найнижчою готовністю допомагати близьким.
Масив ESS можна завантажити за посиланням: https://drive.google.com/file/d/1K8wQtdHTKAoAAxbrojh4ZIES7rqSoEW-/view?usp=sharing (варто клікнути на посилання правою кнопкою миші та обрати пункт “Відкрити посилання у новій вкладці”)↩︎