lab6
Анисимов М.А.
2026-04-05
knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE)
packages <- c("haven", "dplyr", "ggplot2", "psych", "DataExplorer", "questionr", "sjlabelled")
new_packages <- packages[!(packages %in% installed.packages()[,"Package"])]
if(length(new_packages)) install.packages(new_packages)
library(haven)
library(dplyr)##
## Присоединяю пакет: 'dplyr'## Следующие объекты скрыты от 'package:stats':
##
## filter, lag## Следующие объекты скрыты от 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(ggplot2)
library(psych)## Warning: пакет 'psych' был собран под R версии 4.5.3##
## Присоединяю пакет: 'psych'## Следующие объекты скрыты от 'package:ggplot2':
##
## %+%, alphalibrary(DataExplorer)## Warning: пакет 'DataExplorer' был собран под R версии 4.5.3library(questionr)## Warning: пакет 'questionr' был собран под R версии 4.5.3##
## Присоединяю пакет: 'questionr'## Следующий объект скрыт от 'package:psych':
##
## describelibrary(sjlabelled)##
## Присоединяю пакет: 'sjlabelled'## Следующий объект скрыт от 'package:ggplot2':
##
## as_label## Следующий объект скрыт от 'package:dplyr':
##
## as_label## Следующие объекты скрыты от 'package:haven':
##
## as_factor, read_sas, read_spss, read_stata, write_sas, zap_labelsdf <- haven::read_sav("C:/Users/maksi/Downloads/База_КлимРиск_2023.sav")
# Сразу после загрузки файла преобразуем все метки в факторы
df <- sjlabelled::as_label(df)# Визуальный анализ: Q-Q Plot
DataExplorer::plot_qq(iris$Sepal.Length, title = "Q-Q Plot для Sepal.Length")
# Гистограмма с кривой плотности
ggplot(iris, aes(x = Sepal.Length)) +
geom_histogram(aes(y = ..density..), bins = 15, fill = "steelblue", color = "white") +
geom_density(color = "red", size = 1) +
theme_minimal() +
labs(title = "Распределение Sepal.Length (набор iris)")
# Тест Шапиро-Уилка
shapiro.test(iris$Sepal.Length)##
## Shapiro-Wilk normality test
##
## data: iris$Sepal.Length
## W = 0.97609, p-value = 0.01018# Таблица дескриптивных статистик
psych::describe(as.numeric(df$V12)) # Преобразуем в numeric для корректного счета, если это factor## vars n mean sd median trimmed mad min max range skew kurtosis se
## X1 1 899 2.25 1.04 2 2.11 1.48 1 5 4 1.11 1.12 0.03psych::describe(df[, c("V12", "V13", "V15")])## vars n mean sd median trimmed mad min max range skew kurtosis se
## V12* 1 899 2.25 1.04 2 2.11 1.48 1 5 4 1.11 1.12 0.03
## V13* 2 890 1.54 0.79 1 1.43 0.00 1 3 2 1.01 -0.65 0.03
## V15* 3 893 1.52 0.77 1 1.40 0.00 1 3 2 1.07 -0.48 0.03# Графики распределения
DataExplorer::plot_bar(df[, c("V12", "V13", "V15")],
ncol = 2,
title = "Частотный анализ V12, V13, V15")
# Таблица средних значений
df %>%
group_by(Region) %>%
summarise(Средний_возраст = mean(age, na.rm = TRUE),
Количество = n())## # A tibble: 4 × 3
## Region Средний_возраст Количество
## <fct> <dbl> <int>
## 1 Алтайский край 47.1 274
## 2 Республика Алтай 44.0 446
## 3 Республика Тыва 39.6 192
## 4 Монголия 48 1# График: Boxplot
ggplot(df, aes(x = as.factor(Region), y = as.numeric(age), fill = as.factor(Region))) +
geom_boxplot() +
theme_minimal() +
labs(title = "Распределение возраста по регионам", x = "Регион", y = "Возраст") +
theme(legend.position = "none")
# Анализ блока V14
V14_set <- df %>% select(starts_with("V14_"))
V14_tab <- questionr::multi.table(V14_set, true.codes = 1) # Обычно в SPSS "Да" кодируется как 1
# Присваиваем текстовые метки (labels) из SPSS-файла
rownames(V14_tab) <- sjlabelled::get_label(V14_set)
print("Таблица частот для блока V14:")## [1] "Таблица частот для блока V14:"print(V14_tab)## n %multi
## Резкие перепады температуры (от холода к теплу и наоборот) 0 0
## Затяжные морозы, увеличение периодов аномального холода 0 0
## Частые оттепели 0 0
## Увеличение гололеда на дорогах 0 0
## Обильные снегопады, увеличение снежного покрова 0 0
## Сход снежных лавин 0 0
## Увеличение количества пасмурных дней, нехватка солнца 0 0
## Раннее таяние и более позднее образование речного льда 0 0
## Участились ледовые зажоры, наледи на реках 0 0
## Усилились ветра, метели и снежные наносы 0 0
## Другое 0 0
## Другое 0 0# Анализ блока V16
V16_set <- df %>% select(starts_with("V16_"))
V16_tab <- questionr::multi.table(V16_set, true.codes = 1)
rownames(V16_tab) <- sjlabelled::get_label(V16_set)
print("Таблица частот для блока V16:")## [1] "Таблица частот для блока V16:"print(V16_tab)## n
## Увеличение количества засушливых дней, без осадков 0
## Увеличение периодов аномальной жары 0
## Большое количество осадков, сильных дождей 0
## Увеличение количества камнепадов и оползней в горах 0
## Усилился паводок, разливы рек, затопление мест, которые раньше не затапливались 0
## Таяние вечной мерзлоты, выход грунтовых вод на поверхность 0
## Сильные ветры, штормы 0
## Рост количества насекомых, комаров, мошки 0
## Рост количества насекомых-вредителей, угрожающих сельскохозяйственным культурам, хвойным лесам 0
## Другое 0
## Другое 0
## %multi
## Увеличение количества засушливых дней, без осадков 0
## Увеличение периодов аномальной жары 0
## Большое количество осадков, сильных дождей 0
## Увеличение количества камнепадов и оползней в горах 0
## Усилился паводок, разливы рек, затопление мест, которые раньше не затапливались 0
## Таяние вечной мерзлоты, выход грунтовых вод на поверхность 0
## Сильные ветры, штормы 0
## Рост количества насекомых, комаров, мошки 0
## Рост количества насекомых-вредителей, угрожающих сельскохозяйственным культурам, хвойным лесам 0
## Другое 0
## Другое 0# Двумерный анализ: используем Region с БОЛЬШОЙ буквы
df %>%
group_by(Region) %>%
summarise(
Средний_возраст = mean(as.numeric(V5), na.rm = TRUE), # Замените V5 на реальный номер колонки возраста
Количество = n()
)## # A tibble: 4 × 3
## Region Средний_возраст Количество
## <fct> <dbl> <int>
## 1 Алтайский край 1.25 274
## 2 Республика Алтай 1.07 446
## 3 Республика Тыва 1.15 192
## 4 Монголия 1 1# И в графике тоже исправляем на Region
ggplot(df, aes(x = as.factor(Region), y = as.numeric(V5), fill = as.factor(Region))) +
geom_boxplot() +
theme_minimal() +
labs(title = "Распределение возраста по регионам", x = "Регион", y = "Возраст")
R Markdown
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
summary(cars)## speed dist
## Min. : 4.0 Min. : 2.00
## 1st Qu.:12.0 1st Qu.: 26.00
## Median :15.0 Median : 36.00
## Mean :15.4 Mean : 42.98
## 3rd Qu.:19.0 3rd Qu.: 56.00
## Max. :25.0 Max. :120.00Including Plots
You can also embed plots, for example:
Note that the echo = FALSE parameter was added to the
code chunk to prevent printing of the R code that generated the
plot.