library(tidyr)
library(haven)
library(dplyr)
## 
## Присоединяю пакет: 'dplyr'
## Следующие объекты скрыты от 'package:stats':
## 
##     filter, lag
## Следующие объекты скрыты от 'package:base':
## 
##     intersect, setdiff, setequal, union
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(knitr)
climat <- read_sav("~/files/climat.sav")
#  (1 = явление выбрано, 0 = не выбрано)
v16_binary <- climat %>% 
  select(V16_1:V16_9) %>% 
  # Заменим NA на 0 
  mutate(across(everything(), ~ ifelse(is.na(.), 0, as.numeric(.))))
str(v16_binary)
## tibble [913 × 9] (S3: tbl_df/tbl/data.frame)
##  $ V16_1: num [1:913] 1 1 0 0 1 0 1 0 1 0 ...
##  $ V16_2: num [1:913] 0 1 0 0 1 1 1 0 1 0 ...
##  $ V16_3: num [1:913] 0 0 0 0 0 0 0 1 1 0 ...
##  $ V16_4: num [1:913] 0 0 0 0 0 0 0 0 0 0 ...
##  $ V16_5: num [1:913] 0 0 0 0 0 1 0 0 0 0 ...
##  $ V16_6: num [1:913] 0 0 1 0 0 0 0 0 0 0 ...
##  $ V16_7: num [1:913] 1 1 0 0 0 1 0 1 1 0 ...
##  $ V16_8: num [1:913] 0 0 0 0 0 1 0 0 1 0 ...
##  $ V16_9: num [1:913] 0 0 1 0 1 1 0 0 1 0 ...
summary(v16_binary)
##      V16_1            V16_2            V16_3            V16_4        
##  Min.   :0.0000   Min.   :0.0000   Min.   :0.0000   Min.   :0.00000  
##  1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.00000  
##  Median :0.0000   Median :0.0000   Median :0.0000   Median :0.00000  
##  Mean   :0.3571   Mean   :0.3176   Mean   :0.4294   Mean   :0.06243  
##  3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:1.0000   3rd Qu.:0.00000  
##  Max.   :1.0000   Max.   :1.0000   Max.   :1.0000   Max.   :1.00000  
##      V16_5            V16_6             V16_7            V16_8       
##  Min.   :0.0000   Min.   :0.00000   Min.   :0.0000   Min.   :0.0000  
##  1st Qu.:0.0000   1st Qu.:0.00000   1st Qu.:0.0000   1st Qu.:0.0000  
##  Median :0.0000   Median :0.00000   Median :0.0000   Median :0.0000  
##  Mean   :0.1895   Mean   :0.08762   Mean   :0.4447   Mean   :0.2421  
##  3rd Qu.:0.0000   3rd Qu.:0.00000   3rd Qu.:1.0000   3rd Qu.:0.0000  
##  Max.   :1.0000   Max.   :1.00000   Max.   :1.0000   Max.   :1.0000  
##      V16_9       
##  Min.   :0.0000  
##  1st Qu.:0.0000  
##  Median :0.0000  
##  Mean   :0.1555  
##  3rd Qu.:0.0000  
##  Max.   :1.0000

Построим таблицу сопряженности

cooccur_matrix <- t(v16_binary) %*% as.matrix(v16_binary)
phenomena_names <- c(
  "Увеличение количества засушливых дней, без осадков",                           # V16_1
  "Увеличение периодов аномальной жары",                                          # V16_2
  "Большое количество осадков, сильных дождей",                                   # V16_3
  "Увеличение количества камнепадов и оползней в горах",                          # V16_4
  "Усилился паводок, разливы рек, затопление мест, которые раньше не затапливались", # V16_5
  "Таяние вечной мерзлоты, выход грунтовых вод на поверхность",                   # V16_6
  "Сильные ветры, штормы",                                                        # V16_7
  "Рост количества насекомых, комаров, мошки",                                    # V16_8
  "Рост количества насекомых-вредителей, угрожающих сельскохозяйственным культурам, хвойным лесам" # V16_9
)
rownames(cooccur_matrix) <- phenomena_names
colnames(cooccur_matrix) <- phenomena_names

