Лабораторная 9
А. С. Миндергасов
2026-03-14
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.0 ✔ readr 2.2.0
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.2 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.1
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(caret)## Загрузка требуемого пакета: lattice
##
## Присоединяю пакет: 'caret'
##
## Следующий объект скрыт от 'package:purrr':
##
## liftlibrary(olsrr)##
## Присоединяю пакет: 'olsrr'
##
## Следующий объект скрыт от 'package:datasets':
##
## riverslibrary(dplyr)
library(readr)
Student_Performance <- read_csv("~/files/Student_Performance.csv")## Rows: 10000 Columns: 6
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): Extracurricular Activities
## dbl (5): Hours Studied, Previous Scores, Sleep Hours, Sample Question Papers...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.Student_Performance <- Student_Performance %>%
rename(
Hours.Studied = `Hours Studied`,
Previous.Scores = `Previous Scores`,
Extracurricular.Activities = `Extracurricular Activities`,
Sleep.Hours = `Sleep Hours`,
Sample.Question.Papers.Practiced = `Sample Question Papers Practiced`,
Performance.Index = `Performance Index`
)
Student_Performance$Extracurricular.Activities <- factor(Student_Performance$Extracurricular.Activities)Отразим описательные статистики и визуализируем корреляцию
summary(Student_Performance)## Hours.Studied Previous.Scores Extracurricular.Activities Sleep.Hours
## Min. :1.000 Min. :40.00 No :5052 Min. :4.000
## 1st Qu.:3.000 1st Qu.:54.00 Yes:4948 1st Qu.:5.000
## Median :5.000 Median :69.00 Median :7.000
## Mean :4.993 Mean :69.45 Mean :6.531
## 3rd Qu.:7.000 3rd Qu.:85.00 3rd Qu.:8.000
## Max. :9.000 Max. :99.00 Max. :9.000
## Sample.Question.Papers.Practiced Performance.Index
## Min. :0.000 Min. : 10.00
## 1st Qu.:2.000 1st Qu.: 40.00
## Median :5.000 Median : 55.00
## Mean :4.583 Mean : 55.22
## 3rd Qu.:7.000 3rd Qu.: 71.00
## Max. :9.000 Max. :100.00# Корреляционная матрица
numeric_vars <- Student_Performance %>%
select(Hours.Studied, Previous.Scores, Sleep.Hours,
Sample.Question.Papers.Practiced, Performance.Index)
cor_matrix <- cor(numeric_vars)
print(round(cor_matrix, 3))## Hours.Studied Previous.Scores Sleep.Hours
## Hours.Studied 1.000 -0.012 0.001
## Previous.Scores -0.012 1.000 0.006
## Sleep.Hours 0.001 0.006 1.000
## Sample.Question.Papers.Practiced 0.017 0.008 0.004
## Performance.Index 0.374 0.915 0.048
## Sample.Question.Papers.Practiced
## Hours.Studied 0.017
## Previous.Scores 0.008
## Sleep.Hours 0.004
## Sample.Question.Papers.Practiced 1.000
## Performance.Index 0.043
## Performance.Index
## Hours.Studied 0.374
## Previous.Scores 0.915
## Sleep.Hours 0.048
## Sample.Question.Papers.Practiced 0.043
## Performance.Index 1.000library(corrplot)## corrplot 0.95 loadedcorrplot(cor_matrix, method = "number", type = "upper", tl.cex = 0.8)
Previous Scores — безусловно самый важный предиктор успеваемости. Hours
Studied — второй по значимости фактор. Внеклассная деятельность, часы
сна и количество практических работ требуют дополнительной проверки в
регрессионной модели для оценки их влияния при контроле других
факторов.
Построим регрессионную модель
model_full <- lm(Performance.Index ~ ., data = Student_Performance)
summary(model_full)##
## Call:
## lm(formula = Performance.Index ~ ., data = Student_Performance)
##
## Residuals:
## Min 1Q Median 3Q Max
## -8.6333 -1.3684 -0.0311 1.3556 8.7932
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -34.075588 0.127143 -268.01 <2e-16 ***
## Hours.Studied 2.852982 0.007873 362.35 <2e-16 ***
## Previous.Scores 1.018434 0.001175 866.45 <2e-16 ***
## Extracurricular.ActivitiesYes 0.612898 0.040781 15.03 <2e-16 ***
## Sleep.Hours 0.480560 0.012022 39.97 <2e-16 ***
## Sample.Question.Papers.Practiced 0.193802 0.007110 27.26 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.038 on 9994 degrees of freedom
## Multiple R-squared: 0.9888, Adjusted R-squared: 0.9887
## F-statistic: 1.757e+05 on 5 and 9994 DF, p-value: < 2.2e-16Previous.Scores (1.018) при увеличении предыдущих баллов на 1, успеваемость растет на 1.02 балла, Hours.Studied (2,853) дополнительный час учебы повышает успеваемость на 2.85 балла.Распределение симметричное (медиана близка к нулю). Ошибка модели ~2 балла. Модель отличного качества, все факторы значимы. Наибольшее влияние оказывают предыдущие баллы и часы учебы.
par(mfrow = c(2, 2))
plot(model_full)
cooks_dist <- cooks.distance(model_full)
plot(cooks_dist, type = "h", main = "Расстояние Кука", ylab = "Cook's distance")
abline(h = 4/length(cooks_dist), col = "red", lty = 2)
confint(model_full)## 2.5 % 97.5 %
## (Intercept) -34.3248136 -33.8263626
## Hours.Studied 2.8375484 2.8684157
## Previous.Scores 1.0161302 1.0207382
## Extracurricular.ActivitiesYes 0.5329596 0.6928356
## Sleep.Hours 0.4569937 0.5041258
## Sample.Question.Papers.Practiced 0.1798645 0.2077397Регрессионная модель продемонстрировала исключительно высокое качество:R² = 0.9888 — модель объясняет 98.9% вариации успеваемости студентов, скорректированный R² = 0.9887 — подтверждает адекватность модели без переобучения, F-статистика = 175 700 (p < 2.2e-16) — модель статистически значима на высочайшем уровне. Все включенные в модель факторы оказались статистически значимыми (p < 2e-16) и влияют на успеваемость. Построенная регрессионная модель обладает высокой предсказательной способностью. Модель подтверждает, что успеваемость формируется комплексом факторов, среди которых ключевую роль играют предыдущие достижения и текущие усилия студента.