library(haven)
library(FactoMineR)
## Warning: пакет 'FactoMineR' был собран под R версии 4.5.3
library(factoextra)
## Warning: пакет 'factoextra' был собран под R версии 4.5.3
## Загрузка требуемого пакета: ggplot2
## Welcome to factoextra!
## Want to learn more? See two factoextra-related books at https://www.datanovia.com/en/product/practical-guide-to-principal-component-methods-in-r/
library(dplyr)
## 
## Присоединяю пакет: 'dplyr'
## Следующие объекты скрыты от 'package:stats':
## 
##     filter, lag
## Следующие объекты скрыты от 'package:base':
## 
##     intersect, setdiff, setequal, union
data <- as.data.frame(read_sav("~/files/religions.sav"))

Подготовка матрицы для анализа

df_pca <- data %>% 
  dplyr::select(starts_with("d"))

Проверяем результат

head(df_pca) 
##         d1       d2       d3       d4       d5       d6       d7       d8
## 1 4.142857 4.166667 4.149171 4.131868 4.032967 3.988889 3.677596 3.664835
## 2 3.950000 3.960894 3.837989 3.770950 3.772222 3.657303 3.653631 3.620112
## 3 3.769663 3.776536 3.617978 3.567416 3.612360 3.525140 3.564972 3.474860
## 4 3.770950 3.816667 3.615819 3.581006 3.584270 3.500000 3.539326 3.566667
## 5 3.653631 3.661111 3.463687 3.368715 3.422222 3.340782 3.458101 3.460674
## 6       NA       NA       NA       NA       NA       NA       NA       NA
##         d9      d10      d11      d12      d13      d14      d15      d16
## 1 3.884615 3.840659 3.883333 4.120219 3.923077 3.662983 3.679558 3.967213
## 2 3.608939 3.407821 3.569832 3.816667 3.741573 3.573034 3.653631 3.811111
## 3 3.511236 3.151685 3.483146 3.584270 3.581006 3.471910 3.539326 3.525140
## 4 3.550562 3.005682 3.357542 3.383333 3.558659 3.353933 3.508380 3.494444
## 5 3.519553 2.882682 3.376404 3.238889 3.444444 3.314607 3.525140 3.411111
## 6       NA       NA       NA       NA       NA       NA       NA       NA
##        d17      d18      d19      d20      d21      d22      d23      d24
## 1 3.961538 3.945055 3.868132 3.708791 4.054945 3.681319 3.956044 4.005495
## 2 3.821229 3.810056 3.589888 3.578652 3.759777 3.383333 3.821229 3.793296
## 3 3.612360 3.606742 3.320225 3.497175 3.585227 3.101124 3.719101 3.651685
## 4 3.601124 3.664804 3.141243 3.488764 3.513966 2.832402 3.688889 3.441341
## 5 3.558659 3.592179 3.117318 3.389831 3.329609 2.741573 3.514124 3.392045
## 6       NA       NA       NA       NA       NA       NA       NA       NA
##        d25      d26      d27      d28
## 1 4.005525 3.725275 3.950276 3.983516
## 2 3.737430 3.605556 3.882682 3.837079
## 3 3.528090 3.508380 3.786517 3.638418
## 4 3.424581 3.488889 3.606742 3.522222
## 5 3.307263 3.427778 3.567416 3.516854
## 6       NA       NA       NA       NA
dim(df_pca)  
## [1]  6 28

Проверка на наличие пропущенных значений (NA)

sum(is.na(df_pca))
## [1] 28

Пропущенные значения отсутсвуют, проведем анализ главных компонент (РСА)

res.pca <- PCA(df_pca, scale.unit = TRUE, ncp = 10, graph = FALSE)
## Warning in PCA(df_pca, scale.unit = TRUE, ncp = 10, graph = FALSE): Missing
## values are imputed by the mean of the variable: you should use the imputePCA
## function of the missMDA package

Оценим, сколько информации сохраняют извлеченные компоненты.

