R 에서 ROC 곡선 그리는 법

R 에서 ROC 곡선 그리는 법

How to Plot ROC Curve

정의

오류행렬의 False Positive Rate와 True Positive Rate를 각각 축으로 두고 그린 그림을 ROC 곡선Receiver Operating Characteristic Curve이라 한다.

설명

ROC 곡선은 모델의 퍼포먼스를 한 눈에 보여줄 뿐만 아니라 최적의 컷오프를 찾고 모델 간의 비교에도 쓰이는 등 요긴하게 쓸 데가 많다. 예제를 통해 R 에서 ROC 곡선을 그려보고 그 의미를 이해해보자. 핵심적인 패키지로 ROCR이 쓰인다.

실습

Car 패키지의 내장데이터 Chile 데이터를 불러와보자.

20190128\_132747.png

Chile는 칠레의 독재자 아우구스토 피노체트가 1988년 자신의 집권 연장 찬반 여부를 묻는 투표에 대한 설문조사 데이터로써, region(지역), population(응답자 커뮤니티의 인구), sex(성별), age(연령), education(교육수준), income(수입), statusquo(현재 상황에 대한 지지도)에 따른 vote(투표경향)를 파악할 수 있다.

20190128\_133740.png 투표경향은 A(기권), U(보류), N(반대), Y(찬성) 네 가지 계급을 가지는데, 로지스틱 회귀분석을 사용하기 위해 Y 외엔 모두 N으로 바꾸었다. 이 포스트에서는 Y를 ‘찬성’, N을 ‘반대’라고 하겠다.

20190128\_152957.png 모델의 퍼포먼스를 확인하기 위해 트레이닝 데이터와 테스트 데이터를 나누었다.

20190128\_153114.png 트레이닝 데이터를 통해 얻은 로지스틱 회귀모형은 위와 같다. 이제 이 모델에 테스트 데이터를 넣어서 유권자들이 찬성할 확률을 계산해보자. predict() 함수에 newdata=test 옵션을 주면 모델에 테스트 데이터를 넣어서 알아서 계산해준다. 이때 type=“response"를 넣어야 우리가 원하는 ‘확률’의 꼴로 반환하는 것에 주의하자.

out0<-glm(vote~.,family=binomial(),data=train); summary(out0)
p <- predict(out0, newdata=test, type="response"); p

출력 결과는 다음과 같다.

20190128\_152826.png 문제는 이 확률을 어떻게 해석하고 사용할 것인가다. 사실 우리가 정말로 계산하고 싶었던건 확률이 아니라, 그래서 어떤 사람이 ‘찬성’을 했는지 안 했는지를 맞추는 것이다. 해서 일정 확률보다 높은 경우를 ‘찬성’했다고 예측하고, 낮은 경우를 ‘반대’했다고 예측하고 싶다. 그 ‘일정 확률’을 컷오프Cutoff 혹은 역치Threshold라 하고, 보통은 컷오프라는 표현을 잘 쓴다.

최적 컷오프

이 컷오프를 어떻게 하느냐에 따라서 정분류율은 달라질 것이다. 극단적으로 0.99 이하를 전부 ‘반대’라고 예측해도 그냥 ‘반대’를 한 사람들만큼은 맞췄기 때문에 정분류율은 어느정도 나온다. 0.01 이상을 전부 ‘찬성’이라고 예측해도 마찬가지로 맞을 사람은 맞는다. 예를 들어 1년 365일 중에 120일 동안 비가 오는 나라가 있다면 1년 내내 다음날의 날씨를 ‘맑음’이라고 예측해도 정답률이 얼추 $67\%$ 는 나오게 되어있다.

우리는 이 보다는 좋은 분석과 예측이 필요하기 때문에, 좋은 컷오프를 구하고 싶다. 그냥 간단하게 생각하기엔 0.5를 기준으로 높으면 ‘찬성’ 낮으면 ‘반대’로 예측하면 될 것 같다. 하지만 계산해보면 그렇지 않은 경우가 훨씬 많다. (또 항상 정분류율만이 기준이 되는 것은 아니다. 사안에 따라 더 중요한 척도가 있을 수 있다.)해서 이 좋은 컷오프를 찾기 위해 하는 일이 바로 위에서 구한 p의 모든 확률을 컷오프로써 써보는 것이다. 0.89572040으로 오차행렬을 만들어서 False Positive Rate와 True Positive Rate를 계산해보고, 0.81810785로 또 계산해보고, 0.70215561로 또 계산해보고, … 이것을 반복해서 가로축을 False Positive Rate, 세로축을 True Positive Rate로 나타낸 그래프가 바로 ROC 커브 다.

