1. Введение

Респонденты оценивали пять позиций по отношению к религии:

  1. «Я верующий»
  2. «Я верю в Бога по-своему»
  3. «Не могу сказать, верю я или нет»
  4. «Религия меня не интересует»
  5. «Атеист»

Оценки производились по 28 шкалам-дескрипторам (d1–d28). Данные представляют собой средние оценки респондентов.

Для анализа используется пакет FactoMineR и визуализация через factoextra.

2. Загрузка данных и подготовка

# Установка и загрузка необходимых пакетов
if (!require("FactoMineR")) install.packages("FactoMineR", repos = "https://cran.r-project.org")
if (!require("factoextra")) install.packages("factoextra", repos = "https://cran.r-project.org")
if (!require("readxl")) install.packages("readxl", repos = "https://cran.r-project.org")
if (!require("knitr")) install.packages("knitr", repos = "https://cran.r-project.org")
if (!require("kableExtra")) install.packages("kableExtra", repos = "https://cran.r-project.org")
if (!require("corrplot")) install.packages("corrplot", repos = "https://cran.r-project.org")

library(FactoMineR)
library(factoextra)
library(readxl)
library(knitr)
library(kableExtra)
library(corrplot)
# Чтение данных из Excel-файла
# Если файл .sav — используйте: library(haven); data <- read_sav("religions.sav")
data <- read_excel("religions.xlsx")

# Убираем пустые строки (если есть)
data <- data[!is.na(data$Group.1) & data$Group.1 != "", ]

# Присваиваем имена строк (роли)
rownames(data) <- data$Group.1

# Оставляем только числовые столбцы (дескрипторы d1-d28)
data_num <- data[, -1]

# Преобразуем в числовой формат
data_num <- as.data.frame(lapply(data_num, as.numeric))
rownames(data_num) <- data$Group.1

# Просмотр данных
kable(round(data_num, 3), caption = "Таблица 1 — Исходные данные (средние оценки по дескрипторам)") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE, font_size = 11) %>%
  scroll_box(width = "100%")
Таблица 1 — Исходные данные (средние оценки по дескрипторам)
d1 d2 d3 d4 d5 d6 d7 d8 d9 d10 d11 d12 d13 d14 d15 d16 d17 d18 d19 d20 d21 d22 d23 d24 d25 d26 d27 d28
Я верующий 4.143 4.167 4.149 4.132 4.033 3.989 3.678 3.665 3.885 3.841 3.883 4.120 3.923 3.663 3.680 3.967 3.962 3.945 3.868 3.709 4.055 3.681 3.956 4.005 4.006 3.725 3.950 3.984
Я верю в Бога по-своему 3.950 3.961 3.838 3.771 3.772 3.657 3.654 3.620 3.609 3.408 3.570 3.817 3.742 3.573 3.654 3.811 3.821 3.810 3.590 3.579 3.760 3.383 3.821 3.793 3.737 3.606 3.883 3.837
Не могу сказать, верю я или нет 3.770 3.777 3.618 3.567 3.612 3.525 3.565 3.475 3.511 3.152 3.483 3.584 3.581 3.472 3.539 3.525 3.612 3.607 3.320 3.497 3.585 3.101 3.719 3.652 3.528 3.508 3.787 3.638
Религия меня не интересует 3.771 3.817 3.616 3.581 3.584 3.500 3.539 3.567 3.551 3.006 3.358 3.383 3.559 3.354 3.508 3.494 3.601 3.665 3.141 3.489 3.514 2.832 3.689 3.441 3.425 3.489 3.607 3.522
Атеист 3.654 3.661 3.464 3.369 3.422 3.341 3.458 3.461 3.520 2.883 3.376 3.239 3.444 3.315 3.525 3.411 3.559 3.592 3.117 3.390 3.330 2.742 3.514 3.392 3.307 3.428 3.567 3.517

Комментарий: Загружены данные по 5 позициям (строки) и 28 дескрипторам (столбцы). Значения представляют собой средние оценки респондентов по каждой паре «позиция × дескриптор».

3. Корреляционная матрица

# Корреляция между дескрипторами (транспонируем, т.к. дескрипторы в столбцах)
cor_matrix <- cor(data_num)

corrplot(cor_matrix, method = "color", type = "upper", 
         tl.col = "black", tl.cex = 0.7, 
         title = "Корреляционная матрица дескрипторов",
         mar = c(0, 0, 2, 0))

Комментарий: Корреляционная матрица показывает взаимосвязи между 28 дескрипторами. Высокая корреляция указывает на то, что дескрипторы измеряют сходные аспекты восприятия, что является предпосылкой для снижения размерности.

