Final Project

Политика в Швейцарии

Intro

Наша группа в качестве темы исследования решила выбрать отношение людей и участие в политике в Швейцарии по данным за 2016 год. Для начала мы сделали таблицу с переменными, к каждой из которой есть описание в следующих категориях: «качественная/количественная» переменная, ее «шкала измерения», и «дискретная или непрерывная» величина определенной переменной.

№	Variable	Qualitative/Quantitative	Level of Measurement	Continous/Discrete
1	Gender	Qualitative	Nominal	Discrete
2	Age	Quantitative	Ratio	Continous
3	How interesred in politics	Quantitative	Ordinal	Discrete
4	Trust in the legal system	Quantitative	Ordinal	Discrete
5	Voted last national election	Quantitative	Ordinal	Discrete
6	Taking part in lawful public demonstration last 12 months	Quantitative	Ordinal	Discrete
7	Posted or shared anything about politics online last 12 months	Quantitative	Ordinal	Discrete
8	Which party feel closer to	Quantitative	Ordinal	Discrete
9	How satisfied with present state of economy in country	Quantitative	Ordinal	Discrete
10	How satisfied with the national government	Quantitative	Ordinal	Discrete
11	How satisfied with the way democracy works in country	Quantitative	Ordinal	Discrete

Часть первая

library(ggplot2)
library(dplyr)
library(sjPlot)
library(RCurl)
library(car)
library(corrplot)

eval(parse(text = getURL("https://raw.githubusercontent.com/MaksimRudnev/LittleHelpers/master/download_ess/download_ess.R")))
Tesla <- download_ess(round = 8, country="CH", "vladlebedev2014@mail.ru")
Tesla <- dplyr::select(Tesla, c("agea","gndr","polintr", "psppsgva", "actrolga", "psppipla", "cptppola", "trstprl", "trstlgl", "trstplc", "trstplt", "trstprt", "trstep", "trstun", "vote", "prtvtfch", "contplt", "wrkprty", "wrkorg", "badge", "sgnptit", "pbldmn", "bctprd", "pstplonl", "clsprty", "prtclfch", "prtdgcl", "lrscale", "stflife", "stfeco", "stfgov", "stfdem", "stfedu", "stfhlth", "gincdif", "mnrgtjb", "freehms", "hmsfmlsh", "hmsacld", "euftf", "imsmetn", "imdfetn", "impcntr", "imbgeco", "imueclt", "imwbcnt"))

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

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

library(ggplot2)
ggplot()+ geom_histogram(data = Tesla, aes(x = agea, fill = factor(gndr)))+
  ylab("Количество")+
  xlab("Возраст")+
  ggtitle("Распределение возраста")+
  scale_fill_manual("Пол", values = c("#00B0F6", "#FF0034"), labels = c("Мужчины", "Женщины"))

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

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

## Warning: Removed 6 rows containing non-finite values (stat_bin).

Уровень заинтересованности в политике

Этот график дает нам информацию об уровне заинтересованности людей в политике, значения которого варьируются от 1 - показатель «очень заинтересован» до 9 – «нет ответа». Как можно заметить, большая часть населения Швейцарии отметила, что им «вполне интересно», что происходит в политической сфере их страны. В этом графике мода=2.

ggplot()+ geom_bar(data = Tesla, aes(x = factor(polintr))) + 
  theme_light()+ 
  xlab("Уровень заинтересованности")+
  ylab("Количество людей")+
  ggtitle("Уровень заинтересованности в политике")

Доверие к правовой системе

Следующий график описывает уровень доверия к правовой системе в стране, где данные варьируются от 0 – «совсем не доверяю» до 10 – «полностью доверяю». Большая часть опрошенных оценила свое доверие к правовой системе как 8.

hist(Tesla$trstlgl, xlab = "Уровень доверия к правовой системе", ylab = "Количество", main = "Доверие к правовой системе")

Наличие постов о политике за последние 12 месяцев в зависимости от возраста

