4 / laba4
.docxКритерий правдоподобия (Log-likelihood) - -189.564 Логарифмическое правдоподобие показывает, насколько хорошо модель соответствует исходным данным. Снижение его величины означает улучшение качества модели (чем меньше значение, тем выше качество модели).
Качество модели улучшилось.
Критерий согласия Хосмера–Лемешоу y = числовой вектор наблюдений, двоичный (0/1) yhat = ожидаемые значения (вероятности )
y <- model1$y yhat <- predict(model1,train_down, type="response") hoslem.test(y, yhat)
## ## Hosmer and Lemeshow goodness of fit (GOF) test ## ## data: y, yhat ## X-squared = 3.7479, df = 8, p-value = 0.8791
Уровень значимости является большим, модель точно описывает реальные данные.
Графический тест:
qqnorm(model1$residuals)
Рассмотрим параметрические тесты:
lillie.test(model1$residuals)
## ## Lilliefors (Kolmogorov-Smirnov) normality test ## ## data: model1$residuals ## D = 0.23677, p-value < 2.2e-16
Поскольку значение p-value меньше 0.05 нулевая гипотеза о согласие распределения остатков с нормальным законом распределения отвергается.
Спрогнозируем значения по выбранной модели на тестовой выборке.
test1$pred_1 <- predict(model1, test1, type = 'response')
Расчетаем маржинальный эффект для логит-модели
logitmfx(Outcome ~ Pregnancies + Glucose + BloodPressure + BMI + DiabetesPedigreeFunction, data = test1)
## Call: ## logitmfx(formula = Outcome ~ Pregnancies + Glucose + BloodPressure + ## BMI + DiabetesPedigreeFunction, data = test1) ## ## Marginal Effects: ## dF/dx Std. Err. z P>|z| ## Pregnancies 0.0476313 0.0109780 4.3388 1.433e-05 *** ## Glucose 0.0059406 0.0012286 4.8352 1.330e-06 *** ## BloodPressure -0.0020503 0.0020566 -0.9970 0.318783 ## BMI 0.0160701 0.0052483 3.0620 0.002199 ** ## DiabetesPedigreeFunction 0.1255835 0.1078624 1.1643 0.244305 ## --- ## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Маржинальные эффекты умножаются на 100% и интерпретируются как предсказательный эффект влияния независимого фактора на вероятность положительной альтернативы.
Оценим качество классификации
test1$pred1 <- ifelse(test1$pred_1 < 0.8, 0, 1) test1$pred1 <- as.factor(test1$pred1) confusionMatrix(data = test1$pred1,reference = test1$Outcome, positive = "1")
## Confusion Matrix and Statistics ## ## Reference ## Prediction 0 1 ## 0 142 60 ## 1 8 20 ## ## Accuracy : 0.7043 ## 95% CI : (0.6408, 0.7625) ## No Information Rate : 0.6522 ## P-Value [Acc > NIR] : 0.05433 ## ## Kappa : 0.2318 ## ## Mcnemar's Test P-Value : 6.224e-10 ## ## Sensitivity : 0.25000 ## Specificity : 0.94667 ## Pos Pred Value : 0.71429 ## Neg Pred Value : 0.70297 ## Prevalence : 0.34783 ## Detection Rate : 0.08696 ## Detection Prevalence : 0.12174 ## Balanced Accuracy : 0.59833 ## ## 'Positive' Class : 1 ##
Для оценки качества построенной модели бинарного выбора используется ROC кривая. ROC-кривая показывает зависимость количества верно классифицированных положительных примеров от количества неверно классифицированных отрицательных примеров.
Чем ближе кривая к верхнему левому углу, тем выше предсказательная способность модели. Наоборот, чем меньше изгиб кривой и чем ближе она расположена к диагональной прямой, тем менее эффективна модель.
Построим ROC-кривую для Логит-модели
pr <- prediction(test1$pred_1, test1$Outcome) prf <- performance(pr, measure = "tpr", x.measure = "fpr") plot(prf) lines(c(0,1),c(0,1)) title("ROC-кривая")
Численный показатель площади под кривой AUC (Area Under Curve)
auc.tmp <- performance(pr,"auc"); auc <- as.numeric(auc.tmp@y.values) show(auc)
## [1] 0.8013333
Качество модели очень хорошее.
Коэффициент Джини статистический показатель степени неоднородности (расслоения) по отношению к какому-либо изучаемому признаку.
Коэффициент Джини изменяется от 0 до 1. Чем больше его значение отклоняется от нуля и приближается к единице, тем в большей степени признак сконцентрирован в отдельных группах.
Gini <- 2 * auc * (auc - 0.5) show(Gini)
## [1] 0.4829369
Построим ROC-кривую для Пробит-модели
test1$pred_2 <- predict(model_2, test1, type = 'response') pr <- prediction(test1$pred_2, test1$Outcome) prf <- performance(pr, measure = "tpr", x.measure = "fpr") plot(prf) lines(c(0,1),c(0,1)) title("ROC-кривая")
Численный показатель площади под кривой AUC (Area Under Curve)
auc.tmp <- performance(pr,"auc"); auc <- as.numeric(auc.tmp@y.values) show(auc)
## [1] 0.80725
Качество модели очень хорошее.
Коэффициент Джини статистический показатель степени неоднородности (расслоения) по отношению к какому-либо изучаемому признаку.
Коэффициент Джини изменяется от 0 до 1. Чем больше его значение отклоняется от нуля и приближается к единице, тем в большей степени признак сконцентрирован в отдельных группах.
Gini <- 2 * auc * (auc - 0.5) show(Gini)
## [1] 0.4960551
Построим ROC-кривую для Гомплит-модели
test1$pred_3 <- predict(model_3, test1, type = 'response') pr <- prediction(test1$pred_3, test1$Outcome) prf <- performance(pr, measure = "tpr", x.measure = "fpr") plot(prf) lines(c(0,1),c(0,1)) title("ROC-кривая")
Численный показатель площади под кривой AUC (Area Under Curve)
auc.tmp <- performance(pr,"auc"); auc <- as.numeric(auc.tmp@y.values) show(auc)
## [1] 0.80325
Качество модели очень хорошее.
Коэффициент Джини статистический показатель степени неоднородности (расслоения) по отношению к какому-либо изучаемому признаку.
Коэффициент Джини изменяется от 0 до 1. Чем больше его значение отклоняется от нуля и приближается к единице, тем в большей степени признак сконцентрирован в отдельных группах.
Gini <- 2 * auc * (auc - 0.5) show(Gini)
## [1] 0.4871711
Выбранная Логит-модель лучше откалибрована и достаточно точно описывает реальные данные.