#1 Провести комплексную проверку на нормальность переменной Sepal.Length из набора `iris.

data (iris)
library(ggplot2)
## Warning: пакет 'ggplot2' был собран под R версии 4.5.3
ggplot(data = iris, aes(x = Sepal.Length)) + 
  geom_density(fill="lightblue")+
  ggtitle("Плотность распределения Sepal.Length") +
  theme_bw()

Распределение одномодальное, близкое к симметричному.

library(DescTools)
## Warning: пакет 'DescTools' был собран под R версии 4.5.3
Desc(iris$Sepal.Length, plotit = TRUE)
## ────────────────────────────────────────────────────────────────────────────── 
## iris$Sepal.Length (numeric)
## 
##   length       n    NAs  unique     0s   mean  meanCI'
##      150     150      0      35      0  5.843   5.710
##           100.0%   0.0%           0.0%          5.977
##                                                      
##      .05     .10    .25  median    .75    .90     .95
##    4.600   4.800  5.100   5.800  6.400  6.900   7.255
##                                                      
##    range      sd  vcoef     mad    IQR   skew    kurt
##    3.600   0.828  0.142   1.038  1.300  0.309  -0.606
##                                                      
## lowest : 4.3, 4.4 (3), 4.5, 4.6 (4), 4.7 (2)
## highest: 7.3, 7.4, 7.6, 7.7 (4), 7.9
## 
## ' 95%-CI (classic)

Отклонения по асимметрии и эксцессу статистически незначимы, выбросы отсутствуют.

Отдельно можно посчитать показатели асимметрии и эксцесса вместе с доверительными интервалами.

Skew(iris$Sepal.Length, na.rm=TRUE, conf.level = 0.95, ci.type = "classic")
##   skewness     lwr.ci     upr.ci 
##  0.3086407 -0.3804196  0.3804196
Kurt(iris$Sepal.Length, na.rm=TRUE, method=2, conf.level = 0.95, ci.type = "classic")
##   kurtosis     lwr.ci     upr.ci 
## -0.5520640 -0.7714087  0.7714087

Тест Шапиро-Уилка

shapiro.test(iris$Sepal.Length)
## 
##  Shapiro-Wilk normality test
## 
## data:  iris$Sepal.Length
## W = 0.97609, p-value = 0.01018

Тест Колмогорова-Смирнова

nortest::lillie.test(iris$Sepal.Length)
## 
##  Lilliefors (Kolmogorov-Smirnov) normality test
## 
## data:  iris$Sepal.Length
## D = 0.088654, p-value = 0.005788
plot(ecdf(scale(iris$Sepal.Length)), col="red", main="Эмпирическая и теоретическая кумулятивные функции")
curve(pnorm, from = -10, to = 10, add = TRUE, col="blue")

Тест Андерсона-Дарлинга

nortest::ad.test(iris$Sepal.Length)
## 
##  Anderson-Darling normality test
## 
## data:  iris$Sepal.Length
## A = 0.8892, p-value = 0.02251

Тест Крамера-фон-Мизеса

nortest::cvm.test(iris$Sepal.Length)
## 
##  Cramer-von Mises normality test
## 
## data:  iris$Sepal.Length
## W = 0.1274, p-value = 0.04706

#2 Провести одномерный анализ по переменным V12, V13, V15. Сделать двумерный анализ по региону и возрасту.

library(haven)
## Warning: пакет 'haven' был собран под R версии 4.5.3
df<-read_sav("База_КлимРиск_2023.sav")
df <- haven::as_factor(df)

Одномерный анализ переменных V12, V13, V15

prop.table(table(df$V12))*100
## 
##                 Выше                 Ниже        Не изменилась 
##            21.134594            48.609566            21.023359 
##               Другое Затрудняюсь ответить 
##             2.113459             7.119021
prop.table(table(df$V13))*100
## 
## Стала холоднее   Стала теплее  Не изменилась 
##       64.60674       16.74157       18.65169
prop.table(table(df$V15))*100
## 
## Стала холоднее   Стала теплее  Не изменилась 
##       65.62150       17.13326       17.24524

Почти половина респондентов отмечают снижение среднегодовой темпереатуры. Большинство опрошенных считают, что зимняя температура стала ниже. Большинство опрошенных считают, что летняя температура стала ниже.

Двумерный анализ по региону и возрасту.