Следующий график дает нам информацию о том, делятся ли люди разных возрастных категориях в социальных сетях какой-нибудь информацией, связанной с политической сферой. (1 – да, 2 – нет, NA – нет ответа). Как можно видеть, большая часть тех, кто делает какие-нибудь посты, принадлежат следующим возрастным категориям: от 25 и старше 45 лет. Что касается тех, кто не занимается подобной деятельностью, то подавляющее большинство принадлежит пожилым людям (>45 лет).

Tesla$age.gr <- ifelse(Tesla$agea > 45,"> 45", ifelse(Tesla$agea <= 45 & Tesla$agea >= 25,"25-45", ifelse(Tesla$agea < 25 & Tesla$agea >= 18,"18-24","< 18")))
ggplot()+ geom_bar(data = Tesla, aes(x = factor(pstplonl), fill = age.gr), position = "dodge")+
  xlab("Наличие постов о политике")+
  ylab("Количество")+
  ggtitle("Наличие постов о политике\nза последние 12 месяцев в зависимости\nот возраста")

Уровень удовлетворенности работой правительства

Следующий график показывает уровень удовлетворенности работы правительством, где 0 – «полностью не удовлетворён» и 10 – «полностью удовлетворен». Как можно заметить, большая часть опрошенных оценила свой уровень доверия в 7 и 8 значения.

ggplot()+ geom_bar(data = Tesla, aes( x = factor(stfgov)), fill = "#33FFFF")+
  ylab("Количество")+
  xlab("Уровень удовлетворенности правительством")+
  ggtitle("Уровень удовлетворенности\nработой правительства")+
  theme_light()

Уровень удовлетворенности демократией в зависимости от возраста

С помощью данных графиков можно сделать вывод о том, что в целом не наблюдается особой разницы между уровнем удовлетворенности демократией между разными возрастными группами, поскольку медианные значения находятся приблизительно на одном уровне. Среди групп < 18, 25-45 и > 45 есть несколько выбросов.

ggplot() +
  geom_boxplot(data = Tesla, aes(x = age.gr, y = as.numeric(stfdem), fill = age.gr)) +
  xlab("Возрастная группа") +
  ylab("Удовлетворенность уровнем демократии") +
  ggtitle("Уровень удовлетворенности демократией\nв зависимости от возрастной группы") +
  theme_light()

## Warning: Removed 45 rows containing non-finite values (stat_boxplot).

Часть вторая

В данной работе мы провели два статистических теста: t-test и хи-квадрат.

library(ggplot2)
library(dplyr)
library(sjPlot)
library(RCurl)
library(car)
library(corrplot)

eval(parse(text = getURL("https://raw.githubusercontent.com/MaksimRudnev/LittleHelpers/master/download_ess/download_ess.R")))
Tesla <- download_ess(round = 8, country="CH", "vladlebedev2014@mail.ru")
Tesla <- dplyr::select(Tesla, c("polintr", "psppsgva", "actrolga", "psppipla", "cptppola", "trstprl", "trstlgl", "trstplc", "trstplt", "trstprt", "trstep", "trstun", "vote", "prtvtfch", "contplt", "wrkprty", "wrkorg", "badge", "sgnptit", "pbldmn", "bctprd", "pstplonl", "clsprty", "prtclfch", "prtdgcl", "lrscale", "stflife", "stfeco", "stfgov", "stfdem", "stfedu", "stfhlth", "gincdif", "mnrgtjb","freehms", "hmsfmlsh", "hmsacld", "euftf", "imsmetn", "imdfetn", "impcntr", "imbgeco", "imueclt", "imwbcnt", "agea", "gndr"))

T-test

Отношение к демократии в зависимости от участия в выборах

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

Tesla.t.test <- Tesla %>% dplyr::select(vote, stfdem) %>% filter(vote %in% c(1,2))

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

Есть ли разница в отношении к демократии между теми кто голосовал и не голосовал?