4. Анализ главных компонент (PCA)

# Выполнение PCA с помощью FactoMineR
# scale.unit = TRUE — стандартизация переменных
# ncp = 5 — сохраняем до 5 компонент (максимум для 5 наблюдений)
# graph = FALSE — графики построим отдельно

res.pca <- PCA(data_num, scale.unit = TRUE, ncp = 4, graph = FALSE)

Комментарий: PCA выполнен с помощью функции PCA() из пакета FactoMineR. Данные стандартизированы (scale.unit = TRUE), чтобы дескрипторы с разным масштабом вносили сопоставимый вклад. Максимальное число компонент = min(n-1, p) = min(4, 28) = 4.

5. Собственные значения и объяснённая дисперсия

# Собственные значения
eig <- get_eigenvalue(res.pca)

kable(round(eig, 4), 
      caption = "Таблица 2 — Собственные значения и объяснённая дисперсия") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)
Таблица 2 — Собственные значения и объяснённая дисперсия
eigenvalue variance.percent cumulative.variance.percent
Dim.1 26.6564 95.2015 95.2015
Dim.2 0.6584 2.3514 97.5529
Dim.3 0.3854 1.3763 98.9292
Dim.4 0.2998 1.0708 100.0000 
# Scree plot — диаграмма каменистой осыпи
fviz_eig(res.pca, addlabels = TRUE, ylim = c(0, 100),
         main = "Собственные значения компонент",
         xlab = "Главная компонента", ylab = "Процент объяснённой дисперсии") +
  theme_minimal()
Рис. 1 — Диаграмма каменистой осыпи (Scree plot)

Рис. 1 — Диаграмма каменистой осыпи (Scree plot)

Комментарий: Первая главная компонента объясняет подавляющую долю дисперсии данных. Диаграмма каменистой осыпи (scree plot) позволяет определить оптимальное число компонент: выбираются компоненты до «перегиба» кривой. В нашем случае первые 2 компоненты уже объясняют основную часть вариации.

6. Результаты по дескрипторам (переменным)

6.1. Координаты (корреляции) дескрипторов с компонентами

var_coord <- res.pca$var$coord

kable(round(var_coord, 4), 
      caption = "Таблица 3 — Координаты дескрипторов (корреляции с компонентами)") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE, font_size = 11) %>%
  scroll_box(width = "100%", height = "400px")
Таблица 3 — Координаты дескрипторов (корреляции с компонентами)
Dim.1 Dim.2 Dim.3 Dim.4
d1 0.9960 0.0867 0.0220 0.0005
d2 0.9857 0.1560 0.0562 -0.0303
d3 0.9933 0.1088 -0.0300 -0.0264
d4 0.9862 0.1363 -0.0125 -0.0926
d5 0.9938 0.0616 0.0080 -0.0923
d6 0.9841 0.1064 -0.0638 -0.1271
d7 0.9533 -0.1333 0.2690 -0.0330
d8 0.8857 0.3344 0.2969 0.1246
d9 0.9108 0.3057 -0.2775 -0.0016
d10 0.9955 -0.0131 -0.0892 -0.0280
d11 0.9592 -0.0145 -0.2810 -0.0265
d12 0.9915 -0.1210 -0.0035 -0.0479
d13 0.9985 0.0398 0.0276 -0.0245
d14 0.9723 -0.2329 0.0190 -0.0097
d15 0.9401 -0.1264 -0.0136 0.3163
d16 0.9902 -0.0059 0.0460 0.1320
d17 0.9874 0.0424 -0.0164 0.1515
d18 0.9673 0.1989 0.0253 0.1555
d19 0.9882 -0.1065 -0.0839 0.0713
d20 0.9894 0.0693 0.0483 -0.1181
d21 0.9944 0.0083 0.0115 -0.1044
d22 0.9851 -0.1701 -0.0232 0.0051
d23 0.9695 -0.0163 0.1675 -0.1780
d24 0.9768 -0.2033 -0.0554 -0.0372
d25 0.9987 -0.0397 -0.0216 -0.0219
d26 0.9992 0.0350 -0.0078 -0.0167
d27 0.9344 -0.3505 0.0540 -0.0339
d28 0.9825 -0.1319 -0.0560 0.1195

Комментарий: Координаты (loadings) показывают корреляцию каждого дескриптора с каждой главной компонентой. Высокие абсолютные значения указывают на сильную связь дескриптора с данной компонентой.

6.2. Вклады дескрипторов (contributions)

var_contrib <- res.pca$var$contrib

