Побудова кола цінностей Шварца в R

У мене з’явилася чергова ідея: продемонструвати, як можна побудувати коло цінностей Шварца в R. На це мене надихнула публікація Олександра Виноградова (клікніть на посилання правою кнопкою миші та оберіть пункт “Відкрити посилання у новій вкладці”). Для цього я традиційно використаю масив 6 хвилі ESS (Україна)¹.

# Бібліотеки, які нам знадобляться
library(foreign)
library(smacof)
library(ggplot2)
library(ggrepel)
library(ggforce)
library(tibble)

# Завантажуємо масив
dataESS <- read.spss("ESS6UA.sav", to.data.frame = T)

В масиві є 21 ціннісне твердження, кожне має шкалу від 1 до 6: 1 – Дуже схожий на мене, 2 – Схожий на мене, 3 – Певною мірою схожий на мене, 4 – Трохи схожий на мене, 5 – Не схожий на мене, 6 – Зовсім не схожий на мене.

Змінні було перекодовано наступним чином: 1 – Зовсім не схожий на мене, 2 – Не схожий на мене, 3 – Трохи схожий на мене, 4 – Певною мірою схожий на мене, 5 – Схожий на мене, 6 – Дуже схожий на мене.

# Виокремлюємо 21 ціннісне твердження і перекодовуємо їх
data_values <- as.data.frame(7 - sapply(dataESS[,581:601], as.numeric))

Ціннісні твердження об’єднуються в 10 цінностей. Спочатку на основі ціннісних тверджень, що входять до кожної з 10 цінностей, розраховуються середні значення. Також розраховується середнє для всіх ціннісних тверджень. А потім ми вираховуємо центровані оцінки: від середніх значень, розрахованих для кожної з 10 цінностей віднімаємо середнє, розраховане на основі всіх ціннісних тверджень.

# Розрахунок центрованих оцінок для 10 цінностей
Universalism <- apply(data_values[,c(3, 8, 19)], 1, mean) + apply(data_values, 1, mean)
Benevolence <- apply(data_values[,c(12, 18)], 1, mean) + apply(data_values, 1, mean)
Conformity <- apply(data_values[,c(7, 16)], 1, mean) + apply(data_values, 1, mean)
Tradition <- apply(data_values[,c(9, 20)], 1, mean) + apply(data_values, 1, mean)
Security <- apply(data_values[,c(5, 14)], 1, mean) + apply(data_values, 1, mean)
Power <- apply(data_values[,c(2, 17)], 1, mean) + apply(data_values, 1, mean)
Achievement <- apply(data_values[,c(4, 13)], 1, mean) + apply(data_values, 1, mean)
Hedonism <- apply(data_values[,c(10, 21)], 1, mean) + apply(data_values, 1, mean)
Stimulation <- apply(data_values[,c(6, 15)], 1, mean) + apply(data_values, 1, mean)
Self_Direction <- apply(data_values[,c(1, 11)], 1, mean) + apply(data_values, 1, mean)

# Цінності об'єднуємо в окремий масив
values_10 <- data.frame(Universalism, Benevolence, Conformity, Tradition, Security,
                        Power, Achievement, Hedonism, Stimulation, Self_Direction)
colnames(values_10)[10] <- "Self-Direction"

Тепер побудуємо коло цінностей Шварца. Воно, взагалі-то, передбачає ще й об’єднання 10 цінностей у 4 метацінності, але опустимо цей момент; принаймні в даній публікації я про це не писатиму. У нас буде два кола цінностей: оригінальний варіант (перший малюнок) та варіант кола цінностей Шварца на даних ESS 6 хвилі, Україна (останній малюнок).

Спочатку підготуємо масив, що включатиме дані, необхідні для побудови оригінального варіанту кола цінностей Шварца: назви цінностей, вектор, що дозволить розбити коло на сектори, кольори для кожного сектору.

# Масив з назвами цінностей та вектором, що дозволить розбити коло на 9 секторів (цінності Conformity й Tradition входять до одного сектору)
values_circle <- data.frame(c(colnames(values_10)[1:2], "Conformity, \n Tradition", 
                              colnames(values_10)[5:10]),
                            rep(2 * pi / 9, 9))