prop.table(table(df$Region, df$age_cats3, df$V12), margin = 2)*100
## , ,  = Выше
## 
##                   
##                     До 30 лет  31-49 лет 50 лет и старше
##   Алтайский край    5.1282051  7.1428571       8.7542088
##   Республика Алтай 10.8974359  9.0476190      11.4478114
##   Республика Тыва   5.7692308  4.0476190       1.6835017
##   Монголия          0.0000000  0.0000000       0.0000000
## 
## , ,  = Ниже
## 
##                   
##                     До 30 лет  31-49 лет 50 лет и старше
##   Алтайский край    7.6923077  8.5714286      14.1414141
##   Республика Алтай 23.7179487 30.2380952      27.9461279
##   Республика Тыва  12.8205128 10.9523810       7.7441077
##   Монголия          0.0000000  0.0000000       0.0000000
## 
## , ,  = Не изменилась
## 
##                   
##                     До 30 лет  31-49 лет 50 лет и старше
##   Алтайский край    6.4102564  7.6190476       9.4276094
##   Республика Алтай 10.8974359  8.3333333       6.7340067
##   Республика Тыва   9.6153846  4.2857143       3.0303030
##   Монголия          0.0000000  0.0000000       0.0000000
## 
## , ,  = Другое
## 
##                   
##                     До 30 лет  31-49 лет 50 лет и старше
##   Алтайский край    0.0000000  0.0000000       0.3367003
##   Республика Алтай  0.6410256  1.9047619       1.3468013
##   Республика Тыва   0.0000000  0.9523810       0.3367003
##   Монголия          0.0000000  0.0000000       0.0000000
## 
## , ,  = Затрудняюсь ответить
## 
##                   
##                     До 30 лет  31-49 лет 50 лет и старше
##   Алтайский край    1.2820513  3.5714286       4.3771044
##   Республика Алтай  1.2820513  1.4285714       2.0202020
##   Республика Тыва   3.8461538  1.9047619       0.6734007
##   Монголия          0.0000000  0.0000000       0.0000000
prop.table(table(df$Region, df$age_cats3, df$V13), margin = 2)*100
## , ,  = Стала холоднее
## 
##                   
##                     До 30 лет  31-49 лет 50 лет и старше
##   Алтайский край    9.8684211  8.6330935      16.5540541
##   Республика Алтай 34.8684211 38.1294964      37.1621622
##   Республика Тыва  17.7631579 18.2254197      11.4864865
##   Монголия          0.0000000  0.0000000       0.0000000
## 
## , ,  = Стала теплее
## 
##                   
##                     До 30 лет  31-49 лет 50 лет и старше
##   Алтайский край    5.2631579 10.3117506      10.8108108
##   Республика Алтай  3.2894737  4.7961631       7.4324324
##   Республика Тыва   6.5789474  0.9592326       1.3513514
##   Монголия          0.0000000  0.0000000       0.0000000
## 
## , ,  = Не изменилась
## 
##                   
##                     До 30 лет  31-49 лет 50 лет и старше
##   Алтайский край    6.5789474  8.1534772       9.7972973
##   Республика Алтай  7.8947368  7.6738609       4.3918919
##   Республика Тыва   7.8947368  3.1175060       1.0135135
##   Монголия          0.0000000  0.0000000       0.0000000
prop.table(table(df$Region, df$age_cats3, df$V15), margin = 2)*100
## , ,  = Стала холоднее
## 
##                   
##                     До 30 лет  31-49 лет 50 лет и старше
##   Алтайский край    9.0322581 14.3540670      19.6610169
##   Республика Алтай 25.8064516 38.0382775      35.2542373
##   Республика Тыва  19.3548387 18.4210526      10.5084746
##   Монголия          0.0000000  0.0000000       0.0000000
## 
## , ,  = Стала теплее
## 
##                   
##                     До 30 лет  31-49 лет 50 лет и старше
##   Алтайский край    6.4516129  6.2200957       5.0847458
##   Республика Алтай 14.8387097  6.6985646       7.7966102
##   Республика Тыва   7.7419355  1.4354067       0.6779661
##   Монголия          0.0000000  0.0000000       0.0000000
## 
## , ,  = Не изменилась
## 
##                   
##                     До 30 лет  31-49 лет 50 лет и старше
##   Алтайский край    5.8064516  6.4593301      12.5423729
##   Республика Алтай  5.8064516  5.9808612       5.7627119
##   Республика Тыва   5.1612903  2.3923445       2.7118644
##   Монголия          0.0000000  0.0000000       0.0000000

