판별분석/분류분석 Classification Analysis
# 분류되어 있는 집단 간의 차이를 의미있게 설명해 줄 수 있는 독립변수들을 찾음.
# 변수의 결합으로 판별식(Discriminant function)을 만들어 관측치를 판별하는 규칙 만듬.
# • 예 - 서비스 이용 불만 고객의 성향 분석, SKT/KT/LGT 가입고객 판별변수 및 판별함수 유도
# 비교: 군집분석
# • 관측치를 그룹으로 구분함
# • 판별분석과는 다르게 데이터에 집단을 나타내는 변수 없음
# 비교: 회귀분석
# • 종속변수가 이산형인 logistic regression은 두 집단 판별분석의 한 방법
# • 판별분석은 집단이 2개 이상의 범주를 갖는 범주형변수인 경우 가능
# • 판별분석은 집단을 구분하는 판별식 유도
# • 회귀분석은 집단에 속하는 확률 예측
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
summary(Default)
## default student balance income
## No :9667 No :7056 Min. : 0.0 Min. : 772
## Yes: 333 Yes:2944 1st Qu.: 481.7 1st Qu.:21340
## Median : 823.6 Median :34553
## Mean : 835.4 Mean :33517
## 3rd Qu.:1166.3 3rd Qu.:43808
## Max. :2654.3 Max. :73554
# 선형회귀모형은 적당치 않음
plot(Default$balance, Default$income, pch=as.numeric(Default$default), col=as.numeric(Default$default))
boxplot(balance ~ default, Default, col=c('yellow','red'), ylab='Balance')
boxplot(income ~ default, Default, col=c('yellow','red'), ylab='Income')
# Simple Logistic regression
# Balance를 사용해 default=Yes일 확률 예측
glm.fit = glm(default ~ balance, data = Default, family = binomial)
summary(glm.fit)
##
## Call:
## glm(formula = default ~ balance, family = binomial, data = Default)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.2697 -0.1465 -0.0589 -0.0221 3.7589
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.065e+01 3.612e-01 -29.49 <2e-16 ***
## balance 5.499e-03 2.204e-04 24.95 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2920.6 on 9999 degrees of freedom
## Residual deviance: 1596.5 on 9998 degrees of freedom
## AIC: 1600.5
##
## Number of Fisher Scoring iterations: 8
# --> balance의 회귀계수 p-value<0.0001 : 파산확률과 카드잔고 사이에 관계가 있음
# log-odds(logit) - Odds: 성공확률/실패확률
# balance의 회귀계수 : 5.499e-03
# X가 1단위 증가할 때 e의 b1승 배 증가 : odds ratio
exp(5.499e-03 * 100) # balance 가 100 증가할 때 파산할 odds가 73% 증가한다.
## [1] 1.73308
# 카드 잔고가 $1000인 사람의 파산 확률은?
a = predict(glm.fit, data.frame(balance = 1000)) # logit
exp(a)/(1+exp(a))
## 1
## 0.005752145
predict(glm.fit, data.frame(balance = 1000), type = "response") # P(x)
## 1
## 0.005752145
# Multiple logistic regression
model1 = glm(default ~ ., data = Default, family = binomial)
summary(model1)
##
## Call:
## glm(formula = default ~ ., family = binomial, data = Default)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.4691 -0.1418 -0.0557 -0.0203 3.7383
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.087e+01 4.923e-01 -22.080 < 2e-16 ***
## studentYes -6.468e-01 2.363e-01 -2.738 0.00619 **
## balance 5.737e-03 2.319e-04 24.738 < 2e-16 ***
## income 3.033e-06 8.203e-06 0.370 0.71152
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2920.6 on 9999 degrees of freedom
## Residual deviance: 1571.5 on 9996 degrees of freedom
## AIC: 1579.5
##
## Number of Fisher Scoring iterations: 8
model2 = glm(default ~ student, data = Default, family = binomial)
summary(model2)
##
## Call:
## glm(formula = default ~ student, family = binomial, data = Default)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.2970 -0.2970 -0.2434 -0.2434 2.6585
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -3.50413 0.07071 -49.55 < 2e-16 ***
## studentYes 0.40489 0.11502 3.52 0.000431 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2920.6 on 9999 degrees of freedom
## Residual deviance: 2908.7 on 9998 degrees of freedom
## AIC: 2912.7
##
## Number of Fisher Scoring iterations: 6
boxplot(balance ~ student, Default, ylab='Balance', xlab='Student')
# --> 현재잔고와 학생여부는 파산과 연관이 있음
# • 학생더미 변수의 계수가 음수
# • Simple logistic regression에서는 양수
# 학생이면 파산가능성이 더 낮은가?
# deviance
# H0 : 두 모형의 차이가 없다.
# Null deviance : 설명변수가 의미없는 경우
# Residual deviance : 설명변수가 추가된 만큼의 자유도가 떨어진 경우
exp(coef(model1)[2])
## studentYes
## 0.5237317
exp(coef(model2)[2])
## studentYes
## 1.499133
# Confounding effect
# • 같은 수준의 income과 balance를 가지고 있을 경우 학생의 파산가능성(odds)이 더 낮음
# • 학생일 경우 credit card balance가 더 높은 경향이 있음
# • 학생인 경우 아닌 경우보다 파산가능성(odds)이 1.5배
# • 같은 수준의 income과 balance를 가지고 있을 경우 학생의 파산가능성(odds)은 0.5배
# 모형비교: Deviance Goodness-of-fit Test
anova(model1, test = "Chisq")
## Analysis of Deviance Table
##
## Model: binomial, link: logit
##
## Response: default
##
## Terms added sequentially (first to last)
##
##
## Df Deviance Resid. Df Resid. Dev Pr(>Chi)
## NULL 9999 2920.7
## student 1 11.97 9998 2908.7 0.0005416 ***
## balance 1 1337.00 9997 1571.7 < 2.2e-16 ***
## income 1 0.14 9996 1571.5 0.7115139
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
anova(model1, model2, test = "Chisq")
## Analysis of Deviance Table
##
## Model 1: default ~ student + balance + income
## Model 2: default ~ student
## Resid. Df Resid. Dev Df Deviance Pr(>Chi)
## 1 9996 1571.5
## 2 9998 2908.7 -2 -1337.1 < 2.2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
# balance + income 이 동시에 미치는 영향
# balance + income의 영향이 ddefault 확률을 예측하는데 유의하다.
# 반복 측정된 자료 (summarised data)
# 한 개의 X값에서 여러 개의 Y가 측정된 경우
# Binomial Distribution
# x1 x2 y
# 1 1 20 (1이 20번 반복 측정됨)
# 1 2 5
# Example: Coupon Effectiveness
# 가격 할인 쿠폰의 효과를 검증하기 위해 무작위로 추출된 각 200개의 가구에 5,10,15,20,30 달러의 쿠폰을 제공.
coupon = read.csv("data/coupon.csv")
coupon
## Price_reduc N N_redeemed
## 1 5 200 30
## 2 10 200 55
## 3 15 200 70
## 4 20 200 100
## 5 30 200 137
# Yes , No 갯수
model4 = glm(cbind(N_redeemed, N-N_redeemed) ~ Price_reduc, data = coupon, family = binomial)
summary(model4)
##
## Call:
## glm(formula = cbind(N_redeemed, N - N_redeemed) ~ Price_reduc,
## family = binomial, data = coupon)
##
## Deviance Residuals:
## 1 2 3 4 5
## -0.8988 0.6677 -0.1837 0.7612 -0.5477
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.044348 0.160977 -12.70 <2e-16 ***
## Price_reduc 0.096834 0.008549 11.33 <2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 149.4627 on 4 degrees of freedom
## Residual deviance: 2.1668 on 3 degrees of freedom
## AIC: 33.793
##
## Number of Fisher Scoring iterations: 3
exp(0.096834) # = 1.10 : 쿠폰 할인액이 1달러 증가할 때 쿠폰을 사용할 Odds는 10% 증가.
## [1] 1.101677
exp(0.096834 * 5) # 10달러 쿠폰의 5달러 쿠폰 대비 사용 확률
## [1] 1.622828
# Cutoff
head(model1$fitted.values)
## 1 2 3 4 5
## 0.0014287239 0.0011222039 0.0098122716 0.0004415893 0.0019355062
## 6
## 0.0019895182
x = data.frame(default = Default$default, fit = model1$fitted.values)
head(x)
## default fit
## 1 No 0.0014287239
## 2 No 0.0011222039
## 3 No 0.0098122716
## 4 No 0.0004415893
## 5 No 0.0019355062
## 6 No 0.0019895182
xtabs(~default + (fit>0.5), data = x) # ---> confusion matrix
## fit > 0.5
## default FALSE TRUE
## No 9627 40
## Yes 228 105
xtabs(~default + (fit>0.3), data = x)
## fit > 0.3
## default FALSE TRUE
## No 9530 137
## Yes 164 169
library(ROCR)
## Loading required package: gplots
##
## Attaching package: 'gplots'
## The following object is masked from 'package:stats':
##
## lowess
pred = prediction(x$fit, x$default)
plot(performance(pred, "tpr", "fpr"))
plot(performance(pred, "err"))
# Practice 5
# S&P500 지수의 수익률을 1250일간 기록한 데이터이다. Lag1-Lag5는 1일에서 5일 전의 수익률을 나타내고 Volume은 전일 거래량(in billions), Today는 오늘의 수익률, Direction은 오늘 시장의 상승(up)과 하락(down)을 나타낸다. 로지스틱 회귀분석을 이용하여 아래의 질문에 답하시오.
head(Smarket)
## Year Lag1 Lag2 Lag3 Lag4 Lag5 Volume Today Direction
## 1 2001 0.381 -0.192 -2.624 -1.055 5.010 1.1913 0.959 Up
## 2 2001 0.959 0.381 -0.192 -2.624 -1.055 1.2965 1.032 Up
## 3 2001 1.032 0.959 0.381 -0.192 -2.624 1.4112 -0.623 Down
## 4 2001 -0.623 1.032 0.959 0.381 -0.192 1.2760 0.614 Up
## 5 2001 0.614 -0.623 1.032 0.959 0.381 1.2057 0.213 Up
## 6 2001 0.213 0.614 -0.623 1.032 0.959 1.3491 1.392 Up
summary(Smarket)
## Year Lag1 Lag2
## Min. :2001 Min. :-4.922000 Min. :-4.922000
## 1st Qu.:2002 1st Qu.:-0.639500 1st Qu.:-0.639500
## Median :2003 Median : 0.039000 Median : 0.039000
## Mean :2003 Mean : 0.003834 Mean : 0.003919
## 3rd Qu.:2004 3rd Qu.: 0.596750 3rd Qu.: 0.596750
## Max. :2005 Max. : 5.733000 Max. : 5.733000
## Lag3 Lag4 Lag5
## Min. :-4.922000 Min. :-4.922000 Min. :-4.92200
## 1st Qu.:-0.640000 1st Qu.:-0.640000 1st Qu.:-0.64000
## Median : 0.038500 Median : 0.038500 Median : 0.03850
## Mean : 0.001716 Mean : 0.001636 Mean : 0.00561
## 3rd Qu.: 0.596750 3rd Qu.: 0.596750 3rd Qu.: 0.59700
## Max. : 5.733000 Max. : 5.733000 Max. : 5.73300
## Volume Today Direction
## Min. :0.3561 Min. :-4.922000 Down:602
## 1st Qu.:1.2574 1st Qu.:-0.639500 Up :648
## Median :1.4229 Median : 0.038500
## Mean :1.4783 Mean : 0.003138
## 3rd Qu.:1.6417 3rd Qu.: 0.596750
## Max. :3.1525 Max. : 5.733000
df = Smarket[, -1]
head(df)
## Lag1 Lag2 Lag3 Lag4 Lag5 Volume Today Direction
## 1 0.381 -0.192 -2.624 -1.055 5.010 1.1913 0.959 Up
## 2 0.959 0.381 -0.192 -2.624 -1.055 1.2965 1.032 Up
## 3 1.032 0.959 0.381 -0.192 -2.624 1.4112 -0.623 Down
## 4 -0.623 1.032 0.959 0.381 -0.192 1.2760 0.614 Up
## 5 0.614 -0.623 1.032 0.959 0.381 1.2057 0.213 Up
## 6 0.213 0.614 -0.623 1.032 0.959 1.3491 1.392 Up
boxplot(df)
# Lag변수들과 Volume을 사용하여 시장의 상승 하락을 예측하는 모형을 추정.
model = glm(Direction ~ Lag1+Lag2+Lag3+Lag4+Lag5+Volume, data = df, family = binomial)
summary(model)
##
## Call:
## glm(formula = Direction ~ Lag1 + Lag2 + Lag3 + Lag4 + Lag5 +
## Volume, family = binomial, data = df)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.446 -1.203 1.065 1.145 1.326
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.126000 0.240736 -0.523 0.601
## Lag1 -0.073074 0.050167 -1.457 0.145
## Lag2 -0.042301 0.050086 -0.845 0.398
## Lag3 0.011085 0.049939 0.222 0.824
## Lag4 0.009359 0.049974 0.187 0.851
## Lag5 0.010313 0.049511 0.208 0.835
## Volume 0.135441 0.158360 0.855 0.392
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 1731.2 on 1249 degrees of freedom
## Residual deviance: 1727.6 on 1243 degrees of freedom
## AIC: 1741.6
##
## Number of Fisher Scoring iterations: 3
anova(model, test = "Chisq")
## Analysis of Deviance Table
##
## Model: binomial, link: logit
##
## Response: Direction
##
## Terms added sequentially (first to last)
##
##
## Df Deviance Resid. Df Resid. Dev Pr(>Chi)
## NULL 1249 1731.2
## Lag1 1 1.97822 1248 1729.2 0.1596
## Lag2 1 0.79313 1247 1728.4 0.3732
## Lag3 1 0.03167 1246 1728.4 0.8587
## Lag4 1 0.01942 1245 1728.3 0.8892
## Lag5 1 0.03540 1244 1728.3 0.8508
## Volume 1 0.73283 1243 1727.6 0.3920
# Cutoff를 0.5로 설정하여 분할표를 출력하고 민감도, 특이도, 오분류율을 계산하시오.
x = data.frame(Direction = Smarket$Direction, fit = model$fitted.values)
head(x)
## Direction fit
## 1 Up 0.5070841
## 2 Up 0.4814679
## 3 Down 0.4811388
## 4 Up 0.5152224
## 5 Up 0.5107812
## 6 Up 0.5069565
xtabs(~Direction + (fit>0.3), data = x) # ---> confusion matrix
## fit > 0.3
## Direction TRUE
## Down 602
## Up 648
err = performance(pred, "err")
err@x.values[[1]][err@y.values[[1]]==min(err@y.values[[1]])]
## [1] 0.4298679
# ROC curve를 그리고 모형의 적절성을 판단하시오.
pred = prediction(x$fit, x$Direction)
plot(performance(pred, "tpr", "fpr"))
plot(performance(pred, "err"))
# 분류 데이터가 희귀한 경우. rara event : 희귀병 등 yes인 경우가 30개 미만인 경우
# model = glm(......, family = binomial(link = "cloglog")) # complementary log-log link