Гипотезы

\(H_0\): нет разницы в отношении к демократии между теми кто голосовал и не голосовал
\(H_1\): разница есть

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

Наше распределение не является нормальным, поскольку p-value очень мало (p-value < 2.2e-16)

shapiro.test(Tesla.t.test$stfdem)

## 
##  Shapiro-Wilk normality test
## 
## data:  Tesla.t.test$stfdem
## W = 0.91741, p-value < 2.2e-16

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

hist(Tesla.t.test$stfdem, xlab = "Уровень удовлетворенности демократией", ylab = "Количество", main = "Уровень удовлетворенности демократией")

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

В связи с тем, что полученное распределение не нормальное, воспользуемся Levene’s Test.

leveneTest(as.numeric(Tesla.t.test$stfdem) ~ as.factor(Tesla.t.test$vote))

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

Также выполним проверку с помощью Bartlett test.

bartlett.test(as.numeric(Tesla.t.test$stfdem) ~ as.factor(Tesla.t.test$vote))

## 
##  Bartlett test of homogeneity of variances
## 
## data:  as.numeric(Tesla.t.test$stfdem) by as.factor(Tesla.t.test$vote)
## Bartlett's K-squared = 1.6715, df = 1, p-value = 0.1961

p-value = 0.002553 < 0.05, значит мы можем отклонить нулевую гипотезу на основе наших данных, и разница в отношении к демократии между голосовавшими и не голосовавшими присутствует.

t.test(Tesla.t.test$stfdem ~ Tesla.t.test$vote)

## 
##  Welch Two Sample t-test
## 
## data:  Tesla.t.test$stfdem by Tesla.t.test$vote
## t = 3.0297, df = 605.49, p-value = 0.002553
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  0.1332931 0.6245326
## sample estimates:
## mean in group 1 mean in group 2 
##        7.387634        7.008721

Чтобы сделать более точный вывод, применим тест Вилкоксона, поскольку распределение не нормальное
p-value = 0.001111 < 0.05, значит мы отклоняем нулевую гипотезу.

wilcox.test(Tesla.t.test$stfdem ~ Tesla.t.test$vote) 

## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  Tesla.t.test$stfdem by Tesla.t.test$vote
## W = 161780, p-value = 0.001111
## alternative hypothesis: true location shift is not equal to 0

ggplot() +
  geom_boxplot(data = na.omit(Tesla.t.test), aes(x = factor(vote), y = as.numeric(stfdem), fill = factor(vote))) +
   xlab("Голосовал или нет") +
  ylab("Уровень доверия к демократии") +
  ggtitle("Уровень доверия к демократии\nв зависимости от участия в выборах") +
  theme_light()+
  scale_fill_manual("Участие в выборах", values = c("#00B0F6", "#FF67A4"), labels = c("Участвовал(а)", "Не участвовал(а)"))+
  scale_x_discrete(labels = c("Участвовал(а)", "Не участвовал(а)"))

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

Хи-квадрат

(Men should have more right to job than women when jobs are scarce)

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

Есть ли разница в отношении мужчин и женщин к приоритету мужчин к большим правам отосительно ограниченного количества рабочих мест?

Гипотезы

\(H_0\):Нет разницы в отношении мужчин и женщин к приоритету мужчин к большим правам отосительно ограниченного количества рабочих мест
\(H_1\): Есть разница

Для начала убедимся, что в каждой ячейке находится не менее 5 наблюдений

Table <- table(Tesla$gndr,Tesla$mnrgtjb)
row.names(Table) <- c("Male","Female") 
colnames(Table) <- c("Agree strongly","Agree", "Neither agree nor disagree", "Disagree", "Disagree strongly")
Table

##         
##          Agree strongly Agree Neither agree nor disagree Disagree
##   Male               14    86                        129      288
##   Female             10    86                         99      213
##         
##          Disagree strongly
##   Male                 263
##   Female               329

Построим хи-квадрат:

