Задание 1
Проведена предобработка в экселе: я отчаялась
и сократила названия меток.
Посомтрим категориальную перемнную
regr = lm(Index ~ Activities, data = data)
summary(regr)$coef## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 54.7585115 0.2702369 202.631541 0.00000000
## ActivitiesYes 0.9423778 0.3841756 2.452987 0.01418449Этап построения регрессионной модели
regres = lm(Index ~ Hours+Scores+Activities+Sleep+Sample, data = data)
summary(regres)##
## Call:
## lm(formula = Index ~ Hours + Scores + Activities + Sleep + Sample,
## data = data)
##
## 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 2.852982 0.007873 362.35 <2e-16 ***
## Scores 1.018434 0.001175 866.45 <2e-16 ***
## ActivitiesYes 0.612898 0.040781 15.03 <2e-16 ***
## Sleep 0.480560 0.012022 39.97 <2e-16 ***
## Sample 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-16sjPlot::tab_model(regres)| Index | |||
|---|---|---|---|
| Predictors | Estimates | CI | p |
| (Intercept) | -34.08 | -34.32 – -33.83 | <0.001 |
| Hours | 2.85 | 2.84 – 2.87 | <0.001 |
| Scores | 1.02 | 1.02 – 1.02 | <0.001 |
| Activities [Yes] | 0.61 | 0.53 – 0.69 | <0.001 |
| Sleep | 0.48 | 0.46 – 0.50 | <0.001 |
| Sample | 0.19 | 0.18 – 0.21 | <0.001 |
| Observations | 10000 | ||
| R2 / R2 adjusted | 0.989 / 0.989 | ||
Все 5 предикторов значимо влияют на итоговый результат: при
увеличении любого предиктора будет увеличиваться индекс успеваемости.
Коэффициент детерминации высокий: 98,9% дисперсии зависимой
переменной объясняется регрессионной моделью.
F-статистика тоже
статистически значима (1.757e+05 on 5 and 9994 DF, p-value: <
2.2e-16)
из интереса (актуальности :( ) уберем показатель сна
для сравнения моделей
regresss = lm(Index ~ Hours+Scores+Activities+Sample, data = data)
summary(regresss)##
## Call:
## lm(formula = Index ~ Hours + Scores + Activities + Sample, data = data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -8.8111 -1.4561 -0.0075 1.4583 9.0593
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -30.945965 0.107882 -286.85 <2e-16 ***
## Hours 2.853403 0.008479 336.52 <2e-16 ***
## Scores 1.018722 0.001266 804.80 <2e-16 ***
## ActivitiesYes 0.574765 0.043905 13.09 <2e-16 ***
## Sample 0.195003 0.007657 25.47 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.195 on 9995 degrees of freedom
## Multiple R-squared: 0.987, Adjusted R-squared: 0.9869
## F-statistic: 1.89e+05 on 4 and 9995 DF, p-value: < 2.2e-16sjPlot::tab_model(regresss)| Index | |||
|---|---|---|---|
| Predictors | Estimates | CI | p |
| (Intercept) | -30.95 | -31.16 – -30.73 | <0.001 |
| Hours | 2.85 | 2.84 – 2.87 | <0.001 |
| Scores | 1.02 | 1.02 – 1.02 | <0.001 |
| Activities [Yes] | 0.57 | 0.49 – 0.66 | <0.001 |
| Sample | 0.20 | 0.18 – 0.21 | <0.001 |
| Observations | 10000 | ||
| R2 / R2 adjusted | 0.987 / 0.987 | ||
anova(regres, regresss)## Analysis of Variance Table
##
## Model 1: Index ~ Hours + Scores + Activities + Sleep + Sample
## Model 2: Index ~ Hours + Scores + Activities + Sample
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 9994 41514
## 2 9995 48151 -1 -6637 1597.8 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1модель тоже хорошая, качество снизилось буквально на 1 тысячную.
степень свободы снизилась на 1 единицу, что не особо значимо.
мультиколлинеарность из интереса. Ругался на активизм, пришлось
убрать
library(dplyr)##
## Присоединяю пакет: 'dplyr'## Следующие объекты скрыты от 'package:stats':
##
## filter, lag## Следующие объекты скрыты от 'package:base':
##
## intersect, setdiff, setequal, uniondata %>%
dplyr::select(Hours,Scores,Sleep,Sample) %>%
cor()## Hours Scores Sleep Sample
## Hours 1.000000000 -0.012389916 0.001245198 0.017463168
## Scores -0.012389916 1.000000000 0.005944219 0.007888025
## Sleep 0.001245198 0.005944219 1.000000000 0.003990220
## Sample 0.017463168 0.007888025 0.003990220 1.000000000достаточно удивительно (для меня), что корреляции между факторами
очень маленькие.
Вывод. Все предикторы: количество часов на
учебу, предшествущие результаты, внеклассная деятельность, сон, эказмены
- влияют на показатель общей успеваемости.Причем если предиктор будет
увелививаться, то и успеваемость будет лучше (в завивисмости от
коэффициента)
Задание 2
в базе пришлось
перекодировать в те же переменные (2 поменять на 0)
library(haven)
kl<-read_sav("C:/Users/malya/Desktop/База_КлимРиск_2023.sav")перевод в факторы
kl$type <- factor(kl$type)
kl$V1 <- factor(kl$V1)Формируем регрессионную модель
model_glm <- glm(V19 ~ type + V1 + age_cats3, data = kl, family = "binomial")
summary(model_glm)##
## Call:
## glm(formula = V19 ~ type + V1 + age_cats3, family = "binomial",
## data = kl)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.23294 0.32249 -3.823 0.000132 ***
## type2 -0.63873 0.48761 -1.310 0.190221
## type3 0.28330 0.52582 0.539 0.590046
## type4 -0.29673 0.26408 -1.124 0.261179
## type5 -0.31947 0.29471 -1.084 0.278358
## type6 -0.06609 0.41086 -0.161 0.872213
## type7 0.31842 0.24093 1.322 0.186291
## V12 0.74930 0.15464 4.845 1.26e-06 ***
## age_cats3 0.41272 0.10530 3.919 8.88e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1151.2 on 834 degrees of freedom
## Residual deviance: 1089.0 on 826 degrees of freedom
## (78 пропущенных наблюдений удалены)
## AIC: 1107
##
## Number of Fisher Scoring iterations: 4на данном этапе наблюдается несколько значимых перемнных: мужской пол и возраст более 50 лет. Проживание в разном типе района незначимо (было бы интересно), как и возраст до 50 лет и женский пол.
exp(cbind(OR = coef(model_glm), confint(model_glm)))## Waiting for profiling to be done...## OR 2.5 % 97.5 %
## (Intercept) 0.2914333 0.1540204 0.5462918
## type2 0.5279611 0.1971553 1.3573295
## type3 1.3274982 0.4823173 3.8931683
## type4 0.7432464 0.4417900 1.2460589
## type5 0.7265321 0.4064793 1.2929272
## type6 0.9360495 0.4174097 2.1052935
## type7 1.3749589 0.8553192 2.2037381
## V12 2.1155227 1.5642667 2.8691308
## age_cats3 1.5109249 1.2305761 1.8601040Сложноинтерпретируемые к нашем случае шансы: принадлежность к мужскому полу на 113% увеличивает шанс ощущать опасность от таяния ледников (но как бы так не говорят), а возраст более 50 лет - в 118% повышает это чувство.
with(summary(model_glm), 1 - deviance/null.deviance)## [1] 0.05399195R2 получился скромный - 0,055. То есть 5% дисперсии перемнной описывается регрессионной моделью. Это значит, что модель требует корректировки и внесения иных предикторов.