To accompany your final model: 5) you have provided a correct interpretation of the overall model fit (F-statistic, R-squared) 6) correct interpretation of all coefficients

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

Для анализа регрессии мы решили выбрать следующие переменные: возраст(agea), пол(gndr), количество лет потраченных на образование (eduyrs), заинтересованность в политике(polintr), удовлетворенность жизнью в целом в качестве независимых(stflife), как зависимую - доверие к политической системе(trstlgl).

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

Что может оказать влияние на доверие граждан к политической системе в Швейцарии?

Гипотезы:

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

Описательная статистика

library(foreign)
library(ggplot2)
library(dplyr)
library(RCurl)
library(corrplot)
library(sjPlot)
library(lmtest)
library(plyr)
library(car)
hw4 <- read.csv("~/Desktop/Регрессия/hw4.csv")

library(dplyr)
sos <- dplyr::select(hw4, 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", "stflife", "eduyrs"))

sos$polintr_new <- mapvalues(sos$polintr, from = c(1:4), to = c(4:1))

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

Получившеяся гистограмма (где 1 - совсем не доверяю и 10 - полностью доверяю) говорит о том, что респондеты больше доверяют политической системе их страны, чем нет.

ggplot() +
geom_bar(data = sos, aes(x = trstlgl), fill = "#FF9999")+
  ggtitle("Доверие к политической системе")+
  xlab("Уровень доверия")+
  ylab("Количество")+
  theme_light()

Пол

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

ggplot()+
  geom_bar(data = sos, aes(x = as.factor (gndr)), fill = "#20B2AA", alpha = 0.5)+
  ggtitle("Распределение по полу")+
xlab("Гендер")+
  ylab("Количество")

ggplot()+ geom_boxplot(data = sos, aes(x = as.factor(gndr), y = trstlgl), col = "#E52B50", fill = "#F0F8FF")+
  ggtitle("Доверие к политической сестеме в зависимости от пола")+
  xlab("Пол")+
  ylab(" ")+
  theme_light()

Возраст

Далее мы рассмотрели распределение по возрасту респондентов, здесь можно заметить большое количество тех, кому примерно чуть меньше 25 лет, 30, 40, 50, 60 и 70 лет.

ggplot() +
geom_histogram(data = sos, aes(x = agea), fill = "#33FFFF")+
  ggtitle("Распределение по возрасту")+
  xlab("Возраст")+
  ylab("Количество")+
  theme_light()

ggplot()+ geom_point(data = sos, aes(x = agea, y = trstlgl))

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

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

ggplot() +
geom_bar(data = sos, aes(x = eduyrs), fill = "#FF3333")+
  ggtitle("Количество лет потраченных на образование")+
  xlab("Потраченные года")+
  ylab("Количество")+
  theme_light()

ggplot()+ geom_point(data = sos, aes(x = eduyrs, y = trstlgl))

Удовлетворенность жизнью в целом

На этой жегистограмме предствлены результаты удовлетворенностью жизнью респондентов, где 1 - совсем неудовлетворен, 10 - полностью удовлетворен. Как можно заметить, подавляющее большинство опрошенных оценили свою удовлетворенность в 8 баллов и выше.

ggplot() +
geom_bar(data = sos, aes(x = stflife), fill = "#FF6666", alpha = 0.8)+
  ggtitle("Удовлетворенность жизнью в целом")+
  xlab("Степень удовлетворенности")+
  ylab("Количество")+
  theme_light()

ggplot()+ geom_point(data = sos, aes(x = stflife, y = trstlgl))

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

Гистограмма дает нам информацию о заинтересованности респондентов в политике, можно заметить, что большинство опрошенных достаточно заинтересованы (около 600), когда количество совсем незаинтересованных состовляет около 200.

ggplot() +
  geom_bar(data = sos, aes(x = polintr_new, fill = factor (polintr_new)), position = "dodge") +
  xlab("Уровень интереса") +
  ylab("Количество") +
  ggtitle("Заинтересованность респондентов в политике") +
  scale_fill_manual("Заинтересованность", values = c("#FF0066", "#FF67A4", "#33FF66", "#00CCFF"), labels = c("1-совсем не заинтересованы", "2-слабо заинтересованы", "3-достаточно заинтересованы", "4-очень заинтересованы"))

ggplot()+ geom_point(data = sos, aes(x = polintr_new, y = trstlgl))

Модели

Поскольку F-statistic не значима и p-value: 0.3486, модель является не очень хорошей.

model_1 <- lm(trstlgl ~ as.factor(gndr), data = sos)
summary(model_1)

## 
## Call:
## lm(formula = trstlgl ~ as.factor(gndr), data = sos)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -6.6778 -1.5762  0.3222  1.4238  3.4238 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       6.67779    0.07495  89.099   <2e-16 ***
## as.factor(gndr)2 -0.10157    0.10834  -0.938    0.349    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.092 on 1492 degrees of freedom
##   (31 observations deleted due to missingness)
## Multiple R-squared:  0.0005887,  Adjusted R-squared:  -8.11e-05 
## F-statistic: 0.8789 on 1 and 1492 DF,  p-value: 0.3486

Trust in Legal System = 7.3 - 0.088*GenderFemale - 0.0137*Age

model_2 <- lm(trstlgl ~ as.factor(gndr) + agea, data = sos)
summary(model_2)

## 
## Call:
## lm(formula = trstlgl ~ as.factor(gndr) + agea, data = sos)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -7.0136 -1.3550  0.3212  1.4529  4.0072 
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       7.329156   0.155707  47.070  < 2e-16 ***
## as.factor(gndr)2 -0.087770   0.107866  -0.814    0.416    
## agea             -0.013721   0.002881  -4.763 2.09e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.078 on 1486 degrees of freedom
##   (36 observations deleted due to missingness)
## Multiple R-squared:  0.01562,    Adjusted R-squared:  0.01429 
## F-statistic: 11.79 on 2 and 1486 DF,  p-value: 8.324e-06

Trust in Legal System = 6.49 + 0.005*GenderFemale - 0.017*Age + 0.35*InterestInPolitics

model_3 <- lm(trstlgl ~ as.factor(gndr) + agea + polintr_new, data = sos)
summary(model_3)

## 
## Call:
## lm(formula = trstlgl ~ as.factor(gndr) + agea + polintr_new, 
##     data = sos)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -6.9794 -1.2163  0.3098  1.4435  4.6307 
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       6.490641   0.211672  30.664  < 2e-16 ***
## as.factor(gndr)2  0.005775   0.107966   0.053    0.957    
## agea             -0.017291   0.002919  -5.923 3.93e-09 ***
## polintr_new       0.359943   0.062481   5.761 1.02e-08 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.056 on 1484 degrees of freedom
##   (37 observations deleted due to missingness)
## Multiple R-squared:  0.03705,    Adjusted R-squared:  0.0351 
## F-statistic: 19.03 on 3 and 1484 DF,  p-value: 4.123e-12

Trust in Legal System = 4.9 - 0.026*GenderFemale - 0.018*Age + 0.31*+ 0.2193*SatisfactionLife

model_4 <- lm(trstlgl ~ as.factor(gndr) + agea + polintr_new + stflife, data = sos)
summary(model_4)

## 
## Call:
## lm(formula = trstlgl ~ as.factor(gndr) + agea + polintr_new + 
##     stflife, data = sos)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -7.2582 -1.2383  0.2643  1.4175  5.3034 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       4.90109    0.30873  15.875  < 2e-16 ***
## as.factor(gndr)2 -0.02620    0.10643  -0.246    0.806    
## agea             -0.01847    0.00288  -6.413 1.92e-10 ***
## polintr_new       0.31343    0.06187   5.066 4.58e-07 ***
## stflife           0.21930    0.03142   6.981 4.42e-12 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.025 on 1482 degrees of freedom
##   (38 observations deleted due to missingness)
## Multiple R-squared:  0.06753,    Adjusted R-squared:  0.06502 
## F-statistic: 26.83 on 4 and 1482 DF,  p-value: < 2.2e-16

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

model_full <- lm(trstlgl ~ as.factor(gndr) + agea + polintr + stflife + eduyrs, data = sos)
summary(model_full)

## 
## Call:
## lm(formula = trstlgl ~ as.factor(gndr) + agea + polintr + stflife + 
##     eduyrs, data = sos)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -7.1177 -1.2305  0.2854  1.4061  5.5533 
## 
## Coefficients:
##                   Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       5.799727   0.414075  14.006  < 2e-16 ***
## as.factor(gndr)2 -0.031027   0.106371  -0.292  0.77057    
## agea             -0.016969   0.002916  -5.820 7.20e-09 ***
## polintr          -0.272712   0.063753  -4.278 2.01e-05 ***
## stflife           0.218565   0.031383   6.965 4.94e-12 ***
## eduyrs            0.045139   0.015565   2.900  0.00379 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 2.02 on 1478 degrees of freedom
##   (41 observations deleted due to missingness)
## Multiple R-squared:  0.0729, Adjusted R-squared:  0.06976 
## F-statistic: 23.24 on 5 and 1478 DF,  p-value: < 2.2e-16

Предположения

Линейность и остатки

Как мы можем увидеть, p-value меньше, чем 0,05. Есть выбросы.

model_full <- lm(trstlgl ~ as.factor(gndr) + agea + polintr + stflife + eduyrs, data = sos)
outlierTest(model_full)

## 
## No Studentized residuals with Bonferonni p < 0.05
## Largest |rstudent|:
##      rstudent unadjusted p-value Bonferonni p
## 780 -3.543929         0.00040649      0.60324

Независимые ошибки

durbinWatsonTest(model_full)

##  lag Autocorrelation D-W Statistic p-value
##    1     -0.03887576      2.075682   0.154
##  Alternative hypothesis: rho != 0

Гомоскедастичность

ncvTest(model_full)

## Non-constant Variance Score Test 
## Variance formula: ~ fitted.values 
## Chisquare = 25.67502    Df = 1     p = 4.040239e-07

Нормальность остатков

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

qqPlot(model_full, main = "QQ Plot" )

Сравнение моделей

#anova(model_1, model_2)

sjt.lm(model_1, model_2, model_3, model_4, model_full, show.ci = F, p.numeric = F)

		trstlgl	trstlgl	trstlgl	trstlgl	trstlgl
		B	B	B	B	B
(Intercept)		6.68 ***	7.33 ***	6.49 ***	4.90 ***	5.80 ***
as.factor(gndr) (2)		-0.10	-0.09	0.01	-0.03	-0.03
agea			-0.01 ***	-0.02 ***	-0.02 ***	-0.02 ***
polintr_new				0.36 ***	0.31 ***
stflife					0.22 ***	0.22 ***
polintr						-0.27 ***
eduyrs						0.05 **
Observations		1494	1489	1488	1487	1484
R² / adj. R²		.001 / -.000	.016 / .014	.037 / .035	.068 / .065	.073 / .070
Notes	* p<.05 p<.01 * p<.001

Homework 4

Team LovePugs