#3. Проанализировать переменные с множественным выбором V14 и V16, также сделать двумерный анализ по региону. По всем видам анализа сделать таблицы и графики.

объединим все подвопросы вопроса V14 в один набор и сохраним его под отдельным именем - V14.

library(tidyverse)
## Warning: пакет 'tidyverse' был собран под R версии 4.5.3
## Warning: пакет 'tidyr' был собран под R версии 4.5.3
## Warning: пакет 'readr' был собран под R версии 4.5.3
## Warning: пакет 'purrr' был собран под R версии 4.5.3
## Warning: пакет 'stringr' был собран под R версии 4.5.3
## Warning: пакет 'forcats' был собран под R версии 4.5.3
## Warning: пакет 'lubridate' был собран под R версии 4.5.3
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr     1.1.4     ✔ readr     2.2.0
## ✔ forcats   1.0.1     ✔ stringr   1.6.0
## ✔ lubridate 1.9.5     ✔ tibble    3.3.1
## ✔ purrr     1.2.1     ✔ tidyr     1.3.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag()    masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(magrittr)
## 
## Присоединяю пакет: 'magrittr'
## 
## Следующий объект скрыт от 'package:purrr':
## 
##     set_names
## 
## Следующий объект скрыт от 'package:tidyr':
## 
##     extract
library(questionr)
## Warning: пакет 'questionr' был собран под R версии 4.5.3
V14<-df %>% 
  select(contains("V14")) %>% 
  select_if(is.factor)

создадим таблицу и сохраним ее в качестве отдельного датафрейма.

V14tab<-V14 %>% 
multi.table(true.codes=list("да"), freq=TRUE) %>% 
    as.data.frame() %>% 
  rename(Pct=`%multi`) %>% 
  arrange(desc(Pct))
V14tab
##          n  Pct
## V14_2  436 47.8
## V14_1  428 46.9
## V14_10 381 41.7
## V14_5  310 34.0
## V14_4  266 29.1
## V14_7  211 23.1
## V14_3  102 11.2
## V14_8   64  7.0
## V14_6   58  6.4
## V14_9   42  4.6
## V14_88  23  2.5

Извлечем метки вопросов по блоку V14

library(sjlabelled)
## Warning: пакет 'sjlabelled' был собран под R версии 4.5.3
## 
## Присоединяю пакет: 'sjlabelled'
## Следующий объект скрыт от 'package:forcats':
## 
##     as_factor
## Следующий объект скрыт от 'package:dplyr':
## 
##     as_label
## Следующие объекты скрыты от 'package:haven':
## 
##     as_factor, read_sas, read_spss, read_stata, write_sas, zap_labels
## Следующий объект скрыт от 'package:ggplot2':
## 
##     as_label
V14labs<-df %>% 
select(contains("V14")) %>% 
  select_if(is.factor) %>% 
  get_label()
V14labs
##                                                        V14_1 
## "Резкие перепады температуры (от холода к теплу и наоборот)" 
##                                                        V14_2 
##    "Затяжные морозы, увеличение периодов аномального холода" 
##                                                        V14_3 
##                                            "Частые оттепели" 
##                                                        V14_4 
##                             "Увеличение гололеда на дорогах" 
##                                                        V14_5 
##            "Обильные снегопады, увеличение снежного покрова" 
##                                                        V14_6 
##                                         "Сход снежных лавин" 
##                                                        V14_7 
##      "Увеличение количества пасмурных дней, нехватка солнца" 
##                                                        V14_8 
##     "Раннее таяние и более позднее образование речного льда" 
##                                                        V14_9 
##                 "Участились ледовые зажоры, наледи на реках" 
##                                                       V14_10 
##                   "Усилились ветра, метели и снежные наносы" 
##                                                       V14_88 
##                                                     "Другое"

Присвоим имена в переменную n

V14tab$n<-V14labs
V14tab
##                                                                 n  Pct
## V14_2  Резкие перепады температуры (от холода к теплу и наоборот) 47.8
## V14_1     Затяжные морозы, увеличение периодов аномального холода 46.9
## V14_10                                            Частые оттепели 41.7
## V14_5                              Увеличение гололеда на дорогах 34.0
## V14_4             Обильные снегопады, увеличение снежного покрова 29.1
## V14_7                                          Сход снежных лавин 23.1
## V14_3       Увеличение количества пасмурных дней, нехватка солнца 11.2
## V14_8      Раннее таяние и более позднее образование речного льда  7.0
## V14_6                  Участились ледовые зажоры, наледи на реках  6.4
## V14_9                    Усилились ветра, метели и снежные наносы  4.6
## V14_88                                                     Другое  2.5

