http://rpubs.com/Petr001/412448

Опубликовано

date()
## [1] "Tue Sep 25 13:18:56 2018"

Описание шкал

Code
Шифр испытуемого
Номер

Learning_area направление подготовки Музыка/Театр/Хореография

Group_code
Код группы
те, кто учатся вместе (оценивали друг-друга)

Age Возраст

City
Город

Groupe
Название группы Есть разные написания

Sch.coll - предыдущий уровень образования college - полсле колледжа school - после школы

Buget - оплата за обучение no_budget - внебюджетники buget - бюджет

Name
Фамилия Имя

Chislo_ocenok
Количество оценок
Число «положительных» засданные экзамены и дифзачеты

Dolya_5 Доля пятерок Процент пятерок от всех положительных оценок Dolya_4 Доля четвёрок

Dolya_3 Доля троек

Chislo_dolgov
Количество долгов несданные и пропущенные экзамены и зачеты

Uroven_ocenok
Уровень успеваймости: Пятерок больше 75 процентов /Отличник Пятерок от 50 до 75 процентов /Хорошись+ Пятерок меньше 50 процентов /Хорошист- Есть задолженности /задолженности

Gr.ocenka_mean
Групповая оценка - среднее

Gr.ocenka_moda
Групповая оценка - среднее

Gr.ocenka_number
Количество полученных групповых оценок

Potrebnost_dostigeni Потребность в достижениях
Методика «Потребность в достижении успеха» Ю.М. Орлов, В.И. Шкуркин, Л.П. Орлова

Motiv_znaniya
Приобретение знаний Мотивация обучения в вузе Т.И. Ильина

Motiv_prof
Овладение профессией Мотивация обучения в вузе Т.И. Ильина

Motiv_diplom
Получение диплома Мотивация обучения в вузе Т.И. Ильина

Motiv_summa Сумма по мотивации Мотивация обучения в вузе Т.И. Ильина

KA_znaniya
Контент-анализ: Мотив получения знаний
1 – выражен, 0 – не проявлен

KA_prof Мотив получение профессии
1 – выражен, 0 – не проявлен

KA_diplom
Мотив получение диплома 1 – выражен, 0 – не проявлен

KA_otnoshen_studenchestvo Отношение к студенческому периоду -1 отрицательное 0 – не проявлено 1 - положительное

KA_otnoshen_vuz Отношение к вузу и преподавателям
-1 - отрицательное 0 – не проявлено 1 - положительное

KA_otnoshen_prof
Отношение к профессии
-1 - отрицательное (не моё) 0 – не проявлено 1 – положительное (моё дело)

KA_legko легко – трудно
-1 - трудно 0 - не проявлено 1 - легко

KA_fiziolog физиологические потребности 1 выражены (еда, сон) 0 не проявлены

KA_budusch категория будущего
1 есть 0 не проявлена

KA_otvetstv ответственность 1 есть 0 не проявлена

KA_samorazv самосовершенствование и саморазвитие
1 есть 0 не проявлена

Импорт данных

library(ggplot2)

df <- read.csv2("StudentMotivation.csv", sep = "\t")
df$Uroven_ocenok <- factor(df$Uroven_ocenok, labels  = c("отличник", "хорошист+", "успевающий", "задолженности"))

редактирую факторы в Контент-анализе.

df$KA_znaniya <- factor(df$KA_znaniya, levels = c(0, 1), labels = c("нет", "есть"))

df$KA_prof <- factor(df$KA_prof , levels = c(0, 1), labels = c("нет", "есть"))  

df$KA_diplom <- factor(df$KA_diplom , levels = c(0, 1), labels = c("нет", "есть"))

df$KA_otnoshen_studenchestvo <- factor(df$KA_otnoshen_studenchestvo
        , levels = c(-1, 0, 1)
        , labels = c("отрицательное"
                     , "нет"
                     , "положительное"))


df$KA_otnoshen_vuz <- factor(df$KA_otnoshen_vuz 
        , levels = c(-1, 0, 1)
        , labels = c("отрицательное"
                        , "нет"
                        , "положительное")) 


df$KA_otnoshen_prof <- factor(df$KA_otnoshen_prof 
                , levels = c(-1, 0, 1)
                , labels = c("отрицательное"
                             , "нет"
                             , "положительное"))    
df$KA_legko <- factor(df$KA_legko
                , levels = c(-1, 0, 1)
                , labels = c("трудно"
                             , "нет"
                             , "легко"))

df$KA_fiziolog <- factor(df$KA_fiziolog
                , levels = c(0, 1), 
                labels = c("нет"
                           , "есть"))

df$KA_budusch <- factor(df$KA_budusch
                , levels = c(0, 1)
                , labels = c("нет"
                           , "есть"))

df$KA_otvetstv <- factor(df$KA_otvetstv
                , levels = c(0, 1)
                , labels = c("нет"
                             , "есть"))

df$KA_samorazv <- factor(df$KA_samorazv
                , levels = c(0, 1)
                , labels = c("нет"
                             , "есть"))
df2 <- subset(df, subset = df$Learning_area != "театр")
# Сабсет данных без театралов, так как их очень мало заполнило методики

Описание выборки

Возраст

summary(df$Age)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   19.00   19.00   20.00   20.76   21.00   28.00      23

Средний возраст 20,76 (медиана 20). Минимум 19, максимум 28.

Пол

Выборка не сбалансирована по полу. Подовляющее числов испытуемых женщины, так что сравнение по полу не производится.

Направление подготовки

table(df$Learning_area, dnn = "Количество студентов")
## Количество студентов
##      музыка       театр хореография 
##          39          10          19

В некоторых анализах направление Театр исключено из сравнения, так как тех, кто заполнил все методики только несколько человек. Но можно сопоставаить успеваемость, так как эта информация есть про 10 студентов.

Город

table(df$City, df$Learning_area, dnn = c("Город", "Направление обучения"))
##                      Направление обучения
## Город            музыка театр хореография
##                            0     1           0
##   Алма-Аты                 0     0           1
##   Ангарск                  0     0           1
##   Барнаул                  0     0           1
##   Вел. Новгород            1     0           0
##   Г.Лянтор                 0     0           1
##   Гатчина                  1     0           0
##   Гомель                   0     0           1
##   Ижевск                   0     1           0
##   Иркутск                  0     0           1
##   Калининград              1     0           0
##   Камч.край, Елизово       0     1           0
##   Кемерово                 1     0           0
##   Красноярск               1     0           0
##   Липецк                   0     0           1
##   Норильск                 0     0           1
##   Петрозаводск             1     0           0
##   Псков                    1     0           0
##   Самарканд                1     0           0
##   Симферополь              1     0           0
##   СПб                     10     0           5
##   Тыва г.Кызыл             0     0           1
##   Тюмень                   1     0           0
##   Усть-Каменогорск         1     0           0
##   Якутск                   0     0           1

