Пакет ISLR представляет симулированный набор данных Default, который ставит
вероятность дефолта клиента банка в зависимость от трех параметров:
- Является клиент студентом или нет:
student - Доход клиента:
income - Размер задолженности:
balance
library(ISLR)
head(Default)
## default student balance income ## 1 No No 729.5265 44361.625 ## 2 No Yes 817.1804 12106.135 ## 3 No No 1073.5492 31767.139 ## 4 No No 529.2506 35704.494 ## 5 No No 785.6559 38463.496 ## 6 No Yes 919.5885 7491.559
Выборка имеет две интересные особенности. Во первых, студенты в целом как группа,
имеют более высокую вероятность дефолта: 4.3% vs. 2.9%.
tbl <- table(Default$student, Default$default)
prop.table(tbl, margin = 1)
## ## No Yes ## No 0.97080499 0.02919501 ## Yes 0.95686141 0.04313859
Во вторых, при равной задолженности, студенты являются более надежными заемщиками
(вероятность дефолта ниже)
glm.fit <- glm(default ~ ., data=Default, family=binomial)
contrasts(Default$default) # the probability of "event" is probability of default
## Yes ## No 0 ## Yes 1
std <- Default$student == "Yes"
probStudentDefault <- predict(glm.fit, subset(Default,std), type="response")
probNonStudentDefault <- predict(glm.fit, subset(Default, !std), type="response")
plot(x=subset(Default,std)[,"balance"], y = probStudentDefault,
xlab="Balance",
ylab="Probability of default",
col= "blue") # students are blue
points(x=subset(Default,!std)[,"balance"], y = probNonStudentDefault)
Происходит это из-за того, что у студентов в целом, как у группы,
выше средняя задолженность (“balance”).
boxplot(balance ~ student,
border=c("black", "blue"), # students are blue
data=Default,
ylab= "Balance")
В этой ситуации интересно было бы задаться следующим вопросом:
Является ли отличие уровней дефолта “для студентов” и “не студентов” в выборке статистически значимым?
Иными словами, есть ли шанс, что явление, наблюдаемое в выборке, будет гарантированно
(или с высокой степенью вероятности) наблюдаться в популяции в целом?
Ответить на этот вопрос можно сравнивая доверительные интервалы для
точечных оценок значений вероятности дефолта. Ниже я покажу как в R
можно вычислить вероятность наступления события (дефолта
в данном случае) для бинарного распределения, а также верхнюю и нижнею
границы доверительных интервалов при помощи пакета prevalence
library(prevalence)
myTable <- table(Default$student, Default$default)
myTable1 <- addmargins(myTable)
st <- propCI(x = 127, 2944) # for Students
nonSt <- propCI(x = 206, 7056) # for non-Students
Далее, мы можем наглядно убедиться в том, что разница между вероятностью
дефолта для “студентов” и “не студентов”, является действительно статистически значимой:
st # for Students
## x n p method level lower upper ## 1 127 2944 0.04313859 agresti.coull 0.95 0.03635159 0.05111629 ## 2 127 2944 0.04313859 exact 0.95 0.03608730 0.05111493 ## 3 127 2944 0.04313859 jeffreys 0.95 0.03624318 0.05093151 ## 4 127 2944 0.04313859 wald 0.95 0.03579959 0.05047758 ## 5 127 2944 0.04313859 wilson 0.95 0.03637561 0.05109228
nonSt # for non-Students
## x n p method level lower upper ## 1 206 7056 0.02919501 agresti.coull 0.95 0.02550743 0.03339495 ## 2 206 7056 0.02919501 exact 0.95 0.02539152 0.03339381 ## 3 206 7056 0.02919501 jeffreys 0.95 0.02545773 0.03331836 ## 4 206 7056 0.02919501 wald 0.95 0.02526685 0.03312317 ## 5 206 7056 0.02919501 wilson 0.95 0.02551575 0.03338663
В таблицах приведены результаты вычисления доверительных интервалов 5-ю
различными, наиболее часто встречающимися способами.