объединим все подвопросы вопроса V16 в один набор и сохраним его под отдельным именем - V16.

library(tidyverse)
library(magrittr)
library(questionr)
V16<-df %>% 
  select(contains("V16")) %>% 
  select_if(is.factor)

создадим таблицу и сохраним ее в качестве отдельного датафрейма.

V16tab<-V16 %>% 
multi.table(true.codes=list("да"), freq=TRUE) %>% 
    as.data.frame() %>% 
  rename(Pct=`%multi`) %>% 
  arrange(desc(Pct))
V16tab
##          n  Pct
## V16_7  406 44.5
## V16_3  392 42.9
## V16_1  326 35.7
## V16_2  290 31.8
## V16_8  221 24.2
## V16_5  173 18.9
## V16_9  142 15.6
## V16_6   80  8.8
## V16_4   57  6.2
## V16_88  34  3.7

Извлечем метки вопросов по блоку V16

library(sjlabelled)
V16labs<-df %>% 
select(contains("V16")) %>% 
  select_if(is.factor) %>% 
  get_label()
V16labs
##                                                                                            V16_1 
##                                             "Увеличение количества засушливых дней, без осадков" 
##                                                                                            V16_2 
##                                                            "Увеличение периодов аномальной жары" 
##                                                                                            V16_3 
##                                                     "Большое количество осадков, сильных дождей" 
##                                                                                            V16_4 
##                                            "Увеличение количества камнепадов и оползней в горах" 
##                                                                                            V16_5 
##                "Усилился паводок, разливы рек, затопление мест, которые раньше не затапливались" 
##                                                                                            V16_6 
##                                     "Таяние вечной мерзлоты, выход грунтовых вод на поверхность" 
##                                                                                            V16_7 
##                                                                          "Сильные ветры, штормы" 
##                                                                                            V16_8 
##                                                      "Рост количества насекомых, комаров, мошки" 
##                                                                                            V16_9 
## "Рост количества насекомых-вредителей, угрожающих сельскохозяйственным культурам, хвойным лесам" 
##                                                                                           V16_88 
##                                                                                         "Другое"

Присвоим имена в переменную n

V16tab$n<-V16labs
V16tab
##                                                                                                     n
## V16_7                                              Увеличение количества засушливых дней, без осадков
## V16_3                                                             Увеличение периодов аномальной жары
## V16_1                                                      Большое количество осадков, сильных дождей
## V16_2                                             Увеличение количества камнепадов и оползней в горах
## V16_8                 Усилился паводок, разливы рек, затопление мест, которые раньше не затапливались
## V16_5                                      Таяние вечной мерзлоты, выход грунтовых вод на поверхность
## V16_9                                                                           Сильные ветры, штормы
## V16_6                                                       Рост количества насекомых, комаров, мошки
## V16_4  Рост количества насекомых-вредителей, угрожающих сельскохозяйственным культурам, хвойным лесам
## V16_88                                                                                         Другое
##         Pct
## V16_7  44.5
## V16_3  42.9
## V16_1  35.7
## V16_2  31.8
## V16_8  24.2
## V16_5  18.9
## V16_9  15.6
## V16_6   8.8
## V16_4   6.2
## V16_88  3.7

Таблица сопряженности v14

V14Regiontab<-cross.multi.table(V14, df$Region, true.codes=list("да"), freq=TRUE)
V14Regiontab<-as_tibble(V14Regiontab)
V14Regiontab$n<-V14labs
V14Regiontab<-V14Regiontab %>% 
  relocate(n)
V14Regiontab
## # A tibble: 11 × 5
##    n              `Алтайский край` `Республика Алтай` `Республика Тыва` Монголия
##    <chr>                     <dbl>              <dbl>             <dbl>    <dbl>
##  1 Резкие перепа…             63.5               43.3              31.8        0
##  2 Затяжные моро…             25.5               63                44.3        0
##  3 Частые оттепе…             17.9                9.4               5.7        0
##  4 Увеличение го…             23.4               29.6              36.5        0
##  5 Обильные снег…             22.6               39.7              37          0
##  6 Сход снежных …              2.2                9                 6.2        0
##  7 Увеличение ко…             17.5               26.7              22.9        0
##  8 Раннее таяние…              7.7                8.1               3.6        0
##  9 Участились ле…              1.8                6.7               3.6        0
## 10 Усилились вет…             34.7               47.3              39.1        0
## 11 Другое                      0                  4.5               1.6        0