Большая часть студентов - приезжие. только 10 направления Музыка и 5 Хореография из Санкт-Петербурга

Оплата

Сколько платников и бюджетников?

table(df$Buget)
## 
##     buget no_budget 
##        49        19
table(df$Learning_area,df$Buget)
##              
##               buget no_budget
##   музыка         32         7
##   театр           7         3
##   хореография    10         9

Предыдущий уровень образования

table(df$Sch.coll)
## 
## college  school 
##      37      31
table(df$Learning_area, df$Sch.coll)
##              
##               college school
##   музыка           30      9
##   театр             2      8
##   хореография       5     14

Успеваемость

Так как студенты учатся по разным направлениям и имеют разное число экзаменов и зачетов, то подсчитывается процент пятерок, четверок и троек. Посмотрим на распределение доли разных оценок (отлично, хорошо и удовлетворительно) у студентов трёх направлений.

Построим коробчатую диаграмму распеределения оценок у студентов разных направлений. box-plot. По вертикальной оси отложена доля (от нуля до 1) тех или иных оценок от всех оценок студента.

горизонтальная линия - медиана, то есть половина выборки имеет результат выше линии, половина ниже. верх-низ ящика - второй и третий квартили (внутри “ящика” помещается 50 процентов выборки) Линии - максимум и минимум. Точки - выбросы (очень сильно отличающиеся от среднего)

library(reshape2)
melt_df <- melt(df, id.vars = "Learning_area", measure.vars = c("Dolya_3", "Dolya_4", "Dolya_5"))

#ggplot(melt_df2, aes(variable, value, col = Learning_area)) +
#        geom_boxplot()

ggplot(melt_df, aes(Learning_area, value, col = variable)) +
        geom_boxplot()

У направления Театр и Хорегорафия процент четверок и пятерок в среднем близок. А подавляющее большинство студентов направления Музыка имеют пятерок больше чем четверок и троек

Посмотрим на средние значения и стандартное отклонение доли оценок Пятерки:

print("Пятерки")
## [1] "Пятерки"
mean(df$Dolya_5)
## [1] 0.5515294
sd(df$Dolya_5)
## [1] 0.2421834

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

print("Четверки")
## [1] "Четверки"
mean(df$Dolya_4)
## [1] 0.3473529
sd(df$Dolya_4)
## [1] 0.1818084

Средняя доля четверок 34 процента.

print("Тройки")
## [1] "Тройки"
mean(df$Dolya_3)
## [1] 0.1011471
sd(df$Dolya_3)
## [1] 0.1358393

Средний процент троек - 10 процентов.

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

table(df$Uroven_ocenok)
## 
##      отличник     хорошист+    успевающий задолженности 
##            19            14            15            20

Оценки ~ Направление

посмотрим на распределение успеваймости по направлениям:

t1 <- table(df$Learning_area, df$Uroven_ocenok)
t1
##              
##               отличник хорошист+ успевающий задолженности
##   музыка            13         8          3            15
##   театр              2         2          4             2
##   хореография        4         4          8             3

В процентах по направлению (округлено до 2 знаков)

round(prop.table(t1, 1),2)
##              
##               отличник хорошист+ успевающий задолженности
##   музыка          0.33      0.21       0.08          0.38
##   театр           0.20      0.20       0.40          0.20
##   хореография     0.21      0.21       0.42          0.16
barplot(prop.table(t1, 1)
        , legend.text = TRUE
        , args.legend = list(x = "topright")
        , beside = TRUE)

Точный критерий Фишера (хорошо подходит для маленьких выборок)

fisher.test(t1)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  t1
## p-value = 0.04591
## alternative hypothesis: two.sided

Показывает значимые различия на пятипроцентном уровне. Можно утверждать, что группы учатся по-разному.

Оценки ~ Уровень образования

tUS <- table(df$Uroven_ocenok, df$Sch.coll)
tUS
##                
##                 college school
##   отличник           11      8
##   хорошист+          10      4
##   успевающий          4     11
##   задолженности      12      8
round(prop.table(tUS, 1),2)
##                
##                 college school
##   отличник         0.58   0.42
##   хорошист+        0.71   0.29
##   успевающий       0.27   0.73
##   задолженности    0.60   0.40

Можно увидеть, что среди всех направлений, в группе Успевающих больше всего школьников. А вот в других уровнях - больше будет после колледжа.

проверим значимость отличия распределения от случайного

fisher.test(tUS)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  tUS
## p-value = 0.08969
## alternative hypothesis: two.sided

Но в целом эти отличия не являются значимыми. p > 0,05 Можно говорить только о тенденции

Оценки ~ Оплата обучения

tUB <- table(df$Uroven_ocenok, df$Buget)
tUB
##                
##                 buget no_budget
##   отличник         19         0
##   хорошист+        12         2
##   успевающий        8         7
##   задолженности    10        10
round(prop.table(tUB, 1),2)
##                
##                 buget no_budget
##   отличник       1.00      0.00
##   хорошист+      0.86      0.14
##   успевающий     0.53      0.47
##   задолженности  0.50      0.50

Среди тех, кто платит оценки хуже. Отличников вообще нет, и многие имеют задолженности.

fisher.test(tUB)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  tUB
## p-value = 0.0003079
## alternative hypothesis: two.sided

Критерий фишера показывает, что эти различия весьма значимы p <- 0,001

Потребность в достижениях

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

Рассмотрим результаты методики на потребность в достижениях Стандартное отклонение, квартили и среднее:

sd(df$Potrebnost_dostigeni, na.rm = T)
## [1] 2.236769
summary(df$Potrebnost_dostigeni)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##    9.00   12.00   13.00   13.39   15.00   18.00      17

Среднее значение 13,39 - то есть попадает в интервал 10 - 15 баллов - средняя потребность в достижениях. минимум - 9 (7-9 пониженная потребность). никого нет с низкой потребностью. Максимум - 18 (повышенная потребность) Никого нет с Высокой потребностью в достижениях.

table(df$Potrebnost_dostigeni)
## 
##  9 10 11 12 13 14 15 16 17 18 
##  3  3  4  7  9  8  9  3  4  1

Гистограмма

Распределение оценок по шкале Потребность в достижениях

ggplot(df, aes(Potrebnost_dostigeni)) +
               geom_histogram(binwidth = 1
                              , fill = "white"
                              , col = "black")
## Warning: Removed 17 rows containing non-finite values (stat_bin).

Распределение достаточно симметричное. Большинство имеют средние значения.

Шапиро тест

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

shapiro.test(df$Potrebnost_dostigeni)
## 
##  Shapiro-Wilk normality test
## 
## data:  df$Potrebnost_dostigeni
## W = 0.96985, p-value = 0.218

Распределение не отличается значимо от нормального.

Потребность в достижениях ~ направление

Нарисуем коробчатую диаграмму.

ggplot(df2, aes(Learning_area, Potrebnost_dostigeni)) +
        geom_boxplot()
