Пакет 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)

plot of chunk unnamed-chunk-3

Происходит это из-за того, что у студентов в целом, как у группы,
выше средняя задолженность (“balance”).

boxplot(balance ~ student,
        border=c("black", "blue"), # students are blue
        data=Default,
        ylab= "Balance")

plot of chunk unnamed-chunk-4

В этой ситуации интересно было бы задаться следующим вопросом:

Является ли отличие уровней дефолта “для студентов” и “не студентов” в выборке статистически значимым?

Иными словами, есть ли шанс, что явление, наблюдаемое в выборке, будет гарантированно
(или с высокой степенью вероятности) наблюдаться в популяции в целом?

Ответить на этот вопрос можно сравнивая доверительные интервалы для
точечных оценок значений вероятности дефолта. Ниже я покажу как в 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-ю
различными, наиболее часто встречающимися способами.

© 2014 In R we trust.
Top
Follow us: