Работа по анализу данных

Гришуниной Лидии, Мастюгиной Екатерины и Пикуновой Серафимы

команды The Crazy

В качестве темы исследования мы выбрали отношение людей к изменению климата в Норвегии по данным за 2016 год.

1 часть

Краткий анализ данных

На первом этапе мы составили таблицу, которая определяет каждую выбранную переменную в таких категориях, как “качественная или количественная”, “шкала измерения” и “непрерывная или дискретная”.

Для того, чтобы провести дальнейший анализ, мы изменили тип переменных.

Затем мы сделали краткий анализ наших данных. Так, единственная численная переменная в наших данных - возраст, для которой мы определили минимальное и максимальное значение, медиану, среднее и первый и третий квартили. Для факторных переменных мы определили моду, которая равна самому частовстречающемуся значению в таблице.

summary(ESS2)

##      eduyrs         gndr                agea          eneffap    rdcenr  
##  Min.   : 1.0   Length:1420        Min.   :15.00   8      :344   1 : 17  
##  1st Qu.:12.0   Class :character   1st Qu.:32.00   7      :217   2 : 67  
##  Median :14.0   Mode  :character   Median :47.00   10     :191   3 :369  
##  Mean   :14.3                      Mean   :47.42   9      :185   4 :455  
##  3rd Qu.:17.0                      3rd Qu.:61.25   5      :180   5 :408  
##  Max.   :28.0                      Max.   :98.00   6      :112   6 :102  
##                                                    (Other):191   55:  2  
##     cflsenr    wrpwrct wrenexp clmchng    cntry              psppipla    
##  8      :314   1:389   1:143   1:713   Length:1420        Min.   :1.000  
##  10     :304   2:705   2:577   2:628   Class :character   1st Qu.:2.000  
##  7      :215   3:263   3:517   3: 79   Mode  :character   Median :3.000  
##  9      :165   4: 52   4:164                              Mean   :3.003  
##  5      :150   5: 11   5: 19                              3rd Qu.:4.000  
##  6      :119                                              Max.   :5.000  
##  (Other):153                                                             
##     gvsrdcc          hinctnta     
##  Min.   : 0.000   Min.   : 1.000  
##  1st Qu.: 3.000   1st Qu.: 3.000  
##  Median : 5.000   Median : 5.000  
##  Mean   : 4.885   Mean   : 5.306  
##  3rd Qu.: 6.000   3rd Qu.: 7.000  
##  Max.   :10.000   Max.   :10.000  
## 

Графики

Дальше мы построили графики, которые описывают наши переменные. Данная гистограмма иллюстрирует распределение возраста в наших данных.

hist(ESS2$agea, xlab = "Возраст", ylab = "Частота", main = "Распределение возраста")

Этот график иллюстрирует переменную “вероятность покупки наиболее энергоэффективной бытовой техники” и варьируется от “не совсем вероятно”(0) и заканчивается на “чрезвычайно вероятно” (10). График показывает, что большинство респондентов с довольно высокой вероятностью купит более энергоэффективную бытовую технику.

plot(ESS2$eneffap, xlab = "Вероятность покупки наиболее энергоэффективной бытовой техники", ylab = "Количество ответов", main = "Распределение ответов по вероятности покупки")

Следующая диаграмма иллюстрирует количество ответов по переменной “как часто респонденты сокращают энергопотребление”, которое варьируется от никогда (1) до всегда (6), а также есть вариант ответа “не могу уменьшить потребление энергии” (55). Согласно графику, большинство людей со средней частотой сокращает потребление энергии.

plot(ESS2$rdcenr, xlab = "Частота сокращения энергопотребления", ylab = "Количество ответов", main = "Распределение ответов по частоте сокращения энергопотребления")

Этот график дает информацию о том, “насколько вы уверены, что могли бы использовать меньше электроэнергии, чем сейчас”, и он варьируется от не совсем уверен(а) (0) до полностью уверен(а) (10). Результаты не показывают однозначной тенденции, но существует сильный перевес в сторону большей уверенности.

plot(ESS2$cflsenr, xlab = "Уверенность в сокращении электроэнергии", ylab = "Количество ответов", main = "Распределение ответов по уверенности в \n сокращении электроэнергии")

Этот график иллюстрирует данные из переменной “как сильно вы беспокоитесь о возможности отключения электроэнергии”, и она варьируется от совсем не беспокоюсь (1) до чрезвычайно беспокоюсь (5), и показывает, что люди склонны не беспокоиться об этом (ответ 2 - не очень беспокоятся - преобладает).

plot(ESS2$wrpwrct, xlab = "Степень обеспокоенности отключением электроэнергии", ylab = "Количество ответов", main = "Распределение ответов по обеспокоенности \n отключения электроэнергии")

Следующий график показывает количество ответов по переменной “как сильно вы беспокоитесь о дороговизне электроэнергии для многих людей”. Как и в прошлом, он варьируется от совсем не беспокоюсь (1) до чрезвычайно беспокоюсь (5), и наиболее часто встречающимся ответом является среднее беспокойство о данной проблеме.

plot(ESS2$wrenexp, xlab = "Степень обеспокоенности о дороговизне электроэнергии", ylab = "Количество ответов", main = "Распределение ответов по степени обеспокоенности о дороговизне \n электроэнергии для многих людей")

Этот график предоставляет данные о переменной “как вы думаете, меняется ли климат в мире”. Подавляющее большинство респондентов считает, что он “определенно меняется” (1) и “вероятно меняется” (2).

plot(ESS2$clmchng, xlab = "Мнения об изменении климата в мире", ylab = "Количество ответов", main = "Распределение ответов по мнениям об изменении климата")

Сравнительные графики

Этот график иллюстрирует ответы на вопрос “как часто вы делаете что-либо, чтобы уменьшить потребление энергии?”(варьируются от никогда (1) до всегда (6), а также есть вариант ответа “не могу уменьшить потребление энергии” (55)) по гендеру. Так, как женщины, так и мужчины, чаще всего выбирают 4 вариант ответа, а реже всего - “не могу уменьшить потребление энергии”.

library(ggplot2)
ggplot(ESS2) + 
  geom_bar(aes(x = rdcenr, fill = gndr), position = "dodge")+
  xlab("Гендер") +
  ylab("Количество") +
  scale_fill_discrete(name = "Гендер", labels = c("Мужчины", "Женщины"))+
  ggtitle("Как часто вы делаете что-либо, чтобы уменьшить потребление энергии?")

ESS2$gndr = str_replace(ESS2$gndr, "1", "Мужчины")
ESS2$gndr = str_replace(ESS2$gndr, "2", "Женщины")
ggplot() + 
  geom_bar(data = ESS2, aes(x = factor(gndr)), position = "dodge", fill = "blue") +
  xlab("Гендер") +
  ylab("Количество") +
  ggtitle("Количество мужчин и женщин в выборке")

Затем мы проверили, есть ли значимая разница между числом ответов женщин и мужчин по возрасту. Как видно на графике, разница незначительна.

ggplot(ESS2) + 
  geom_bar(aes(x = agea, fill = gndr)) +
  scale_fill_discrete(name = "Гендер", labels = c("Мужчины", "Женщины"))+
  ggtitle("Различия в числе отвтов среди мужчин и женщин разных возрастов")+
  xlab ("Возраст") +
  ylab ("Частота") 

Последние бокс-плоты показывают распределение возраста респондентов с различными ответами на вопрос “как сильно вы беспокоитесь о возможности отключения электроэнергии?”. Так как возраст - это единственная численная переменная в нашей базе данных, мы не смогли построить другие информативные графики распределения. Старшее поколение чаще отвечали, что они беспокоятся о возможности отключения электроэнергии, тогда как более молодые респонденты почти не выбирали варианты 4 и 5.

ESS2$wrpwrct = as.factor(ESS2$wrpwrct)
ggplot() +
  geom_boxplot(data = ESS2, aes(x = wrpwrct, y = agea))+
  xlab ("Степень беспокойства о \n возможности отключения электроэнергии") +
  ylab ("Возраст") +
  ggtitle("Как сильно вы беспокоитесь о возможности отключения электроэнергии?")

В заключении следует отметить, что общая картина показывает, что люди обеспокоены изменением климата и предпринимают ряд усилий для сокращения потребления энергии, причем люди старшего поколения обеспокоены этой проблемой в большей степени.

2 часть

T-test

Для проверки гипотез с помощью t-test, мы поставили следующие исследовательские вопросы:

1. Влияет ли пол респондента на число лет, потраченных на образование?
2. Существует ли взаимосвязь между числом лет, потраченных на образование, и степенью обеспокоенности о возможном отключении электроэнергии?

Далее мы проверили предположения, согласно которым мы можем использовать переменные для проверки гипотез с помощью t-test.

Для проверки гипотезы с помощью t-test мы должны удостовериться, что наша переменная распределена нормально. Так, для начала мы взяли переменную “возраст” и построили для нее гистограмму, Q-Q plot и график плотности.

hist(ESS2$agea, xlab = "Возраст", ylab = "Частота", main = "Распределение возраста") 

ggplot(ESS2) + geom_density(aes(ESS2$agea)) + xlab("Возраст")+
  ylab("Плотность") +ggtitle("График плотности")

q = qqnorm(ESS2$agea); qqline(ESS2$agea, col = 2) 

Как можно заметить, распределение имеет значительный скос влево, то есть распределение ненормально. Этот факт подтверждают и density plot, и Q-Q plot (значительные отклонения от Q-Q линии). Так, эту переменную мы не можем использовать для проверки гипотез тестом Стьюдента.

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

hist(ESS2$eduyrs, xlab = "Количество лет", ylab = "Частота", main = "Распределение лет, потраченных на образование") 

ggplot(ESS2) + geom_density(aes(ESS2$eduyrs)) + xlab("Количество лет")+
  ylab("Плотность") +ggtitle("График плотности")

qqnorm(ESS2$eduyrs); qqline(ESS2$eduyrs, col = 2)

Также мы проверили распределение в каждой группе.

qqnorm(ESS2$eduyrs[ESS2$gndr == "Мужчины"]); qqline(ESS2$eduyrs[ESS2$gndr == "Мужчины"], col = 2)

qqnorm(ESS2$eduyrs[ESS2$gndr == "Женщины"]); qqline(ESS2$eduyrs[ESS2$gndr == "Женщины"], col = 2)

Как можно заметить, данная переменная не имеет явных выбросов и сильных скосов, что свидетельствует о большей схожести с нормальными распределением в сравнении с первой переменной. Так, мы решили использовать данную переменную для проверки гипотез с помощью Теста Стьюдента.

Равенство дисперсий

Чтобы проверить равенство дисперсий, мы использовали тест Levene.

\(H_0\) - дисперсии равны; \(H_A\) - дисперсии не равны.

leveneTest(ESS2$eduyrs~ESS2$gndr)

## Levene's Test for Homogeneity of Variance (center = median)
##         Df F value  Pr(>F)  
## group    1  2.9685 0.08512 .
##       1418                  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Вывод: по результатам тестa Levene, p-value <0.05, значит \(H_0\) отвергается, т.е. дисперсии не равны.

I. Отвечая на первый вопрос (влияет ли пол респондента на число лет, потраченных на образование?), мы определили следующие гипотезы:

• нулевая (\(H_0\)), согласно которой пол респондента не влияет на число лет, потраченных на образование;

• альтернативная (\(H_A\)), отвергающая нулевую гипотезу и утверждающая, что пол респондента влияет на число лет, потраченных на образование.

t = t.test(eduyrs~gndr, data = ESS2, var.equal = F)
t

## 
##  Welch Two Sample t-test
## 
## data:  eduyrs by gndr
## t = 2.7092, df = 1343.2, p-value = 0.00683
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.1473690 0.9208773
## sample estimates:
## mean in group Женщины mean in group Мужчины 
##              14.58860              14.05447

Для ответа на вопрос, мы проанализировали полученное p-value - вероятность получить такой же результат, как есть в данных, или больший, при условии, что нулевая гипотеза верна. Так как полученное p-value много меньше, чем 0.05, то нулевая гипотеза отвергается на уровне значимости = 0.05. Таким образом, женщины и мужчины тратят разное количество лет на образование (женщины больше, чем мужчины).

Затем мы построили бокс-плоты для данных переменных:

ggplot() +
  geom_boxplot(data = ESS2, aes(x = gndr, y = eduyrs))+
  xlab ("Гендер: 1 - мужчины, 2 - женщины") +
  ylab ("Количество лет")+
  ggtitle("Распределение лет, потраченных на \n образование среди мужчин и женщин")

Разница в распределении, согласно графику, незначительна, но в случае женщин бокс-плот имеет больше выбросов в сторону большего количества лет, потраченных на образование.

2. Чтобы ответить на второй вопрос (Существует ли взаимосвязь между числом лет, потраченных на образование, и степенью обеспокоенности о возможном отключении электроэнергии?), мы разделили степени обеспокоенности о возможном отключении на две части: “меньше 3” (меньшая степень обеспокоенности) и “3 и больше” (более высокая степерь обеспокоенности), и проверили равенство дисперсий с помощью Levene-test.

ESS2$wrpwrct = as.numeric(ESS2$wrpwrct)
ESS3 = ESS2 %>% mutate(new = wrpwrct > 2)
ESS3$new = factor(ESS3$new, labels = c("Меньше 3", "3 и больше"))

\(H_0\) - дисперсии равны; \(H_A\) - дисперсии не равны.

leveneTest(ESS2$eduyrs~ESS3$new)

## Levene's Test for Homogeneity of Variance (center = median)
##         Df F value Pr(>F)
## group    1   1.865 0.1723
##       1418

Вывод: по результатам тестa Levene, p-value >0.05, значит мы не можем отвергнуть \(H_0\), т.е. дисперсии равны.

Затем мы определили следующие гипотезы:

• нулевая (\(H_0\)), согласно которой взаимосвязи между числом лет, потраченных на образование, и степенью обеспокоенности о возможном отключении электроэнергии нет;

• альтернативная (\(H_A\)), отвергающая нулевую гипотезу и утверждающая, что есть взаимосвязь между числом лет, потраченных на образование, и степенью обеспокоенности о возможном отключении электроэнергии.

t = t.test(eduyrs~new, data = ESS3, var.equal = T)
t

## 
##  Two Sample t-test
## 
## data:  eduyrs by new
## t = 1.5289, df = 1418, p-value = 0.1265
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -0.1006719  0.8121041
## sample estimates:
##   mean in group Меньше 3 mean in group 3 и больше 
##                 14.38026                 14.02454

Полученное p-value больше, чем 0.05, => нулевая гипотеза НЕ отвергается на уровне значимости = 0.05. Значит, количество лет, потраченных на образование, не влияет на степень обеспокоенности о возможном отключении электроэнергии.

ggplot() +
  geom_boxplot(data = ESS3, aes(x = new, y = eduyrs))+
  xlab ("Степень беспокойства") +
  ylab ("Количество лет, потраченных на образование")+
  ggtitle("Распределение количества лет, потраченных на образование \n среди двух групп ответивших  (по степени беспокойства)")

Для проверки гипотез с помощью критерия Хи-квадрат, мы поставили следующие исследовательские вопросы:

1. Есть ли зависимость между полом респондента и степенью обеспокоенности о возможном отключении электроэнергии?
2. Есть ли зависимость между полом респондента и вероятностью покупки наиболее энергоэффективной бытовой техники?

I. Для ответа на первый вопрос, мы определили следующие гипотезы:

• нулевая (\(H_0\)), согласно которой между полом респондента и степенью обеспокоенности о возможном отключении электроэнергии нет зависимости;

• альтернативная (\(H_A\)), отвергающая нулевую гипотезу и утверждающая, что между полом респондента и степенью обеспокоенности о возможном отключении электроэнергии есть зависимость.

ch <- chisq.test(ESS3$new, ESS3$gndr)
ch

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  ESS3$new and ESS3$gndr
## X-squared = 13.967, df = 1, p-value = 0.0001861

Затем мы сравнили ожидаемые и наблюдаемые значения и составили график, отображающий отклонения от ожидаемых значений - Пирсоновские остатки.

ch$observed
ch$expected

ch$residuals
library(vcd)
df_resid = as.data.frame(ch$residuals)
df_resid
df_count = as.data.frame(ch$observed)
df_count

ggplot() + 
  geom_raster(data = df_resid, aes(x = ESS3.new, y = ESS3.gndr, fill = Freq), hjust = 0.5, vjust = 0.5) + 
  scale_fill_gradient2("Пирсоновские остатки", low = "#2166ac", mid = "#f7f7f7", high = "#b2182b", midpoint = 0) +
  geom_text(data = df_count, aes(x = ESS3.new, y = ESS3.gndr, label = Freq)) +
  xlab("Степень беспокойства") +
  ylab("Гендер: 1 - мужчины, 2 - женщины") +
  theme(axis.text.x = element_text(angle = 90))  

Для ответа на данный вопрос, мы также проанализировали полученное p-value, которое в данном случае = 0.0005174. Так как p-value много меньше 0.05, нулевая гипотеза отвергается, что подтверждает тот факт, что пол респондента и уровень беспокойства взаимосвязаны. Более того, график иллюстрирует, что существуют некоторые значительные отклонения от ожидаемых значений, например, в случае женщин, выше среднего беспокоящихся об отключении электроэнергии (в положительную сторону), и мужчин с тем же уровнем беспокойства, только уже в отрицательную сторону.

2. Чтобы ответить на второй вопрос, мы разделили вероятность покупки наиболее энергоэффективной бытовой техники на две части: “меньше 5” (меньшая вероятность покупки) и “5 и больше” (большая вероятность покупки), и затем определили следующие гипотезы:

• нулевая (\(H_0\)), согласно которой между полом респондента и вероятностью покупки наиболее энергоэффективной бытовой техники нет взаимосвязи;

• альтернативная (\(H_A\)), отвергающая нулевую гипотезу и утверждающая, что между полом респондента и вероятностью покупки наиболее энергоэффективной бытовой техники есть взаимосвязь.

ESS2$eneffap = as.numeric(ESS2$eneffap)
ESS3 = ESS2 %>% mutate(new1 = eneffap > 5)
ESS3$new1 = factor(ESS3$new1, labels = c("Меньше 5", "5 и больше"))

ch <- chisq.test(ESS3$eneffap, ESS3$gndr)
ch

## 
##  Pearson's Chi-squared test
## 
## data:  ESS3$eneffap and ESS3$gndr
## X-squared = 6.5331, df = 10, p-value = 0.7687

Для ответа на данный вопрос, мы проанализировали полученное p-value, которое равно 0.5572. Так как полученное значение больше, чем 0.05, нулевая гипотеза не отвергается на уровне значимости 0.05. Это значит, что между полом респондента и вероятностью покупки более энергоэффективной бытовой техники нет зависимости.

3 часть

Обзор данных

В первую очередь, для того, что применить ANOVA, нам необходимо было выбрать одну категориальную и одну численную переменные. Для этого переменную agea (возраст респондента) мы разделили на 3 интервала: <=30, 31-50, 51+. В качестве метрической переменной мы выбрали eneffap (вероятность купить одну из самых энергоэффективных моделей бытовой техники). Так, значения метрической переменной варьируются от 1 до 10, причем 1 - “Совсем невероятно”, 10 - “Чрезвычайно вероятно”.

ESS2$agea = as.numeric(ESS2$agea)
ESS2 = ESS2 %>% mutate(age = cut(ESS2$agea, breaks = c(0, 30, 50, 98)))
ESS2$age = as.factor(ESS2$age)
ESS2$eneffap = as.numeric(ESS2$eneffap)

class(ESS2$age)

## [1] "factor"

class(ESS2$eneffap)

## [1] "numeric"

Число наблюдений в каждой группе

tapply(ESS2$eneffap, ESS2$age, length)

##  (0,30] (30,50] (50,98] 
##     312     484     624

Распределение данных выборки

ggplot() +
  geom_boxplot(data = ESS2, aes(x = age, y = eneffap))+
  xlab ("Возраст") +
  ylab ("Вероятность покупки \n энергоэффективной техники")+
  ggtitle("Распределение вероятности среди трех возрастных групп")

График демонстрирует, что распределения имеют различия: так, распределение ответов респондентой из второй и третьей группы в большей степени смещено вверх и имеют большие значения медиан, в сравнении с первой, что говорит о большей вероятности покупки энергоэффективных моделей бытовой техники в старшем возрасте.

Выборки независимы, так как одному респонденту соответствует один ответ.

Общее число наблюдений меньше 5000 => нам нужно проверить данные на нормальность распределения.

Нормальность распределения остатков

Для проверки нормальности распределения остатков мы построили гистограммы для всех групп вместе и для каждой отдельно.

hist(ESS2$eneffap, xlab = "Вероятность покупки \n энергоэффективной техники", ylab = "Частота", main = "Вероятность покупки \n энергоэффективной техники (по всем возрастным категориям)")

ggplot(ESS2) + geom_histogram(aes(x = eneffap, fill = age), binwidth = 1.0) + facet_grid(~age) + xlab ("Вероятность покупки \n энергоэффективной техники") +
  ylab ("Количество ответов")+
  ggtitle("Распределение вероятности среди трех возрастных групп")

Как можно заметить, во всех графиках наблюдается отрицательная смещенность (negative skew), соответственно, распределение ненормальное.

Далее мы проверили нашу переменную на нормальность с помощью теста Shapiro-Wilk.

\(H_0\) - переменная распределена нормально; \(H_A\) - переменная распределена ненормально.

res=residuals(lm(ESS2$eneffap~ESS2$age))
model=aov(ESS2$eneffap~ESS2$age) 
res=model$residuals
shapiro.test(res)

## 
##  Shapiro-Wilk normality test
## 
## data:  res
## W = 0.94016, p-value < 2.2e-16

Вывод: согласно тесту нормальности Shapiro-Wilk, p-value <<0.05, таким образом \(H_0\) отвергается, соответственно переменная распределена ненормально.

Затем мы использовали тест для проверки нормальности в каждой возрастной группе.

\(H_0\) - переменная распределена нормально; \(H_A\) - переменная распределена ненормально.

shapiro.test(ESS2$eneffap[ESS2$age == "(0,30]"])

## 
##  Shapiro-Wilk normality test
## 
## data:  ESS2$eneffap[ESS2$age == "(0,30]"]
## W = 0.9548, p-value = 3.186e-08

shapiro.test(ESS2$eneffap[ESS2$age == "(30,50]"])

## 
##  Shapiro-Wilk normality test
## 
## data:  ESS2$eneffap[ESS2$age == "(30,50]"]
## W = 0.90767, p-value < 2.2e-16

shapiro.test(ESS2$eneffap[ESS2$age == "(50,98]"])

## 
##  Shapiro-Wilk normality test
## 
## data:  ESS2$eneffap[ESS2$age == "(50,98]"]
## W = 0.89623, p-value < 2.2e-16

Вывод: согласно тесту нормальности Shapiro-Wilk, p-value во всех случаях <<0.05, таким образом \(H_0\) отвергается, соответсвенно, переменная распределена ненормально в каждой возрастной группе.

Общий вывод: данные распределены ненормально.

Равенство дисперсий

Чтобы проверить равенство дисперсий, мы использовали тест Levene.

\(H_0\) - дисперсии равны; \(H_A\) - дисперсии не равны.

leveneTest(ESS2$eneffap~ESS2$age)

## Levene's Test for Homogeneity of Variance (center = median)
##         Df F value    Pr(>F)    
## group    2  8.8932 0.0001451 ***
##       1417                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Вывод: по результатам тестa Levene, p-value <0.05, значит \(H_0\) отвергается, т.е. дисперсии не равны.

Дисперсии не равны.

Тест Kruskal-Wallis

Так как наши группы распределены ненормально и есть значительная разница в объемах выборок, мы применили непераметрический тест Краскела-Уоллиса.

\(H_0\) - медианы в группах равны; \(H_A\) - медианы в группах не равны.

kruskal.test(ESS2$eneffap~ESS2$age)

## 
##  Kruskal-Wallis rank sum test
## 
## data:  ESS2$eneffap by ESS2$age
## Kruskal-Wallis chi-squared = 76.256, df = 2, p-value < 2.2e-16

Вывод: p-value <<0.05, таким образом, \(H_0\) отвергается, медианы в группах не равны.

Post hoc test

Затем мы использовали постхок-тест Данна (Dunn’s), чтобы проверить попарные различия.

dunn.test::dunn.test(ESS2$eneffap, ESS2$age, method="bonferroni")

##   Kruskal-Wallis rank sum test
## 
## data: x and group
## Kruskal-Wallis chi-squared = 76.2562, df = 2, p-value = 0
## 
## 
##                            Comparison of x by group                            
##                                  (Bonferroni)                                  
## Col Mean-|
## Row Mean |     (0,30]    (30,50]
## ---------+----------------------
##  (30,50] |  -7.454098
##          |    0.0000*
##          |
##  (50,98] |  -8.253668  -0.513400
##          |    0.0000*     0.9115
## 
## alpha = 0.05
## Reject Ho if p <= alpha/2

Вывод: статистически значимой разницы нет только в паре (30,50] - (50,98], так как p-value > 0.05, а также значения в первой группе в сравниваемых парах выше из-за отрицательной разницы (Col Mean - Row Mean).

Общий вывод: таким образом, мы можем с уверенностью сказать, что вероятность покупки энергоэффективной техники отличается в зависимости от возрастной группы: так, молодые люди до 30 лет с меньшей вероятностью приобретут энергеэффективную технику в сравнении с респондентами, возраст которых достиг 30 лет. Кроме того, важно отметить, что значимой разницы между группами (30,50] - (50,98] нет. Также важно отметить, что возраст влияет на обеспокоенность об отключении электроэнергии - чем выше значение возраста, тем больше обеспокоенность. Кроме того, нет связи между числом лет, потраченных на образование, и степенью обеспокоенности возможным отключением электроэнергии.

4 часть.

Изучив интернет-ресурсы, мы пришли к выводу, что в Норвегии правительство принимает достаточные меры по охране окружающей среды: норвежцы обязаны сортировать мусор, их вода считается самой лучшей в мире, они используют природные ресурсы для производства электроэнергии (гидроэлектростанции).

Так, мы поставили следующие исследовательские вопросы:

1. Влияет ли образование респондента на оценку достаточности принятия мер по сокращению климатических изменений?

2. Влияет ли доход респондента на оценку достаточности принятия мер по сокращению климатических изменений?

3. Влияет ли покупка респондентом энергоэффективной техники на оценку достаточности принятия мер по сокращению климатических изменений?

4. Влияет ли обеспокоенность респондента отключением электроэнергии на оценку достаточности принятия мер по сокращению климатических изменений?

Наши гипотезы:

1. Чем выше уровень образования, тем респонденты лучше оценивают достаточность принятия мер по сокращению климатических изменений.

2. Чем больше доход респондента, тем лучше оценивают достаточность принятия мер по сокращению климатических изменений.

3. Чем чаще респондент покупает более энергоэффективную технику, тем лучше оценивают достаточность принятия мер по сокращению климатических изменений.

4. Чем меньше респондент обеспокоен отключением электроэнергии, тем лучше оценивает достаточность принятия мер по сокращению климатических изменений (так как в Норвегии электроэнергия производится на гидроэлектростанциях, очень мала вероятность, что электроэнергию отключат. Мы предполагаем, что норвежцы, которые интересуются этой информацией, не беспокоятся об отключении электроэнергии, и, зная, что государство принимает данную меру, более удовлетворены принятием государством мер по сокращению климатических изменений).

Таким образом, для регрессионного анализа нами были выбраны следующие переменные:

Независимые:

• gndr - гендер;

• agea - возраст;

• hinctnta - доход;

• eduyrs количество лет, потраченных на образование;

• wrpwrct - степень обеспокоенности отключением электроэнергии;

• eneffap - вероятность покупки наиболее энергоэффективной бытовой техники.

Зависимая:

• gvsrdcc - оценка достаточности принятия мер правительством по сокращению климатических изменений wrpwrct - степень обеспокоенности отключением электроэнергии.

I. Гендер.

ESS2$gndr = str_replace(ESS2$gndr, "1", "Мужчины")
ESS2$gndr = str_replace(ESS2$gndr, "2", "Женщины")
ggplot() + 
  geom_bar(data = ESS2, aes(x = factor(gndr)), position = "dodge", fill = "blue") +
  xlab("Гендер") +
  ylab("Количество") +
  ggtitle("Количество мужчин и женщин в выборке")

II. Возраст.

hist(ESS2$agea, xlab = "Возраст", ylab = "Частота", main = "Распределение возраста")

III. Доход.

hist(ESS2$hinctnta, xlab = "Доход", ylab = "Частота", main = "Распределение дохода")
legend("topright", c("1 - низкий, 10 - высокий"), title = "Доход")

IV. Количество лет, потраченных на образование.

hist(ESS2$eduyrs, xlab = "Количество лет, потраченных на образование", ylab = "Частота", main = "Распределение количества лет, потраченных на образование")

V. Вероятность покупки наиболее энергоэффективной бытовой техники.

hist(ESS2$eneffap, xlab = "Вероятность покупки наиболее \n энергоэффективной бытовой техники", ylab = "Частота", main = "Распределение вероятности покупки \n наиболее энергоэффективной бытовой техники")
legend("topleft", c("1 = Совсем не вероятно", "10 = Очень вероятно"), title = "Вероятность")

VI. Степень обеспокоенности отключением электроэнергии.

hist(ESS2$wrpwrct, xlab = "Степень обеспокоенности отключением электроэнергии", ylab = "Частота", main = "Распределение степени обеспокоенности \n отключением электроэнергии")
legend("topright", c("1 = Совсем не обеспокоен(а)", "5 = Очень обеспокоен(а)"), title = "Степень обеспокоенности")

VII. Оценка достаточности принятия мер правительством по сокращению климатических изменений.

hist(ESS2$gvsrdcc, xlab = "Оценка", ylab = "Частота", main = "Распределение оценки достаточности принятия мер \n правительства  по сокращению климатических изменений") 
legend("topright", c("1 = Меры недостаточны", "10 = Меры достаточны"), title = "Оценка")

Затем мы построили графики, показывающие распределение каждой независимой переменной по переменной gvsrdcc (оценка достаточности принятия мер правительством по сокращению климатических изменений).

I. Гендер + оценка достаточности принятия мер правительством по сокращению климатических изменений

ggplot(data = ESS2, aes(x = as.character(gndr), y = gvsrdcc)) +
  geom_boxplot() +
  xlab("Гендер") +
  ylab("Оценка") +
  ggtitle("Распределение оценки достаточности принятия мер \n правительства по гендеру")

## Don't know how to automatically pick scale for object of type labelled. Defaulting to continuous.

II. Количество лет, потраченных на образование + оценка достаточности принятия мер правительством по сокращению климатических изменений

plot(ESS2$gvsrdcc~ESS2$eduyrs, xlab = "Количество лет, потраченных на образование", ylab = "Вероятность", main = "Распределение оценки достаточности принятия мер \n правительства  по сокращению климатич. изменений \n по количеству лет на образование")

III. Возраст + оценка достаточности принятия мер правительством по сокращению климатических изменений.

plot(ESS2$gvsrdcc~ESS2$agea, xlab = "Возраст", ylab = "Оценка", main = "Распределение оценки достаточности принятия мер \n правительства  по сокращению климатич. изменений \n по возрасту")

IV. Доход + оценка достаточности принятия мер правительством по сокращению климатических изменений.

ggplot(data = ESS2, aes(x = as.character(hinctnta), y = gvsrdcc)) +
  geom_boxplot() +
  xlab("Доход") +
  ylab("Оценка") +
  ggtitle("Распределение оценки достаточности принятия мер \n правительства по доходу")

## Don't know how to automatically pick scale for object of type labelled. Defaulting to continuous.

V. Степень обеспокоенности отключением электроэнергии + оценка достаточности принятия мер правительством по сокращению климатических изменений.

ggplot(data = ESS2, aes(x = as.character(wrpwrct), y = gvsrdcc)) +
  geom_boxplot() +
  xlab("Степень обеспокоенности отключением электроэнергии") +
  ylab("Оценка") +
  ggtitle("Распределение оценки достаточности принятия мер \n правительства по степени обеспокоенности отключением электроэнергии")

## Don't know how to automatically pick scale for object of type labelled. Defaulting to continuous.

VI. Вероятность покупки наиболее энергоэффективной бытовой техники + оценка достаточности принятия мер правительством по сокращению климатических изменений

ggplot(data = ESS2, aes(x = as.character(eneffap), y = gvsrdcc)) +
  geom_boxplot() +
  xlab("Вероятность покупки наиболее энергоэффективной бытовой техники") +
  ylab("Оценка") +
  ggtitle("Распределение оценки достаточности принятия мер \n правительства по по вероятности покупки наиболее \n энергоэффективной техники")

## Don't know how to automatically pick scale for object of type labelled. Defaulting to continuous.

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

Кроме того, мы проверили нормальность данной переменной по различным группам.

\(H_0\) - переменная распределена нормально; \(H_A\) - переменная распределена ненормально.

res=residuals(lm(ESS2$gvsrdcc~ESS2$gndr))
modell1=aov(ESS2$gvsrdcc~ESS2$gndr) 
res=modell1$residuals
shapiro.test(res)

## 
##  Shapiro-Wilk normality test
## 
## data:  res
## W = 0.98339, p-value = 1.028e-11

res=residuals(lm(ESS2$gvsrdcc~ESS2$eduyrs))
modell2=aov(ESS2$gvsrdcc~ESS2$eduyrs) 
res=modell2$residuals
shapiro.test(res)

## 
##  Shapiro-Wilk normality test
## 
## data:  res
## W = 0.98729, p-value = 8.184e-10

class(ESS2$wrpwrct)

## [1] "numeric"

res=residuals(lm(ESS2$gvsrdcc~ESS2$wrpwrct))
modell3=aov(ESS2$gvsrdcc~ESS2$wrpwrct) 
res=modell3$residuals
shapiro.test(res)

## 
##  Shapiro-Wilk normality test
## 
## data:  res
## W = 0.98294, p-value = 6.498e-12

res=residuals(lm(ESS2$gvsrdcc~ESS2$eneffap))
modell4=aov(ESS2$gvsrdcc~ESS2$eneffap) 
res=modell4$residuals
shapiro.test(res)

## 
##  Shapiro-Wilk normality test
## 
## data:  res
## W = 0.99242, p-value = 1.112e-06

res=residuals(lm(ESS2$gvsrdcc~ESS2$agea))
modell5=aov(ESS2$gvsrdcc~ESS2$agea) 
res=modell5$residuals
shapiro.test(res)

## 
##  Shapiro-Wilk normality test
## 
## data:  res
## W = 0.98483, p-value = 4.769e-11

res=residuals(lm(ESS2$gvsrdcc~ESS2$hinctnta))
modell5=aov(ESS2$gvsrdcc~ESS2$hinctnta) 
res=modell5$residuals
shapiro.test(res)

## 
##  Shapiro-Wilk normality test
## 
## data:  res
## W = 0.97453, p-value = 3.78e-15

Таким образом, p-value во всех случаях < 0.05, следовательно, нормально только межгрупповое распределение, внутри групп распределение ненормальное.

Далее мы переходим к построению моделей.

Построение моделей.

В качестве контрольных переменных мы взяли возраст и пол.

model1 <- lm(gvsrdcc ~ gndr + agea, data = ESS2)
summary(model1)

## 
## Call:
## lm(formula = gvsrdcc ~ gndr + agea, data = ESS2)
## 
## Residuals:
## <Labelled double>
##     Min      1Q  Median      3Q     Max 
## -4.9232 -1.7001  0.0718  1.2441  5.3278 
## 
## Labels:
##  value             label
##      0 Not at all likely
##      1                 1
##      2                 2
##      3                 3
##      4                 4
##      5                 5
##      6                 6
##      7                 7
##      8                 8
##      9                 9
##     10  Extremely likely
##     66    Not applicable
##     77           Refusal
##     88        Don't know
##     99         No answer
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  4.760891   0.154670  30.781   <2e-16 ***
## gndrМужчины -0.177019   0.105209  -1.683   0.0927 .  
## agea         0.004648   0.002881   1.613   0.1069    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.973 on 1417 degrees of freedom
## Multiple R-squared:  0.003645,   Adjusted R-squared:  0.002239 
## F-statistic: 2.592 on 2 and 1417 DF,  p-value: 0.07522