## Warning: Removed 10 rows containing non-finite values (stat_boxplot).

Бартлетт тест

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

bartlett.test(Potrebnost_dostigeni ~ Learning_area, df2)
## 
##  Bartlett test of homogeneity of variances
## 
## data:  Potrebnost_dostigeni by Learning_area
## Bartlett's K-squared = 0.19029, df = 1, p-value = 0.6627

Гомогенность дисперсий соблюдается. Можно использовать Т-тест с равенством дисперсий.

t-test

Отличается ли потребность в достижениях у разных направлений?

t.test(Potrebnost_dostigeni ~ Learning_area, df2, var.equal = TRUE)
## 
##  Two Sample t-test
## 
## data:  Potrebnost_dostigeni by Learning_area
## t = -1.1875, df = 46, p-value = 0.2411
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -2.030263  0.523622
## sample estimates:
##      mean in group музыка mean in group хореография 
##                  13.12903                  13.88235
  • нет, не отличается. Значит выбором специальности не объясняется различия

Потребность в достижениях ~ оплата обучения

Нарисуем коробчатую диаграмму.

ggplot(df2, aes(Buget, Potrebnost_dostigeni)) +
        geom_boxplot()
## Warning: Removed 10 rows containing non-finite values (stat_boxplot).

Разброс у внебюджетников несколько больше.

Бартлетт тест

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

bartlett.test(Potrebnost_dostigeni ~ Buget, df2)
## 
##  Bartlett test of homogeneity of variances
## 
## data:  Potrebnost_dostigeni by Buget
## Bartlett's K-squared = 4.3848, df = 1, p-value = 0.03626

Гомогенность дисперсий соблюдается. Можно использовать Т-тест с равенством дисперсий.

t-test

Отличается ли потребность в достижениях у разных направлений?

t.test(Potrebnost_dostigeni ~ Buget, df2, var.equal = TRUE)
## 
##  Two Sample t-test
## 
## data:  Potrebnost_dostigeni by Buget
## t = -0.039051, df = 46, p-value = 0.969
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -1.459584  1.404029
## sample estimates:
##     mean in group buget mean in group no_budget 
##                13.38889                13.41667

Бюджетники и небеюджетники не отличаются по потребности в достижении.

Потребность в достижениях ~ предыдущее образование

Нарисуем коробчатую диаграмму.

ggplot(df2, aes(Sch.coll, Potrebnost_dostigeni)) +
        geom_boxplot()
## Warning: Removed 10 rows containing non-finite values (stat_boxplot).

среднее у школьников чуть-чуть выше.

Бартлетт тест

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

bartlett.test(Potrebnost_dostigeni ~ Sch.coll, df2)
## 
##  Bartlett test of homogeneity of variances
## 
## data:  Potrebnost_dostigeni by Sch.coll
## Bartlett's K-squared = 0.019813, df = 1, p-value = 0.8881

Гомогенность дисперсий соблюдается. Можно использовать Т-тест с равенством дисперсий.

t-test

Отличается ли потребность в достижениях у разных направлений?

t.test(Potrebnost_dostigeni ~ Sch.coll, df2, var.equal = TRUE)
## 
##  Two Sample t-test
## 
## data:  Potrebnost_dostigeni by Sch.coll
## t = -1.1241, df = 46, p-value = 0.2668
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
##  -1.9335227  0.5478084
## sample estimates:
## mean in group college  mean in group school 
##              13.10714              13.80000

Потребность в достижении не отличается у тех, кто после колледжа и тех, кто после школы.

Групповая оценка личности

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

summary(df$Gr.ocenka_mean)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   1.000   1.413   1.780   1.823   2.295   2.710
sd(df$Gr.ocenka_mean)
## [1] 0.4927159

средяя оценка 1,82 Минимальная 1 - то есть все оценивающие поставили единицу. Максимум 2,7 - не было таких, кого все оценивающие оценили максимально.

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

ggplot(df, aes(Gr.ocenka_mean)) +
        geom_histogram(binwidth = 0.25
                , fill = "white"
                , col = "black")

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

shapiro.test(df2$Gr.ocenka_mean)
## 
##  Shapiro-Wilk normality test
## 
## data:  df2$Gr.ocenka_mean
## W = 0.96283, p-value = 0.07286

Распределение значимо отличается от нормального. То есть здесь не нужно применять параметрические методы. ##Групповая оценка личности ~ направления обучения

ggplot(df2, aes(Learning_area, Gr.ocenka_mean)) +
        geom_boxplot()

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

wilcox.test(Gr.ocenka_mean ~ Learning_area, df2)
## Warning in wilcox.test.default(x = c(1.54, 1.33, 2.4, 2, 1.67, 2.47,
## 1.67, : cannot compute exact p-value with ties
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  Gr.ocenka_mean by Learning_area
## W = 373.5, p-value = 0.9669
## alternative hypothesis: true location shift is not equal to 0

Групповая оценка личности в двух группах (Музыканты и Хореографы) не отличается.

Групповая оценка личности ~ оплата обучения

ggplot(df2, aes(Buget, Gr.ocenka_mean)) +
        geom_boxplot()

У внебюджетников групповая оценка гораздо ниже (надо споставить с успеваемостью). Возможно, что эта связь объясняется успеваемостью.

wilcox.test(Gr.ocenka_mean ~ Buget, df2)
## Warning in wilcox.test.default(x = c(2.4, 2, 1.67, 2.47, 1.67, 1.76,
## 1.59, : cannot compute exact p-value with ties
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  Gr.ocenka_mean by Buget
## W = 503, p-value = 0.003714
## alternative hypothesis: true location shift is not equal to 0

Отличия в групповой оценке личности между бюджетниками и платниками значимы.

Групповая оценка личности ~ предыдущее образование

ggplot(df2, aes(Sch.coll, Gr.ocenka_mean)) +
        geom_boxplot()

у школьников разброс больше, но в целом очень близкие средние.

wilcox.test(Gr.ocenka_mean ~ Sch.coll, df2)
## Warning in wilcox.test.default(x = c(1.54, 1.33, 2.4, 2, 1.67, 1.21,
## 1.67, : cannot compute exact p-value with ties
## 
##  Wilcoxon rank sum test with continuity correction
## 
## data:  Gr.ocenka_mean by Sch.coll
## W = 340, p-value = 0.3236
## alternative hypothesis: true location shift is not equal to 0

Значимых отличий по групповой оценке тех кто после школы и после колледжа нет.

Мотивация обучения в вузе

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

summary(df2$Motiv_znaniya)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   0.000   6.600   7.800   7.769   9.300  12.600       7
summary(df2$Motiv_prof)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##   1.000   4.500   6.000   5.902   7.000  10.000       7
summary(df2$Motiv_diplom)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##    0.00    3.25    5.00    4.99    7.50    8.50       7
summary(df2$Motiv_summa)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max.    NA's 
##    3.80   15.75   18.70   18.66   22.70   29.10       7

Мотив знания в среднем более выражен - 7,76 (минимум 0, максимум - 12,6) Профессия - в среднем - 5,90 Мотивация диплом - в срднем наименее выражена 4,99

Стандартное отклонение

sd(df2$Motiv_znaniya, na.rm = TRUE)
## [1] 2.881214
sd(df2$Motiv_prof, na.rm = TRUE)
## [1] 2.147137
sd(df2$Motiv_diplom, na.rm = TRUE)
## [1] 2.759511
sd(df2$Motiv_summa, na.rm = TRUE)
## [1] 5.223565

C

Гистограмма

ggplot(df2, aes(Motiv_znaniya)) +
        geom_histogram(binwidth = 1.5
                , fill = "white"
                , col = "black")
## Warning: Removed 7 rows containing non-finite values (stat_bin).

ggplot(df2, aes(Motiv_prof)) +
        geom_histogram(binwidth = 1.5
                , fill = "white"
                , col = "black")
## Warning: Removed 7 rows containing non-finite values (stat_bin).

ggplot(df2, aes(Motiv_diplom)) +
        geom_histogram(binwidth = 1.5
                , fill = "white"
                , col = "black")
## Warning: Removed 7 rows containing non-finite values (stat_bin).

В отличие от других форм мотивации здесь достаточно много студентов совсем не проявляют мотивацию связанную с получением диплома.

ggplot(df2, aes(Motiv_summa)) +
        geom_histogram(binwidth = 2
                , fill = "white"
                , col = "black")
## Warning: Removed 7 rows containing non-finite values (stat_bin).

Мотивация по направлениям

library(reshape2)
melt_df2 <- melt(df2, id.vars = "Learning_area", measure.vars = c("Motiv_znaniya", "Motiv_prof", "Motiv_diplom"))

#ggplot(melt_df2, aes(variable, value, col = Learning_area)) +
#        geom_boxplot()

ggplot(melt_df2, aes(Learning_area, value, col = variable)) +
        geom_boxplot()
## Warning: Removed 21 rows containing non-finite values (stat_boxplot).

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

Сумма по мотивации (box-plot)

ggplot(df2, aes(Learning_area, Motiv_summa)) +
        geom_boxplot()
## Warning: Removed 7 rows containing non-finite values (stat_boxplot).

Мотивация ~ оплата

library(reshape2)
melt_df2 <- melt(df2, id.vars = "Buget"
                 , measure.vars = c("Motiv_znaniya", "Motiv_prof", "Motiv_diplom"))

ggplot(melt_df2, aes(Buget, value, col = variable)) +
        geom_boxplot()
## Warning: Removed 21 rows containing non-finite values (stat_boxplot).

На диаграмме не видны заметные отличия.

Мотивация ~ предыдущее образование

library(reshape2)
melt_df2 <- melt(df2, id.vars = "Sch.coll"
                 , measure.vars = c("Motiv_znaniya", "Motiv_prof", "Motiv_diplom"))

ggplot(melt_df2, aes(Sch.coll, value, col = variable)) +
        geom_boxplot()
## Warning: Removed 21 rows containing non-finite values (stat_boxplot).

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

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

shapiro.test(df2$Motiv_znaniya)
## 
##  Shapiro-Wilk normality test
## 
## data:  df2$Motiv_znaniya
## W = 0.95073, p-value = 0.0338
shapiro.test(df2$Motiv_prof)
## 
##  Shapiro-Wilk normality test
## 
## data:  df2$Motiv_prof
## W = 0.94324, p-value = 0.0166
shapiro.test(df2$Motiv_diplom)
## 
##  Shapiro-Wilk normality test
## 
## data:  df2$Motiv_diplom
## W = 0.90429, p-value = 0.0005866
shapiro.test(df2$Motiv_summa)
## 
##  Shapiro-Wilk normality test
## 
## data:  df2$Motiv_summa
## W = 0.98024, p-value = 0.5492

Распределение по отдельным шкалам значимо отличается от нормального по отдельным шкалам. Только у суммы нет значимых отличий от нормального распределения. Лучше использовать непараметрические методы. Но вообще-то достаточно много студентов и гистограмма имеет колоколовидную форму по всем трём шкалам.

Потребность в достижениях и успеваемость

Отличается ли потребность в достижениях у студентов с разной успеваемостью?

dost_fit <- aov(Potrebnost_dostigeni ~ Uroven_ocenok, df)
summary(dost_fit)
##               Df Sum Sq Mean Sq F value Pr(>F)
## Uroven_ocenok  3   8.93   2.978    0.58  0.631
## Residuals     47 241.22   5.132               
## 17 observations deleted due to missingness

Значимых различий не обнаружено. Посмотрим на график.

ggplot(df, aes(Uroven_ocenok, Potrebnost_dostigeni)) +
        geom_boxplot() +
        labs(x = "Уровень оценок", y = "Потребность в достижениях") +
         theme_classic()
## Warning: Removed 17 rows containing non-finite values (stat_boxplot).

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

Потребность достижения ~ Оценки, образование и оплата

dostUSB_fit <- aov(Potrebnost_dostigeni ~ Uroven_ocenok * Sch.coll * Buget, df2)
summary(dostUSB_fit)
##                        Df Sum Sq Mean Sq F value Pr(>F)  
## Uroven_ocenok           3  10.19   3.396   0.720 0.5465  
## Sch.coll                1   3.49   3.487   0.740 0.3955  
## Buget                   1   0.09   0.086   0.018 0.8936  
## Uroven_ocenok:Sch.coll  3   7.33   2.442   0.518 0.6726  
## Uroven_ocenok:Buget     2   2.29   1.147   0.243 0.7854  
## Sch.coll:Buget          1  16.36  16.364   3.471 0.0706 .
## Residuals              36 169.74   4.715                 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 10 observations deleted due to missingness

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

ggplot(df2, aes(Uroven_ocenok, Potrebnost_dostigeni)) +
        geom_boxplot() +
        facet_grid(Sch.coll ~ Buget)
## Warning: Removed 10 rows containing non-finite values (stat_boxplot).

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

Потребность достижения ~ Направление, Оценки, образование и оплата

Уберём теперь из графика бюджет/небюджет, но добавим направление обучения.

ggplot(df2, aes(Uroven_ocenok, Potrebnost_dostigeni)) +
        geom_boxplot() +
        facet_grid(Sch.coll ~ Learning_area)
## Warning: Removed 10 rows containing non-finite values (stat_boxplot).

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

проведём дисперсионный анализ с учетом направления обучения и всех остальных факторов

