library(psych)
library(haven)
library(dplyr)
library(ggplot2)
library(sjPlot)
library(RColorBrewer)
library(grid)
library(gridExtra)
library(lattice)
dbp <- read_sav("C:\\Users\\ASUS\\Documents\\проект школы\\SchoolChoice_dataclean_withisei_06172019.sav")
db1 <- dbp %>%
select ("schtype", "q19", "q21", "q24", "momedu", "fathedu", "q39", "q40", "q41", "q42", "ISEI_08_mom", "ISEI_08_dad")
db1$schtype <- as.factor(db1$schtype)
db1$q19[db1$q19 == "1"] <- "да"
db1$q19[db1$q19 == "2"] <- "нет"
db1$q19 <- as.factor(db1$q19)
db1$q21[db1$q21 == "1"] <- "да"
db1$q21[db1$q21 == "2"] <- "нет"
db1$q21[db1$q21 == "3"] <- NA
db1$q21 <- as.factor(db1$q21)
db1$q24[db1$q24 == "1"] <- "да"
db1$q24[db1$q24 == "0"] <- "нет"
db1$q24[db1$q24 == "4"] <- NA
db1$q24 <- as.factor(db1$q24)
db1$fathedu[db1$fathedu == "1" |
db1$fathedu == "2"] <- "1+2"
db1$fathedu <- as.factor(db1$fathedu)
db1$momedu[db1$momedu == "1" |
db1$momedu == "2"] <- "1 + 2"
db1$momedu <- as.factor(db1$momedu)
db1$q41[db1$q41 == "1" |
db1$q41 == "2"] <- "1 полка и меньше (<40 книг)"
db1$q41[db1$q41 == "3" |
db1$q41 == "4"] <- "2-3 полки (60-120 книг)"
db1$q41[db1$q41 == "5" ] <- "4-5 полок (120-200 книг)"
db1$q41[db1$q41 == "6" ] <- "6 и больше полок (>200 книг)"
db1$q41 <- as.factor(db1$q41)
db1$q42[db1$q42 == "2" |
db1$q42 == "3"|
db1$q42 == "5"] <- "Не знаю"
db1$q42[db1$q42 == "1"] <- "Да"
db1$q42[db1$q42 == "4"] <- "Нет"
db1$q42 <- as.factor(db1$q42)
describeBy(db1)
db2 <- db1 %>% select(q19, q21, q24)
db2 <- na.omit(db2)
g1.1 <- ggplot(db2, aes(x = q24, fill = q24)) +
geom_bar(aes(y = prop.table(..count..) * 100),
position = "dodge") +
geom_text(aes(y = prop.table(..count..) * 100 + 0.5,
label = paste0(round(prop.table(..count..) * 100,digits= 2), '%')),
stat = 'count',
position = position_dodge(.9),
size = 5) +
labs(y="", x = "",
title="Рассматривали ли\nродители альтернативы\nпри выборе школы?") +
theme_bw() +
theme(axis.text = element_text(size=13.5), plot.title = element_text(size=12), legend.position = "none") +
scale_fill_manual(values=c("lightseagreen", "tomato2"))
g1.2 <- ggplot(db2, aes(x = q19, fill = q19)) +
geom_bar(aes(y = prop.table(..count..) * 100),
position = "dodge") +
geom_text(aes(y = prop.table(..count..) * 100 + 0.5,
label = paste0(round(prop.table(..count..) * 100,digits= 2), '%')),
stat = 'count',
position = position_dodge(.9),
size = 5) +
labs(y="Пропорция ответов (%)", x = "",
title="Ближайшая ли\nк дому школа") +
theme_bw() +
theme(axis.text = element_text(size=13.5), plot.title = element_text(size=12), legend.position = "none") +
scale_fill_manual(values=c("lightseagreen", "tomato2"))
g1.3 <- ggplot(db2, aes(x = q21, fill = q21)) +
geom_bar(aes(y = prop.table(..count..) * 100),
position = "dodge") +
geom_text(aes(y = prop.table(..count..) * 100 + 0.5,
label = paste0(round(prop.table(..count..) * 100,digits= 2), '%')),
stat = 'count',
position = position_dodge(.9),
size = 5) +
labs(y="", x = "",
title="Приписан ли дом\nк школе?") +
theme_bw() +
theme(axis.text = element_text(size=13.5), plot.title = element_text(size=12), legend.position = "none") +
scale_fill_manual(values=c("lightseagreen", "tomato2"))
grid.arrange(g1.2, g1.3, g1.1, ncol=3, top = textGrob("Тенденции выбора школы", gp=gpar(fontsize=17)))
В общем и целом мы наблюдаем следующую картину:
Нас наиболее заинтересовало с чем может быть связано рассматривают ли родители альтернативные варианты школ или нет. На данный момент родитель (законный представитель) ребенка может выбрать от 1-й до 3-х школ при подаче электронного заявления (информация получена с сайта ГосУслуг, https://gu.spb.ru/first-school/).
Выбор школы - стратегия среднего класса, так ли это? Проверим нашими тестами!
sjp.xtab(db1$momedu, db1$q24,
margin = "row",
bar.pos = "stack",
axis.titles = "Образование матери",
legend.title = "Рассматривали ли родители альтернативы при выборе школы",
show.summary = TRUE,
coord.flip = TRUE)
sjp.xtab(db1$fathedu, db1$q24,
margin = "row",
bar.pos = "stack",
axis.titles = "Образование отца",
legend.title = "Рассматривали ли родители альтернативы при выборе школы",
show.summary = TRUE,
coord.flip = T)
t_momedu_24 <- with(db1, table(momedu, q24))
chi_momedu_24 <- chisq.test(t_momedu_24)
chi_momedu_24
##
## Pearson's Chi-squared test
##
## data: t_momedu_24
## X-squared = 18.868, df = 2, p-value = 7.996e-05
chi_momedu_24$stdres
## q24
## momedu да нет
## 1 + 2 -0.961090 0.961090
## 3 -4.031764 4.031764
## 4 4.158092 -4.158092
t_fathedu_24 <- with(db1, table(fathedu, q24))
chi_fathedu_24 <- chisq.test(t_fathedu_24)
chi_fathedu_24
##
## Pearson's Chi-squared test
##
## data: t_fathedu_24
## X-squared = 24.64, df = 2, p-value = 4.461e-06
chi_fathedu_24$stdres
## q24
## fathedu да нет
## 1+2 -2.873305 2.873305
## 3 -3.256310 3.256310
## 4 4.928624 -4.928624
Вывод 1: Родители с высшим образованием чаще рассматривают альтернативные варианты школы, не останавливаясь на одном (выбирают), а родители со средним профессиональным образованием (по отцам + среднее) не рассматривают других вариантов, кроме одной школы - чаще той, к которой приписаны.
sjp.xtab(db1$q41, db1$q24,
margin = "row",
bar.pos = "stack",
axis.titles = "Количество книг в доме",
legend.title = "Рассматривали ли родители альтернативы при выборе школы",
show.summary = TRUE,
coord.flip = TRUE)
t_41_24 <- table(db1$q41, db1$q24)
chi_41_24 <- chisq.test(t_41_24)
chi_41_24
##
## Pearson's Chi-squared test
##
## data: t_41_24
## X-squared = 29.44, df = 3, p-value = 1.81e-06
chi_41_24$stdres
##
## да нет
## 1 полка и меньше (<40 книг) -3.907509 3.907509
## 2-3 полки (60-120 книг) -1.779244 1.779244
## 4-5 полок (120-200 книг) 1.388654 -1.388654
## 6 и больше полок (>200 книг) 4.518116 -4.518116
Вывод 2: на графике видно, что с увеличением книг в доме увеличивается и тенденция родителей выбирать школу, не останавливаясь на одном варианте. Результаты теста это подтверждают: в семьях, где большое количество книг в доме (больше 6 полок или >200 книг) родители часто рассматривают альтернативные варианты при выборе школы, в то время как чем меньше книг - тем чаще родители склонны останавливать выбор только на одной.
sjp.xtab(db1$q42, db1$q24,
margin = "row",
bar.pos = "stack",
axis.titles = "Планируют ли родители давать\nвысшее образование своему ребёнку",
legend.title = "Рассматривали ли родители альтернативы при выборе школы",
show.summary = TRUE,
coord.flip = TRUE)
## Warning in stats::chisq.test(ftab): Chi-squared approximation may be
## incorrect
t_42_24 <- table(db1$q42, db1$q24)
chi_42_24 <- chisq.test(t_42_24)
## Warning in chisq.test(t_42_24): Chi-squared approximation may be incorrect
chi_42_24
##
## Pearson's Chi-squared test
##
## data: t_42_24
## X-squared = 11.326, df = 2, p-value = 0.003472
chi_42_24$stdres
##
## да нет
## Да 3.222568 -3.222568
## Не знаю -3.153994 3.153994
## Нет -1.095976 1.095976
Вывод 3: родители, которые рассчитывают в будущем дать ребёнку высшее образование рассматривают различные варианты школ, в то время как родители, которые не могут дать однозначного ответа получит ребёнок высшее образование или нет, чаще не рассматривают альтернативных вариантов при выборе школы.
db2 <- db1 %>% select(ISEI_08_mom, ISEI_08_dad, q24)
db2 <- na.omit(db2)
plot1 <- ggplot(db2, aes(x = q24, y = ISEI_08_mom, fill = q24)) +
geom_boxplot() +
labs(y="Социально-профессиональный статус", x = "",
title="СПС матери") +
theme_bw() +
theme(legend.position = "none", axis.text = element_text(size=13)) +
scale_fill_manual(values=c("mistyrose", "palevioletred3"))
plot2 <- ggplot(db2, aes(x = q24, y = ISEI_08_dad, fill = q24)) +
geom_boxplot() +
labs(y="", x = "",
title="СПС отца") +
theme_bw() +
theme(legend.position = "none", axis.text = element_text(size=11)) +
scale_fill_manual(values=c("lightblue1", "lightskyblue3"))
grid.arrange(plot1, plot2, ncol=2, top = textGrob("Рассматривают ли родители альтернативы",gp=gpar(fontsize=17)))
По матери - ничего интересного. И на графике видно, и тест подтвердил, что разница в средний значениях не значительна.
t.test(db1$ISEI_08_mom ~ db1$q24)
##
## Welch Two Sample t-test
##
## data: db1$ISEI_08_mom by db1$q24
## t = 2.7793, df = 1247.8, p-value = 0.005529
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.5546207 3.2167095
## sample estimates:
## mean in group да mean in group нет
## 51.56367 49.67800
t.test(db1$ISEI_08_dad ~ db1$q24)
##
## Welch Two Sample t-test
##
## data: db1$ISEI_08_dad by db1$q24
## t = 3.3919, df = 1268.4, p-value = 0.0007156
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 0.9981779 3.7369660
## sample estimates:
## mean in group да mean in group нет
## 52.80976 50.44218
Что касается отцов: разница в средних значениях статистически важна. Вывод 4: среди респондентов, которые рассматривали альтернативные варинаты при выборе школы, социально-профессиональный статус отца выше, чем в тех, где не рассматривали других вариантов, изначально останавливаясь на одном.