chi <- chisq.test(Tesla$gndr,Tesla$mnrgtjb)
chi

## 
##  Pearson's Chi-squared test
## 
## data:  Tesla$gndr and Tesla$mnrgtjb
## X-squared = 21.999, df = 4, p-value = 0.0002006

Визуализируем полученный результат:

• Количество мужчин “сильно негативно” относящихся к приоритету мужчин к большим правам отосительно ограниченного количества рабочих мест оказалось меньше ожидаемого, в то время как просто “негативно” - больше
  
• Также количество женщин “сильно негативно” относящихся к приоритету мужчин к большим правам отосительно ограниченного количества рабочих мест оказалось больше ожидаемого, в то время как просто “негативно” - меньше

chi_resid = as.data.frame(chi$residuals)
chi_count = as.data.frame(chi$observed)

ggplot() + 
  geom_raster(data = chi_resid, aes(x = Tesla.gndr, y = Tesla.mnrgtjb, fill = Freq), hjust = 0.5, vjust = 0.5) + 
  scale_fill_gradient2("Пирсоновские остатки", low = "#2166ac", mid = "#f7f7f7", high = "#b2182b", midpoint = 0) +
  geom_text(data = chi_count, aes(x = Tesla.gndr, y = Tesla.mnrgtjb, label = Freq)) +
  xlab("Пол") +
  ylab("Отношение")+
  scale_x_discrete(labels = c("Мужчины", "Женщины"))

Третья часть

В данной работе мы провели статистический тест ANOVA. Для этого были выбраны две переменные: категориальная и количественная. Первая- степень удовлетворенности правительством. Вторая- насколько политическая система позволяет иметьправо голоса в деятельности правительства.

library(ggplot2)
library(dplyr)
library(sjPlot)
library(RCurl)
library(car)
library(corrplot)

eval(parse(text = getURL("https://raw.githubusercontent.com/MaksimRudnev/LittleHelpers/master/download_ess/download_ess.R")))
Tesla <- download_ess(round = 8, country="CH", "vladlebedev2014@mail.ru")
Tesla <- dplyr::select(Tesla, c("psppsgva","stfgov", "gndr"))

Среднее значение по каждой группе

tapply(Tesla$stfgov, Tesla$psppsgva, mean, na.rm = T) 

##        1        2        3        4        5 
## 6.204724 6.079295 6.337972 6.997872 7.376344

Дисперсии для каждой группы

tapply(Tesla$stfgov, Tesla$psppsgva, var, na.rm = T)

##        1        2        3        4        5 
## 4.989501 4.073330 3.013037 2.518119 2.845956

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

tapply(Tesla$stfgov, Tesla$psppsgva, length)

##   1   2   3   4   5 
## 138 239 519 482  93

Boxplot

ggplot() + 
  geom_boxplot(data = na.omit(Tesla), aes(y=as.numeric(stfgov), x=as.factor(psppsgva), fill=as.factor(psppsgva)))+
  ggtitle("Взаимодействие граждан и правительства")+
  xlab ("Насколько политическая система позволяет иметь\n право голоса в деятельности правительства")+
  ylab ("Степень удовлетворенности правительством")+
  scale_x_discrete(labels = c("Совсем нет", "Очень мало", "Умеренно", "Много", "Очень много"))

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

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

Гипотезы

\(H_0\) распределение нормальное \(H_1\) распределение не нормальное

shapiro.test(Tesla$stfgov[Tesla$psppsgva == "1"])

## 
##  Shapiro-Wilk normality test
## 
## data:  Tesla$stfgov[Tesla$psppsgva == "1"]
## W = 0.91561, p-value = 7.385e-07

shapiro.test(Tesla$stfgov[Tesla$psppsgva == "2"])

## 
##  Shapiro-Wilk normality test
## 
## data:  Tesla$stfgov[Tesla$psppsgva == "2"]
## W = 0.93959, p-value = 4.472e-08