Согласно результатам, данная модель модель оказалась незначимой, но, так как данные переменные - контрольные, мы будем использовать их при дальнейшем анализе.

model3 <- lm(gvsrdcc ~ gndr + agea + hinctnta, data = ESS2)
summary(model3)

## 
## Call:
## lm(formula = gvsrdcc ~ gndr + agea + hinctnta, data = ESS2)
## 
## Residuals:
## <Labelled double>
##     Min      1Q  Median      3Q     Max 
## -4.9270 -1.6920  0.0721  1.2443  5.3326 
## 
## Labels:
##  value             label
##      0 Not at all likely
##      1                 1
##      2                 2
##      3                 3
##      4                 4
##      5                 5
##      6                 6
##      7                 7
##      8                 8
##      9                 9
##     10  Extremely likely
##     66    Not applicable
##     77           Refusal
##     88        Don't know
##     99         No answer
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  4.744825   0.187857  25.258   <2e-16 ***
## gndrМужчины -0.177869   0.105396  -1.688   0.0917 .  
## agea         0.004668   0.002885   1.618   0.1059    
## hinctnta     0.002938   0.019481   0.151   0.8802    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.973 on 1416 degrees of freedom
## Multiple R-squared:  0.003661,   Adjusted R-squared:  0.00155 
## F-statistic: 1.734 on 3 and 1416 DF,  p-value: 0.158

Согласно результатам, переменная hinctnta имеет незначимый коэффициент, поэтому мы не будем учитывать ее при дальнейшем анализе.

model4 <- lm(gvsrdcc ~ wrpwrct + gndr + agea, data = ESS2)
summary(model4)

## 
## Call:
## lm(formula = gvsrdcc ~ wrpwrct + gndr + agea, data = ESS2)
## 
## Residuals:
## <Labelled double>
##     Min      1Q  Median      3Q     Max 
## -4.9779 -1.6774  0.0639  1.2482  5.3726 
## 
## Labels:
##  value             label
##      0 Not at all likely
##      1                 1
##      2                 2
##      3                 3
##      4                 4
##      5                 5
##      6                 6
##      7                 7
##      8                 8
##      9                 9
##     10  Extremely likely
##     66    Not applicable
##     77           Refusal
##     88        Don't know
##     99         No answer
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  4.651993   0.190991  24.357   <2e-16 ***
## wrpwrct      0.063140   0.064964   0.972    0.331    
## gndrМужчины -0.166656   0.105750  -1.576    0.115    
## agea         0.004153   0.002926   1.419    0.156    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.973 on 1416 degrees of freedom
## Multiple R-squared:  0.004309,   Adjusted R-squared:  0.0022 
## F-statistic: 2.043 on 3 and 1416 DF,  p-value: 0.106

Согласно результатам, переменная wrpwrct имеет незначимый коэффициент, поэтому мы не будем учитывать ее при дальнейшем анализе.

model5 <- lm(gvsrdcc ~ gndr + agea + eneffap, data = ESS2)
summary(model5)

## 
## Call:
## lm(formula = gvsrdcc ~ gndr + agea + eneffap, data = ESS2)
## 
## Residuals:
## <Labelled double>
##     Min      1Q  Median      3Q     Max 
## -5.1630 -1.4588  0.0243  1.3277  5.4903 
## 
## Labels:
##  value             label
##      0 Not at all likely
##      1                 1
##      2                 2
##      3                 3
##      4                 4
##      5                 5
##      6                 6
##      7                 7
##      8                 8
##      9                 9
##     10  Extremely likely
##     66    Not applicable
##     77           Refusal
##     88        Don't know
##     99         No answer
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  4.225153   0.220906  19.127  < 2e-16 ***
## gndrМужчины -0.156609   0.104996  -1.492 0.136035    
## agea         0.002889   0.002917   0.990 0.322246    
## eneffap      0.076334   0.022552   3.385 0.000732 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.965 on 1416 degrees of freedom
## Multiple R-squared:  0.01164,    Adjusted R-squared:  0.009548 
## F-statistic:  5.56 on 3 and 1416 DF,  p-value: 0.0008591

Таким образом, при повышении возможности частоты покупки энергоэффективной техники на один пункт, зависимая переменная - достаточность принятия мер по сокращению климатических изменений - повышается на 0.077705 единицы.

F-statistics равна 5.735 при p-value, равном 0.0006719.

Adjusted R-squared, то есть доля общей дисперсии зависимой переменной, объяснённая моделью, равна 0.009849, то есть модель объясняет приблизительно 1% случаев.

model6 <- lm(gvsrdcc ~ gndr + agea + eneffap + eduyrs, data = ESS2)
summary(model6)

## 
## Call:
## lm(formula = gvsrdcc ~ gndr + agea + eneffap + eduyrs, data = ESS2)
## 
## Residuals:
## <Labelled double>
##     Min      1Q  Median      3Q     Max 
## -5.2413 -1.4666 -0.0005  1.3373  5.6319 
## 
## Labels:
##  value             label
##      0 Not at all likely
##      1                 1
##      2                 2
##      3                 3
##      4                 4
##      5                 5
##      6                 6
##      7                 7
##      8                 8
##      9                 9
##     10  Extremely likely
##     66    Not applicable
##     77           Refusal
##     88        Don't know
##     99         No answer
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  4.709839   0.310667  15.160  < 2e-16 ***
## gndrМужчины -0.170613   0.105042  -1.624 0.104547    
## agea         0.001719   0.002961   0.581 0.561582    
## eneffap      0.080737   0.022608   3.571 0.000367 ***
## eduyrs      -0.031939   0.014415  -2.216 0.026867 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.963 on 1415 degrees of freedom
## Multiple R-squared:  0.01506,    Adjusted R-squared:  0.01228 
## F-statistic: 5.409 on 4 and 1415 DF,  p-value: 0.0002536

Вывод:

В результате регрессии было выяснено, что при повышении возможности частоты покупки энергоэффективной техники на один пункт, зависимая переменная - достаточность принятия мер по сокращению климатических изменений - повышается на 0.081989 единицы. При повышении количества лет, потраченных на образование на 1 год, зависимая переменная уменьшается на 0.031454 единицы.

F-statistics равна 5.515 при p-value, равном 0.0002093.

Adjusted R-squared, то есть доля общей дисперсии зависимой переменной, объяснённая моделью, равна 0.01249, то есть модель объясняет приблизительно 1.25% случаев.

Таким образом, наша итоговая модель имеет вид следующего уравнения:

Y = 4.760491 + 0.081989 * eneffap + (-0.031454) * eduyrs + error

Затем мы проверили модель на мультиколинеарность.

vif(model6)

##     gndr     agea  eneffap   eduyrs 
## 1.009295 1.069171 1.043230 1.041485

Так как данные значения коэффициента меньше 5 => переменные не связаны.

ANOVA

Также мы проверили, являются ли наши улучшения модели значимыми, используя ANOVA.

anova(model1, model5)

## Analysis of Variance Table
## 
## Model 1: gvsrdcc ~ gndr + agea
## Model 2: gvsrdcc ~ gndr + agea + eneffap
##   Res.Df    RSS Df Sum of Sq      F    Pr(>F)    
## 1   1417 5514.1                                  
## 2   1416 5469.9  1    44.257 11.457 0.0007318 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Вывод: p-value < 0.05 => добавив в модель переменную eneffap, мы значимо улучшили ее.

anova(model5, model6)

## Analysis of Variance Table
## 
## Model 1: gvsrdcc ~ gndr + agea + eneffap
## Model 2: gvsrdcc ~ gndr + agea + eneffap + eduyrs
##   Res.Df    RSS Df Sum of Sq      F  Pr(>F)  
## 1   1416 5469.9                              
## 2   1415 5450.9  1    18.913 4.9096 0.02687 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Вывод: p-value < 0.05 => добавив в модель переменную eduyrs, мы значимо улучшили ее. Таким образом, эта модель подходит больше всего для нашего исследовательского вопроса.

sjt.lm(model1, model5, model6, group.pred = FALSE, show.ci = F)

		gvsrdcc			gvsrdcc			gvsrdcc
		B	p		B	p		B	p
(Intercept)		4.76	<.001		4.23	<.001		4.71	<.001
gndr		-0.18	.093		-0.16	.136		-0.17	.105
agea		0.00	.107		0.00	.322		0.00	.562
eneffap					0.08	<.001		0.08	<.001
eduyrs								-0.03	.027
Observations		1420			1420			1420
R2 / adj. R2		.004 / .002			.012 / .010			.015 / .012

Общий вывод по 4 части.

Итого, из выдвинутых нами гипотез, подтвердилась только четвёртая - чем меньше респондент обеспокоен отключением электроэнергии, тем лучше оценивает достаточность принятия мер по сокращению климатических изменений. Доход респондента и обеспокоенность отключением электроэнергии не влияют на мнение респондента о достаточности принятия мер по сокращению климатических изменений. Увеличение продолжительности времени, потраченного на образование, негативно влияет на оценку достаточности принятия мер по сокращению климатических изменений. Возможно, это связано с тем, что люди с низкий уровнем образования недостаточно осведомлены о проблемах окружающей среды, поэтому лучше оценивают политику государства по данной теме.

5 часть.

Исследовательский вопрос и гипотеза.

Для создания интерактивного эффекта мы добавили переменную “psppipla” (“политическая система позволяет людям говорить о том, что делает правительство”).

Мы предполагаем, что чем лучше респонденты оценивают возможность свободы слова относительно правительства (переменная psppipla), тем лучше они оценивают достаточность принятия мер по сокращению климатических изменений. Мы считаем, что это связано с удовлетворенностью властью в стране в принципе, и свобода слова и достаточность принятия мер по сокращению климатических изменений являются важными аспектами оценки власти для норвежцев (большой частью философии норвежцев является экология, например, слабо урбанизированные города).

Распределение переменных и корреляция.

I. Гендер.

ESS2$gndr = str_replace(ESS2$gndr, "1", "Мужчины")
ESS2$gndr = str_replace(ESS2$gndr, "2", "Женщины")
ggplot() + 
  geom_bar(data = ESS2, aes(x = factor(gndr)), position = "dodge", fill = "blue") +
  xlab("Гендер") +
  ylab("Количество") +
  ggtitle("Количество мужчин и женщин в выборке")

II. Возраст.

hist(ESS2$agea, xlab = "Возраст", ylab = "Частота", main = "Распределение возраста")

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

hist(ESS2$psppipla, xlab = "Оценка", ylab = "Частота", main = "Распределение оценки")
legend("topright", c("1 = Совсем невозможно", "5 = Вполне возможно"), title = "Возможность свободы слова")

IV. Количество лет, потраченных на образование.

hist(ESS2$eduyrs, xlab = "Количество лет, потраченных на образование", ylab = "Частота", main = "Распределение количества лет, потраченных на образование")

V. Вероятность покупки наиболее энергоэффективной бытовой техники.

hist(ESS2$eneffap, xlab = "Вероятность покупки наиболее \n энергоэффективной бытовой техники", ylab = "Частота", main = "Распределение вероятности покупки \n наиболее энергоэффективной бытовой техники")
legend("topleft", c("1 = Совсем не вероятно", "10 = Очень вероятно"), title = "Вероятность")

VI. Оценка достаточности принятия мер правительством по сокращению климатических изменений.

hist(ESS2$gvsrdcc, xlab = "Оценка", ylab = "Частота", main = "Распределение оценки достаточности принятия мер \n правительства  по сокращению климатических изменений") 
legend("topright", c("1 = Меры недостаточны", "10 = Меры достаточны"), title = "Оценка")

Корреляция непрерывных переменных.

Чтобы посчитать корреляцию между двумя непрерывными переменными “возраст” и “количество лет, потраченных на образование”, мы воспользовались методом Кендалла, так как распределение данных переменных ненормально.

cor.test(ESS2$eduyrs, ESS2$agea, method = "kendall")

## 
##  Kendall's rank correlation tau
## 
## data:  ESS2$eduyrs and ESS2$agea
## z = -5.6661, p-value = 1.461e-08
## alternative hypothesis: true tau is not equal to 0
## sample estimates:
##        tau 
## -0.1049183

Вывод: коэффициент корреляции = (-0.07) => между нашими переменными наблюдается сильная отрицательная корреляция.

Модель.

• для более точного расчета, мы процентрировали наши непрерывные переменные.

ESS2$agea_cent = ESS2$agea - mean(ESS2$agea)
ESS2$eduyrs_cent = ESS2$eduyrs - mean(ESS2$eduyrs)

model8 <- lm(gvsrdcc ~ gndr + agea_cent + eneffap + eduyrs_cent + psppipla, data = ESS2)
summary(model8)

## 
## Call:
## lm(formula = gvsrdcc ~ gndr + agea_cent + eneffap + eduyrs_cent + 
##     psppipla, data = ESS2)
## 
## Residuals:
## <Labelled double>
##     Min      1Q  Median      3Q     Max 
## -5.3541 -1.3610  0.0104  1.3557  5.4170 
## 
## Labels:
##  value             label
##      0 Not at all likely
##      1                 1
##      2                 2
##      3                 3
##      4                 4
##      5                 5
##      6                 6
##      7                 7
##      8                 8
##      9                 9
##     10  Extremely likely
##     66    Not applicable
##     77           Refusal
##     88        Don't know
##     99         No answer
## 
## Coefficients:
##              Estimate Std. Error t value Pr(>|t|)    
## (Intercept)  3.485814   0.260797  13.366  < 2e-16 ***
## gndrМужчины -0.189071   0.104240  -1.814  0.06992 .  
## agea_cent    0.003477   0.002958   1.175  0.23999    
## eneffap      0.073750   0.022466   3.283  0.00105 ** 
## eduyrs_cent -0.048313   0.014670  -3.293  0.00101 ** 
## psppipla     0.304562   0.061307   4.968 7.59e-07 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.946 on 1414 degrees of freedom
## Multiple R-squared:  0.03196,    Adjusted R-squared:  0.02853 
## F-statistic: 9.335 on 5 and 1414 DF,  p-value: 9.206e-09

F-statistics = 9.335 при p-value < 0.001. Adjusted R-squared = 0.028, то есть модель объясняет приблизительно 3% случаев.

При повышении возможности частоты покупки энергоэффективной техники на один пункт, зависимая переменная - достаточность принятия мер по сокращению климатических изменений - повышается на 0.07. При повышении количества лет, потраченных на образование на 1 год, зависимая переменная уменьшается на 0.05. При повышении оценки возмести свобода слова относительно действий правительства на один пункт, зависимая переменная повышается на 0.3.

Уравнение: DATA = model + error Model = Y = 3.5 + 0.07 * eneffap + (-0.05) * eduyrs_cent + 0.3 * psppipla

Модель с интерактивным эффектом.

model9 <- lm(gvsrdcc ~ gndr + agea_cent +  eduyrs_cent + eneffap + psppipla*gndr, data = ESS2)
summary(model9)

## 
## Call:
## lm(formula = gvsrdcc ~ gndr + agea_cent + eduyrs_cent + eneffap + 
##     psppipla * gndr, data = ESS2)
## 
## Residuals:
## <Labelled double>
##     Min      1Q  Median      3Q     Max 
## -5.2216 -1.3572 -0.0055  1.3228  5.5293 
## 
## Labels:
##  value             label
##      0 Not at all likely
##      1                 1
##      2                 2
##      3                 3
##      4                 4
##      5                 5
##      6                 6
##      7                 7
##      8                 8
##      9                 9
##     10  Extremely likely
##     66    Not applicable
##     77           Refusal
##     88        Don't know
##     99         No answer
## 
## Coefficients:
##                       Estimate Std. Error t value Pr(>|t|)    
## (Intercept)           4.023772   0.333740  12.057  < 2e-16 ***
## gndrМужчины          -1.108017   0.371692  -2.981  0.00292 ** 
## agea_cent             0.003363   0.002952   1.139  0.25474    
## eduyrs_cent          -0.046441   0.014659  -3.168  0.00157 ** 
## eneffap               0.073021   0.022423   3.257  0.00115 ** 
## psppipla              0.126626   0.092291   1.372  0.17027    
## gndrМужчины:psppipla  0.306581   0.119048   2.575  0.01012 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.943 on 1413 degrees of freedom
## Multiple R-squared:  0.03648,    Adjusted R-squared:  0.03239 
## F-statistic: 8.916 on 6 and 1413 DF,  p-value: 1.425e-09

F-statistics = 8.916 при p-value < 0.001 Adjusted R-squared = 0.03239, то есть модель объясняет приблизительно 3.2% случаев.

Уравнение: DATA = model + error Model = Y = 4.02 - 1.1 * gndrМужчины - 0.05 * eduyrs_cent + 0.07 * eneffap + 0.3 *gndrМужчиныpsppipla

Мужчины, по сравнению с женщинами, на 1.1 хуже оценивают достаточность принятия мер по сокращению климатических изменений. При повышении возможности частоты покупки энергоэффективной техники на один пункт, зависимая переменная - достаточность принятия мер по сокращению климатических изменений - повышается на 0.07. При повышении количества лет, потраченных на образование на 1 год, зависимая переменная уменьшается на 0.05. С ростом значения переменной о свободе мужчины более склонны считать, что меры, предпринятые правительством, достаточны.

График взаимодействия с доверительными интервалами.

gp <- ggplot(data=model9, aes(x=psppipla, y=gvsrdcc, colour=gndr))
gp +  stat_smooth(method="lm") +
  xlab("Оценка свободы слова \n относительно правительства") +
  ylab("Оценка достаточности \n предпринятых правительством мер") 

## Don't know how to automatically pick scale for object of type labelled. Defaulting to continuous.
## Don't know how to automatically pick scale for object of type labelled. Defaulting to continuous.

Доверительные интервалы не пересекаются при низких значениях оценки свободы слова (1-3), а это значит, что при данных значениях предсказанное значение оценки предпринятых правительством мер среди женщин значимо выше, чем у мужчин. Далее предсказанные значения у мужчин выше, но доверительные интервалы имеют пересечение.

Marginal effect plot.

library(sjPlot)
library(ggplot2)
theme_set(theme_sjplot())

fit <- lm(gvsrdcc ~ gndr + agea_cent +  eduyrs_cent + eneffap + psppipla*gndr , data = ESS2)

plot_model(fit, type = "pred", terms = "psppipla", title = "Предсказанные значения \n оценки предпринятых правительством мер", axis.title = c("Возможность свободы слова", "Оценка") )

График показывает предсказанные значения зависимой переменной в соответствии со значением переменной, отвечающей за возможность свободы слова в отношении к правительству.

theme_set(theme_sjplot())

fit <- lm(gvsrdcc ~ gndr + agea_cent +  eduyrs_cent + eneffap + psppipla*gndr , data = ESS2)
plot_model(fit, type = "pred", terms = c("psppipla", "gndr"), title = "Предсказанные значения \n оценки предпринятых правительством мер", axis.title = c("Возможность свободы слова", "Оценка") )

График показывает предсказанные значения зависимой переменной в соответствии со значением переменной, отвечающей за возможность свободы слова в отношении к правительству и полом.

ANOVA

anova(model8, model9)

## Analysis of Variance Table
## 
## Model 1: gvsrdcc ~ gndr + agea_cent + eneffap + eduyrs_cent + psppipla
## Model 2: gvsrdcc ~ gndr + agea_cent + eduyrs_cent + eneffap + psppipla * 
##     gndr
##   Res.Df    RSS Df Sum of Sq     F  Pr(>F)  
## 1   1414 5357.4                             
## 2   1413 5332.4  1    25.028 6.632 0.01012 *
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

sjt.lm(model8, model9, group.pred = FALSE, show.ci = F)

		gvsrdcc			gvsrdcc
		B	p		B	p
(Intercept)		3.49	<.001		4.02	<.001
gndrМужчины		-0.19	.070		-1.11	.003
agea_cent		0.00	.240		0.00	.255
eneffap		0.07	.001		0.07	.001
eduyrs_cent		-0.05	.001		-0.05	.002
psppipla		0.30	<.001		0.13	.170
gndrМужчины:psppipla					0.31	.010
Observations		1420			1420
R2 / adj. R2		.032 / .029			.036 / .032

Выводы:

1. P-value < 0.05, Adjusted R^2 во втором случае больше, следовательно, добавив в модель интерактивный эффект, мы значимо улучшили ее;
2. Наша гипотеза (о положительном влиянии возможности свободы слова на оценку достаточности принятия мер правительством) была подтверждена;
3. Model = Y = 4.02 - 1.1 * gndrМужчины - 0.05 * eduyrs_cent + 0.07 * eneffap + 0.3 *gndrМужчиныpsppipla.

Общий вывод:

Если же говорить о всей работе в целом, норвежцы обеспокоены изменением климата и предпринимают ряд усилий для сокращения потребления энергии. При этом, чем выше значение возраста, тем больше обеспокоенность. Однако, нет связи между числом лет, потраченных на образование, и степенью обеспокоенности возможным отключением электроэнергии. Гипотеза, которая была нами подтверждена - чем меньше респондент обеспокоен отключением электроэнергии, тем лучше оценивает достаточность принятия мер по сокращению климатических изменений. Однако, доход респондента и обеспокоенность отключением электроэнергии не влияют. Время же, потраченное на образование влияет негативно. Кроме того, было подтвержено, что чем больше респонденты оценивают возможность свободы слова, тем рни лучше оценивают предпринятые правительством меры.