말은 어렵지만 코드상으로는 간단하니 걱정하지 말자.오차행렬을 만들고 필요한 수치들을 계산하기 위해서는 다음과 같은 코드를 실행시켜야한다. 확률과는 달리 실제로 출력 결과를 볼 필요는 없으므로 각 함수가 어떤 역할을 하는지만 대략적으로 설명하겠다. prediction() 함수는 위에서 계산한 확률 p와 실제 테스트 데이터의 test$vote를 비교해서 분류율을 계산해준다. performance() 함수는 위에서 계산한 오차행렬의 수치 pr에서 필요한 데이터를 뽑아 plot() 함수에 넣으면 ROC 곡선을 그릴 수 있도록 하는 데이터를 반환해준다.

pr <- prediction(p, test$vote)
prf <- performance(pr, measure = "tpr", x.measure = "fpr")
win.graph(); plot(prf, main='ROC of Test Data')

위의 코드를 실행하면 다음과 같이 ROC 커브를 그려준다.

ROC.png

위 곡선은 모든 컷오프에 대해서 FPR과 TPR을 계산하고, 그것을 각각 $x$ 축의 좌표, $y$ 축의 좌표로 갖는 곡선이다. 곡선은 가능한 한 그 아래의 면적이 넓은 것이 좋다. 궤적으로 보자면 곡선과 왼쪽 위의 점 $(0,1)$ 이 가깝게 붙는 식으로 나오는 게 좋다.막상 그 컷오프는 그림에서 표현되지 않는데, 자료구조를 뜯어보면 $alpha.values 를 통해 참조할 수 있음을 알 수 있다.

20190129\_101311.png str() 함수로 뜯어보면 컷오프가 0.939 일 때 TPR이 0, FPR이 0.00556 임을 알 수 있다. FPR이 0.00556 이라는 것은 ‘반대’를 잘못 예측한 비율이 $0.5%$ 밖에 안 된다는 뜻이다. 여기까진 좋아보이지만, TPR이 0이므로 ‘찬성’을 제대로 예측한 케이스가 단 한 건도 없다는 말이 된다. 직관적으로 생각해보면 ‘찬성’할 확률이 0.939 이하인 사람을 모두 ‘반대’로 예측했기 때문에 ‘찬성’을 ‘찬성’으로 예측하는 허들이 너무 높았던 것이다. 이러니 ‘반대’는 다 맞춰도 ‘찬성’은 맞출 수가 없는 것이다.

그림이 각져서 나와요

자기가 그린 ROC 곡선은 너무 네모나서 이상하다는 사람이 있다. 그건 단순히 테스트 데이터가 적기 때문에 일어나는 일이다. 데이터가 적은 것 자체는 걱정할 수 있지만 각진 모양으로 나오는건 전혀 걱정하지 않아도 좋다. 예를 들어 이 예제에서도 테스트 데이터의 크기를 20개로 줄이면 다음과 같은 모양이 나온다.

smallroc.png

코드

아래는 예제 코드 전체다.

install.packages("car")
install.packages("ROCR")
 
library(car)
library(ROCR)
 
set.seed(150421)
 
?Chile
str(Chile)
nrow(Chile)
head(Chile); tail(Chile)
 
DATA<-na.omit(Chile)
DATA$vote[DATA
          $vote!='Y']<-'N'
DATA$vote<-factor(DATA$vote)
head(DATA); tail(DATA)
 
DATANUM<-nrow(DATA)
train<-sample(1:DATANUM)<(DATANUM*0.8)
test<-DATA[!train,]; head(test)
train<-DATA[train,]; head(train)
 
out0<-glm(vote~.,family=binomial(),data=train); summary(out0)
p <- predict(out0, newdata=test, type="response"); p
 
pr <- prediction(p, test$vote)
prf <- performance(pr, measure = "tpr", x.measure = "fpr")
win.graph(); plot(prf, main='ROC of Test Data')
str(prf)
 
smalltest<-test[sample(nrow(test),20),]
p <- predict(out0, newdata=smalltest, type="response"); p
pr <- prediction(p, smalltest$vote)
prf <- performance(pr, measure = "tpr", x.measure = "fpr")
win.graph(); plot(prf, main='ROC of Small Test Data')
댓글