dostUSBL_fit <- aov(Potrebnost_dostigeni ~ Learning_area * Uroven_ocenok * Sch.coll * Buget, df2)
summary(dostUSBL_fit)
##                             Df Sum Sq Mean Sq F value Pr(>F)  
## Learning_area                1   6.23   6.231   1.515 0.2276  
## Uroven_ocenok                3   6.03   2.011   0.489 0.6924  
## Sch.coll                     1   1.85   1.850   0.450 0.5074  
## Buget                        1   0.23   0.235   0.057 0.8128  
## Learning_area:Uroven_ocenok  3  34.70  11.566   2.813 0.0555 .
## Learning_area:Sch.coll       1   0.00   0.002   0.000 0.9830  
## Uroven_ocenok:Sch.coll       3  15.53   5.178   1.259 0.3054  
## Learning_area:Buget          1   4.38   4.378   1.065 0.3101  
## Uroven_ocenok:Buget          1   0.88   0.878   0.214 0.6471  
## Sch.coll:Buget               1  12.19  12.190   2.965 0.0950 .
## Residuals                   31 127.45   4.111                 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 10 observations deleted due to missingness

Действительно, с учетом двух факторов мы можем увидеть различия на уровне тенденции в потребности в достижениях с учётом области образования и предыдущего образования Learning_area:Uroven_ocenok p = 0.0555

ggplot(df2, aes(Uroven_ocenok, Potrebnost_dostigeni)) +
        geom_boxplot() +
        facet_grid(~ Learning_area )
## Warning: Removed 10 rows containing non-finite values (stat_boxplot).

Групповая оценка и успеваемость

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

gr_ocenka_fit <- aov(Gr.ocenka_mean ~ Uroven_ocenok, df)
summary(gr_ocenka_fit)
##               Df Sum Sq Mean Sq F value   Pr(>F)    
## Uroven_ocenok  3  8.050  2.6835   20.91 1.48e-09 ***
## Residuals     64  8.215  0.1284                     
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

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

ggplot(df, aes(Uroven_ocenok, Gr.ocenka_mean)) +
        geom_boxplot() +
        labs(x = "Уровень оценок"
             , y = "Групповая оценка") +
         theme_classic()

Мы видим, что есть прямая связь оценки студента одногрупниками и его успеваймости.

построим

ggplot(df, aes(Uroven_ocenok, Gr.ocenka_mean)) +
        stat_summary(fun.data = mean_cl_normal
                       , geom = "errorbar"
                     , width = 0.1) + # узкие усы
        stat_summary(fun.y = mean, 
                     geom = "point", size = 2)

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

TukeyHSD(gr_ocenka_fit)
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = Gr.ocenka_mean ~ Uroven_ocenok, data = df)
## 
## $Uroven_ocenok
##                                diff        lwr        upr     p adj
## хорошист+-отличник       -0.2315414 -0.5644171  0.1013344 0.2667702
## успевающий-отличник      -0.6963509 -1.0227756 -0.3699261 0.0000026
## задолженности-отличник   -0.8126842 -1.1154498 -0.5099186 0.0000000
## успевающий-хорошист+     -0.4648095 -0.8160102 -0.1136088 0.0047483
## задолженности-хорошист+  -0.5811429 -0.9104692 -0.2518165 0.0000974
## задолженности-успевающий -0.1163333 -0.4391377  0.2064710 0.7776501

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

Мотивация и успеваемость

Влияние мотивации на успеваемость. В начале посмотрим на сумму по всем трём шкалам (знания, профессия и диплом)

Mot_fit <- aov(Motiv_summa ~ Uroven_ocenok, df)
summary(Mot_fit)
##               Df Sum Sq Mean Sq F value Pr(>F)
## Uroven_ocenok  3   82.5    27.5   0.972  0.414
## Residuals     49 1386.5    28.3               
## 15 observations deleted due to missingness

Здесь значимых отличий нет. График

ggplot(df, aes(Uroven_ocenok, Motiv_summa)) +
        geom_boxplot()
## Warning: Removed 15 rows containing non-finite values (stat_boxplot).

Разброс у отличников чуть больше, но в целом медианы очень близки.

Проверим отличия по отдельным шкалам: Знания

Mot_fit <- aov(Motiv_znaniya ~ Uroven_ocenok, df)
summary(Mot_fit)
##               Df Sum Sq Mean Sq F value Pr(>F)
## Uroven_ocenok  3   23.7   7.888   0.957   0.42
## Residuals     49  403.7   8.239               
## 15 observations deleted due to missingness

Мотивация Знания и успешность обучения не связаны

ggplot(df, aes(Uroven_ocenok, Motiv_znaniya)) +
        geom_boxplot()
## Warning: Removed 15 rows containing non-finite values (stat_boxplot).

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

Профессия

Mot_fit <- aov(Motiv_prof ~ Uroven_ocenok, df)
summary(Mot_fit)
##               Df Sum Sq Mean Sq F value Pr(>F)
## Uroven_ocenok  3  19.82   6.608   1.401  0.254
## Residuals     49 231.16   4.718               
## 15 observations deleted due to missingness

нет значимых отличий в уровне мотивации связанной с профессией.

ggplot(df, aes(Uroven_ocenok, Motiv_prof)) +
        geom_boxplot()
## Warning: Removed 15 rows containing non-finite values (stat_boxplot).

Диплом

Mot_fit <- aov(Motiv_diplom ~ Uroven_ocenok, df)
summary(Mot_fit)
##               Df Sum Sq Mean Sq F value Pr(>F)
## Uroven_ocenok  3   12.4   4.145   0.518  0.672
## Residuals     49  392.0   8.000               
## 15 observations deleted due to missingness

Мотивация Диплом тоже не проявляет связей.

ggplot(df, aes(Uroven_ocenok, Motiv_diplom)) +
        geom_boxplot()
## Warning: Removed 15 rows containing non-finite values (stat_boxplot).

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

Контент анализ и успеваемость

Мотив Знания

table(df$Uroven_ocenok, df$KA_znaniya, dnn = c("Уровень оценок:", "Мотив знания"))
##                Мотив знания
## Уровень оценок: нет есть
##   отличник       12    6
##   хорошист+       7    4
##   успевающий      5    7
##   задолженности   6    4
fisher.test(
  table(df$Uroven_ocenok, df$KA_znaniya)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Uroven_ocenok, df$KA_znaniya)
## p-value = 0.6115
## alternative hypothesis: two.sided

Связи с успеваемостью нет.

Мотив Профессия

table(df$Uroven_ocenok, df$KA_prof, dnn = c("Уровень оценок:", "Мотив Профессия"))
##                Мотив Профессия
## Уровень оценок: нет есть
##   отличник        6   12
##   хорошист+       4    7
##   успевающий      6    6
##   задолженности   9    1
fisher.test(
  table(df$Uroven_ocenok, df$KA_prof)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Uroven_ocenok, df$KA_prof)
## p-value = 0.02419
## alternative hypothesis: two.sided

Здесь есть значимые связи.

Мотив Диплом