eig.val <- get_eigenvalue(res.pca)
print(eig.val)
##         eigenvalue variance.percent cumulative.variance.percent
## Dim.1 2.665641e+01     9.520147e+01                    95.20147
## Dim.2 6.583989e-01     2.351425e+00                    97.55290
## Dim.3 3.853713e-01     1.376326e+00                    98.92922
## Dim.4 2.998172e-01     1.070776e+00                   100.00000
## Dim.5 8.091662e-29     2.889879e-28                   100.00000
fviz_eig(res.pca)

На основе графика собственных значений и таблицы мы определяем, сколько компонент объясняют достаточную долю дисперсии.

Посмотрим, как дескрипторы (переменные) коррелируют с главными компонентами.

var <- get_pca_var(res.pca)
print(var$coord) 
##         Dim.1        Dim.2        Dim.3         Dim.4         Dim.5
## d1  0.9959931  0.086676747  0.022014250  0.0005284871  2.615128e-15
## d2  0.9856867  0.156042152  0.056190454 -0.0302516782 -3.766686e-15
## d3  0.9932608  0.108792638 -0.029976029 -0.0264323415 -6.983863e-16
## d4  0.9862426  0.136338912 -0.012507994 -0.0926322853  4.934473e-16
## d5  0.9937955  0.061582017  0.007998030 -0.0922719871  6.349557e-16
## d6  0.9840930  0.106417740 -0.063847424 -0.1271205906 -2.008757e-15
## d7  0.9532898 -0.133349926  0.269007837 -0.0330319222 -1.479596e-16
## d8  0.8857152  0.334373270  0.296941643  0.1246142023  2.748424e-15
## d9  0.9107824  0.305748461 -0.277471819 -0.0016499190 -2.652933e-16
## d10 0.9955315 -0.013122623 -0.089222144 -0.0280030765  2.607445e-16
## d11 0.9592306 -0.014509065 -0.281009138 -0.0264572369  1.909078e-15
## d12 0.9914928 -0.120963225 -0.003532183 -0.0479326216  2.874294e-16
## d13 0.9985266  0.039805702  0.027591837 -0.0244689026  1.977912e-16
## d14 0.9722735 -0.232866859  0.019040570 -0.0097353603  3.327374e-16
## d15 0.9400943 -0.126354293 -0.013616083  0.3163413355 -4.352800e-15
## d16 0.9901692 -0.005878897  0.046011604  0.1319596052 -8.444189e-16
## d17 0.9874091  0.042391609 -0.016410085  0.1515152649  1.614389e-15
## d18 0.9672797  0.198851589  0.025292479  0.1555260238  7.383217e-16
## d19 0.9882010 -0.106468618 -0.083917401  0.0712820534 -4.166932e-16
## d20 0.9894043  0.069302866  0.048254386 -0.1181008259 -2.916213e-15
## d21 0.9944304  0.008346577  0.011549202 -0.1044272837 -1.009493e-15
## d22 0.9851345 -0.170141518 -0.023150224  0.0050979946 -5.205996e-16
## d23 0.9695310 -0.016339434  0.167466767 -0.1780380384  1.623385e-16
## d24 0.9768466 -0.203266697 -0.055406567 -0.0371945930  1.776867e-15
## d25 0.9987365 -0.039714963 -0.021629515 -0.0219147891  1.091463e-15
## d26 0.9992180  0.034962278 -0.007842625 -0.0167184249 -5.127242e-16
## d27 0.9343990 -0.350479363  0.053970491 -0.0339103916  3.826844e-16
## d28 0.9824528 -0.131850605 -0.055965050  0.1194564853  2.359155e-15
print(var$contrib) 
##        Dim.1        Dim.2       Dim.3        Dim.4       Dim.5
## d1  3.721439  1.141080086  0.12575590 9.315629e-05  8.45178305
## d2  3.644820  3.698237318  0.81930512 3.052406e-01 17.53400946
## d3  3.701049  1.797669849  0.23316792 2.330315e-01  0.60277287
## d4  3.648933  2.823257983  0.04059719 2.861990e+00  0.30091504
## d5  3.705036  0.575995024  0.01659918 2.839770e+00  0.49825216
## d6  3.633044  1.720041704  1.05780922 5.389832e+00  4.98674242
## d7  3.409166  2.700825169 18.77804834 3.639243e-01  0.02705505
## d8  2.942975 16.981420654 22.88035737 5.179388e+00  9.33533460
## d9  3.111914 14.198402259 19.97829182 9.079640e-04  0.08697910
## d10 3.717991  0.026154850  2.06569356 2.615501e-01  0.08402190
## d11 3.451790  0.031973468 20.49092078 2.334707e-01  4.50411529
## d12 3.687885  2.222376455  0.00323748 7.663123e-01  0.10209975
## d13 3.740396  0.240658652  0.19755218 1.996974e-01  0.04834773
## d14 3.546298  8.236188650  0.09407635 3.161167e-02  0.13682499
## d15 3.315440  2.424883741  0.04810885 3.337761e+01 23.41529956
## d16 3.678046  0.005249314  0.54935785 5.807984e+00  0.88120747
## d17 3.657569  0.272942222  0.06987829 7.656957e+00  3.22090902
## d18 3.509962  6.005774845  0.16599820 8.067696e+00  0.67367985
## d19 3.663438  1.721686809  1.82736220 1.694743e+00  0.21458288
## d20 3.672365  0.729479853  0.60421873 4.652102e+00 10.50995220
## d21 3.709771  0.010581024  0.03461183 3.637235e+00  1.25941603
## d22 3.640737  4.396747444  0.13906921 8.668464e-03  0.33494226
## d23 3.526320  0.040549447  7.27742707 1.057229e+01  0.03256909
## d24 3.579736  6.275428347  0.79660509 4.614270e-01  3.90186578
## d25 3.741969  0.239562719  0.12139874 1.601836e-01  1.47224625
## d26 3.745578  0.185656584  0.01596039 9.322537e-02  0.32488519
## d27 3.275390 18.656742439  0.75584601 3.835385e-01  0.18098548
## d28 3.620943  2.640433088  0.81274514 4.759517e+00  6.87820552
fviz_pca_var(res.pca, repel = TRUE)