kable(round(var_contrib, 3), 
      caption = "Таблица 4 — Вклады дескрипторов в компоненты (%)") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE, font_size = 11) %>%
  scroll_box(width = "100%", height = "400px")
Таблица 4 — Вклады дескрипторов в компоненты (%)
Dim.1 Dim.2 Dim.3 Dim.4
d1 3.721 1.141 0.126 0.000
d2 3.645 3.698 0.819 0.305
d3 3.701 1.798 0.233 0.233
d4 3.649 2.823 0.041 2.862
d5 3.705 0.576 0.017 2.840
d6 3.633 1.720 1.058 5.390
d7 3.409 2.701 18.778 0.364
d8 2.943 16.981 22.880 5.179
d9 3.112 14.198 19.978 0.001
d10 3.718 0.026 2.066 0.262
d11 3.452 0.032 20.491 0.233
d12 3.688 2.222 0.003 0.766
d13 3.740 0.241 0.198 0.200
d14 3.546 8.236 0.094 0.032
d15 3.315 2.425 0.048 33.378
d16 3.678 0.005 0.549 5.808
d17 3.658 0.273 0.070 7.657
d18 3.510 6.006 0.166 8.068
d19 3.663 1.722 1.827 1.695
d20 3.672 0.729 0.604 4.652
d21 3.710 0.011 0.035 3.637
d22 3.641 4.397 0.139 0.009
d23 3.526 0.041 7.277 10.572
d24 3.580 6.275 0.797 0.461
d25 3.742 0.240 0.121 0.160
d26 3.746 0.186 0.016 0.093
d27 3.275 18.657 0.756 0.384
d28 3.621 2.640 0.813 4.760 
# Топ вкладов в первую компоненту
fviz_contrib(res.pca, choice = "var", axes = 1, top = 28,
             title = "Вклады дескрипторов в компоненту 1") +
  theme_minimal()
Рис. 2 — Вклады дескрипторов в PC1

Рис. 2 — Вклады дескрипторов в PC1 

# Топ вкладов во вторую компоненту
fviz_contrib(res.pca, choice = "var", axes = 2, top = 28,
             title = "Вклады дескрипторов в компоненту 2") +
  theme_minimal()
Рис. 3 — Вклады дескрипторов в PC2

Рис. 3 — Вклады дескрипторов в PC2

Комментарий: Вклад (contribution) показывает, какую долю дисперсии данной компоненты объясняет каждый дескриптор. Красная пунктирная линия — порог равномерного вклада (1/28 ≈ 3,57%). Дескрипторы выше этой линии вносят вклад выше среднего.

6.3. Качество представления дескрипторов (cos²)

var_cos2 <- res.pca$var$cos2

kable(round(var_cos2, 4), 
      caption = "Таблица 5 — Качество представления дескрипторов (cos²)") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE, font_size = 11) %>%
  scroll_box(width = "100%", height = "400px")
Таблица 5 — Качество представления дескрипторов (cos²)
Dim.1 Dim.2 Dim.3 Dim.4
d1 0.9920 0.0075 0.0005 0.0000
d2 0.9716 0.0243 0.0032 0.0009
d3 0.9866 0.0118 0.0009 0.0007
d4 0.9727 0.0186 0.0002 0.0086
d5 0.9876 0.0038 0.0001 0.0085
d6 0.9684 0.0113 0.0041 0.0162
d7 0.9088 0.0178 0.0724 0.0011
d8 0.7845 0.1118 0.0882 0.0155
d9 0.8295 0.0935 0.0770 0.0000
d10 0.9911 0.0002 0.0080 0.0008
d11 0.9201 0.0002 0.0790 0.0007
d12 0.9831 0.0146 0.0000 0.0023
d13 0.9971 0.0016 0.0008 0.0006
d14 0.9453 0.0542 0.0004 0.0001
d15 0.8838 0.0160 0.0002 0.1001
d16 0.9804 0.0000 0.0021 0.0174
d17 0.9750 0.0018 0.0003 0.0230
d18 0.9356 0.0395 0.0006 0.0242
d19 0.9765 0.0113 0.0070 0.0051
d20 0.9789 0.0048 0.0023 0.0139
d21 0.9889 0.0001 0.0001 0.0109
d22 0.9705 0.0289 0.0005 0.0000
d23 0.9400 0.0003 0.0280 0.0317
d24 0.9542 0.0413 0.0031 0.0014
d25 0.9975 0.0016 0.0005 0.0005
d26 0.9984 0.0012 0.0001 0.0003
d27 0.8731 0.1228 0.0029 0.0011
d28 0.9652 0.0174 0.0031 0.0143