print("Матрица сопряженности (количество респондентов, выбравших оба явления):")
## [1] "Матрица сопряженности (количество респондентов, выбравших оба явления):"
kable(cooccur_matrix, caption = "Совместная встречаемость природных явлений")
Совместная встречаемость природных явлений
Увеличение количества засушливых дней, без осадков Увеличение периодов аномальной жары Большое количество осадков, сильных дождей Увеличение количества камнепадов и оползней в горах Усилился паводок, разливы рек, затопление мест, которые раньше не затапливались Таяние вечной мерзлоты, выход грунтовых вод на поверхность Сильные ветры, штормы Рост количества насекомых, комаров, мошки Рост количества насекомых-вредителей, угрожающих сельскохозяйственным культурам, хвойным лесам
Увеличение количества засушливых дней, без осадков 326 124 81 28 74 43 158 93 52
Увеличение периодов аномальной жары 124 290 123 21 66 32 131 75 55
Большое количество осадков, сильных дождей 81 123 392 29 69 33 164 108 76
Увеличение количества камнепадов и оползней в горах 28 21 29 57 26 18 30 22 18
Усилился паводок, разливы рек, затопление мест, которые раньше не затапливались 74 66 69 26 173 43 91 66 47
Таяние вечной мерзлоты, выход грунтовых вод на поверхность 43 32 33 18 43 80 46 31 29
Сильные ветры, штормы 158 131 164 30 91 46 406 115 89
Рост количества насекомых, комаров, мошки 93 75 108 22 66 31 115 221 87
Рост количества насекомых-вредителей, угрожающих сельскохозяйственным культурам, хвойным лесам 52 55 76 18 47 29 89 87 142

Наиболее частыми явлениями по мнению респондентов являются сильные ветры/штормы (406 чел.), сильные дожди (392 чел.) и засуха (326 чел.). Наименее часто отмечаются камнепады/оползни (57 чел.) и таяние мерзлоты (80 чел.), что объясняется их локальным характером (горные и северные регионы). Сильные ветры являются центральным явлением — они наиболее тесно связаны практически со всеми другими явлениями. Особенно сильна связь ветров с осадками (164) и засухой (158), что может отражать чередование засушливых и штормовых периодов.

Проведем анализ соответствий

res.ca <- CA(cooccur_matrix, graph = FALSE)

Собственные значения:

eig.ca <- get_eigenvalue(res.ca)
print(eig.ca)
##       eigenvalue variance.percent cumulative.variance.percent
## Dim.1 0.07976848        24.202606                    24.20261
## Dim.2 0.06800812        20.634387                    44.83699
## Dim.3 0.04771191        14.476301                    59.31329
## Dim.4 0.03679538        11.164110                    70.47740
## Dim.5 0.03230097         9.800458                    80.27786
## Dim.6 0.02696953         8.182841                    88.46070
## Dim.7 0.02358095         7.154713                    95.61542
## Dim.8 0.01445099         4.384584                   100.00000

Структура взаимосвязей между природными явлениями является многомерной и достаточно сбалансированной. Первая ось объясняет 24,2% дисперсии, а вторая — 20,6%, что свидетельствует о почти равной значимости этих двух измерений для дифференциации явлений. Совместно первые две оси аккумулируют 44,8% общей инерции, что является приемлемым результатом для анализа множественных ответов. Добавление третьей оси повышает кумулятивный процент до 59,3%, однако, учитывая, что каждая последующая ось вносит всё меньший вклад (Dim.4 — 11,2%, Dim.5 — 9,8%), для содержательной интерпретации целесообразно ограничиться первыми двумя-тремя осями.

Построим график собственных значений

fviz_eig(res.ca, addlabels = TRUE, 
         title = "Собственные значения анализа соответствий (CA)")

Отразим также карту взаимосвязей явлений

fviz_ca_biplot(res.ca, 
               repel = TRUE,
               title = "Анализ соответствий: группировка природных явлений",
               xlab = "Ось 1", ylab = "Ось 2",
               labelsize = 3)

Результаты показали, что наиболее распространенными явлениями являются сильные ветры и штормы (406 респондентов), сильные дожди (392) и засуха (326). Выявлены устойчивые кластеры взаимосвязанных явлений: «сухой синдром» (засуха, аномальная жара, насекомые-вредители) и «влажный синдром» (сильные дожди, паводки, комары). Первые две оси CA объясняют 44,8% дисперсии, а три оси — 59,3%, что свидетельствует о приемлемом качестве модели. Таким образом, анализ соответствий на матрице сопряженности позволил корректно выявить структуру взаимосвязей между климатическими явлениями и может быть рекомендован для анализа подобных вопросов с множественным выбором.