shapiro.test(Tesla$stfgov[Tesla$psppsgva == "3"])

## 
##  Shapiro-Wilk normality test
## 
## data:  Tesla$stfgov[Tesla$psppsgva == "3"]
## W = 0.95257, p-value = 1.254e-11

shapiro.test(Tesla$stfgov[Tesla$psppsgva == "4"])

## 
##  Shapiro-Wilk normality test
## 
## data:  Tesla$stfgov[Tesla$psppsgva == "4"]
## W = 0.91122, p-value = 5.789e-16

shapiro.test(Tesla$stfgov[Tesla$psppsgva == "5"])

## 
##  Shapiro-Wilk normality test
## 
## data:  Tesla$stfgov[Tesla$psppsgva == "5"]
## W = 0.85875, p-value = 5.984e-08

Для всех групп не нормальное распределение

Нормальность распределения для каждой группе

Поскольку в нашей выборке меньше 5000 наблюдений, необходимо проверить нормальность распределения остатков.

Гипотезы

\(H_0\) распределение остатков нормальное
\(H_1\) распределение остатков не нормальное

p-value < 2.2e-16 - поэтому распределение не нормальное

model = aov(Tesla$stfgov~Tesla$psppsgva) 
res = model$residuals 
shapiro.test(res)

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

Сравнение дисперсий

P-value очень (6.871e-08) маленькое, значит мы можем отклонить нулевую гипотезу и дисперсии не равны

Гипотезы

\(H_0\): дисперсии равны
\(H_1\): дисперсии не равны

leveneTest(as.numeric(Tesla$stfgov) ~ factor(Tesla$psppsgva))

## Levene's Test for Homogeneity of Variance (center = median)
##         Df F value    Pr(>F)    
## group    4   9.886 6.871e-08 ***
##       1415                      
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

ANOVA

Гипотезы

\(H_0\) нет разницы между группами
\(H_1\) разница есть, как минимум в одной паре групп

P-value ниже уровня значимости, поэтому мы можем отвергнуть нулевую гипотезу, и средние значения как минимум для двух групп не равны.
F (4.00, 371.68)= 19.691, p-value = 1.03e-14

oneway.test(Tesla$stfgov ~ Tesla$psppsgva, var.equal = FALSE)

## 
##  One-way analysis of means (not assuming equal variances)
## 
## data:  Tesla$stfgov and Tesla$psppsgva
## F = 19.691, num df = 4.00, denom df = 371.68, p-value = 1.03e-14

Post hoc test

pairwise.t.test(Tesla$stfgov, as.factor(Tesla$psppsgva), adjust="bonferroni") 

## 
##  Pairwise comparisons using t tests with pooled SD 
## 
## data:  Tesla$stfgov and as.factor(Tesla$psppsgva) 
## 
##   1       2       3       4   
## 2 0.90    -       -       -   
## 3 0.90    0.25    -       -   
## 4 4.7e-05 2.6e-09 8.0e-08 -   
## 5 1.0e-05 4.0e-08 2.0e-06 0.25
## 
## P value adjustment method: holm

Есть значимые различия между группами 4-1, 4-2, 4-3 и 5-1, 5-1, 5-3 (самые значимое отличие между значением “Очень мало” и “Много”)

Критерий Краскела-Уоллиса

Данный критерий основан на проверке равенства медиан, а не средних. Поэтому данный тест менее чувствителен к выбросам

Гипотезы

\(H_0\) нет разницы между группами
\(H_1\) разница есть, как минимум в одной паре групп

kruskal.test(Tesla$stfgov ~ Tesla$psppsgva)

## 
##  Kruskal-Wallis rank sum test
## 
## data:  Tesla$stfgov by Tesla$psppsgva
## Kruskal-Wallis chi-squared = 77.482, df = 4, p-value = 5.946e-16

P-value ниже уровня значимости, поэтому мы можем отвергнуть нулевую гипотезу, и средние значения как минимум для двух групп не равны.