Комментарий: Cos² показывает, насколько хорошо каждый дескриптор представлен в пространстве выбранных компонент. Значения близкие к 1 означают отличное представление.

7. Результаты по ролям (строкам / индивидам)

7.1. Координаты ролей

ind_coord <- res.pca$ind$coord

kable(round(ind_coord, 4), 
      caption = "Таблица 6 — Координаты ролей в пространстве компонент") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)
Таблица 6 — Координаты ролей в пространстве компонент
Dim.1 Dim.2 Dim.3 Dim.4
Я верующий 8.4670 0.4982 -0.5737 -0.1543
Я верю в Бога по-своему 2.9922 -0.6046 0.7637 0.6916
Не могу сказать, верю я или нет -1.9818 -1.1764 -0.1006 -0.7190
Религия меня не интересует -3.3602 1.1269 0.6625 -0.3905
Атеист -6.1172 0.1559 -0.7519 0.5722

7.2. Вклады ролей

ind_contrib <- res.pca$ind$contrib

kable(round(ind_contrib, 3), 
      caption = "Таблица 7 — Вклады ролей в компоненты (%)") %>%
  kable_styling(bootstrap_options = c("striped", "hover"), full_width = FALSE)
Таблица 7 — Вклады ролей в компоненты (%)
Dim.1 Dim.2 Dim.3 Dim.4
Я верующий 53.788 7.540 17.084 1.588
Я верю в Бога по-своему 6.718 11.106 30.270 31.906
Не могу сказать, верю я или нет 2.947 42.039 0.525 34.489
Религия меня не интересует 8.472 38.576 22.779 10.173
Атеист 28.075 0.739 29.342 21.844 
fviz_contrib(res.pca, choice = "ind", axes = 1,
             title = "Вклады ролей (позиций) в компоненту 1") +
  theme_minimal()
Рис. 4 — Вклады ролей в PC1

Рис. 4 — Вклады ролей в PC1 

fviz_contrib(res.pca, choice = "ind", axes = 2,
             title = "Вклады ролей (позиций) в компоненту 2") +
  theme_minimal()
Рис. 5 — Вклады ролей в PC2

Рис. 5 — Вклады ролей в PC2

Комментарий: Вклады ролей показывают, какие позиции по отношению к религии больше всего «определяют» каждую компоненту. Высокий вклад означает, что данная позиция сильно дифференцирована от остальных по данной компоненте.

8. Визуализации

8.1. Карта ролей (строк / индивидов)

fviz_pca_ind(res.pca, 
             col.ind = "cos2",
             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
             repel = TRUE,
             title = "Карта ролей (позиций) в пространстве PC1–PC2",
             xlab = paste0("PC1 (", round(eig[1, 2], 1), "%)"),
             ylab = paste0("PC2 (", round(eig[2, 2], 1), "%)")) +
  theme_minimal()
Рис. 6 — Карта ролей в пространстве PC1–PC2

Рис. 6 — Карта ролей в пространстве PC1–PC2

Комментарий: Карта ролей показывает расположение пяти религиозных позиций в пространстве первых двух главных компонент. Близкие позиции имеют сходный профиль оценок по дескрипторам. Цвет отражает качество представления (cos²): чем теплее цвет, тем лучше позиция представлена в данном пространстве.

8.2. Карта дескрипторов (переменных)

fviz_pca_var(res.pca,
             col.var = "contrib",
             gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
             repel = TRUE,
             title = "Карта дескрипторов в пространстве PC1–PC2",
             xlab = paste0("PC1 (", round(eig[1, 2], 1), "%)"),
             ylab = paste0("PC2 (", round(eig[2, 2], 1), "%)")) +
  theme_minimal()
Рис. 7 — Карта дескрипторов в пространстве PC1–PC2

Рис. 7 — Карта дескрипторов в пространстве PC1–PC2

Комментарий: Карта переменных показывает, как 28 дескрипторов соотносятся с главными компонентами. Длина стрелки отражает качество представления. Направление — корреляцию с компонентами. Дескрипторы, направленные в одну сторону, положительно коррелируют; в противоположную — отрицательно.

8.3. Биплот (совмещённая карта ролей и дескрипторов)

fviz_pca_biplot(res.pca,
                repel = TRUE,
                col.var = "#5C6B3C",    # дескрипторы — зелёные
                col.ind = "#CC3333",    # роли — красные
                title = "Биплот: роли × дескрипторы (PC1–PC2)",
                xlab = paste0("PC1 (", round(eig[1, 2], 1), "%)"),
                ylab = paste0("PC2 (", round(eig[2, 2], 1), "%)")) +
  theme_minimal()