colnames(values_circle) <- c("Values", "Amount")
# Змінна, що включає назви цінностей, буде факторною
values_circle$Values <- factor(values_circle$Values, levels = values_circle$Values)

# Додаємо до масиву кольори для секторів
values_circle$colors <- c("turquoise", "cyan2", "deepskyblue", "lightslateblue",
                          "orangered", "coral2", "orange", "gold", "yellow")

А тепер ліричний відступ: доведеться згадати дещо зі шкільного курсу геометрії. Це в подальшому знадобиться для того, щоб розрахувати координати назв цінностей і вставити відповідні написи у сектори кола.

Маємо коло і відрізок, що перетинається з ним. Завдання – знайти координати точки перетину кола й відрізка. Центр кола розташований на початку координат, відповідно, рівняння кола має наступний вигляд:

$x^2 + y^2 = R^2,$

де $R$ – радіус кола, а точки з координатами $x$ та $y$ лежать на колі.

Відрізок, що перетинає коло, виходить з початку координат і описується рівнянням прямої:

$y = kx,$

де $k$ – тангенс кута нахилу прямої та осі абсцис.

Щоб визначити, у якій точці перетинається коло та відрізок, слід розв’язати наступне рівняння:

$R^2 - x^2 = k^2x^2$ $k^2x^2 + x^2 = R^2$ $x^2(k^2 + 1) = R^2$

$x^2 = \frac{R^2}{k^2 + 1}$ $x = \pm \frac{R}{\sqrt{k^2 + 1}}$

Те, яким буде значення $x$ – додатнім чи від’ємним – залежить залежить від того, у якій чверті координатної площини знаходиться відрізок. Якщо він знаходиться у I чи IV чверті або співпадає з віссю абсцис і знаходиться між I і IV чвертями, $x$ буде додатнім. Якщо ж відрізок знаходиться у II або III чверті чи співпадає з віссю абсцис і знаходиться між IІ і IІІ чвертями, $x$ від’ємний. Знаючи, якого значення набуває $x$ та маючи рівняння прямої (див. вище), можемо розрахувати $y$ . Шукані значення $x$ та $y$ будуть координатами точки перетину кола й відрізка.

Буває й так, що відрізок співпадає з віссю ординат і виходить з початку координат. В цьому разі $x$ дорівнюватиме 0, а $y = \pm R$ (якщо відрізок знаходиться між І і ІІ чвертями координатної площини, то $y$ додатній, якщо між ІІІ і IV – від’ємний).

Я написала відповідну функцію для розрахунку координат точки перетину кола й відрізка, яка підсумовує сказане вище.

## Функція coord дозволяє розрахувати координати точки перетину кола й відрізка

# angle - кут нахилу прямої й відрізка

# R - радіус кола

# q - номер чверті координатної площини (набуває значень від 1 до 4).
# Якщо відрізок співпадає з віссю абсцис / ординат, обираємо номер однієї з чвертей, між якими він знаходиться. 
# Так, якщо відрізок співпадає з віссю абсцис й знаходиться між II і ІІІ чвертями, вказуємо q = 2 або q = 3.

# x0 - набуває значень T або F. Якщо x0 = T, відрізок, що перетинає коло, співпадає з віссю ординат
coord <- function(angle, R, q, x0 = F) {
  k = tan(angle * pi / 180)
  if(x0 == F) {
    if(q == 1 | q == 4) {
      x = R / sqrt(k^2 + 1)
    }
    if(q == 2 | q == 3) {
      x = -R / sqrt(k^2 + 1)
    }
    y = k * x
  }
  if(x0 == T) {
    if(q == 1 | q == 2) {
      y = r
    }
    if(q == 3 | q == 4) {
      y = -r
    }
    x = 0
  }
  coordinates <- c(x, y)
  coordinates
}

