Homework 4
Team LovePugs
Политика в Швейцарии
Regression
library(foreign)
library(ggplot2)
library(dplyr)
library(RCurl)
library(corrplot)
library(sjPlot)
library(lmtest)
library(plyr)
library(car)
getwd()## [1] "/Users/puggy/Desktop/Регрессия"hw4 <- read.csv("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"))Для анализа регрессии мы решили выбрать следующие переменные: возраст(agea), пол(gndr), заинтересованность в политике, доверие к полиции и политикам в качестве независимых, как зависимую - доверие к политической системе.
model1 <- lm(trstlgl ~ agea, data = sos)
summary(model1)##
## Call:
## lm(formula = trstlgl ~ agea, data = sos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.9733 -1.3668 0.3161 1.4678 3.9640
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.290360 0.148210 49.189 < 2e-16 ***
## agea -0.013784 0.002879 -4.788 1.86e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.078 on 1487 degrees of freedom
## (36 observations deleted due to missingness)
## Multiple R-squared: 0.01518, Adjusted R-squared: 0.01452
## F-statistic: 22.92 on 1 and 1487 DF, p-value: 1.856e-06Видно, что предиктор “возраст” с большой вероятностью влияет на доверие к политической системе, так как p-value < 0.05. F-statistic равна 22.92, и это значит, что оно значимо и указывает на то, что регрессионная модель хорошо описывает данные. Последний показатель - p-value, который по значению p-value: 1.856e-06, что говорит о том, что модель значима. Adjusted R-squared: 0.014, значит наша модель описывает 1%
model2 <- lm(trstlgl ~ as.factor(gndr), data = sos)
summary(model2)##
## 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Следующая модель показывает, что предиктор “гендер” не влияет на участие в выборах. Коэфициент не является значимым - p-value - 0.349. F-statistic: 0.8789 on 1 and 1492 DF и p-value: 0.3486 указывают на то, что построенная регрессионная модель не значима.
model3 <- lm(trstlgl ~ polintr, data = sos)
summary(model3)##
## Call:
## lm(formula = trstlgl ~ polintr, data = sos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -7.0001 -1.4377 0.2811 1.2811 3.8435
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 7.28125 0.15155 48.045 < 2e-16 ***
## polintr -0.28119 0.06101 -4.609 4.4e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.078 on 1491 degrees of freedom
## (32 observations deleted due to missingness)
## Multiple R-squared: 0.01405, Adjusted R-squared: 0.01338
## F-statistic: 21.24 on 1 and 1491 DF, p-value: 4.399e-06В другой модели можно увидеть, что предиктор “заинтересованность в политике” влияет на доверие к правовой системе, так как p-value 4.4e-06. F-statistic: 21.24, p-value: 4.399e-06 & Adjusted R-squared: 0.01338 также говорит о том, что модель нормально описывает данные.
ggplot() +
geom_bar(data = sos, aes(x = polintr, fill = factor (polintr)), position = "dodge") +
xlab("Уровень интереса") +
ylab("Количество") +
ggtitle("Заинтересованность респондентов в политике") +
scale_fill_manual("Заинтересованность", values = c("#FF0066", "#FF67A4", "#33FF66", "#00CCFF"), labels = c("1-очень заинтересованы", "2-достаточно заинтересованы", "3-слабо заинтересованы", "4-совсем не заинтересованы"))## Warning: Removed 1 rows containing non-finite values (stat_count).
ggplot() +
geom_histogram(data = sos, aes(x = agea), fill = "#33FFFF")+
ggtitle("Распределение по возрасту")+
xlab("Возраст")+
ylab("Количество")+
theme_light()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.## Warning: Removed 6 rows containing non-finite values (stat_bin).
ggplot()+
geom_bar(data = sos, aes(x = as.factor (gndr)), fill = "#20B2AA", alpha = 0.5)+
ggtitle("")+
xlab("Гендер")+
ylab("Количество")
В представленной ниже модели используются и другие предикторы - уровень доверия к полиции и политикам, возраст и заинтересованность в политике.
Данная модель довольно хорошо описывает данные (47%), а также все предикторы являются значимыми.
model_full <- lm(trstlgl ~ gndr + trstplc + trstplt + agea + polintr, data = sos)
summary(model_full)##
## Call:
## lm(formula = trstlgl ~ gndr + trstplc + trstplt + agea + polintr,
## data = sos)
##
## Residuals:
## Min 1Q Median 3Q Max
## -7.0390 -0.7715 0.1249 0.9489 6.1838
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.659122 0.255776 10.396 < 2e-16 ***
## gndr -0.105561 0.080717 -1.308 0.191
## trstplc 0.533374 0.023076 23.114 < 2e-16 ***
## trstplt 0.288645 0.022959 12.572 < 2e-16 ***
## agea -0.017563 0.002179 -8.060 1.58e-15 ***
## polintr -0.192934 0.047600 -4.053 5.32e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1.517 on 1451 degrees of freedom
## (68 observations deleted due to missingness)
## Multiple R-squared: 0.4754, Adjusted R-squared: 0.4736
## F-statistic: 262.9 on 5 and 1451 DF, p-value: < 2.2e-16Shapiro.test
shapiro.test(sos$trstlgl)##
## Shapiro-Wilk normality test
##
## data: sos$trstlgl
## W = 0.94009, p-value < 2.2e-16Наше распределение является не нормальным, так как p-value < 2.2e-16
Линейность зависимости
leveragePlots(model_full)
Как можно заметить, зависимости в целом линейные
crPlots(model_full)
Нормальность
Распределение не нормальное, а также есть некоторые выбросы.
qqPlot(model_full, main = "График Q-Q")
ggplot() +
geom_bar(data = sos, aes(x = trstplc, fill = factor (trstplc))) +
xlab("Уровень доверия") +
ylab("Количество") +
ggtitle("Уровень доверия к полиции")## Warning: Removed 6 rows containing non-finite values (stat_count).
ggplot() +
geom_bar(data = sos, aes(x = trstplt, fill = factor(trstplt))) +
xlab("Уровень доверия") +
ylab("Количество") +
ggtitle("Уровень доверия к политикам")## Warning: Removed 45 rows containing non-finite values (stat_count).