table(df$Uroven_ocenok, df$KA_diplom, dnn = c("Уровень оценок:", "Мотив Диплом"))
##                Мотив Диплом
## Уровень оценок: нет есть
##   отличник       11    7
##   хорошист+       7    4
##   успевающий      7    5
##   задолженности   6    4
fisher.test(
  table(df$Uroven_ocenok, df$KA_diplom)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Uroven_ocenok, df$KA_diplom)
## p-value = 1
## alternative hypothesis: two.sided

нет связи, (совсем :) - одинаковый процент у всех групп по успеваймости.

Отношение к студенческому периоду

table(df$Uroven_ocenok, df$KA_otnoshen_studenchestvo, dnn = c("Уровень оценок", "Отношение к студенчеству"))
##                Отношение к студенчеству
## Уровень оценок отрицательное нет положительное
##   отличник                  1   9             8
##   хорошист+                 1   5             5
##   успевающий                1   5             6
##   задолженности             1   6             3
fisher.test(
  table(df$Uroven_ocenok, df$KA_otnoshen_studenchestvo)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Uroven_ocenok, df$KA_otnoshen_studenchestvo)
## p-value = 0.9781
## alternative hypothesis: two.sided

нет взаимосвязи

Отношение к вузу

table(df$Uroven_ocenok, df$KA_otnoshen_vuz, dnn = c("Уровень оценок:", "Отношение к вузу"))
##                Отношение к вузу
## Уровень оценок: отрицательное нет положительное
##   отличник                  2  14             2
##   хорошист+                 2   4             5
##   успевающий                1   7             4
##   задолженности             2   7             1
fisher.test(
  table(df$Uroven_ocenok, df$KA_otnoshen_vuz)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Uroven_ocenok, df$KA_otnoshen_vuz)
## p-value = 0.2585
## alternative hypothesis: two.sided

нет взаимосвязи

Отношение к профессии

table(df$Uroven_ocenok, df$KA_otnoshen_prof, dnn = c("Уровень оценок:", "Отношение к профессии"))
##                Отношение к профессии
## Уровень оценок: отрицательное нет положительное
##   отличник                  2   5            11
##   хорошист+                 0   7             4
##   успевающий                3   2             7
##   задолженности             2   6             2
fisher.test(
  table(df$Uroven_ocenok, df$KA_otnoshen_prof)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Uroven_ocenok, df$KA_otnoshen_prof)
## p-value = 0.07469
## alternative hypothesis: two.sided

Связь ну уровне тенденции p < 0,1 У задолжников оба варианта встречаются одинаково. У отличников положительное намного чаще.

Трудность обучения

table(df$Uroven_ocenok, df$KA_legko, dnn = c("Уровень оценок:", "Трудность"))
##                Трудность
## Уровень оценок: трудно нет легко
##   отличник           0  18     0
##   хорошист+          3   7     1
##   успевающий         0  12     0
##   задолженности      0  10     0
fisher.test(
  table(df$Uroven_ocenok, df$KA_legko)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Uroven_ocenok, df$KA_legko)
## p-value = 0.003481
## alternative hypothesis: two.sided

Только Хорошисты что-то говорят про трудность. У остальных эта категория никак не проявилась. Значимые связи.

Физиологические потребности

table(df$Uroven_ocenok, df$KA_fiziolog, dnn = c("Уровень оценок:", "Физиология"))
##                Физиология
## Уровень оценок: нет есть
##   отличник       15    3
##   хорошист+      11    0
##   успевающий      8    4
##   задолженности   7    3
fisher.test(
  table(df$Uroven_ocenok, df$KA_fiziolog)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Uroven_ocenok, df$KA_fiziolog)
## p-value = 0.1665
## alternative hypothesis: two.sided

нет взаимосвязи

Категория Будущего

table(df$Uroven_ocenok, df$KA_budusch, dnn = c("Уровень оценок:", "Будущее"))
##                Будущее
## Уровень оценок: нет есть
##   отличник       13    5
##   хорошист+      10    1
##   успевающий      7    5
##   задолженности   7    3
fisher.test(
  table(df$Uroven_ocenok, df$KA_budusch)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Uroven_ocenok, df$KA_budusch)
## p-value = 0.3937
## alternative hypothesis: two.sided

нет взаимосвязи

Ответственность

table(df$Uroven_ocenok, df$KA_otvetstv, dnn = c("Уровень оценок:", "Ответственность"))
##                Ответственность
## Уровень оценок: нет есть
##   отличник       14    4
##   хорошист+       8    3
##   успевающий     11    1
##   задолженности   9    1
fisher.test(
  table(df$Uroven_ocenok, df$KA_otvetstv)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Uroven_ocenok, df$KA_otvetstv)
## p-value = 0.5788
## alternative hypothesis: two.sided

нет взаимосвязи

Саморазвитие

table(df$Uroven_ocenok, df$KA_samorazv, dnn = c("Уровень оценок:", "Саморазвитие"))
##                Саморазвитие
## Уровень оценок: нет есть
##   отличник       11    7
##   хорошист+       8    3
##   успевающий     10    2
##   задолженности   8    2
fisher.test(
  table(df$Uroven_ocenok, df$KA_samorazv)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Uroven_ocenok, df$KA_samorazv)
## p-value = 0.6015
## alternative hypothesis: two.sided

Нет взаимосвязи

Внутри Контент-анализа

table(df$KA_otnoshen_prof, df$KA_prof
      , dnn = c("отношение к проф", "мотивация проф"))
##                 мотивация проф
## отношение к проф нет есть
##    отрицательное   7    0
##    нет            12    8
##    положительное   6   18
fisher.test(
  table(df$KA_otnoshen_prof, df$KA_prof)
  )
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$KA_otnoshen_prof, df$KA_prof)
## p-value = 0.0005122
## alternative hypothesis: two.sided

Контент анализ и Уровень образования

Мотив Знания

table(df$Sch.coll, df$KA_znaniya, dnn = c("Уровень образования:", "Мотив знания"))
##                     Мотив знания
## Уровень образования: нет есть
##              college  13   15
##              school   17    6
fisher.test(
  table(df$Sch.coll, df$KA_znaniya)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Sch.coll, df$KA_znaniya)
## p-value = 0.08521
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##  0.07659587 1.15221143
## sample estimates:
## odds ratio 
##   0.313344

Нет значимых.

Мотив Профессия

table(df$Sch.coll, df$KA_prof, dnn = c("Уровень образования:", "Мотив Профессия"))
##                     Мотив Профессия
## Уровень образования: нет есть
##              college  14   14
##              school   11   12
fisher.test(
  table(df$Sch.coll, df$KA_prof)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Sch.coll, df$KA_prof)
## p-value = 1
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##  0.3152949 3.7842249
## sample estimates:
## odds ratio 
##   1.089048

совершенно одинаковые результаты у коледжа и школы

Мотив Диплом