Якщо ви дочитали до цього моменту, вітаю, але це далеко не все. Ми ж маємо вписати назви цінностей у коло Шварца, а, отже, варто встановити координати кожного з написів. Для цього спочатку розіб’ємо коло на 9 секторів: у нас хоч і 10 цінностей, однак дві цінності Conformity й Tradition входять до одного сектору. А потім від кожного з 9 центральних кутів проводимо бісектриси. Вони виходять з початку координат та перетинають коло. Визначимо координати точок, у яких бісектриси перетинають коло (використавши наведену вище функцію) та, орієнтуючись на них, обчислимо координати кожного з написів. Було б непогано візуалізувати написане, але тоді вийде забагато малюнків в одній публікації.

# Кути між бісектрисами та віссю абсцис
angle_val <- seq(from = 70, by = -40, length = 9)
# Номер чверті координатної площини, де знаходиться кожна з бісектрис
q_val <- c(rep(1, 2), rep(4, 3), rep(3, 2), rep(2, 2))

# Координати точок перетину бісектрис і кола (з радіусом, що дорівнює 1)
points <- t(sapply(1:9, function(x) 
  coord(angle = angle_val[x], R = 1, q = q_val[x])))

# Координати написів
points_m <- points / 1.7

# Включаємо в масив координати написів
values_circle <- data.frame(values_circle, points_m)
colnames(values_circle)[4:5] <- c("X", "Y")

Нарешті побудуємо коло цінностей Шварца (дійсно, нарешті вже).

# Коло цінностей Шварца: оригінальний варіант
ggplot(values_circle, aes(x = X, y = Y)) +
  stat_pie(aes(x0 = 0, y0 = 0, r0 = 0, r = 1, amount = Amount, fill = Values),
           show.legend = F,
           inherit.aes = F) +
  coord_fixed() +
  xlab(" ") + ylab(" ") +
  geom_text(aes(label = Values,
                angle = c(seq(from = 70, by = -40, length.out = 4),
                          seq(from = 90, by = -40, length.out = 5))),
            cex = 4.5) +
  scale_fill_manual(values = values_circle$colors) +
  theme_void()

Тепер побудуємо коло цінностей Шварца на даних ESS 6 хвилі (Україна). Спершу створимо матрицю кореляцій між цінностями, використавши коефіцієнт кореляції Спірмена. А потім трансформуємо її у матрицю відстаней.

# Матриця кореляцій
corr <- cor(values_10, use = "pairwise.complete.obs", method = "spearman")

# Матриця відстаней
dist <- sim2diss(corr, method = "corr")

На основі матриці відстаней проведено неметричне багатовимірне шкалювання. Було використано алгоритм SMACOF, який дозволяє мінімізувати функцію стресу. Крім того, мали на меті розташувати цінності у вигляді точок на колі, що дозволяє зробити функція smacofSphere.

# Неметричне багатовимірне шкалювання, алгоритм SMACOF
mds <- smacofSphere(dist, type = "ordinal", itmax = 10000)

# Значення стресу
mds$stress

## [1] 0.09342233

Вважається, що значення стресу, менші за 0,1, є свідченням “хорошої” моделі (див. статтю). Отримане нами значення показника стресу (0,093) є цілком прийнятним, тож можемо рухатися далі.

Маємо координати кожної з цінностей (точок), які розташовані на колі. Впорядкуємо назви цінностей за годинниковою стрілкою, починаючи з точок, які знаходяться у І чверті координатної площини. Для кожної з цінностей визначимо кольори, вони будуть ті ж самі, що й для оригінального варіанту кола Шварца. Також варто розрахувати радіус кола, що буде побудовано (див. вище рівняння кола з центром у початку координат).

# Координати кожної з цінностей
mds <- data.frame(-mds$conf[,1], mds$conf[,2])
colnames(mds) <- c("X", "Y")

# Назви цінностей виступатимуть окремою змінною
rownames(mds) <- colnames(values_10)
mds <- rownames_to_column(mds, "Values")

# Кольори для цінностей
mds$colors <- c("turquoise", "cyan2", "deepskyblue", "deepskyblue", "lightslateblue",
                "orangered", "coral2", "orange", "gold", "yellow")

