Самостоятельная работа №10. Метод главных компонент и анализ соответствий
Мозер К.О.
2025-03-29
Задания 1-3
Подготовка данных
library("factoextra")## Загрузка требуемого пакета: ggplot2## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBalibrary("FactoMineR")
library(haven)
df<-read_sav("C:/Users/Admin/Documents/religions.sav")Подготовка данных для PCA Выбираем только числовые переменные (PCA работает только с количественными данными)
numeric_vars <- df[, sapply(df, is.numeric)]Выполнение PCA
res.pca <- PCA(numeric_vars, graph = FALSE)## Warning in PCA(numeric_vars, 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)
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.262803e-29 2.951001e-28 100.00000График собственных значений
fviz_eig(res.pca, addlabels = TRUE, ylim = c(0, 50))
Результаты по переменным (дескрипторам)
var <- get_pca_var(res.pca)Представим результаты: Координаты
head(var$coord)## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## d1 0.9959931 0.08667675 0.02201425 0.0005284871 2.842586e-15
## d2 0.9856867 0.15604215 0.05619045 -0.0302516782 -3.824405e-15
## d3 0.9932608 0.10879264 -0.02997603 -0.0264323415 -7.493470e-16
## d4 0.9862426 0.13633891 -0.01250799 -0.0926322853 5.205856e-16
## d5 0.9937955 0.06158202 0.00799803 -0.0922719871 6.275713e-16
## d6 0.9840930 0.10641774 -0.06384742 -0.1271205906 -2.020674e-15Cos2: качество анализа
head(var$cos2)## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## d1 0.9920022 0.007512859 4.846272e-04 2.792986e-07 8.080296e-30
## d2 0.9715783 0.024349153 3.157367e-03 9.151640e-04 1.462607e-29
## d3 0.9865669 0.011835838 8.985623e-04 6.986687e-04 5.615209e-31
## d4 0.9726745 0.018588299 1.564499e-04 8.580740e-03 2.710094e-31
## d5 0.9876296 0.003792345 6.396848e-05 8.514120e-03 3.938457e-31
## d6 0.9684391 0.011324735 4.076494e-03 1.615964e-02 4.083122e-30Вклады в компоненты
head(var$contrib)## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## d1 3.721439 1.141080 0.12575590 9.315629e-05 9.7791213
## d2 3.644820 3.698237 0.81930512 3.052406e-01 17.7011016
## d3 3.701049 1.797670 0.23316792 2.330315e-01 0.6795767
## d4 3.648933 2.823258 0.04059719 2.861990e+00 0.3279872
## d5 3.705036 0.575995 0.01659918 2.839770e+00 0.4766490
## d6 3.633044 1.720042 1.05780922 5.389832e+00 4.9415703Координаты переменных
head(var$coord, 4)## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## d1 0.9959931 0.08667675 0.02201425 0.0005284871 2.842586e-15
## d2 0.9856867 0.15604215 0.05619045 -0.0302516782 -3.824405e-15
## d3 0.9932608 0.10879264 -0.02997603 -0.0264323415 -7.493470e-16
## d4 0.9862426 0.13633891 -0.01250799 -0.0926322853 5.205856e-16fviz_pca_var(res.pca, col.var = "black")
Качество представленности переменных
head(var$cos2, 4)## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## d1 0.9920022 0.007512859 0.0004846272 2.792986e-07 8.080296e-30
## d2 0.9715783 0.024349153 0.0031573671 9.151640e-04 1.462607e-29
## d3 0.9865669 0.011835838 0.0008985623 6.986687e-04 5.615209e-31
## d4 0.9726745 0.018588299 0.0001564499 8.580740e-03 2.710094e-31library("corrplot")## corrplot 0.95 loadedcorrplot(var$cos2, is.corr=FALSE)
fviz_cos2(res.pca, choice = "var", axes = 1:2)
fviz_pca_var(res.pca, col.var = "cos2",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE # Avoid text overlapping
)
Вклады переменных в компоненты
head(var$contrib, 4)## Dim.1 Dim.2 Dim.3 Dim.4 Dim.5
## d1 3.721439 1.141080 0.12575590 9.315629e-05 9.7791213
## d2 3.644820 3.698237 0.81930512 3.052406e-01 17.7011016
## d3 3.701049 1.797670 0.23316792 2.330315e-01 0.6795767
## d4 3.648933 2.823258 0.04059719 2.861990e+00 0.3279872library("corrplot")
corrplot(var$contrib, is.corr=FALSE)
Вклад переменных в PC1
fviz_contrib(res.pca, choice = "var", axes = 1, top = 10)
Вклад переменных в PC2
fviz_contrib(res.pca, choice = "var", axes = 2, top = 10)
Общий вклад переменных в обе компоненты:
fviz_contrib(res.pca, choice = "var", axes = 1:2, top = 10)
Вклад переменных может быть визуализирован следующим образом:
fviz_pca_var(res.pca, col.var = "contrib",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07")
)
Биплот
fviz_pca_biplot(res.pca,
col.ind = "#696969",
col.var = "contrib",
gradient.cols = c("#00AFBB", "#E7B800", "#FC4E07"),
repel = TRUE,
title = "Биплот PCA (наблюдения и переменные)"
)
Задание 4
library(haven)
library(dplyr)##
## Присоединяю пакет: 'dplyr'## Следующие объекты скрыты от 'package:stats':
##
## filter, lag## Следующие объекты скрыты от 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(questionr)
df<-read_sav("База_КлимРиск_2023.sav")
V16<-df %>%
select(contains("V16"))
table_V16_region<-cross.multi.table(V16, df$Region, true.codes=list("да"), freq=FALSE)
table_V16_region<-table_V16_region[1:9, 1:3]
colnames(table_V16_region)<-c("АК", "РА", "РТ")
rownames(table_V16_region)<-c("Засуха", "Жара", "Ливни", "Оползни", "Паводки", "Таяние", "Ветры", "Комары", "Вредители")
res.ca <- CA(table_V16_region, graph = FALSE)
get_eigenvalue(res.ca)## eigenvalue variance.percent cumulative.variance.percent
## Dim.1 0.07085082 84.15681 84.15681
## Dim.2 0.01333823 15.84319 100.00000Данные описываются всего двумя измерениями, первое из которых описывает 84,2% дисперсии, второе - 15,8%.
row <- get_ca_row(res.ca)
row## Correspondence Analysis - Results for rows
## ===================================================
## Name Description
## 1 "$coord" "Coordinates for the rows"
## 2 "$cos2" "Cos2 for the rows"
## 3 "$contrib" "contributions of the rows"
## 4 "$inertia" "Inertia of the rows"row$cos2## Dim 1 Dim 2
## Засуха 0.9923788 0.007621233
## Жара 0.9490015 0.050998504
## Ливни 0.9401817 0.059818305
## Оползни 0.7425789 0.257421102
## Паводки 0.9832683 0.016731714
## Таяние 0.7042489 0.295751054
## Ветры 0.6654422 0.334557785
## Комары 0.5775468 0.422453231
## Вредители 0.6973866 0.302613434row$contrib## Dim 1 Dim 2
## Засуха 6.717048 0.274014
## Жара 8.195487 2.339439
## Ливни 30.983030 10.471110
## Оползни 9.646569 17.763189
## Паводки 17.104878 1.546090
## Таяние 11.995053 26.757701
## Ветры 7.084298 18.919261
## Комары 1.808883 7.028272
## Вредители 6.464754 14.900922fviz_ca_biplot(res.ca, repel = TRUE)
Корреспондентный анализ выявил, что первое измерение (Dim 1), объясняющее наибольшую долю дисперсии, тесно связано с такими климатическими рисками, как засуха, жара, ливни и паводки (cos² > 0.94), что указывает на их повсеместную значимость во всех регионах. Второе измерение (Dim 2) отражает более специфичные риски: ветры, комары и таяние мерзлоты (cos² Dim 2 от 0.30 до 0.42).