table(df$Sch.coll, df$KA_diplom, dnn = c("Уровень образования:", "Мотив Диплом"))
##                     Мотив Диплом
## Уровень образования: нет есть
##              college  16   12
##              school   15    8
fisher.test(
  table(df$Sch.coll, df$KA_diplom)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Sch.coll, df$KA_diplom)
## p-value = 0.58
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##  0.1937225 2.5498424
## sample estimates:
## odds ratio 
##  0.7158912

нет связи

Отношение к студенческому периоду

table(df$Sch.coll, df$KA_otnoshen_studenchestvo, dnn = c("Уровень образования", "Отношение к студенчеству"))
##                    Отношение к студенчеству
## Уровень образования отрицательное нет положительное
##             college             2  14            12
##             school              2  11            10
fisher.test(
  table(df$Sch.coll, df$KA_otnoshen_studenchestvo)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Sch.coll, df$KA_otnoshen_studenchestvo)
## p-value = 1
## alternative hypothesis: two.sided

нет взаимосвязи

Отношение к вузу

table(df$Sch.coll, df$KA_otnoshen_vuz, dnn = c("Уровень образования:", "Отношение к вузу"))
##                     Отношение к вузу
## Уровень образования: отрицательное нет положительное
##              college             5  17             6
##              school              2  15             6
fisher.test(
  table(df$Sch.coll, df$KA_otnoshen_vuz)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Sch.coll, df$KA_otnoshen_vuz)
## p-value = 0.7193
## alternative hypothesis: two.sided

нет взаимосвязи

Отношение к профессии

table(df$Sch.coll, df$KA_otnoshen_prof, dnn = c("Уровень образования:", "Отношение к профессии"))
##                     Отношение к профессии
## Уровень образования: отрицательное нет положительное
##              college             3  13            12
##              school              4   7            12
fisher.test(
  table(df$Uroven_ocenok, df$KA_otnoshen_prof)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Uroven_ocenok, df$KA_otnoshen_prof)
## p-value = 0.07469
## alternative hypothesis: two.sided

Связь ну уровне тенденции p < 0,1 (те, кто после коледжа чаще не упоминали).

Контент анализ и Оплата

Мотив Знания

table(df$Buget, df$KA_znaniya, dnn = c("Оплата", "Мотив знания"))
##            Мотив знания
## Оплата нет есть
##   buget      22   17
##   no_budget   8    4
fisher.test(
  table(df$Buget, df$KA_znaniya)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Buget, df$KA_znaniya)
## p-value = 0.7391
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##  0.1224792 2.9535968
## sample estimates:
## odds ratio 
##  0.6524964

Нет значимых.

Мотив Профессия

table(df$Buget, df$KA_prof, dnn = c("Оплата", "Мотив Профессия"))
##            Мотив Профессия
## Оплата нет есть
##   buget      16   23
##   no_budget   9    3
fisher.test(
  table(df$Buget, df$KA_prof)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Buget, df$KA_prof)
## p-value = 0.05223
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##  0.03595437 1.15245861
## sample estimates:
## odds ratio 
##  0.2387017

На уровне тенденции.

Мотив Диплом

table(df$Buget, df$KA_diplom, dnn = c("Оплата", "Мотив Диплом"))
##            Мотив Диплом
## Оплата нет есть
##   buget      24   15
##   no_budget   7    5
fisher.test(
  table(df$Buget, df$KA_diplom)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Buget, df$KA_diplom)
## p-value = 1
## alternative hypothesis: true odds ratio is not equal to 1
## 95 percent confidence interval:
##  0.2386881 5.0964135
## sample estimates:
## odds ratio 
##   1.139841

нет связи

Отношение к студенческому периоду

table(df$Buget, df$KA_otnoshen_studenchestvo, dnn = c("Оплата", "Отношение к студенчеству"))
##            Отношение к студенчеству
## Оплата отрицательное нет положительное
##   buget                 2  19            18
##   no_budget             2   6             4
fisher.test(
  table(df$Buget, df$KA_otnoshen_studenchestvo)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Buget, df$KA_otnoshen_studenchestvo)
## p-value = 0.3169
## alternative hypothesis: two.sided

нет взаимосвязи

Отношение к вузу

table(df$Buget, df$KA_otnoshen_vuz, dnn = c("Оплата", "Отношение к вузу"))
##            Отношение к вузу
## Оплата отрицательное нет положительное
##   buget                 5  24            10
##   no_budget             2   8             2
fisher.test(
  table(df$Buget, df$KA_otnoshen_vuz)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Buget, df$KA_otnoshen_vuz)
## p-value = 0.8
## alternative hypothesis: two.sided

нет взаимосвязи

Отношение к профессии

table(df$Buget, df$KA_otnoshen_prof, dnn = c("Оплата", "Отношение к профессии"))
##            Отношение к профессии
## Оплата отрицательное нет положительное
##   buget                 3  15            21
##   no_budget             4   5             3
fisher.test(
  table(df$Buget, df$KA_otnoshen_prof)     
)
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$Buget, df$KA_otnoshen_prof)
## p-value = 0.04951
## alternative hypothesis: two.sided

значимая связь.

Внутри Контент-анализа

table(df$KA_otnoshen_prof, df$KA_prof
      , dnn = c("отношение к проф", "мотивация проф"))
##                 мотивация проф
## отношение к проф нет есть
##    отрицательное   7    0
##    нет            12    8
##    положительное   6   18
fisher.test(
  table(df$KA_otnoshen_prof, df$KA_prof)
  )
## 
##  Fisher's Exact Test for Count Data
## 
## data:  table(df$KA_otnoshen_prof, df$KA_prof)
## p-value = 0.0005122
## alternative hypothesis: two.sided

множественные сравнения

fit <- aov(Potrebnost_dostigeni ~ KA_znaniya*KA_prof*KA_diplom, df)
summary(fit)
##                              Df Sum Sq Mean Sq F value Pr(>F)
## KA_znaniya                    1   0.09   0.085   0.016  0.900
## KA_prof                       1   3.09   3.094   0.583  0.450
## KA_diplom                     1   3.89   3.890   0.733  0.397
## KA_znaniya:KA_prof            1   2.40   2.401   0.452  0.505
## KA_znaniya:KA_diplom          1   2.09   2.091   0.394  0.534
## KA_prof:KA_diplom             1   3.61   3.613   0.680  0.414
## KA_znaniya:KA_prof:KA_diplom  1  11.55  11.550   2.175  0.148
## Residuals                    42 223.06   5.311               
## 18 observations deleted due to missingness

Если смешиваем мотивацию знания, профессия и диплом, то всё равно нет получается предсказать связь с потребностьюв в достижениях