В Алтайском крае чаще всего отмечают резкие перепады температур (63,5%); в Республике Алтай и Тыва — затяжные морозы (63,0% и 44,3%).

Таблица сопряженности v16

V16Regiontab<-cross.multi.table(V16, df$Region, true.codes=list("да"), freq=TRUE)
V16Regiontab<-as_tibble(V16Regiontab)
V16Regiontab$n<-V16labs
V16Regiontab<-V16Regiontab %>% 
  relocate(n)
V16Regiontab
## # A tibble: 10 × 5
##    n              `Алтайский край` `Республика Алтай` `Республика Тыва` Монголия
##    <chr>                     <dbl>              <dbl>             <dbl>    <dbl>
##  1 Увеличение ко…             23.7               45.3              30.7        0
##  2 Увеличение пе…             39.1               31.4              22.4        0
##  3 Большое колич…             60.2               34.1              39.1        0
##  4 Увеличение ко…              0.7                8.3               9.4        0
##  5 Усилился паво…              6.9               27.6              16.1        0
##  6 Таяние вечной…              2.6               14.8               3.6        0
##  7 Сильные ветры…             29.2               52.2              48.4        0
##  8 Рост количест…             26.6               26.5              15.6        0
##  9 Рост количест…             20.8               15.9               7.3        0
## 10 Другое                      0.4                5.6               4.2        0

В Алтайском крае выделяется увеличение количества осадков (60,2%); в Республике Алтай и Тыве — сильные ветра (52,2% и 48,4%).

# Загрузка всех пакетов (если не установлены, установите их)
library(questionr)
library(dplyr)
library(tidyr)
library(forcats)
library(ggplot2)
library(scales)      # для number()
## Warning: пакет 'scales' был собран под R версии 4.5.3
## 
## Присоединяю пакет: 'scales'
## Следующий объект скрыт от 'package:purrr':
## 
##     discard
## Следующий объект скрыт от 'package:readr':
## 
##     col_factor
library(stringr)

# Если V14tab уже создана, переходим к графику
V14tab %>%
  mutate(n = fct_reorder(n, Pct)) %>%
  ggplot(aes(x = n, y = Pct, fill = n)) +
  geom_bar(stat = "identity", width = 0.6) +
  geom_text(aes(label = number(Pct, accuracy = 0.1, decimal.mark = ",")),
            hjust = -0.3, family = "Ink Free", size = 4) +
  expand_limits(y = c(0, 80)) +
  coord_flip() +
  theme_void() +
  theme(axis.text.y = element_text(size = 10, family = "Ink Free"),
        legend.position = "none") +
  scale_x_discrete(labels = function(x) str_wrap(x, width = 30)) +
  labs(title = "Распределение ответов на V14")
## Warning in grid.Call(C_stringMetric, as.graphicsAnnot(x$label)): семейство
## шрифтов не найдено в базе данных шрифтов Windows
## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x, x$y, :
## семейство шрифтов не найдено в базе данных шрифтов Windows
## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x, x$y, :
## семейство шрифтов не найдено в базе данных шрифтов Windows

library(forcats)
library(ggplot2)
library(scales)
library(stringr)

V16tab %>%
  mutate(n = fct_reorder(n, Pct)) %>%
  ggplot(aes(x = n, y = Pct, fill = n)) +
  geom_bar(stat = "identity", width = 0.6) +
  geom_text(aes(label = number(Pct, accuracy = 0.1, decimal.mark = ",")),
            hjust = -0.3, family = "Ink Free", size = 4) +
  expand_limits(y = c(0, 80)) +
  coord_flip() +
  theme_void() +
  theme(axis.text.y = element_text(size = 10, family = "Ink Free"),
        legend.position = "none") +
  scale_x_discrete(labels = function(x) str_wrap(x, width = 30)) +
  labs(title = "Распределение ответов на V16")
## Warning in grid.Call(C_textBounds, as.graphicsAnnot(x$label), x$x, x$y, :
## семейство шрифтов не найдено в базе данных шрифтов Windows
## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x, x$y, :
## семейство шрифтов не найдено в базе данных шрифтов Windows
## Warning in grid.Call.graphics(C_text, as.graphicsAnnot(x$label), x$x, x$y, :
## семейство шрифтов не найдено в базе данных шрифтов Windows