Рис. 8 — Биплот: роли и дескрипторы в пространстве PC1–PC2

Рис. 8 — Биплот: роли и дескрипторы в пространстве PC1–PC2

Комментарий: Биплот совмещает карту ролей (красные точки) и карту дескрипторов (зелёные стрелки). Это позволяет интерпретировать, какие дескрипторы ассоциируются с какими позициями. Позиция, расположенная в направлении стрелки дескриптора, получает по нему более высокие оценки.

9. Интерпретация и выводы

# Сводка PCA
summary(res.pca)
## 
## Call:
## PCA(X = data_num, scale.unit = TRUE, ncp = 4, graph = FALSE) 
## 
## 
## Eigenvalues
##                        Dim.1   Dim.2   Dim.3   Dim.4
## Variance              26.656   0.658   0.385   0.300
## % of var.             95.201   2.351   1.376   1.071
## Cumulative % of var.  95.201  97.553  98.929 100.000
## 
## Individuals
##                                     Dist    Dim.1    ctr   cos2    Dim.2    ctr
## Я верующий                      |  8.502 |  8.467 53.788  0.992 |  0.498  7.540
## Я верю в Бога по-своему         |  3.222 |  2.992  6.718  0.863 | -0.605 11.106
## Не могу сказать, верю я или нет |  2.416 | -1.982  2.947  0.673 | -1.176 42.039
## Религия меня не интересует      |  3.627 | -3.360  8.472  0.858 |  1.127 38.576
## Атеист                          |  6.192 | -6.117 28.075  0.976 |  0.156  0.739
##                                   cos2    Dim.3    ctr   cos2  
## Я верующий                       0.003 | -0.574 17.084  0.005 |
## Я верю в Бога по-своему          0.035 |  0.764 30.270  0.056 |
## Не могу сказать, верю я или нет  0.237 | -0.101  0.525  0.002 |
## Религия меня не интересует       0.097 |  0.663 22.779  0.033 |
## Атеист                           0.001 | -0.752 29.342  0.015 |
## 
## Variables (the 10 first)
##                                    Dim.1    ctr   cos2    Dim.2    ctr   cos2  
## d1                              |  0.996  3.721  0.992 |  0.087  1.141  0.008 |
## d2                              |  0.986  3.645  0.972 |  0.156  3.698  0.024 |
## d3                              |  0.993  3.701  0.987 |  0.109  1.798  0.012 |
## d4                              |  0.986  3.649  0.973 |  0.136  2.823  0.019 |
## d5                              |  0.994  3.705  0.988 |  0.062  0.576  0.004 |
## d6                              |  0.984  3.633  0.968 |  0.106  1.720  0.011 |
## d7                              |  0.953  3.409  0.909 | -0.133  2.701  0.018 |
## d8                              |  0.886  2.943  0.784 |  0.334 16.981  0.112 |
## d9                              |  0.911  3.112  0.830 |  0.306 14.198  0.093 |
## d10                             |  0.996  3.718  0.991 | -0.013  0.026  0.000 |
##                                  Dim.3    ctr   cos2  
## d1                               0.022  0.126  0.000 |
## d2                               0.056  0.819  0.003 |
## d3                              -0.030  0.233  0.001 |
## d4                              -0.013  0.041  0.000 |
## d5                               0.008  0.017  0.000 |
## d6                              -0.064  1.058  0.004 |
## d7                               0.269 18.778  0.072 |
## d8                               0.297 22.880  0.088 |
## d9                              -0.277 19.978  0.077 |
## d10                             -0.089  2.066  0.008 |

Основные выводы:

  1. Первая компонента (PC1) объясняет основную долю вариации и отражает градиент религиозности: от «Я верующий» до «Атеист». Дескрипторы с наибольшими вкладами в PC1 — это шкалы, которые наиболее сильно дифференцируют верующих от неверующих.

  2. Вторая компонента (PC2) может отражать более тонкие различия, например, между позициями «Я верю в Бога по-своему» и «Не могу сказать, верю я или нет».

  3. Позиции выстраиваются в упорядоченный градиент: от «Я верующий» (крайние положительные координаты по PC1) через промежуточные позиции к «Атеист» (крайние отрицательные).

  4. Дескрипторы, которые вносят наибольший вклад в PC1, являются наиболее семантически значимыми для различения позиций по отношению к религии.

  5. Биплот позволяет определить, какие конкретные дескрипторы ассоциируются с каждой позицией, что даёт содержательную интерпретацию семантического пространства.

Анализ выполнен с использованием пакетов FactoMineR и factoextra в R.