fit <- aov(Potrebnost_dostigeni ~ KA_otnoshen_studenchestvo*KA_otnoshen_vuz*KA_otnoshen_prof, df)
summary(fit)
##                                                            Df Sum Sq
## KA_otnoshen_studenchestvo                                   2   1.08
## KA_otnoshen_vuz                                             2   3.10
## KA_otnoshen_prof                                            2   3.48
## KA_otnoshen_studenchestvo:KA_otnoshen_vuz                   3   3.15
## KA_otnoshen_studenchestvo:KA_otnoshen_prof                  3  25.74
## KA_otnoshen_vuz:KA_otnoshen_prof                            3   8.47
## KA_otnoshen_studenchestvo:KA_otnoshen_vuz:KA_otnoshen_prof  1   0.00
## Residuals                                                  33 204.77
##                                                            Mean Sq F value
## KA_otnoshen_studenchestvo                                    0.538   0.087
## KA_otnoshen_vuz                                              1.550   0.250
## KA_otnoshen_prof                                             1.740   0.280
## KA_otnoshen_studenchestvo:KA_otnoshen_vuz                    1.050   0.169
## KA_otnoshen_studenchestvo:KA_otnoshen_prof                   8.579   1.383
## KA_otnoshen_vuz:KA_otnoshen_prof                             2.822   0.455
## KA_otnoshen_studenchestvo:KA_otnoshen_vuz:KA_otnoshen_prof   0.002   0.000
## Residuals                                                    6.205        
##                                                            Pr(>F)
## KA_otnoshen_studenchestvo                                   0.917
## KA_otnoshen_vuz                                             0.780
## KA_otnoshen_prof                                            0.757
## KA_otnoshen_studenchestvo:KA_otnoshen_vuz                   0.916
## KA_otnoshen_studenchestvo:KA_otnoshen_prof                  0.265
## KA_otnoshen_vuz:KA_otnoshen_prof                            0.716
## KA_otnoshen_studenchestvo:KA_otnoshen_vuz:KA_otnoshen_prof  0.985
## Residuals                                                        
## 18 observations deleted due to missingness

Нет значимых влияний

Дополнительные параметры.

Взаимосвязь между придикторами. Связь групповой оценки и Потребности в достижениях

ggplot(df2, aes(Gr.ocenka_mean
                ,Potrebnost_dostigeni)) +
        geom_point() +
        theme_classic() +
        labs(x = "Групповая оценка", y = "Потребность в достижении")
## Warning: Removed 10 rows containing missing values (geom_point).

cor.test(df$Gr.ocenka_mean, df$Potrebnost_dostigeni)
## 
##  Pearson's product-moment correlation
## 
## data:  df$Gr.ocenka_mean and df$Potrebnost_dostigeni
## t = 0.8165, df = 49, p-value = 0.4182
## alternative hypothesis: true correlation is not equal to 0
## 95 percent confidence interval:
##  -0.1649939  0.3793300
## sample estimates:
##       cor 
## 0.1158578
cor.test(df$Gr.ocenka_mean, df$Potrebnost_dostigeni
         ,method = "spearman")
## Warning in cor.test.default(df$Gr.ocenka_mean, df$Potrebnost_dostigeni, :
## Cannot compute exact p-value with ties
## 
##  Spearman's rank correlation rho
## 
## data:  df$Gr.ocenka_mean and df$Potrebnost_dostigeni
## S = 19315, p-value = 0.3783
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
##       rho 
## 0.1259989

То есть корреляция отсутствует.

Мотивация знания и знания

Попробуем сравнить мотивы из контент-анализа и методику на мотивацию обучения.

ggplot(df, aes(KA_znaniya, Motiv_znaniya)) +
        geom_boxplot()
## Warning: Removed 15 rows containing non-finite values (stat_boxplot).

summary(
        aov(Motiv_znaniya ~ KA_znaniya, df)
)
##             Df Sum Sq Mean Sq F value Pr(>F)
## KA_znaniya   1    8.1   8.145   0.951  0.334
## Residuals   48  411.2   8.567               
## 18 observations deleted due to missingness

Мотивация диплом и диплом

ggplot(df, aes(KA_diplom, Motiv_diplom)) +
        geom_boxplot()
## Warning: Removed 15 rows containing non-finite values (stat_boxplot).

summary(
        aov(Motiv_diplom ~ KA_diplom, df)
)
##             Df Sum Sq Mean Sq F value Pr(>F)
## KA_diplom    1    9.7   9.720   1.202  0.278
## Residuals   48  388.1   8.085               
## 18 observations deleted due to missingness

Профессия и профессия

ggplot(df, aes(KA_prof, Motiv_prof)) +
        geom_boxplot()
## Warning: Removed 15 rows containing non-finite values (stat_boxplot).

summary(
        aov(Motiv_prof ~ KA_prof, df)
)
##             Df Sum Sq Mean Sq F value Pr(>F)
## KA_prof      1   5.76   5.762   1.156  0.288
## Residuals   48 239.22   4.984               
## 18 observations deleted due to missingness

Доля пятерок и КА

Мотивация и пятерки

ggplot(df, aes(KA_znaniya, Dolya_5)) +
        geom_boxplot()

ggplot(df, aes(KA_prof, Dolya_5)) +
        geom_boxplot()

ggplot(df, aes(KA_diplom, Dolya_5)) +
        geom_boxplot()

Мотивация и тройки

ggplot(df, aes(KA_znaniya, Dolya_3)) +
        geom_boxplot()

ggplot(df, aes(KA_prof, Dolya_3)) +
        geom_boxplot()

ggplot(df, aes(KA_diplom, Dolya_3)) +
        geom_boxplot()

Отношение и пятерки

ggplot(df, aes(KA_otnoshen_studenchestvo, Dolya_5)) +
        geom_boxplot()

ggplot(df, aes(KA_otnoshen_vuz, Dolya_5)) +
        geom_boxplot()

ggplot(df, aes(KA_otnoshen_prof, Dolya_5)) +
        geom_boxplot()

Отношение и тройки

ggplot(df, aes(KA_otnoshen_studenchestvo, Dolya_3)) +
        geom_boxplot()

ggplot(df, aes(KA_otnoshen_vuz, Dolya_3)) +
        geom_boxplot()

ggplot(df, aes(KA_otnoshen_prof, Dolya_3)) +
        geom_boxplot()

fit_5p <- aov(Dolya_5 ~ KA_otnoshen_prof, df)
summary(fit_5p)
##                  Df Sum Sq Mean Sq F value Pr(>F)
## KA_otnoshen_prof  2  0.084 0.04198   0.728  0.488
## Residuals        48  2.767 0.05763               
## 17 observations deleted due to missingness
TukeyHSD(fit_5p)
##   Tukey multiple comparisons of means
##     95% family-wise confidence level
## 
## Fit: aov(formula = Dolya_5 ~ KA_otnoshen_prof, data = df)
## 
## $KA_otnoshen_prof
##                                     diff        lwr       upr     p adj
## нет-отрицательное            0.120164286 -0.1348140 0.3751426 0.4946837
## положительное-отрицательное  0.115755952 -0.1336527 0.3651647 0.5051041
## положительное-нет           -0.004408333 -0.1801971 0.1713804 0.9979742