# Впрядковуємо назви цінностей за годинниковою стрілкою
mds1 <- mds[mds$X >= 0 & mds$Y >= 0,]
mds1 <- mds1[order(mds1$X),]
mds2 <- mds[mds$X >= 0 & mds$Y < 0,]
mds2 <- mds2[order(mds2$X, decreasing = T),]
mds3 <- mds[mds$X < 0 & mds$Y < 0,]
mds3 <- mds3[order(mds3$X, decreasing = T),]
mds4 <- mds[mds$X < 0 & mds$Y >= 0,]
mds4 <- mds4[order(mds4$X),]
mds <- rbind(mds1, mds2, mds3, mds4)

# Змінна, що включає назви цінностей, буде факторною
mds$Values <- factor(mds$Values, levels = mds$Values)

# Радіус кола
radius <- sqrt(mds[1, 2]^2 + mds[1, 3]^2)

Візуалізуємо розташування цінностей на колі.

# Візуалізуємо...
ggplot(mds, aes(x = X, y = Y)) +
  geom_circle(aes(x0 = 0, y0 = 0, r = radius), 
              linetype = 2,
              inherit.aes = F) +
  coord_fixed() +
  xlab(" ") + ylab(" ") +
  scale_x_continuous(n.breaks = 7) + 
  scale_y_continuous(n.breaks = 7) +
  geom_point(aes(colour = Values), 
             size = 2.5, 
             show.legend = F) +
  scale_color_manual(values = mds$colors) +
  geom_text(aes(label = c(substr(Values[1:9], 1, 3), "Sdi"),
                x = c(X[1] / 1.14, X[2:6] / 1.12, X[7] / 1.08, X[8:9] / 1.13, X[10] / 1.15), 
                y = c(Y[1:7], Y[8] - 0.02, Y[9] + 0.02, Y[10])))

Тепер, орієнтуючись на цю візуалізацію, побудуємо коло цінностей Шварца на даних ESS 6 хвилі (Україна). Тут кроки, загалом, схожі на ті, які ми здійснювали, будуючи попереднє коло цінностей Шварца. Ми вже знаємо радіус кола та визначили кольори для кожного сектору. Ще варто розбити коло на 10 секторів (бо всі цінності мають різні координати, а, отже, кожна цінність відповідатиме окремому сектору), розрахувати координати написів, які буде нанесено на кожен сектор. А вже тоді візуалізуємо.

# Розбивка кола на 10 секторів
mds$amount <- rep(2 * pi / 10, dim(mds)[1])

# Кути між бісектрисами та віссю абсцис 
angle_ESS <- rep(seq(from = 72, by = -36, length = 5), 2)
# Номер чверті координатної площини, де знаходиться кожна з бісектрис
q_ESS <- c(rep(1, 3), rep(4, 2), rep(3, 3), rep(2, 2))

# Координати точок перетину бісектрис і кола
mds <- data.frame(mds, t(sapply(1:10, function(x) 
  coord(angle = angle_ESS[x], R = radius, q = q_ESS[x]))))
colnames(mds)[6:7] <- c("posx", "posy")

# Координати написів
mds[,6:7] <- mds[,6:7] / 1.5

# Коло цінностей Шварца, побудоване на даних ESS 6 хвилі (Україна)
ggplot(mds, aes(x = X, y = Y)) +
  stat_pie(aes(x0 = 0, y0 = 0, r0 = 0, r = radius, amount = amount, fill = Values), 
           show.legend = F,
           inherit.aes = F) +
  coord_fixed() +
  xlab(" ") + ylab(" ") +
  geom_text(aes(label = Values,
                x = posx, y = posy,
                angle = rep(seq(from = 72, by = -36, length = 5), 2)),
            cex = 4.5) +
  scale_fill_manual(values = mds$colors) +
  theme_void()

Порівняйте це коло Шварца з оригінальним варіантом і подивіться на відмінності. Вони є і досить помітні.

Наостанок скажу наступне. Раджу експериментувати з різними варіантами. Спробуйте замість smacofSphere функцію mds; може тоді вийде створити коло Шварца, більш схоже на оригінальний варіант. Або “пограйтеся” з параметрами функції smacofSphere, наприклад, застосувавши різні початкові конфігурації. Може тоді вдасться досягнути меншого значення стресу та побудувати коло Шварца, що буде більш наближене до оригінального варіанту.

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