График fviz_pca_var показывает, какие дескрипторы группируются вместе. Дескрипторы, находящиеся близко друг к другу, имеют схожий смысл и формируют латентный конструкт.

Проанализируем, как позиции («Я верующий», «Атеист» и т.д.) располагаются в пространстве главных компонент.

ind <- get_pca_ind(res.pca)
print(ind$coord) 
##           Dim.1         Dim.2         Dim.3         Dim.4         Dim.5
## 1  9.275148e+00  5.457616e-01 -6.285093e-01 -1.689929e-01 -8.880235e-15
## 2  3.277801e+00 -6.623591e-01  8.366121e-01  7.576044e-01 -8.880235e-15
## 3 -2.170984e+00 -1.288688e+00 -1.101512e-01 -7.876708e-01 -8.880235e-15
## 4 -3.680956e+00  1.234473e+00  7.257350e-01 -4.277951e-01 -8.880235e-15
## 5 -6.701009e+00  1.708133e-01 -8.236866e-01  6.268545e-01 -8.880235e-15
## 6  5.554941e-15 -2.405173e-15 -6.181589e-15  1.119584e-15 -9.550228e-15
fviz_pca_ind(res.pca, repel = TRUE)

На этом графике мы увидим, какие позиции близки друг к другу. «Я верующий» и «Я верю в Бога по-своему» находятся рядом, это значит, что респонденты оценивают их через схожий набор дескрипторов.

fviz_pca_biplot(res.pca, repel = TRUE)

Биплот позволяет увидеть всю картину целиком. Мы можем проследить, какие дескрипторы характерны для конкретных позиций. Стрелки дескрипторов, направленные к точке «Я верующий», описывают психологический портрет этой роли.