Jekyll2026-06-24T09:50:35+00:00https://www.hds.ai.kr/feed.xmlHello Data SciencePython·R 데이터 분석, 머신러닝, 딥러닝 강의 노트나성호 (Seongho Na)텍스트 마이닝을 활용한 기업리뷰 분석2018-10-31T00:00:00+00:002026-06-24T00:00:00+00:00https://www.hds.ai.kr/posts/jobplanet-review-3

이 글은 2018년 강의 노트를 옮긴 것입니다. 방법론과 결과 그래프 중심으로 정리했으며, R 코드는 접어 두었습니다(펼쳐서 볼 수 있습니다). 잡플래닛 사이트 구조가 바뀌어 수집 코드는 현재 그대로는 동작하지 않을 수 있습니다.

기업리뷰 분석 마지막 포스팅입니다. 이번 포스팅에서는 기업리뷰 중 장점, 단점 및 경영진에 바라는 점 등 텍스트 데이터를 이용하여 기업리뷰에 담긴 공통된 생각을 추출하는 작업을 해보겠습니다. 텍스트 마이닝에 대해서 익숙하지 않은 분들이 많을 것 같습니다. 간단하게 전체 과정을 소개하면 다음과 같습니다.

텍스트 마이닝 과정

  1. 가장 처음 해야 할 일은 자연어를 분석할 수 있는 데이터 형태로 변환하는 것입니다. 따라서 형태소 분석을 실시합니다. 형태소 분석을 할 때 사전이 필요한 데, 텍스트 데이터는 도메인에 영향을 많이 받으므로 형태소 분석을 할 때마다 사전을 만들어야 하는 경우가 일반적입니다. 사전을 만들 때는 N-gram을 사용하는 방법이 있지만 최근에는 딥러닝 기법을 활용한다고도 합니다. (저는 딥알못이라 지금은 모르지만 곧 공부하고 싶습니다.)

  2. 형태소 분석이 끝나면 말뭉치를 전처리하여 문서단어행렬(Document-Term Matrix, 이하 DTM) 또는 이를 전치한 단어문서행렬(Term-Document Matrix, 이하 TDM)를 생성합니다. DTM의 원소는 단어 빈도수(Term Frequency, 이하 TF) 또는 단어 빈도수와 역문서 빈도수(Term Frequency - Inverse Document Frequency, 이하 TF-IDF)가 사용됩니다. TF는 단어의 빈도수가 많을수록 중요하다고 간주하지만, TF-IDF는 여러 문서에서 두루 출현하는 단어에 벌점을 부여함으로써 특정 문서에 집중해서 많이 출현하는 단어를 중요하다고 간주합니다.

  3. DTM이 생성되면 컬럼의 합계(단어별 빈도수) 데이터로 다양한 시각화를 실행할 수 있습니다. 단어별 빈도수를 내림차순으로 정렬한 다음 상위 단어들로 막대그래프를 그리거나 아니면 워드클라우드 또는 트리맵 등을 그릴 수 있습니다.

  4. 특정 단어에 대해 함께 출현하는 연관성이 높은 단어들을 추출해보는 작업을 수행하면 문서에 대한 이해를 높일 수 있습니다. 주로 3가지 방법을 사용하는데 하나는 DTM의 상관행렬을 구하는 것이고, 다른 하나는 R의 tm 패키지에서 제공되는 함수를 사용하는 것이며, 마지막으로 word2vec 알고리즘을 사용하는 것입니다. 이번 포스팅에서는 처음 2가지를 소개합니다.

  5. 마지막으로 상관관계가 높은 단어들을 연결한 네트워크 맵을 그려봄으로써 전체 문서에서 공통적으로 언급된 단어들의 흐름을 파악할 수 있습니다. 중개중심성이 높은 단어들을 중심으로 흐름을 파악하면 됩니다. 생각보다 쉽지 않습니다.

이 외에도 토픽 클러스터링과 감성분석 등이 있지만 이번 포스팅에서는 다루지 않겠습니다. 사실 둘 다 해봤는데요. 데이터가 좀 이상해서 그런지 결과가 별로더라구요. 다음에 기회가 닿으면 소개하도록 하겠습니다.

형태소 분석

기업리뷰 데이터 컬럼 중 텍스트 데이터만 추출하고, 자연어를 분석할 수 있는 데이터로 변환하기 위해 형태소 분석을 실시합니다. 먼저 RDS 데이터를 불러와서 간단한 전처리를 실행합니다.

R 코드 보기 
# 필요한 패키지를 불러옵니다.
library(tidyverse)
library(stringr)
library(stringi)
library(magrittr)
R 코드 보기 
# 분석 대상 회사이름을 지정합니다. 
compNm <- '삼성화재'

# RDS 파일을 읽어옵니다. 
dt <- readRDS(file = '../data/Company_Review_Data_삼성화재해상보험.RDS')

# 별점을 1~5점으로 환산합니다.
dt[, 8:13] <- sapply(X = dt[, 8:13], FUN = function(x) x / 20)

# 추천여부 컬럼을 '추천'과 '비추'로 변환합니다.
dt$추천여부 <- str_extract(string = dt$추천여부, pattern = '추천(?= )')
dt$추천여부[is.na(x = dt$추천여부) == TRUE] <- '비추'

# 필요한 컬럼만 선택합니다. 
cols <- c('기업장점', '기업단점', '바라는점', '재직상태', '별점평가', '추천여부')
texts <- dt[, cols]

# NA가 포함된 행을 제거합니다.
texts <- texts[complete.cases(texts), ]
nrow(x = texts)

## [1] 279
R 코드 보기 
# 중복 행을 제거합니다. 
texts <- unique(x = texts)
nrow(x = texts)

## [1] 279

데이터 원본과 나중에 생성할 DTM을 서로 결합할 때 기준변수로 사용할 id 컬럼을 생성합니다.

R 코드 보기 
# 객체에 id를 추가하는 함수를 생성합니다.
generateIDs <- function(obj, index = 'id') {
  
  # 객체의 종류에 따라 길이를 계산합니다. 
  if (obj %>% class() == 'data.frame') {
    n <- nrow(x = obj)
  } else {
    n <- length(x = obj)
  }
  
  # id를 생성합니다. 
  id <- str_c(
    index, 
    str_pad(
      string = 1:n, 
      width = ceiling(x = log10(x = n)), 
      side = 'left', 
      pad = '0') )
  
  # 결과를 반환합니다. 
  return(id)
}

# texts 객체에 id 컬럼을 추가합니다. 
texts$id <- generateIDs(obj = texts, index = 'doc')

텍스트 데이터 컬럼인 장점, 단점 및 바라는점을 붙여서 하나의 컬럼으로 만듭니다. 그리고 공백을 모두 없앱니다. 그 이유는 다음과 같습니다. 기업리뷰 데이터는 한 명이 작성한 것이 아니므로 회원마다 말버릇이 다릅니다. 같은 단어의 경우 띄어쓰기도 제각각일 수 있습니다. 실제로 이 데이터에서는 ‘자기계발’과 ‘자기계발기회’가 혼재되어 있었습니다. 나중에 사전을 만들어서 형태소 분석할 때 사용한다고 하더라도 100% 같은 방식으로 처리되지 못하므로 아예 처음부터 공백을 없애는 것입니다. 다행인 점은 우리가 앞으로 사용할 형태소 분석기가 띄어쓰기를 처리할 수 있다는 것입니다.

R 코드 보기 
# '장점', '단점' 및 '바라는점' 등 텍스트 데이터를 붙여서 
# 텍스트 마이닝을 위한 content 컬럼을 만듭니다.  
texts$content <- apply(
  X = texts[, c('기업장점', '기업단점', '바라는점')], 
  MARGIN = 1, 
  FUN = str_c, collapse = ' ')

# 텍스트의 공백을 모두 제거합니다. 형태소 분석기가 띄어쓰기를 구분합니다. 
texts$content <- texts$content %>% str_remove_all(pattern = '\\s+')

# 필요한 컬럼만 남깁니다. 
texts <- texts[ , c('id', 'content', '재직상태', '추천여부')]

# 중복을 제거합니다. 
texts <- unique(x = texts)

# 건수를 확인합니다. 
nrow(x = texts)

## [1] 279

회원마다 리뷰를 길게 남기는 사람이 있는가하면 아주 간단하게 쓰는 사람도 있습니다. 텍스트 마이닝에서는 단어 하나 하나가 모두 정보가 되므로 글이 길수록 정보가 많다고 할 수 있습니다. 따라서 글자의 길이가 작은 문서는 과감하게 제외하는 것이 좋습니다. 이번 예제에서는 글자수가 40 미만인 9개의 문서를 제외하였습니다.

R 코드 보기 
# content 컬럼의 글자수를 확인합니다. 
textRange <- texts$content %>% nchar() %>% range()
print(x = textRange)

## [1]   9 554
R 코드 보기 
# 글자수 구간을 15개로 나눌 때 간격(by)을 계산합니다. 
by <- ((textRange[2] - textRange[1]) / 15) %>% round(digits = -1L)
print(x = by)

## [1] 40
R 코드 보기 
# 도수분포표를 생성합니다. 이때, 최소값과 최대값을 포함하도록 합니다.
# Hmisc::cut2() 함수의 minmax 인자로 최소값 또는 최대값을 포함할지 여부를 지정합니다.
cuts <- Hmisc::cut2(
  x = texts$content %>% nchar(),
  cuts = seq(from = 0, to = textRange[2], by = by),
  minmax = TRUE)

# 빈도수를 구합니다.
freq <- table(cuts)
print(freq)

## cuts
## [  0, 40) [ 40, 80) [ 80,120) [120,160) [160,200) [200,240) [240,280) 
##         9        43       101        57        39        16         3 
## [280,320) [320,360) [360,400) [400,440)       440       480 [520,554] 
##         6         2         1         1         0         0         1
R 코드 보기 
# 첫 번째 구간에 포함된 40 글자 미만인 글을 확인합니다. 
texts$content[nchar(x = texts$content) < by]

## [1] "높은보수낮은기본급직원기본급보장"                                              
## [2] "높은인지도와체계적인시스템성과급의부재질좋은프로모션많이해주셨으면"            
## [3] "업무의자율성낮은보수임금인상"                                                  
## [4] "교육이좋음업무강도강함"                                                        
## [5] "자율성영업복리후생"                                                            
## [6] "업무의자율성이용이함성과에따른보수차보너스많이줬으면..."                       
## [7] "좋은시설퇴직금안주려초단시간근로를시킨다초단시간알바에게도복지혜택은주기바란다"
## [8] "신뢰와효율,가치를실현하는것과중된업무로인한피로좀더가족적인이미지가필요하다"   
## [9] "복지혜택좋다급여대비업무과다인력관리에힘좀쓰세요"
R 코드 보기 
# 첫 번째 구간에 해당하는 건을 삭제합니다.
texts <- texts[nchar(x = texts$content) >= by, ]

# 건수를 확인합니다.
nrow(x = texts)

## [1] 270

지금까지 형태소 분석을 하기 위한 전처리 과정을 거쳤고 이제부터 형태소 분석에 들어갑니다. 저는 형태소 분석기로 NLP4kec 패키지의 함수를 사용합니다. CRAN에 등록되어 있지 않으므로 Github 링크로 설치하면 됩니다. 문제는 이 패키지가 rJava 패키지에 의존한다는 것입니다. 그러므로 Java를 설치해야 하고 Java Home을 설정한 다음 rJava 패키지를 불러올 수 있어야 합니다.

R 코드 보기 
# 패키지를 설치합니다.
# install.packages('~/Documents/TextMining/NLP4kec_1.2.0.tgz', repos = NULL)

# 필요한 패키지를 불러옵니다.
library(NLP4kec)

지금 다루고 있는 데이터에 사용할 수 있는 사전이 없으므로 일단 사전 없이 형태소 분석을 수행합니다. 아래 과정을 거치면서 사전을 만들 예정이고, 사전이 완성되면 이번 과정을 한 번 더 반복합니다. 물론 그 때는 사전을 가지고 형태소 분석을 한다는 점에서 차이가 있습니다.

R 코드 보기 
# 형태소를 분석하여 parsed 객체에 할당합니다. 이 때 띄어쓰기가 구분됩니다. 
parsed <- r_parser_r(contentVector = texts$content, language = 'ko')

# 길이를 확인합니다. 
length(x = parsed)

## [1] 270
R 코드 보기 
# 형태소 분석 결과 중 일부를 육안으로 확인합니다. 
parsed[1:10]

##  [1] "그룹 인센티브 포함 많다 급여 네임 밸류 단기 목표 지향 문화 선진 외국 기업 겉 따르다 하다 문화 임원 계약 기간 때문 장기 목표 가져가다 수 없다 현실 이해 이 보완 수 있다 체계 마련 발전 "                                                                     
##  [2] "연봉 주다 연봉 순위 자기 생활 주 오오 않다 사람 최고 회사 영업 쪽 자기 인생 1도 없다 야근 없다 날 드물다 실적 스트레스 상당 한편 지점 실적 줄이다 업무 강도 낮추다 주다 하다 "                                                                              
##  [3] "무엇 연봉 복지 등 장점 이외 것 모르다 승진 나 힘들다 잦다 야근 조직 문화 딱딱하다 조직 문화 유연하다 만들다 좋다 생각 "                                                                                                                                     
##  [4] "본사 위치 좋다 교통 편하다 직원 충성 높다 일 사람 일 맛 나다 구내식당 줄 길다 밥 먹다 때기 다리다 먹다 하다 단점 있다 업무 분담 확실하다 일 더디다 진행 부분 있다 직원 대화 나누다 시간 직원 가족 만남 가지다 기업 개개인 전체 직원 되다 마음 되다 수 있다 "
##  [5] "보험 기업 선두 주자 복지 급여 만족 보수 분위기 비율 하락 시장 경쟁력 확보 필요 시급하다 1위 기업 유지 위하다 많다 노력 시장 조사 필요 "                                                                                                                     
##  [6] "시간 자유 서원 만큼 일 하다 수 있다 양복 입다 근무 것 장점 수 있다 실적 제다 보다 월급 일정 않다 영업 인하다 실적 압박 시달리다 수당 수수료 챙기다 주다 설계사 힘들다 "                                                                                     
##  [7] "기업 자부심 느끼다 수 있다 졸다 취업 결정 학교 생활 마치다 뒤 취업 나가다 좋다 높다 연봉 높다 업무 강도 퇴사 사람 많다 업무 강도 낮추다 주다 좋다 일한 받다 것 생각 "                                                                                       
##  [8] "연봉 연봉 연봉 보람 없다 보수 못하다 일 하다 않다 만년 병장 느낌 수석 많다 좋다 것 좋다 것 가족 분위기 맡다 능력 근거 평가 필요 "                                                                                                                           
##  [9] "급여 같다 연차 회사 직원 비하다 높다 복지 있다 업무 스트레스 직무 순환 되다 않다 어디 갈다 존재 어르신 현장 목소리 듣다 수 있다 기회 만들다 주다 "                                                                                                          
## [10] "높다 연봉 성과급 근무 환경 따르다 연차 쓰다 수 있다 인력 부족 경우 가능 수 있다 삼성 자부심 퇴근 시간 일정 않다 하다 눈치 봄 군대식 문화 나 레비 실적 줄 세우다 직군 은근하다 차별 존재 출퇴근 시간 지키다 직원 스트레스 관리 앞장서다 "
R 코드 보기 
# NA가 포함되어 있는지 확인합니다. 
parsed[is.na(x = parsed) == TRUE]

## character(0)
R 코드 보기 
# 글자수를 확인합니다. 
parsed %>% nchar() %>% table()

## .
##  46  49  51  52  53  55  56  57  61  62  66  68  69  70  72  73  74  75 
##   1   1   1   2   1   1   1   1   1   1   1   1   2   3   1   3   7   1 
##  76  77  78  79  80  81  82  83  84  85  86  87  88  89  91  93  94  95 
##   4   3   2   3   3   4   2   1   3   1   5   3   2   1   2   3   4   3 
##  96  97  98  99 100 101 102 104 105 107 108 109 110 111 112 113 114 115 
##   3   2   5   7   3   2   2   3   3   4   3   3   2   2   1   1   4   2 
## 116 118 119 121 122 124 125 127 128 129 130 131 132 133 134 136 137 138 
##   3   4   3   2   3   1   5   1   3   3   1   2   3   2   1   1   3   1 
## 139 140 141 142 143 144 145 146 147 148 150 151 152 153 155 156 157 158 
##   2   3   2   1   5   1   1   1   1   1   3   1   1   1   4   2   1   1 
## 160 162 163 164 165 166 167 168 169 171 172 173 174 175 178 180 181 184 
##   1   1   1   1   1   1   1   1   1   1   2   1   1   1   1   3   2   1 
## 185 189 190 191 192 193 194 196 197 199 202 205 209 210 214 216 217 219 
##   1   2   1   1   1   1   1   3   1   1   1   1   2   1   1   2   1   2 
## 223 226 229 245 250 254 263 264 271 272 304 315 327 341 343 345 366 554 
##   1   1   1   2   1   1   1   1   1   1   1   1   1   1   1   1   1   1
R 코드 보기 
# 중복 건수를 확인합니다. 
duplicated(x = parsed) %>% sum()

## [1] 0

형태소 분석을 마치면 말뭉치(corpus)를 생성합니다. 말뭉치를 생성하기 전에 텍스트를 벡터 소스로 변경합니다. 벡터 소스는 벡터의 개별 원소를 각각의 문서로 인식합니다. tm 패키지를 불러온 다음 아래 라인을 실행하시면 됩니다.

R 코드 보기 
# 필요한 패키지를 불러옵니다.
library(tm)
R 코드 보기 
# 말뭉치를 생성합니다. 
corpus <- parsed %>% VectorSource() %>% VCorpus()
print(corpus)

## <<VCorpus>>
## Metadata:  corpus specific: 0, document level (indexed): 0
## Content:  documents: 270

결과 객체인 corpus는 content와 meta를 원소로 갖는 리스트입니다. content에는 한글 텍스트가, meta에는 데이터 속성이 할당되어 있습니다.

R 코드 보기 
# 첫 번째 결과를 출력하여 확인합니다. 
str(object = corpus[[1]])

## List of 2
##  $ content: chr "그룹 인센티브 포함 많다 급여 네임 밸류 단기 목표 지향 문화 선진 외국 기업 겉 따르다 하다 문화 임원 계약 기간 때"| __truncated__
##  $ meta   :List of 7
##   ..$ author       : chr(0) 
##   ..$ datetimestamp: POSIXlt[1:1], format: "2018-10-31 02:18:46"
##   ..$ description  : chr(0) 
##   ..$ heading      : chr(0) 
##   ..$ id           : chr "1"
##   ..$ language     : chr "en"
##   ..$ origin       : chr(0) 
##   ..- attr(*, "class")= chr "TextDocumentMeta"
##  - attr(*, "class")= chr [1:2] "PlainTextDocument" "TextDocument"

이제 사전을 만들기 위해 N-gram을 사용합니다. 사전을 만드는 과정은 다음과 같습니다. 말뭉치에서 인접한 2 단어씩 묶은 bigram을 생성하고 빈도수 기준으로 내림차순 정렬합니다. 명사 위주로 띄어쓰기를 없앨 필요가 있는지 확인합니다. 만약 ‘업무 량’ 같이 하나의 단어로 처리해야 한다고 판단되면 이와 같은 bigram만 따로 모아 spacing.txt에 저장합니다. 나중에 공백을 없앤 단어들만 dictionary.txt에 추가하면 됩니다.

R 코드 보기 
# 필요한 패키지를 불러옵니다. 
library(RWeka)
R 코드 보기 
# 인접한 2개의 단어를 결합한 bigram을 생성합니다. 
# min과 max에 할당할 숫자를 바꾸면 원하는 N-gram을 만들 수 있습니다. 
bigram <- function(x) {
  NGramTokenizer(x = x, control = Weka_control(min = 2, max = 2))
}

# 단어문서행렬(Term-Document matrix)을 생성합니다. 
bigramList <- corpus %>% 
  TermDocumentMatrix(control = list(tokenize = bigram)) %>% 
  apply(MARGIN = 1, FUN = sum) %>% 
  sort(decreasing = TRUE)

# bigram의 길이를 확인합니다. 
length(bigramList)

## [1] 8396
R 코드 보기 
# 문서 개수의 1% 이상 발생하는 bigram만 남깁니다. 
# 빈도수가 작은 것은 굳이 관심을 가지지 않아도 됩니다. 
bigramList <- bigramList[bigramList >= (nrow(x = texts) * 0.01)]
length(x = bigramList)

## [1] 451
R 코드 보기 
# bigram의 컬럼명(글자)만 따로 추출하여 bigramNames에 할당합니다. 
bigramNames <- names(bigramList)

# bigramNames을 육안으로 확인하기 위해 최대 100개까지 출력합니다. 
top <- if (length(x = bigramNames) >= 100) bigramNames[1:100] else bigramNames
print(top)

##   [1] "수 있다"       "업무 강도"     "높다 연봉"     "것 같다"      
##   [5] "기업 문화"     "수 없다"       "업계 1위"      "업무 량"      
##   [9] "연봉 높다"     "주다 좋다"     "하다 하다"     "되다 있다"    
##  [13] "복리 후생"     "있다 업무"     "주다 하다"     "받다 수"      
##  [17] "하다 주다"     "강도 높다"     "조직 문화"     "하다 수"      
##  [21] "높다 급여"     "일 하다"       "좋다 회사"     "근무 환경"    
##  [25] "급여 수준"     "높다 편"       "복지 좋다"     "있다 것"      
##  [29] "하다 것"       "교육 기회"     "실적 압박"     "일 많다"      
##  [33] "있다 하다"     "지다 있다"     "되다 않다"     "문화 개선"    
##  [37] "보수 기업"     "삶 균형"       "경우 많다"     "높다 업무"    
##  [41] "돈 주다"       "량 많다"       "보험 회사"     "있다 연봉"    
##  [45] "근무 시간"     "동종 업계"     "되다 수"       "보험 사"      
##  [49] "복지 혜택"     "쓰다 수"       "일 삶"         "있다 좋다"    
##  [53] "자기 계발"     "최고 수준"     "1위 기업"      "1위 자부심"   
##  [57] "국내 최고"     "급여 높다"     "느끼다 수"     "도움 되다"    
##  [61] "쉽다 않다"     "야근 많다"     "야근 잦다"     "연봉 복지"    
##  [65] "인간 관계"     "잦다 야근"     "좋다 지다"     "퇴근 시간"    
##  [69] "필요 있다"     "것 생각"       "근로 문화"     "눈치 보다"    
##  [73] "라이프 밸런스" "보험업 특성"   "삼성 계열사"   "삼성 화재"    
##  [77] "성과 주의"     "손해 보험"     "시스템 되다"   "신경 쓰다"    
##  [81] "업계 최고"     "업무 시간"     "없다 업무"     "워크 라이프"  
##  [85] "의사 결정"     "있다 않다"     "있다 회사"     "자부심 있다"  
##  [89] "출근 시간"     "하다 않다"     "것 없다"       "것 좋다"      
##  [93] "국내 시장"     "네임 밸류"     "높다 수준"     "눈치 보이다"  
##  [97] "늦다 퇴근"     "되다 것"       "많다 업무"     "복지 되다"

top 객체를 spacing.txt를 생성합니다. 이 파일을 열고 띄어쓰기를 수정해야 하는 것들만 남기고 저장합니다.

R 코드 보기 
# spacing.txt를 생성합니다. 
write.table(
  x = top, 
  quote = FALSE, 
  file = '../data/spacing.txt', 
  row.names = FALSE, 
  col.names = FALSE)

spacing.txt 파일을 읽은 다음 spacing 객체에 할당합니다. 이 객체에는 문자 벡터가 하나 저장되어 있을텐데요. 이 컬럼명을 before로 지정합니다. 그리고 before에서 띄어쓰기를 없앤 문자 벡터를 after 컬럼으로 추가한 다음 이 컬럼으로 dictionary.txt 파일을 생성합니다.

R 코드 보기 
# 
spacing <- read.table(file = '../data/spacing.txt', sep = '\t')
colnames(x = spacing) <- 'before'

# 중복을 제거합니다. 
spacing <- unique(x = spacing)

# 띄어쓰기 없앤 문자벡터를 after 컬럼으로 추가합니다. 
spacing$after <- spacing$before %>% str_remove_all(pattern = ' ')
R 코드 보기 
# 이제 dictionary.txt로 저장합니다. 
write.table(
  x = spacing$after,
  quote = FALSE,
  file = '../data/dictionary.txt',
  row.names = FALSE,
  col.names = FALSE)

사전 만들기를 완성했다면 형태소 분석을 재실행합니다. 이번에는 사전을 추가합니다.

R 코드 보기 
# 사전을 추가한 다음 형태소 분석을 다시 실행합니다.
parsed <- r_parser_r(
  contentVector = texts$content, 
  language = 'ko',
  korDicPath = '../data/dictionary.txt')

# 길이를 확인합니다. 
length(x = parsed)

## [1] 270
R 코드 보기 
# 형태소 분석 결과 중 일부를 육안으로 확인합니다. 
parsed[1:10]

##  [1] "그룹 인센티브 포함 많다 급여 네임밸류 단기 목표 지향 문화 선진 외국 기업 겉 따르다 하다 문화 임원 계약 기간 때문 장기 목표 가져가다 수 없다 현실 이해 이 보완 수 있다 체계 마련 발전 "                                                                      
##  [2] "연봉 주다 연봉 순위 자기 생활 주 오오 않다 사람 최고 회사 영업 쪽 자기 인생 1도 없다 야근 없다 날 드물다 실적 스트레스 상당 한편 지점 실적 줄이다 업무강도 낮추다 주다 하다 "                                                                               
##  [3] "무엇 연봉 복지 등 장점 이외 것 모르다 승진 나 힘들다 잦다 야근 조직문화 딱딱하다 조직문화 유연하다 만들다 좋다 생각 "                                                                                                                                       
##  [4] "본사 위치 좋다 교통 편하다 직원 충성 높다 일 사람 일 맛 나다 구내식당 줄 길다 밥 먹다 때기 다리다 먹다 하다 단점 있다 업무 분담 확실하다 일 더디다 진행 부분 있다 직원 대화 나누다 시간 직원 가족 만남 가지다 기업 개개인 전체 직원 되다 마음 되다 수 있다 "
##  [5] "보험 기업 선두 주자 복지 급여 만족 보수 분위기 비율 하락 시장 경쟁력 확보 필요 시급하다 1위 기업 유지 위하다 많다 노력 시장 조사 필요 "                                                                                                                     
##  [6] "시간 자유 서원 만큼 일 하다 수 있다 양복 입다 근무 것 장점 수 있다 실적 제다 보다 월급 일정 않다 영업 인하다 실적압박 시달리다 수당 수수료 챙기다 주다 설계사 힘들다 "                                                                                      
##  [7] "기업 자부심 느끼다 수 있다 졸다 취업 결정 학교 생활 마치다 뒤 취업 나가다 좋다 높다 연봉 높다 업무강도 퇴사 사람 많다 업무강도 낮추다 주다 좋다 일한 받다 것 생각 "                                                                                         
##  [8] "연봉 연봉 연봉 보람 없다 보수 못하다 일 하다 않다 만년 병장 느낌 수석 많다 좋다 것 좋다 것 가족 분위기 맡다 능력 근거 평가 필요 "                                                                                                                           
##  [9] "급여 같다 연차 회사 직원 비하다 높다 복지 있다 업무 스트레스 직무순환 되다 않다 어디 갈다 존재 어르신 현장 목소리 듣다 수 있다 기회 만들다 주다 "                                                                                                           
## [10] "높다 연봉 성과급 근무환경 따르다 연차 쓰다 수 있다 인력 부족 경우 가능 수 있다 삼성 자부심 퇴근시간 일정 않다 하다 눈치 봄 군대식문화 나 레비 실적 줄 세우다 직군 은근하다 차별 존재 출퇴근시간 지키다 직원 스트레스 관리 앞장서다 "
R 코드 보기 
# 말뭉치를 생성하기 전에 텍스트를 벡터 소스로 변경합니다. 
# 벡터 소스는 벡터의 개별 원소를 각각의 문서로 인식합니다. 
corpus <- parsed %>% VectorSource() %>% VCorpus()

사전을 추가하여 형태소 분석을 실시해도 여전히 띄어쓰기가 남아있는 경우가 있습니다. 이런 문제는 하나씩 확인해봐야 합니다. 데이터 분석 중 텍스트 마이닝이 특히 어려운 점이 확인해야 할 텍스트 데이터가 무진장 많다는 것입니다. 이번 예제의 경우 아주 작은 데이터를 다루고 있으니 운이 좋다고 할 수 있습니다. (물론 그래서 분석 결과가 그렇게 좋지는 않습니다.)

R 코드 보기 
# 사전으로도 처리되지 않는 단어 띄어쓰기 강제로 변환하는 함수를 생성합니다.
changeTerms <- function(corpus, before, after) {
  
  # corpus의 길이를 확인합니다.
  n <- length(x = corpus)
  
  # 반복문을 실행합니다.
  for (i in 1:n) {
    corpus[[i]]$content <- corpus[[i]]$content %>%
      str_replace_all(pattern = before, replacement = after)
  }
  
  # 결과를 반환합니다. 
  return(corpus)
}

# 띄어쓰기가 적용되지 않은 단어들을 강제로 적용합니다. 
for (i in 1:nrow(x = spacing)) {
  corpus <- changeTerms(
    corpus = corpus,
    before = spacing$before[i],
    after = spacing$after[i])
}

# 의심되는 단어가 여전히 바뀌지 않은 채로 포함되어 있는지 확인합니다. 
checkTerms <- function(corpus, term) {
  corpus %>% 
    sapply(FUN = `[[`, 'content') %>% 
    str_detect(pattern = term) %>% 
    sum() %>% 
    print()
}

# 의심되는 단어별로 corpus에 포함된 개수를 확인합니다. 
checkTerms(corpus = corpus, term = '워라벨')

## [1] 4
R 코드 보기 
checkTerms(corpus = corpus, term = '일삶균형')

## [1] 8
R 코드 보기 
checkTerms(corpus = corpus, term = '워크라이프밸런스')

## [1] 5
R 코드 보기 
checkTerms(corpus = corpus, term = '자기계발기회')

## [1] 3
R 코드 보기 
checkTerms(corpus = corpus, term = '자기개발')

## [1] 4
R 코드 보기 
checkTerms(corpus = corpus, term = '네임벨류')

## [1] 5
R 코드 보기 
checkTerms(corpus = corpus, term = '군대 문화')

## [1] 0
R 코드 보기 
checkTerms(corpus = corpus, term = '군대식문화')

## [1] 5
R 코드 보기 
checkTerms(corpus = corpus, term = '수직문화')

## [1] 4
R 코드 보기 
checkTerms(corpus = corpus, term = '가정 날')

## [1] 5
R 코드 보기 
checkTerms(corpus = corpus, term = '손보')

## [1] 10
R 코드 보기 
checkTerms(corpus = corpus, term = '조직문화')

## [1] 13
R 코드 보기 
checkTerms(corpus = corpus, term = '회사문화')

## [1] 2
R 코드 보기 
checkTerms(corpus = corpus, term = '근로문화')

## [1] 5

철자가 틀린 단어나 비슷한 뜻을 하나로 통일시키는 작업을 여기에서 실시하면 됩니다.

R 코드 보기 
# 추가로 변경합니다. 
corpus <- changeTerms(corpus = corpus, before = '워라벨', after = '워라밸')
corpus <- changeTerms(corpus = corpus, before = '일삶균형', after = '워라밸')
corpus <- changeTerms(corpus = corpus, before = '워크라이프밸런스', after = '워라밸')
corpus <- changeTerms(corpus = corpus, before = '자기계발기회', after = '자기계발 기회')
corpus <- changeTerms(corpus = corpus, before = '자기개발', after = '자기계발')
corpus <- changeTerms(corpus = corpus, before = '네임벨류', after = '네임밸류')
corpus <- changeTerms(corpus = corpus, before = '군대 문화', after = '군대문화')
corpus <- changeTerms(corpus = corpus, before = '군대식문화', after = '군대문화')
corpus <- changeTerms(corpus = corpus, before = '수직문화', after = '군대문화')
corpus <- changeTerms(corpus = corpus, before = '가정 날', after = '가정의날')
corpus <- changeTerms(corpus = corpus, before = '손보', after = '손해보험')
corpus <- changeTerms(corpus = corpus, before = '조직문화', after = '기업문화')
corpus <- changeTerms(corpus = corpus, before = '회사문화', after = '기업문화')
corpus <- changeTerms(corpus = corpus, before = '근로문화', after = '기업문화')

간혹 corpus 객체를 전처리 하다가 실수로 문자 벡터로 변환해버릴 수 있습니다. 그럴 경우 tm 패키지의 함수들을 사용할 수 없으니 반드시 corpus 객체의 속성을 확인하여야 합니다. PlainTextDocument면 통과입니다.

R 코드 보기 
# corpus 객체의 속성을 확인합니다.
class(x = corpus[[1]])

## [1] "PlainTextDocument" "TextDocument"

아래 함수들은 corpus 객체를 전처리할 때 유용하게 사용할 수 있는 함수들입니다. 만약 영문을 사용하거나 기호나 숫자를 없애야 한다면 아래 함수들을 사용하시기 바랍니다. 아래 3줄은 실행하지 않도록 설정했으니 참고하시기 바랍니다.

R 코드 보기 
# 소문자로 변경합니다. (영어가 포함되었을 경우. 대문자는 toupper)
# [주의] content_transformer() 함수를 사용하지 않으면 character로 강제 변환됩니다.
corpus <- tm_map(x = corpus, FUN = content_transformer(FUN = tolower))

# 특수문자를 제거합니다.
corpus <- tm_map(x = corpus, FUN = removePunctuation)

# 숫자를 삭제합니다.
corpus <- tm_map(x = corpus, FUN = removeNumbers)

corpus 객체 전처리의 마지막은 불용어(stopwords)를 삭제하는 것입니다. 한글 불용어는 인터넷에서 공개된 자료가 많으니 별도로 정리하여 사용하든가 아니면 아래 링크를 사용하시면 됩니다. 아래 링크는 인터넷에서 수집하여 정리한 다음 제 github에 올린 것입니다.

R 코드 보기 
# 불용어 객체를 생성합니다. 
myStopwords <- read.table(
  file = 'stopwords.txt') %>%   # 불용어 사전은 직접 준비한 파일을 사용하세요.
  .$V1

# 불용어(stopwords)를 삭제합니다.
corpus <- tm_map(x = corpus, FUN = removeWords, myStopwords)

# whitespace를 제거합니다.
corpus <- tm_map(x = corpus, FUN = stripWhitespace)

# 문서번호를 새로운 컬럼에 만든 후 데이터 프레임으로 저장합니다.
parsedDf <- data.frame(
  id = generateIDs(obj = parsed, index = 'doc'),
  parsedContent = parsed, 
  corpusContent = sapply(X = corpus, FUN = `[[`, 'content'))

문서단어행렬(DTM) 생성

말뭉치 전처리까지 완료했다면 이제 문서단어행렬(Document-Term Matrix)을 생성할 차례입니다. 말뭉치에서 글자의 길이가 2 이상인 단어들만 남긴 다음 DTM의 원소가 TF인 행렬을 만듭니다. 생성된 dtm 객체를 출력하면 여러 가지 정보를 확인할 수 있습니다. sparsity는 전체 행렬에서 0이 차지하는 비중을 의미합니다. weighting은 행렬을 구성하는 각각의 값(value)을 계산한 방식을 나타냅니다.

R 코드 보기 
# DTM을 생성합니다. 
dtm <- DocumentTermMatrix(x = corpus, control = list(wordLengths = c(2, Inf)))

# 단어(=컬럼명) 양옆의 공백을 제거합니다.
colnames(x = dtm) <- trimws(x = colnames(x = dtm), which = 'both')

# 차원을 확인합니다.
dim(x = dtm)

## [1]  270 1901

현재 작업 중인 dtm 객체는 270개 행(문서)에서 1901개 열(단어)로 구성된 것입니다. 단어의 수가 상당히 많습니다. 작업의 편의를 위해 대부분이 0인 sparse Terms 일부를 삭제하여 차원을 축소하는 편이 좋습니다. sparse 인자에 할당하는 값의 크기가 작을수록 term의 개수가 크게 감소합니다. 그러니까 sparse가 크다는 것은 그만큼 희소성이 있는 컬럼을 남겨두겠다는 의미가 됩니다. 아래 라인은 각각의 열(단어) 기준으로 sparsity가 0.99를 넘는 열을 삭제합니다. 그 결과 문서의 개수는 변함 없이 단어의 개수만 크게 감소합니다.

R 코드 보기 
# dtm의 차원을 줄입니다. 
dtm <- removeSparseTerms(x = dtm, sparse = as.numeric(x = 0.99))

# 차원을 확인합니다.
dim(x = dtm)

## [1] 270 605
R 코드 보기 
# 행의 합이 0인 건수를 확인합니다. 
rowSums(x = dtm %>% as.matrix()) %>% table()

## .
##  7  9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 
##  2  1  2  6  6 11  8 12 17 15 12 15 12 10 14 16 10  8  8 12  9  5  3  6  1 
## 33 34 35 36 37 38 39 40 41 42 44 45 46 49 50 51 56 58 62 63 65 93 
##  6  3  4  6  1  3  3  2  2  1  5  2  1  2  1  1  1  1  1  1  1  1
R 코드 보기 
# 문서 이름(row name)을 지정합니다. 나중에 생성할 parsedDf와 병합하기 위함입니다.
dtm$dimnames$Docs <- generateIDs(obj = dtm$dimnames$Docs, index = 'doc')

# dtm 객체를 육안으로 확인합니다. 
dtm$dimnames$Docs[1:40]

##  [1] "doc001" "doc002" "doc003" "doc004" "doc005" "doc006" "doc007"
##  [8] "doc008" "doc009" "doc010" "doc011" "doc012" "doc013" "doc014"
## [15] "doc015" "doc016" "doc017" "doc018" "doc019" "doc020" "doc021"
## [22] "doc022" "doc023" "doc024" "doc025" "doc026" "doc027" "doc028"
## [29] "doc029" "doc030" "doc031" "doc032" "doc033" "doc034" "doc035"
## [36] "doc036" "doc037" "doc038" "doc039" "doc040"
R 코드 보기 
dtm$dimnames$Terms[1:40]

##  [1] "10년"     "10일"     "1년"      "1등"      "1위"      "30분"    
##  [7] "6시"      "8시"      "가능"     "가정"     "가정의날" "가족"    
## [13] "가지다"   "가치"     "각오"     "갈다"     "감사"     "감수"    
## [19] "감축"     "강도"     "강요"     "강점"     "강제"     "강하다"  
## [25] "갖다"     "갖추다"   "같다"     "개개인"   "개발"     "개선"    
## [31] "개인"     "개인주의" "건강"     "건전"     "결과"     "결재"    
## [37] "결정"     "경력"     "경영"     "경영진"

이번에는 TF-IDF를 원소로 갖는 DTM을 생성해보겠습니다. 같은 함수를 사용하지만 control 인자에 할당하는 파라미터가 많이 다릅니다. 역시 글자의 길이가 2 이상인 단어들만 남기고 원소를 계산하는 방식으로 weightTfIdf() 함수를 사용한다는 특징이 있습니다.

R 코드 보기 
# 문서단어행렬의 원소가 TF-IDF인 dtmTfIdf 객체를 생성합니다.
dtmTfIdf <- DocumentTermMatrix(
  x = corpus,
  control = list(
    removeNumbers = TRUE,
    wordLengths = c(2, Inf),
    weighting = function(x) weightTfIdf(x, normalize = TRUE) ))

# 단어(=컬럼명) 양옆의 공백을 제거합니다.
colnames(x = dtmTfIdf) <- trimws(x = colnames(x = dtmTfIdf))

# 차원을 확인합니다.
dim(x = dtmTfIdf)

## [1]  270 1871

dtmTfIdf 객체의 경우, 행이 270이고 열이 1871인 행렬이 생성되었습니다. 혹시 dtm과 차원이 다른 이유를 짐작하실 수 있나요? 그건 바로 control 인자에 할당된 removeNumbers 때문입니다. 숫자로 된 단어를 모두 제외하였기 때문에 열의 개수가 소폭 감소하였습니다.

dtmTfIdf 객체도 차원을 줄여보겠습니다.

R 코드 보기 
# 네트워크의 크기를 줄이기 위해 sparse가 큰 컬럼을 제거합니다.
# 역시 이 과정을 통해 DTM의 단어 개수가 크게 줄었습니다.
dtmTfIdf <- removeSparseTerms(x =  dtmTfIdf, sparse = as.numeric(x = 0.99))

# 차원을 확인합니다.
dim(x = dtmTfIdf)

## [1] 270 598
R 코드 보기 
# 행의 합이 0인 건수를 확인합니다.
rowSums(x = dtmTfIdf %>% as.matrix() %>% round(digits = 1L)) %>% table()

## .
## 1.5 1.8 1.9   2 2.1 2.2 2.3 2.4 2.5 2.6 2.7 2.8 2.9   3 3.1 3.2 3.3 3.4 
##   1   1   2   2   3   1   6   2   8  10  10  10  15  17  25  28  17  21 
## 3.5 3.6 3.7 3.8 3.9   4 4.1 4.2 4.3 4.4 
##  20  24  11   8  12   6   4   3   2   1
R 코드 보기 
# 문서 이름(row name)을 지정합니다. 나중에 생성할 parsedDf와 병합하기 위함입니다.
dtmTfIdf$dimnames$Docs <- generateIDs(obj = dtmTfIdf$dimnames$Docs, index = 'doc')

고빈도 단어 시각화

dtm과 dtmTfIdf 객체를 생성하였으므로 고빈도 단어 시각화를 3가지 소개해드리겠습니다. 먼저 상위 20개 단어로 막대그래프를 그린 것입니다. dtm에서 열 합계를 계산한 다음 빈도수 기준으로 내림차순 정렬을 하고 상위 20개만 추출하면 막대그래프를 그릴 준비를 마친 것입니다.

R 코드 보기 
# dtm에 언급된 단어(term)별 빈도수를 생성합니다.
wordsFreq <- dtm %>% as.matrix() %>% colSums()

# 사용된 단어의 총 개수를 확인합니다.
length(x = wordsFreq)

## [1] 605
R 코드 보기 
# 내림차순으로 정렬하고, 상위 20개만 확인합니다.
wordsFreq <- wordsFreq[order(wordsFreq, decreasing = TRUE)]
head(x = wordsFreq, n = 20L)

##     좋다     높다     많다     연봉     회사     업무     직원     야근 
##      175      158      140      135      133      119       90       73 
##     기업     복지   대하다     삼성 업무강도     필요 기업문화     영업 
##       71       69       62       60       60       57       56       53 
##      1위     보수     급여   분위기 
##       51       51       47       47
R 코드 보기 
# 단어 빈도를 막대그래프로 그리기 위해 데이터 프레임으로 변환한 다음 
# 내림차순으로 정렬합니다.
wordDf <- data.frame(
  word = names(x = wordsFreq),
  freq = wordsFreq,
  row.names = NULL) %>% 
  arrange(desc(x = freq))

# 건수를 확인합니다.
nrow(x = wordDf)

## [1] 605

ggplot() 함수를 이용하여 막대그래프를 그립니다. 그 전에 깔끔한 그래프를 그릴 수 있도록 나만의 테마를 만듭니다.

R 코드 보기 
# ggplot() 함수에 적용할 나만의 테마(mytheme)를 설정합니다.
mytheme <- theme(
  plot.title = element_text(size = 14, face = 'bold', hjust = 0.5),
  axis.title.x = element_text(color = 'blue', size = 12, face = 'bold'),
  axis.title.y = element_text(color = '#993333', size = 12, face = 'bold'),
  axis.text.x = element_text(family = 'NanumGothic', size = 10, face = 'bold'),
  axis.text.y = element_blank(), 
  axis.ticks.length = unit(0, 'cm'),
  panel.background = element_blank(),
  panel.grid = element_blank() )

# 총 빈도수 상위 15개 단어로 막대그래프를 그립니다. (내림차순 정렬)
ggplot(
  data = head(x = wordDf, n = 20L), 
  mapping = aes(
    x = reorder(word, -freq), 
    y = freq)) + 
  geom_bar(
    stat = 'identity', 
    fill = c(rep(x = 'gray30', times = 5), rep(x = 'gray80', times = 15))) +
  geom_text(
    mapping = aes(label = freq), 
    size = 4, 
    vjust = -0.5) + 
  labs(
    x = '고빈도 단어', 
    y = '빈도수', 
    title = '고빈도 단어 현황_전체') + 
  mytheme

이번에는 아주 유명한 텍스트 시각화 기법 중 하나인 단어 구름(Word Cloud)를 생성해보겠습니다. 단어의 색을 예쁘게 하기 위해 파스텔 색상으로 나만의 팔레트를 만들고 빈도수가 높은 단어에 색을 적용하도록 하겠습니다.

R 코드 보기 
# 필요한 패키지를 불러옵니다. 
library(RColorBrewer)
library(wordcloud2)
library(htmlwidgets)
R 코드 보기 
# 나만의 팔레트를 설정합니다. (n:사용할 색깔 수, name:색깔 조합 이름)
display.brewer.pal(n = 8, name = 'Set2')

R 코드 보기 
pal <- brewer.pal(n = 8, name = 'Set2')
# http://colorbrewer2.org/ 참고

# 워드클라우드에 적용할 데이터의 길이를 최대 300건으로 제한합니다. 
# 이 숫자가 넘어가면 워드클라우드가 예쁘게 그려지지 않습니다. 
if (nrow(x = wordDf) >= 300) wordCloud <- wordDf[1:300, ] else wordCloud <- wordDf

# Wordcloud를 그립니다. 
wordcloud2(
  data = wordCloud,
  size = 0.8,
  fontFamily = 'NanumGothic',
  color = pal,
  backgroundColor = 'white',
  minRotation = -pi / 4,
  maxRotation = pi / 4,
  shuffle = TRUE,
  rotateRatio = 0.25,
  shape = 'circle',
  ellipticity = 0.6)

세 번째 그래프는 트리맵입니다. 사실 별 거 아니지만 단어 빈도수가 높은 순서대로 네모 칸의 크기를 다르게 하여 고빈도 단어들을 한 눈에 파악할 수 있도록 한 것입니다.

R 코드 보기 
# 필요한 패키지를 불러옵니다.
library(treemap)
R 코드 보기 
# 고빈도 단어 트리맵을 그립니다. 
treemap(
  dtf = wordDf,
  title = '고빈도 단어 트리맵',
  index = c('word'),
  vSize = 'freq',
  fontfamily.labels = 'NanumGothic',
  fontsize.labels = 14,
  palette = pal,
  border.col = 'white')

단어 연관성 분석

이번에는 특정 단어와 함께 출현하는 빈도가 높은, 연관성 높은 단어를 추출하는 방법에 대해서 알아보겠습니다. 모두에 말씀드린 바와 같이 저는 3가지 방법을 사용하는데요. 이번 포스팅에서는 2가지만 소개하겠습니다. 둘 다 간단합니다.

첫 번째 방법은 dtmTfIdf 객체를 행렬로 변환한 다음 상관(계수) 행렬을 구하는 걸로 거의 모든 것이 끝납니다. 그리고 나서 특정 단어가 속한 컬럼을 뽑아 행렬 원소를 내림차순으로 정렬하면 끝납니다. 아래는 고빈도 단어 중 명사 위주로 관심 있는 몇 가지에 대해 상위 10개씩 확인해본 것입니다.

R 코드 보기 
# 상관계수 행렬을 직접 생성합니다.
corTerms <- dtmTfIdf %>% as.matrix() %>% cor()

# 차원을 확인합니다. 
dim(x = corTerms)

## [1] 598 598
R 코드 보기 
# 상관계수 행렬로 연관성 높은 단어를 확인합니다.
checkCorTerms <- function(n = 10, keyword) {
  
  # 키워드 유무를 확인합니다.
  corTerms %>% 
    colnames() %>% 
    str_subset(pattern = keyword) %>% 
    print()
  
  # 연관 키워드가 있는 컬럼의 전체 단어를 한꺼번에 출력합니다.
  corRef <- data.frame()
  
  # 상관계수 높은 순서로 정렬합니다.
  corRef <- corTerms[ , keyword] %>%
    sort(decreasing = TRUE) %>%
    data.frame() %>%
    set_colnames(c('corr'))
  
  # 미리보기 합니다. 
  head(x = corRef, n = n + 1)
}

# 빈도수 높은 단어 중 관심 있는 명사 위주로 확인합니다. 
checkCorTerms(n = 10, keyword = '연봉')

## [1] "연봉"

##             corr
## 연봉   1.0000000
## 상승   0.3024012
## 높다   0.3007580
## 해결   0.2232224
## 상당   0.2172382
## 인식   0.1951647
## 각오   0.1802804
## 커리어 0.1726297
## 맡다   0.1715646
## 브랜드 0.1652702
## 자기   0.1599896
R 코드 보기 
checkCorTerms(n = 10, keyword = '야근')

## [1] "야근"     "야근수당"

##               corr
## 야근     1.0000000
## 잦다     0.4773754
## 일상     0.2983263
## 가정     0.2503515
## 기본     0.2398341
## 필수     0.2285899
## 쎄다     0.2266016
## 기업문화 0.2265103
## 이익     0.2259482
## 과도하다 0.2215771
## 기본급   0.2192393
R 코드 보기 
checkCorTerms(n = 10, keyword = '삼성')

## [1] "삼성"     "삼성그룹" "삼성화재"

##               corr
## 삼성     1.0000000
## 자부심   0.3204171
## 타이틀   0.2773458
## 근무시간 0.2634302
## 자랑     0.2251222
## 상당     0.2109360
## 마감     0.2067216
## 나아지다 0.1919994
## 조절     0.1815198
## 압박     0.1761186
## 금융업   0.1759662
R 코드 보기 
checkCorTerms(n = 10, keyword = '업무강도')

## [1] "업무강도"

##               corr
## 업무강도 1.0000000
## 세다     0.3707511
## 높다     0.3550106
## 조절     0.3210592
## 높이다   0.2888525
## 강하다   0.2673936
## 낮추다   0.2421293
## 저녁     0.2073970
## 느끼다   0.2046691
## 바라다   0.1947416
## 교육기회 0.1897041
R 코드 보기 
checkCorTerms(n = 10, keyword = '기업문화')

## [1] "기업문화"

##               corr
## 기업문화 1.0000000
## 유연하다 0.3502078
## 잦다     0.3384624
## 단순     0.3172063
## 보수     0.3013308
## 경직     0.2981385
## 양립     0.2934218
## 바꾸다   0.2889535
## 개선     0.2755130
## 딱딱하다 0.2719651
## 이외     0.2719651
R 코드 보기 
checkCorTerms(n = 10, keyword = '분위기')

## [1] "분위기"

##               corr
## 분위기   1.0000000
## 차별     0.3143072
## 대우     0.2700052
## 자유     0.2649019
## 체계     0.2559453
## 나가다   0.2460992
## 키우다   0.2065264
## 전문가   0.2043906
## 재무구조 0.2009425
## 수직     0.1970148
## 사용     0.1969903
R 코드 보기 
checkCorTerms(n = 10, keyword = '스트레스')

## [1] "스트레스"

##               corr
## 스트레스 1.0000000
## 낮다     0.3046307
## 빼다     0.2740408
## 실질     0.2669483
## 여유     0.2399733
## 교육기회 0.2307128
## 시급     0.2293218
## 관리직   0.2274678
## 금전     0.2268050
## 급여     0.2243942
## 직무순환 0.2203238
R 코드 보기 
checkCorTerms(n = 10, keyword = '자부심')

## [1] "자부심"

##               corr
## 자부심   1.0000000
## 삼성     0.3204171
## 포화상태 0.3185390
## 타이틀   0.2904761
## 자랑     0.2679928
## 보험업   0.2641174
## 해외진출 0.2542467
## 업계     0.2470959
## 단순     0.2133139
## 경직     0.2098528
## 줏다     0.2070730

단어 연관성 분석의 두 번째 방법은 tm 패키지의 findAssocs() 함수를 하용하는 것입니다. 이 함수에 상관계수 행렬과 관심 있는 단어, 그리고 상관계수 기준점만 지정하면 알아서 결과를 제시합니다. 저는 연관성 단어를 추출하고 이것을 재직상태별로 나누어 막대그래프로 표현해보고자 아래와 같이 사용자 정의 함수를 만들었습니다. 전직원과 현직원 간 인식의 차이를 보이는 단어가 보이나요?

R 코드 보기 
# tm 패키지의 findAssocs() 함수 이용하여 상관계수 높은 단어를 확인할 수 있습니다.
# 상관계수가 기준 이상인 단어들만 추출합니다.
checkAssocs <- function(dtm, keyword, corr = 0.01) {
  
  # 재직상태별 상관계수를 생성하고 데이터 프레임에 저장합니다. 
  createDtmObj <- function(dtm, workGb, n = 10) {
    
    # 전직원/현직원별로 dtm을 나눕니다.
    dtmSmp <- dtm[rownames(x = dtm) %in% texts$id[texts$재직상태 == workGb], ]
    
    # 상관계수가 높은 단어만 저장합니다.
    assocs <- findAssocs(x = dtmSmp, terms = keyword, corlimit = corr)
    
    # 재직상태별 상관계수로 데이터 프레임을 생성합니다. 
    dtmObj <- eval(expr = parse(text = str_c('assocs', keyword, sep = '$'))) %>% 
      `[`(1:n) %>% 
      as.data.frame() %>% 
      set_colnames('corr') 
    
    # 행이름으로 word 컬럼을 생성합니다. 
    dtmObj$word <- rownames(x = dtmObj) 
    
    # 행이름을 삭제합니다. 
    rownames(x = dtmObj) <- NULL 
    
    # workGb 컬럼을 생성합니다. 
    dtmObj$workGb <- workGb
    
    # 결과를 반환합니다. 
    return(dtmObj)
  }
  
  # 행 기준으로 붙여서 dtmObj를 생성합니다. 
  dtmObj <- rbind(createDtmObj(dtm = dtm, workGb = '전직원'), 
                  createDtmObj(dtm = dtm, workGb = '현직원'))
  
  # 막대그래프 리스트를 생성합니다. 
  plots <- lapply(X = split(x = dtmObj, f = dtmObj$workGb), FUN = function(x) {
    
    # 단어의 순서를 상관계수 역순으로 재조정합니다. 
    x$word <- factor(x = x$word, levels = x$word[order(x$corr, decreasing = TRUE)])
    
    # 막대그래프를 설정합니다. 
    ggplot(data = x, 
           mapping = aes(
             x = word, 
             y = corr, 
             width = 0.8)) +
      geom_col(fill = 'gray50') +
      geom_text(mapping = aes(label = corr), 
                size = 4, 
                vjust = -0.5) + 
      scale_y_continuous(limits = c(0, max(x$corr)*1.1 )) + 
      labs(x = '', 
           y = '상관계수',
           title = str_c('[', unique(x$workGb), ']', 
                         keyword, 
                         '관련 연관성 높은 단어', 
                         sep = ' ')) + 
      theme(legend.position = 'none') + mytheme 
  })
  
  # 2행으로 그래프를 그립니다. 
  do.call(what = gridExtra::grid.arrange, args = c(plots, nrow = 2))
}

# 재직상태별 상관계수 높은 단어들을 확인합니다. 
checkAssocs(dtm = dtmTfIdf, keyword = '연봉')

R 코드 보기 
checkAssocs(dtm = dtmTfIdf, keyword = '야근')

R 코드 보기 
checkAssocs(dtm = dtmTfIdf, keyword = '삼성')

R 코드 보기 
checkAssocs(dtm = dtmTfIdf, keyword = '업무강도')

R 코드 보기 
checkAssocs(dtm = dtmTfIdf, keyword = '기업문화')

R 코드 보기 
checkAssocs(dtm = dtmTfIdf, keyword = '분위기')

R 코드 보기 
checkAssocs(dtm = dtmTfIdf, keyword = '스트레스')

R 코드 보기 
checkAssocs(dtm = dtmTfIdf, keyword = '자부심')

네트워크 맵 그리기

이번 포스팅의 마지막 꼭지는 네트워크 맵 그리기입니다. dtm이나 dtmTfIdf로 상관계수 행렬을 만들고 네트워크 객체를 생성한 다음 각 단어별로 매개 중심성(Betweenness Centrality)을 계산합니다. 매개 중심성은 네트워크에서 노드 간 최단 연결고리에 속하는지 여부로 결정됩니다. 숫자가 클수록 각각의 노드를 연결하는 중심에 있다는 것이죠. 이 외에 연결 중심성(Degree Centrality)도 중요합니다. 각 노드마다 연결된 엣지의 수가 다를텐데요. 이 엣지의 수가 많을수록 연결되어 있는 노드가 많다는 의미입니다. 이건 쉽죠?

아래는 매개 중심성 상위 10%에 해당하는 노드를 금색으로 색칠하고 각 노드를 연결하는 엣지는 상관계수의 1.2배로 설정했습니다. 상관계수가 높을수록 연결된 선이 굵게 표시됩니다.

R 코드 보기 
# 필요한 패키지를 불러옵니다. 
library(network)
library(GGally)
R 코드 보기 
# 네트워크 맵을 그리는 사용자 정의 함수를 생성합니다. 
drawNetworkmap <- function(dtmObj, title, sparse, corr, prob, link, cex) {
  
  # 상관계수 행렬의 크기를 조정합니다.
  corTerms <- dtmObj %>% as.matrix() %>% cor()
  corTerms[corTerms <= corr] <- 0
  
  # 네트워크 객체를 생성합니다.
  netTerms <- network(x = corTerms, directed = FALSE)
  
  # 매개 중심성을 계산합니다.
  btnTerms <- sna::betweenness(dat = netTerms)
  netTerms %v% 'mode' <-
    ifelse(
      test = btnTerms >= quantile(x = btnTerms, probs = prob, na.rm = TRUE), 
      yes = 'Top', 
      no = 'Rest')
  
  # 노드 컬러를 지정합니다. 
  # 상위 10%는 금색, 나머지 90%는 흰색으로 설정합니다. 
  nodeColors <- c('Top' = 'gold', 'Rest' = 'white')
  
  # 엣지 크기를 지정합니다. 이번 예제에서는 상관계수의 1.2배로 합니다.
  set.edge.value(x = netTerms, attrname = 'edgeSize', value = corTerms * 1.2)
  
  # 네트워크 지도를 그립니다. 
  ggnet2(
    net = netTerms,
    mode = 'fruchtermanreingold',
    layout.par = list(cell.jitter = 0.001),
    size.min = link,
    label = TRUE,
    label.size = cex,
    node.color = 'mode',
    palette = nodeColors,
    node.size = sna::degree(dat = netTerms),
    edge.size = 'edgeSize',
    legend.position = 'None',
    family = 'NanumGothic') + 
    labs(title = title) + 
    theme(plot.title = element_text(hjust = 0.5, face = 'bold'))
}

위와 같이 네트워크 맵을 그리는 사용자 정의 함수를 만들었다면, 이제 네트워크 맵을 그려보겠습니다. 먼저 재직상태별로 네트워크 맵을 그리는 것입니다. 네트워크 맵을 그리면 전체 문서에서 자주 출현하는 단어 간 연결고리를 확인할 수 있습니다. 마치 글을 읽듯이 자연스러운 부분을 발견할 수 있는데요. 예를 들면 실적 - 압박 - 상당을 들 수 있습니다. **보험 - 설계사 - 급여 - 낮다 **도 바로 붙어 있네요. 이런 식으로 네트워크 맵에 있는 연결고리를 찾는 재미가 있습니다. 동시에 이런 걸 찾으려면 힘이 들기도 하겠군요.

R 코드 보기 
# 재직상태별 네트워크 맵을 그리는 함수를 생성합니다. 
dt4Networkmap1 <- function(workGb, sparse, corr, prob = 0.95, link = 4, cex = 4) {
    
    # 입력조건에 따라 dtm을 선택합니다.
    checks <- texts$재직상태 == workGb
    dtmSub <- dtmTfIdf[rownames(x = dtmTfIdf) %in% texts$id[checks], ]
    
    # 모든 값이 0인 열을 삭제합니다. 
    dtmSub <- dtmSub[, as.matrix(x = dtmSub) %>% colSums() >= 1]
    
    # 그래프 제목을 설정합니다. 
    title <- str_c('[', workGb, '] 네트워크맵', sep = ' ')
    
    # 네트워크 맵을 그립니다. 
    drawNetworkmap(dtmObj = dtmSub, title, sparse, corr, prob, link, cex)
}

# 재직상태별 네트워크 맵을 그립니다. 
dt4Networkmap1(workGb = '전직원', sparse = 0.95, corr = 0.30, link = 2, cex = 3)

R 코드 보기 
dt4Networkmap1(workGb = '현직원', sparse = 0.95, corr = 0.30, link = 2, cex = 3)

기업리뷰를 남긴 회원의 추천 여부에 따른 네트워크 맵을 비교할 수도 있습니다. 비추 네트워크 맵을 보면 처음 - 좋다 - 말다라는 문구가 보이네요. 야근 - 잦다 - 기업문화 - 개선이라는 것도 보이구요. 데이터가 좋으면 이런 부분을 쉽게 찾을 수 있는 것 같습니다.

R 코드 보기 
# 추천 여부별 네트워크 맵을 그리는 함수를 생성합니다. 
dt4Networkmap2 <- function(recomm, sparse, corr, prob = 0.95, link = 4, cex = 4) {
    
    # 입력조건에 따라 dtm을 선택합니다.
    checks <- texts$추천여부 == recomm 
    dtmSub <- dtmTfIdf[rownames(x = dtmTfIdf) %in% texts$id[checks], ]
    
    # 모든 값이 0인 열을 삭제합니다. 
    dtmSub <- dtmSub[, as.matrix(x = dtmSub) %>% colSums() >= 1]
    
    # 그래프 제목을 설정합니다. 
    title <- str_c('[', recomm, '] 네트워크맵', sep = ' ')
    
    # 네트워크 맵을 그립니다. 
    drawNetworkmap(dtmObj = dtmSub, title, sparse, corr, prob, link, cex)
  }

# 재직상태별 네트워크 맵을 그립니다. 
dt4Networkmap2(recomm = '추천', sparse = 0.90, corr = 0.30, link = 2, cex = 3)

R 코드 보기 
dt4Networkmap2(recomm = '비추', sparse = 0.90, corr = 0.30, link = 2, cex = 3)

이상으로 부족한 부분이 많지만 텍스트 마이닝 부분까지 모두 소개해드렸습니다. 질문이나 지적사항 모두 환영합니다. 많은 관심 부탁드립니다.

]]>나성호 (Seongho Na)탐색적 데이터 분석(EDA)과 추천모형 적합2018-10-29T00:00:00+00:002026-06-24T00:00:00+00:00https://www.hds.ai.kr/posts/jobplanet-review-2

이 글은 2018년 강의 노트를 옮긴 것입니다. 방법론과 결과 그래프 중심으로 정리했으며, R 코드는 접어 두었습니다(펼쳐서 볼 수 있습니다). 잡플래닛 사이트 구조가 바뀌어 수집 코드는 현재 그대로는 동작하지 않을 수 있습니다.

지난 포스팅에서 우리는 관심 있는 회사에 대한 기업리뷰를 수집하는 방법에 대해 알아봤습니다. 이번 포스팅에서는 수집한 데이터를 이용하여 몇 가지 간단한 분석을 수행해보겠습니다. 먼저 데이터가 어떤 형태로 되어 있는지 확인하기 위해 탐색적 데이터 분석을 실행하는 것이 좋습니다.

탐색적 데이터 분석 (Explortory Data Analysis)

탐색적 데이터 분석 방법으로는 고정된 형태가 없습니다. 보통은 summary() 함수를 사용하여 기초 통계량을 확인하고, 히스토그램이나 상자수염그림을 그려 데이터의 분포를 확인하곤 합니다.

이번 예제에서는 추천여부와 성장예상, 그리고 별점 데이터를 중점으로 몇 가지 인사이트를 찾아보는 작업을 실시하겠습니다. 먼저 RDS 파일을 불러와서 전처리를 실시하겠습니다.

R 코드 보기 
# 필요한 패키지를 불러옵니다.
library(tidyverse)
library(stringr)
library(stringi)
library(lubridate)
library(magrittr)

# 그래프 제목으로 자주 사용할 회사이름을 지정합니다. 
compNm <- '삼성화재'

# RDS 파일을 읽습니다. 
dt <- readRDS(file = '../data/Company_Review_Data_삼성화재해상보험.RDS')

20~100점으로 되어 있는 별점을 1~5점으로 환산하였고, 편의를 위해 성장예상과 추천여부 컬럼을 범주형으로 변환하였고, 연도별 현황 분석을 위해 등록연도 컬럼을 신규로 추가했습니다.

R 코드 보기 
# 별점을 1~5점으로 환산합니다.
dt[, 8:13] <- sapply(X = dt[, 8:13], FUN = function(x) x / 20)

# 추천여부 컬럼을 '추천'과 '비추'로 변환합니다.
dt$추천여부 <- str_extract(string = dt$추천여부, pattern = '추천(?= )')
dt$추천여부[is.na(x = dt$추천여부) == TRUE] <- '비추'

# 성장예상과 추천여부 컬럼을 범주형으로 변환합니다. 
dt$성장예상 <- factor(x = dt$성장예상)
dt$추천여부 <- factor(x = dt$추천여부)

# 등록일자를 날짜형 벡터로 변환합니다.
dt$등록일자 <- as.Date(x = dt$등록일자, format = '%Y/%m/%d')

# 등록연도 컬럼을 추가합니다. 
dt$등록연도 <- year(dt$등록일자)

ggplot() 함수를 이용하여 다양한 그래프를 그릴 예정인데, 나만의 테마를 미리 설정해놓겠습니다.

R 코드 보기 
# 나만의 ggplot 설정을 지정합니다.
mytheme <- theme(
  panel.grid = element_blank(), 
  panel.background = element_rect(fill = 'white', color = 'white', size = 1.2), 
  plot.background = element_blank(), 
  plot.title = element_text(family = 'NanumGothic', face = 'bold', hjust = 0.5, size = 14),
  axis.title = element_text(family = 'NanumGothic'), 
  axis.text.x = element_text(size = 10, face = 'bold'), 
  axis.text.y = element_text(family = 'NanumGothic'), 
  axis.ticks = element_blank(), 
  strip.text.x = element_text(size = 10, face = 'bold', family = 'NanumGothic'), 
  strip.text.y = element_text(size = 10, face = 'bold', angle = 270, family = 'NanumGothic'), 
  strip.background.y = element_rect(fill = 'gray80', color = 'white'),
  legend.title = element_text(family = 'NanumGothic'),
  legend.text = element_text(family = 'NanumGothic'),
  legend.position = 'bottom')

재직상태별 성장예상 및 추천여부 확인

전직과 현직 등 재직상태별로 회사의 성장성을 예상하고 추천 또는 비추천 여부가 달라질 것으로 예상할 수 있습니다. 과연 그런지 그래프로 그려보고 카이제곱 검정을 통해 확인해보겠습니다.

R 코드 보기 
# 추천/비추 여부 막대그래프를 그립니다.
drawBarPlot <- function(data, workGb, var) {
  
  # 빈도테이블을 생성합니다. 
  tbl <- data[data$재직상태 == workGb, c('회사이름', var)] %>% table() %>% t()

  # 막대그래프를 그립니다. 
  bp <- barplot(height = tbl, 
                ylim = c(0, max(tbl)*1.25), 
                names.arg = rownames(x = tbl),
                beside = TRUE, 
                # legend = TRUE, 
                main = str_c(workGb, var, sep = ' ') )
  
  # 빈도수를 추가합니다. 
  text(x = bp, y = tbl, labels = tbl, pos = 3)
}

# 그래픽 파라미터를 설정합니다. 
par(mfrow = c(2, 2), family = 'NanumGothic', mar = c(5, 4, 4, 2))

# 막대그래프를 그립니다. 
drawBarPlot(data = dt, workGb = '전직원', var = '추천여부')
drawBarPlot(data = dt, workGb = '전직원', var = '성장예상')
drawBarPlot(data = dt, workGb = '현직원', var = '추천여부')
drawBarPlot(data = dt, workGb = '현직원', var = '성장예상')

그래프 상으로는 재직상태별로 큰 차이가 보이지 않는 것 같습니다. 그럼 카이제곱 검정을 해볼까요?

R 코드 보기 
# 필요한 패키지를 불러옵니다.
library(descr)
R 코드 보기 
# 카이제곱 검정을 위한 사용자 정의 함수를 생성합니다. 
chisqTest <- function(var1, var2) {
  
  # 변수를 설정합니다. 
  v1 <- eval(expr = parse(text = str_c('dt', var1, sep = '$')))
  v2 <- eval(expr = parse(text = str_c('dt', var2, sep = '$')))
  
  # 빈도테이블을 생성합니다. 
  tbl <- table(v1, v2)
  
  # 교차테이블을 생성합니다. 
  CrossTable(x = tbl, 
             expected = TRUE, 
             prop.r = FALSE, 
             prop.c = FALSE, 
             prop.t = FALSE, 
             prop.chisq = FALSE) %>% 
    print()
  
  # 카이제곱 검정을 실시합니다. 
  chisq.test(x = tbl) %>% print()
}

# 재직상태 * 성장예상
chisqTest(var1 = '재직상태', var2 = '성장예상')

##    Cell Contents 
## |-------------------------|
## |                       N | 
## |              Expected N | 
## |-------------------------|
## 
## =============================
##           v2
## v1        비슷   성장   Total
## -----------------------------
## 전직원      64     64     128
##           60.8   67.2        
## -----------------------------
## 현직원      60     73     133
##           63.2   69.8        
## -----------------------------
## Total      124    137     261
## =============================
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  tbl
## X-squared = 0.44411, df = 1, p-value = 0.5051
R 코드 보기 
# 재직상태 * 추천여부
chisqTest(var1 = '재직상태', var2 = '추천여부')

##    Cell Contents 
## |-------------------------|
## |                       N | 
## |              Expected N | 
## |-------------------------|
## 
## =============================
##           v2
## v1        비추   추천   Total
## -----------------------------
## 전직원      62     77     139
##           57.8   81.2        
## -----------------------------
## 현직원      54     86     140
##           58.2   81.8        
## -----------------------------
## Total      116    163     279
## =============================
## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  tbl
## X-squared = 0.81148, df = 1, p-value = 0.3677

성장예상이나 추천여부 모두 유의확률(p-value)이 0.05보다 큽니다. 따라서 재직상태별로 차이가 없다는 귀무가설을 기각할 수 없습니다. 직관적으로는 전직원의 경우 현직원보다 해당 기업을 덜 추천할 것 같은데 이번 데이터로 분석해보니 반드시 그런 것만은 아닌 것 같습니다. 다들 좋게 좋게 헤어졌나 봅니다.

연도별 성장예상 및 추천여부 변화

R 코드 보기 
# 연도별 현황을 확인합니다. 
drawBarLinePlot <- function(data, workGb, var) {
  
  # 등록연도가 없는 행을 삭제합니다. 
  data <- data[complete.cases(data$등록연도), ]
  
  # 빈도테이블을 생성합니다. 
  tbl <- data %>% 
    dplyr::filter(재직상태 == workGb & !is.na(eval(expr = parse(text = var)))) %>% 
    select(c('등록연도', var)) %>% 
    group_by(등록연도, eval(expr = parse(text = var))) %>% 
    summarize(빈도 = n()) %>% 
    mutate(비중 = (빈도 / sum(빈도) * 100) %>% round(digits = 1L)) 
  
  # 두 번째 컬럼명을 var로 변경합니다. 
  colnames(x = tbl)[2] <- var
  
  # 홀수행의 비중을 NA로 치환합니다. 
  rowNums <- seq(from = 1, to = nrow(x = tbl), by = 2)
  tbl$비중[rowNums] <- NA
  
  # ggplot() 함수를 이용하여 막대그래프를 그립니다.
  ggplot(data = tbl, 
         mapping = aes_string(x = '등록연도', y = '빈도', fill = var)) + 
    geom_bar(stat = 'identity', position = 'dodge') + 
    geom_text(mapping = aes(label = 빈도), 
              position = position_dodge(width = 0.9), 
              vjust = -1) + 
    geom_line(mapping = aes_string(x = '등록연도', y = '비중', color = var, group = var), 
              size = 1.2, 
              stat = 'identity', 
              position = position_dodge(width = 0.9)) +
    geom_point(mapping = aes_string(x = '등록연도', y = '비중', color = var, group = var), 
              shape = 21, 
              fill = 'white', 
              stroke = 2.0, 
              size = 2.4, 
              stat = 'identity', 
              position = position_dodge(width = 0.9)) + 
    geom_text(mapping = aes(y = 비중, label = 비중), 
              fontface = 'bold', 
              position = position_dodge(width = 0.9), 
              vjust = -1.5,
              hjust = 0.5) + 
    coord_cartesian(ylim = c(0, max(tbl$빈도, tbl$비중, na.rm = TRUE) * 1.1)) +
    scale_fill_manual(values = c('gray80', 'gray50')) + 
    scale_color_manual(values = c('black', 'red')) + 
    ggtitle(label = str_c('연도별', workGb, var, sep = ' ')) + 
    mytheme + 
    theme(axis.title = element_blank())
}
R 코드 보기 
# 연도별 현황을 그립니다. 
drawBarLinePlot(data = dt, workGb = '전직원', var = '성장예상')

R 코드 보기 
drawBarLinePlot(data = dt, workGb = '전직원', var = '추천여부')

R 코드 보기 
drawBarLinePlot(data = dt, workGb = '현직원', var = '성장예상')

R 코드 보기 
drawBarLinePlot(data = dt, workGb = '현직원', var = '추천여부')

잡플래닛이 2014년부터 서비스를 시작했는데, 2016년을 기점으로 기업리뷰 등록되는 건수가 점차 감소하는 것으로 보입니다. 전직원의 성장예상은 점차 감소하는 추세를 보였고, 추천여부도 감소하는 듯 했으나 2018년도에 크게 반등하는 모습입니다. 혹시 2017년도에 인사팀에서 기업리뷰 관리를 안한 건 아닐지 모르겠네요.

현직원의 경우, 성장예상은 매년 큰 폭으로 감소하는데 특히 2018년에는 20%로 곤두박질쳤습니다. 추천여부도 크게 감소하였구요. 한 가지 특이한 점은, 2018년도 기업리뷰 신규 등록 건수입니다. 전직원은 32개였는데, 현직원은 13개입니다. 성장예상 컬럼은 NA가 많았는데 추천여부는 NA가 전혀 없었습니다. 2018년 이전에 회사를 떠난 사람들은 삼성화재를 아름답게 기억하고 있는지도 모르겠습니다. 아무튼 현직원들의 참여는 크게 감소했고, 참여한 사람들은 비관적은 견해를 올렸습니다.

재직상태별 별점 비중

잡플래닛 회원들은 기업리뷰를 남길 때 해당 회사에 대한 별점 평가를 1~5점으로 부여합니다. 1점이 가장 낮은 점수고 5점이 가장 높은 점수 입니다. 전체 총점과 다섯 가지 세부 항목 등 총 6가지 별점을 부여하는데요. 아래 그래프는 전체 총점에 대한 비중을 재직상태별로 비교한 것입니다.

R 코드 보기 
# 재직상태에 따른 별점평가(총점) 빈도수를 확인합니다. 
pts <- table(dt$재직상태, dt$별점평가) %>% 
  set_colnames(value = str_c('별점', 1:5)) %>% 
  as.data.frame() %>% 
  set_colnames(value = c('재직상태', '별점구분', '빈도수'))
R 코드 보기 
# 필요한 패키지를 불러옵니다. 
library(RColorBrewer)
library(JLutils)
R 코드 보기 
# 나만의 팔레트를 생성합니다. 
mypal <- brewer.pal(n = 9, name = 'Greys')

# 그래프를 그립니다. 
ggplot(data = pts) +
  aes(x = 재직상태, fill = 별점구분, weight = 빈도수) + 
  geom_bar(position = 'fill', color = 'gray80') + 
  geom_text(stat = 'fill_labels') + 
  scale_fill_manual(values = mypal[3:7]) + 
  ggtitle(label = '삼성화재 전/현직원 별점평가 비중') + 
  mytheme + 
  theme(axis.title = element_blank(),
        axis.text.x = element_text(family = 'NanumGothic'), 
        axis.text.y = element_blank())

전직원과 현직원 간 차이가 많지 않습니다. 이 회사를 거쳐간 전직원의 80%는 별점이 3점 이상이라 생각하고 있고, 현직원은 90%가 3점 이상을 부여했습니다. 생각보다 평가를 잘받았네요.

레이더 차트 그리기

이번에는 6개 별점 항목 데이터를 이용하여 레이더 차트를 그려보겠습니다. 레이더 차트는 한 눈에 여러 가지 항목을 비교할 수 있다는 점에서 자주 사용됩니다.

R 코드 보기 
# 필요한 패키지를 불러옵니다. 
library(fmsb)
R 코드 보기 
# 평균 별점 데이터 프레임을 생성합니다. 
dt4radar1 <- dt %>% 
  dplyr::summarize(
    전체평가 = mean(별점평가),
    승진기회 = mean(승진기회),
    복지급여 = mean(복지급여), 
    워라밸 = mean(워라밸), 
    사내문화 = mean(사내문화), 
    경영진 = mean(경영진)) %>% 
  as.data.frame() 

# 결과를 출력합니다. 
print(x = dt4radar1)

##   전체평가 승진기회 복지급여   워라밸 사내문화   경영진
## 1 3.351254 3.236559 4.114695 2.448029 3.086022 2.942652
R 코드 보기 
# 그래픽 파라미터를 설정합니다. 
par(mfrow = c(1, 1), mar = c(2, 1, 2, 1), family = 'NanumGothic')

# 레이더 차트를 그립니다. 
radarchart(df = rbind(5, 1, dt4radar1), 
           axistype = 1, 
           seg = 4, 
           pty = 19, 
           pcol = rgb(red = 51/255, green = 0/255, blue = 255/255, alpha = 1.0), 
           plty = 1, 
           plwd = 2, 
           #pdensity = 10, 
           #pangle = 60, 
           pfcol = rgb(red = 51/255, green = 0/255, blue = 255/255, alpha = 0.2), 
           cglty = 1, 
           cglwd = 2, 
           cglcol = 'grey80', 
           axislabcol = 'grey30', 
           title = str_c(compNm, '의 평균 별점'), 
           vlcex = 1.2, 
           caxislabels = seq(from = 1, to = 5, by = 1) )

복지급여에서 가장 높은 점수를 받았고, 워라밸에서 가장 낮은 점수를 받았습니다. 여러분, 삼성이 이런 곳입니다. 개인 시간이 중요하지 않지만 높은 연봉이 중요한 사람들은 이 회사에 적극적으로 지원해보시면 될 것입니다.

그런데 재직상태별로는 어떻게 다를까요?

R 코드 보기 
# 전/현직원의 평균 별점을 비교합니다. 
dt4radar2 <- dt %>% 
  group_by(재직상태) %>% 
  dplyr::summarize(
    전체평가 = mean(별점평가),
    승진기회 = mean(승진기회),
    복지급여 = mean(복지급여), 
    워라밸 = mean(워라밸), 
    사내문화 = mean(사내문화), 
    경영진 = mean(경영진)) %>% 
  as.data.frame() 

# 별점 평균을 확인합니다. 
print(x = dt4radar2)

##   재직상태 전체평가 승진기회 복지급여   워라밸 사내문화   경영진
## 1   전직원 3.237410 3.064748 4.028777 2.323741 2.985612 2.848921
## 2   현직원 3.464286 3.407143 4.200000 2.571429 3.185714 3.035714
R 코드 보기 
# 재직상태별 테두리와 채우기 색을 설정합니다. 
colorLines <- c(rgb(red = 255/255, green = 0/255, blue = 0/255, alpha = 1.0), 
                rgb(red = 51/255, green = 0/255, blue = 255/255, alpha = 1.0))

colorFills <- c(rgb(red = 255/255, green = 0/255, blue = 0/255, alpha = 0.2), 
                rgb(red = 51/255, green = 0/255, blue = 255/255, alpha = 0.2))

# 재직상태별 레이터 그래프를 하나의 하나의 그래프로 그립니다. 
radarchart(df = rbind(5, 1, dt4radar2[, 2:7]),
           axistype = 1,
           seg = 4, 
           pty = 19, 
           pcol = colorLines, 
           plty = 1, 
           plwd = 2, 
           #pdensity = 10, 
           #pangle = 60, 
           pfcol = colorFills, 
           cglty = 1, 
           cglwd = 2, 
           cglcol = 'grey80', 
           axislabcol = 'grey30', 
           title = '재직상태별 평균 별점 비교',
           vlcex = 1.2,
           caxislabels = seq(from = 1, to = 5, by = 1) )

# 범주를 추가합니다. 
legend(x = 0.8,
       y = 1.4,
       legend = dt4radar2$재직상태,
       bty = 'n',
       pch = 20,
       col = colorLines,
       text.col = 'grey30',
       cex = 1,
       pt.cex = 2)

전직원은 빨간색, 현직원은 파란색(더 정확하게는 삼성블루)으로 표시해봤습니다. 전체 항목에서 현직원이 전직원보다 후한 평점을 부여한 것으로 보입니다. 다만 항목별로 차이가 나는 부분이 보이는데요. 승진기회와 워라밸에서 차이가 컸습니다. 반대로 복지급여는 가장 차이가 작네요. 복지제도와 연봉 수준이 정말 높은가 봅니다. 제 기억으로도 돈을 많이 받았던 것 같습니다.

탐색적 데이터 분석은 이 정도로 마치고 추천에 영향을 주는 변수들은 무엇인지 분류모형을 적합해보도록 하겠습니다.

의사결정나무를 활용한 추천모형

의사결정나무는 분류모형을 만드는 데 많이 사용되는 알고리즘입니다. 현업 분석가들이 가장 애용하는 알고리즘 중 하나죠. 만들기 쉽고 활용하기 쉽기 때문입니다.

분석 모델링을 하기에 앞서 전체 데이터를 70%대 30%으로 샘플링해서 각각 훈련셋(training set)과 시험셋(test set)으로 분할하도록 하겠습니다. 사실 이 정도로 데이터의 규모가 작을 때는 교차 검증(Cross validation)을 하는 편이 낫습니다만, 이번 포스팅에서는 편의상 자료분할 검증(Hold-out validation) 방법을 사용하겠습니다. 별도로 검증셋(validation set)은 만들지 않았습니다.

R 코드 보기 
# 필요한 컬럼만 선택하여 데이터셋을 생성합니다. 
dt <- dt %>% select(c('승진기회', '복지급여', '워라밸', '사내문화', '경영진', '추천여부'))

# 재현 가능하도록 시드를 생성합니다. 
set.seed(seed = 123)

# 전체 데이터를 임의로 샘플링하기 위해 다음과 같이 처리합니다. 
# 훈련셋을 70%, 시험셋을 30%로 할당합니다. 
idx <- sample(x = 2, size = nrow(x = dt), prob = c(0.7, 0.3), replace = TRUE)

# idx가 1일 때 훈련셋(trset), 2일 때 시험셋(teset)에 할당됩니다.
trset <- dt[idx == 1, ]
teset <- dt[idx == 2, ]

cat('The number of trset is', nrow(x = trset), '!\n')

## The number of trset is 201 !
R 코드 보기 
cat('The number of teset is', nrow(x = teset), '!\n')

## The number of teset is 78 !
R 코드 보기 
# 훈련용, 시험용 데이터셋의 목표변수 비중을 확인합니다.
rbind(dt$추천여부 %>% table() %>% prop.table() %>% t(), 
      trset$추천여부 %>% table() %>% prop.table() %>% t(), 
      teset$추천여부 %>% table() %>% prop.table() %>% t()) %>% 
  `*`(100) %>% 
  round(digits = 2L) %>% 
  set_rownames(c('전체', '훈련셋', '시험셋')) %>% 
  print()

##         비추  추천
## 전체   41.58 58.42
## 훈련셋 41.29 58.71
## 시험셋 42.31 57.69

목표변수를 추천여부로 설정하고, 전체 데이터와 훈련셋 및 시험셋의 빈도를 확인해보니 치우침없이 샘플링이 된 것 같습니다. 이제 이 데이터셋으로 모형을 적합하고 분류 성능을 확인하겠습니다.

가지치기 전 나무모형

의사결정나무는 이상치에 영향을 받지 않고 비모수적 알고리즘이라 쉽게 만들 수 있다는 장점이 있지만 과적합되기 쉽다는 단점이 있습니다. 따라서 초기 모형을 적합한 다음 비용복잡도 기준으로 가지치기를 실시해야 합니다. 일단 초기 모형을 적합하기 위해 순수도 계산 기준으로 gini index를 사용하였습니다.

R 코드 보기 
# 필요한 패키지를 불러옵니다. 
library(rpart)
library(rpart.plot)
library(caret)
R 코드 보기 
# 의사결정나무 알고리즘을 이용하여 추천 분류모형을 적합합니다. 
fit <- rpart(formula = 추천여부 ~ ., 
             data = trset, 
             method = 'class', 
             parms = list(split = 'gini'),
             control = rpart.control(
               minsplit = 20, 
               cp = 0.01, 
               maxdepth = 10))

# 그래픽 파라미터를 설정합니다. 
par(mfrow = c(1, 1), mar = c(5, 4, 4, 2), family = 'NanumGothic')

# 나무모형을 출력합니다.
print(x = fit)

## n= 201 
## 
## node), split, n, loss, yval, (yprob)
##       * denotes terminal node
## 
##   1) root 201 83 추천 (0.41293532 0.58706468)  
##     2) 사내문화< 2.5 56 15 비추 (0.73214286 0.26785714)  
##       4) 경영진< 1.5 15  0 비추 (1.00000000 0.00000000) *
##       5) 경영진>=1.5 41 15 비추 (0.63414634 0.36585366)  
##        10) 승진기회< 3.5 33 10 비추 (0.69696970 0.30303030) *
##        11) 승진기회>=3.5 8  3 추천 (0.37500000 0.62500000) *
##     3) 사내문화>=2.5 145 42 추천 (0.28965517 0.71034483)  
##       6) 경영진< 3.5 93 36 추천 (0.38709677 0.61290323)  
##        12) 워라밸< 1.5 20  8 비추 (0.60000000 0.40000000) *
##        13) 워라밸>=1.5 73 24 추천 (0.32876712 0.67123288)  
##          26) 승진기회< 3.5 51 22 추천 (0.43137255 0.56862745)  
##            52) 승진기회< 2.5 13  5 비추 (0.61538462 0.38461538) *
##            53) 승진기회>=2.5 38 14 추천 (0.36842105 0.63157895)  
##             106) 경영진< 2.5 9  4 비추 (0.55555556 0.44444444) *
##             107) 경영진>=2.5 29  9 추천 (0.31034483 0.68965517) *
##          27) 승진기회>=3.5 22  2 추천 (0.09090909 0.90909091) *
##       7) 경영진>=3.5 52  6 추천 (0.11538462 0.88461538) *
R 코드 보기 
rpart.plot(x = fit, main = '가지치기 전 추천모형')

나무모형 그래프를 살펴보니, 가장 최상위 노드를 보면 추천 비중이 59%이고 전체 훈련셋의 100%가 이 노드에 속해 있습니다. 끝 노드가 모두 9개였는데 추천 비중이 0%에서 91%까지 다양했습니다. 가장 처음 분리에 사용된 입력변수는 사내문화로 1~2점을 부여한 회원의 27%만 추천한 반면, 3점 이상 부여한 회원은 71%가 추천하였습니다. 다음으로 사용된 입력변수는 경영진으로 1점을 부여한 회원은 삼성화재를 추천하지 않았습니다. 아마도 경영진에 대한 실망이 상당히 컸나 봅니다. 계속해서, 경영진에 대한 평가가 2점 이상인 회원 중 승진기회가 3점 이하인 경우 30%가 추천한 반면 4점 이상인 경우 평균보다 높은 62%가 추천하였습니다. 승진기회가 높다고 판단한 회원은 삼성화재에서 잘나가는 임직원인가 봅니다.

사내문화에 대한 별점이 3점 이상이고 경영진에 대한 별점이 4점 이상인 경우, 88%가 삼성화재를 추천했습니다. 이 회사가 군대문화로 유명한데 이 그룹에 속하는 회원들은 좀 독특한 것 같습니다. 실제로 의사결정나무 알고리즘을 이용하여 고객 세분화에도 사용하니까 비슷한 성향을 갖는 회원들이 모여있다고 봐도 무방하겠습니다.

이제 가지치기를 해보겠습니다. 가지치기는 비용복잡도(Cost complexity)를 기준으로 xerror가 가장 낮을 때의 파라미터(cp)를 이용합니다.

R 코드 보기 
# 비용복잡도(Cost Complexity) 표를 출력합니다. 
printcp(x = fit)

## 
## Classification tree:
## rpart(formula = 추천여부 ~ ., data = trset, method = "class", 
##     parms = list(split = "gini"), control = rpart.control(minsplit = 20, 
##         cp = 0.01, maxdepth = 10))
## 
## Variables actually used in tree construction:
## [1] 경영진   사내문화 승진기회 워라밸  
## 
## Root node error: 83/201 = 0.41294
## 
## n= 201 
## 
##         CP nsplit rel error  xerror     xstd
## 1 0.313253      0   1.00000 1.00000 0.084102
## 2 0.024096      1   0.68675 0.75904 0.079238
## 3 0.018072      3   0.63855 0.77108 0.079575
## 4 0.012048      5   0.60241 0.74699 0.078891
## 5 0.010000      8   0.56627 0.74699 0.078891
R 코드 보기 
# 교차확인 상대오차 도표를 확인합니다. 
plotcp(x = fit)
abline(h = fit$cptable[, 'xerror'] %>% min(), col = 'red', lty = 2)

R 코드 보기 
# xerror이 가장 낮을 때의 비용복잡도 파라미터를 구합니다. 
bestCP <- fit$cptable[which.min(fit$cptable[ , 'xerror']), 'CP']

# 가지치기(pruning)를 합니다. 
prn <- prune.rpart(tree = fit, cp = bestCP)

# 가지치기 후 나무모양을 출력합니다.
print(x = prn)

## n= 201 
## 
## node), split, n, loss, yval, (yprob)
##       * denotes terminal node
## 
##  1) root 201 83 추천 (0.41293532 0.58706468)  
##    2) 사내문화< 2.5 56 15 비추 (0.73214286 0.26785714) *
##    3) 사내문화>=2.5 145 42 추천 (0.28965517 0.71034483)  
##      6) 경영진< 3.5 93 36 추천 (0.38709677 0.61290323)  
##       12) 워라밸< 1.5 20  8 비추 (0.60000000 0.40000000) *
##       13) 워라밸>=1.5 73 24 추천 (0.32876712 0.67123288)  
##         26) 승진기회< 3.5 51 22 추천 (0.43137255 0.56862745)  
##           52) 승진기회< 2.5 13  5 비추 (0.61538462 0.38461538) *
##           53) 승진기회>=2.5 38 14 추천 (0.36842105 0.63157895) *
##         27) 승진기회>=3.5 22  2 추천 (0.09090909 0.90909091) *
##      7) 경영진>=3.5 52  6 추천 (0.11538462 0.88461538) *
R 코드 보기 
rpart.plot(x = prn, main = '가지치기 후 추천모형')

가지치기를 하고 나니 끝 노드의 수가 6개로 줄었습니다. 가지치기를 하고 나면 나무모형이 간결해지고 과적합 위험이 감소하는 효과가 있습니다. 가지치기 후 추천모형을 살펴보면, 사내문화가 가장 먼저 사용되었고 다음으로 경영진과 워라밸이 뒤를 이었습니다. 이는 무엇을 의미할까요? 제 생각에는 회사마다 고유한 기업문화를 가지고 있는데, 그 기업문화에 적응하는 사람과 그렇지 못한 사람들의 평가가 가장 극명하게 갈린다고 판단됩니다. 대기업에 다니는 임직원 입장에서는, 회사의 조직문화에 익숙해지려고 노력해야 할 것입니다. 회사 입장에서는 슈퍼 갑 행세를 할 수 있을테니 임직원 개개인이 조직문화에 적응을 하든지 말든지 크게 개의치 않을 것 같구요. 물론 개인의 역량이 아주 뛰어난 임직원이라면 어떨까요? 그래도 별로 상관 안할 것 같아요. 워낙에 큰 회사라 말이죠.

분류모형의 성능 평가

마지막으로 분류모형의 성능을 평가하는 과정을 진행해보겠습니다. 방금 우리가 만든 추천모형에 시험셋을 할당하여 추정값을 계산해냅니다. 그리고 시험셋의 실제값과 추정값으로 분류모형의 성능을 평가할 수 있는데요. 크게 3가지 방법이 사용됩니다.

혼동행렬(Confusion Matrix)을 이용한 성능 평가

R 코드 보기 
# 실제값을 지정합니다. 
real <- teset$추천여부

# 시험셋으로 추정값을 생성합니다. 
pred <- predict(object = prn, newdata = teset, type = 'class')

# 혼동행렬을 사용하여 모형의 분류 성능을 파악합니다. 
confusionMatrix(data = pred, reference = real, positive = '추천')

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction 비추 추천
##       비추   18    8
##       추천   15   37
##                                          
##                Accuracy : 0.7051         
##                  95% CI : (0.5911, 0.803)
##     No Information Rate : 0.5769         
##     P-Value [Acc > NIR] : 0.01356        
##                                          
##                   Kappa : 0.3784         
##  Mcnemar's Test P-Value : 0.21090        
##                                          
##             Sensitivity : 0.8222         
##             Specificity : 0.5455         
##          Pos Pred Value : 0.7115         
##          Neg Pred Value : 0.6923         
##              Prevalence : 0.5769         
##          Detection Rate : 0.4744         
##    Detection Prevalence : 0.6667         
##       Balanced Accuracy : 0.6838         
##                                          
##        'Positive' Class : 추천           
##

혼동행렬의 결과로 여러 숫자가 어지럽게 출력되었습니다만, 우리가 주목해야 할 점은 민감도(Sensitivity)와 특이도(Specificity), 그리고 정밀도(Pos Pred Value)입니다. 민감도는 실제값이 Postive인 것 중 추정값이 Positive인 비율이고, 반대로 특이도는 실제값이 Negative인 것 중 추정값이 Negative인 비율입니다. 정밀도는 추정값이 Positive인 것 중 실제값이 Positive인 것인데요. 혼동행렬에 대해서 궁금하신 분은 따로 공부를 하셔야 할 것입니다.

여기에서 다룰 내용은 이 세 가지 값이 클수록 좋다는 것입니다. 만약 여러 알고리즘을 사용하고, 변수 선택을 다르게 하여 다수의 모형을 만들었을 때 세 가지 값을 비교해야 하는데요. 그럴 때 어떤 기준으로 하면 좋을지 혼동이 될 수가 있습니다. (그래서 혼동행렬인가요???)

이런 경우, F1 점수나 AUROC값을 활용하면 됩니다. 둘 다 0에서 1 사이의 값을 갖습니다.

F1 점수는 민감도와 정밀도의 조화평균 값입니다. 두 가지 모두 커야 이 값이 커집니다. 조화평균은 속도의 평균을 생각하시면 됩니다.

R 코드 보기 
# 필요한 패키지를 불러옵니다. 
library(MLmetrics)
R 코드 보기 
# F1 score를 확인합니다. 
cat('F1 score :', F1_Score(y_true = real, y_pred = pred, positive = '추천'), '\n')

## F1 score : 0.7628866

F1 점수가 0.7628866이면 분류 성능이 우수하다고 할 수 없습니다. 데이터의 한계라고 생각됩니다.

다음으로 AUROC를 확인해보겠습니다. AUROC는 ROC 커브의 아래 면적을 의미합니다. ROC 커브는 민감도와 1-특이도를 양 축으로 하여 그린 그래프입니다. 두 가지 값이 클수록 왼쪽 상단 모서리에 가까운 그래프가 그려지고, AUROC가 1에 가까운 값을 가지게 됩니다. 그림으로 확인하시죠.

R 코드 보기 
# ROC curve와 AUROC에 필요한 패키지를 불러옵니다. 
library(ROCR)
library(pROC)
R 코드 보기 
# ROC 커브를 그려서 분류 성능을 확인합니다.
# 추정값 및 실제값이 범주형인 경우, 숫자 벡터로 변환합니다. 
predObj <- prediction(predictions = pred %>% as.numeric(), 
                      labels = real %>% as.numeric())

# prediction 객체를 활용하여 performance 객체를 생성합니다. 
perform <- performance(prediction.obj = predObj, measure = 'tpr', x.measure = 'fpr')

# ROC 커브를 그립니다.
plot(x = perform, main = str_c('[ROC & AUROC] ', compNm))

# 왼쪽 아래 모서리에서 오른쪽 위 모서리를 잇는 대각선을 추가합니다. 
lines(x = c(0, 1), y = c(0, 1), col = 'red', lty = 2)

# AUROC를 계산하고 ROC 커브 위에 출력합니다.
auroc <- auc(response = real %>% as.numeric(), 
             predictor = pred %>% as.numeric()) %>% 
  round(digits = 4L)
text(x = 0.9, y = 0, labels = str_c('AUROC : ', auroc), col = 'red')

R 코드 보기 
print(x = auroc)

## [1] 0.6838

ROC 커브의 모양도 그렇고 AUROC 값도 0.6838로 크게 낮습니다. 다른 변수를 추가할 수 있으면 좋을 것 같습니다. 예를 들어, 인사팀 직원 여부라든가 실제로 근무했는지 여부를 알 수 있다면 어떤 결과가 나올지 궁금합니다.

혹시 재직상태별로 모형을 나누어 적합해보면 어떨까요? 사실 우리는 맨 처음에 카이제곱 검정을 통해 재직상태와 추천여부에 영향을 주지 않는다는 것을 확인했습니다. 그래도 학습을 위해 한 번 해보시는 건 어떨까요?

이번 포스팅은 이걸로 마무리하겠습니다. 읽어주셔서 감사합니다!

]]>나성호 (Seongho Na)기업리뷰 수집2018-10-25T00:00:00+00:002026-06-24T00:00:00+00:00https://www.hds.ai.kr/posts/jobplanet-review-1

이 글은 2018년 강의 노트를 옮긴 것입니다. 방법론과 결과 그래프 중심으로 정리했으며, R 코드는 접어 두었습니다(펼쳐서 볼 수 있습니다). 잡플래닛 사이트 구조가 바뀌어 수집 코드는 현재 그대로는 동작하지 않을 수 있습니다.

여러분은 취업에 대한 관심이 상당히 많을 것이라 생각합니다. 저는 여러 대기업 금융회사에서만 16년 넘게 근무했습니다. 여러분 입장에서는 대기업 금융회사가 겉으로 보기에는 아주 좋은 직장일 것이라 생각할 것 같습니다. 저도 대학원을 졸업하고 취업을 준비하던 시기에 삼성 금융계열사에서 돈을 많이 준다는 말에 솔깃했으니까요.

그런데 제가 직장생활을 해보니 좋은 회사, 나쁜 회사로 구분하는 것보다는 나와 맞는 회사와 맞지 않는 회사로 구분하는 편이 낫겠다는 생각을 가지게 되었습니다. 크게 3가지로 구분하자면, 회사의 조직문화와 담당하게 될 직무, 그리고 함께 일하게 될 동료(라고 쓰여 있지만 직장상사로 바꿔 읽으면 됩니다).

취업을 할 때 담당할 직무가 결정되어 있을 수도 있지만 그렇지 않은 경우도 많을 것입니다. 하지만 함께 일할 동료는 여러분이 전혀 알 수가 없겠죠? 어렵사리 취업을 했는데 막상 회사를 다녀봐야 자신과 맞는지 안맞는지 그 때 가서야 알 수 있을 겁니다. 주변의 사람들, 그러니까 학교 선배나 어른들 말씀을 들어보면 제각각일 가능성이 높습니다. 그 이유는 각자가 경험한 내용이 제각각이기 때문입니다. 제가 여러분께 드리는 이 말씀도 마찬가지구요.

결국 여러분은 제한된 정보만을 가지고 취업 시장에 문을 두드려야 할 것입니다. 그나마 회사만 겨우 선택할 수 있을지도 모릅니다. 왜냐하면 회사에 입사한 이후에 담당하게 될 직무가 결정될 수 있고 함께 일할 사수는 물론, 과장님, 차장님, 부장님 등 선배 동료들이 어떤 분들일지는 그야말로 며느리도 모르는 상황이 될 것이기 때문입니다.

그래서 자신이 관심있는 회사가 있다면, 그 회사를 미리 경험했던 인생 선배들의 주관적인 기업리뷰를 수집해서 분석해보는 건 어떨까요? 조금이나마 도움이 되지 않을까요? 아무튼 오늘 제가 여러분께 드릴 수 있는 것은 특정 회사에 대한 리뷰를 어떻게 분석하면 좋을지에 대하여 제 나름의 방법을 제시하는 것입니다. 제가 소개하는 방법은 절대로 정답이 아니니 여러분께서 원하는 내용을 추가하시면 더욱 훌륭한 분석 결과가 될 겁니다. 그럼 시작해볼까요?

데이터 수집

데이터 분석에서 가장 중요한 것은 데이터입니다. 양질의 데이터면 좋겠죠? 일단 품질을 알 수 없으니 그 점은 차치하고 온라인 상에서 수집할 수 있는 기업리뷰를 찾아보도록 합시다. 다행하게도 잡플래닛이라는 스타트업이 기업리뷰를 공유하고 있습니다. 사실 이 데이터의 품질에 문제를 제기하는 사람들이 좀 있습니다. 예를 들어, 기업리뷰를 남기는 회원이 그 회사에서 근무한 경험이 있는지 확인하는 절차를 거치지 않는다는 것이 있구요. 또 다른 하나는 인사팀 직원이 긍정적인 리뷰를 남기는 리스크도 있다는 것입니다. 하지만 대수의 법칙을 믿어봅시다. 비록 주관적이지만 여러 회원이 작성한 기업리뷰에는 공통점이 있을테니까요.

우리는 잡플래닛의 기업리뷰 데이터를 수집할 것입니다. 그런데 한 가지 문제가 더 있습니다. 잡플래닛은 어떤 회사에 대한 기업리뷰를 작성한 회원에게만 다른 회사의 기업리뷰를 조회할 수 있도록 한다는 것입니다. 그러므로 기업리뷰를 조회하려면 로그인을 한 상태여야 합니다. 로그인을 한 상태로 웹 크롤링하는 방법은 크게 2가지가 있는데 하나는 쿠키를 이용하는 것이고, 또 다른 하나는 RSelenium을 이용하는 것입니다. 이번 프로젝트에서는 쿠키를 이용하는 방법을 사용할 것입니다. 저의 아이디와 비밀번호로 쿠키를 얻을 것인데요. 당연하게도 저의 로그인 정보는 공개하지 않을 것이므로 만약 여러분게서 이 포스팅을 스스로 따라해보려고 한다면 잡플래닛에 회원가입을 하시고, 기업리뷰를 작성한 후에 하시기 바랍니다.

크롬 개발자도구를 활용하여 HTTP 요청 정보 확인하기

잡플래닛에 접속하면 다음과 같이 메인 화면이 열립니다.

아직 로그인하기 전이므로 오른쪽 상단에 로그인이라는 메뉴가 보입니다. 로그인 메뉴를 클릭해서 로그인 화면이 열리면 크롬 개발자도구를 엽니다. 화면 아무 곳에서나 마우스 오른쪽 버튼을 누르면 메뉴 팝업이 뜨는데 그 중 하단의 검사(Inspect)를 클릭하면 크롬 개발자도구가 열립니다. Network 탭으로 이동한 다음 Preserve log 앞에 있는 라디오버튼을 체크하면 로그인할 준비가 끝났습니다. 이 작업을 하는 이유는, 로그인이 진행될 때 어떤 과정을 거치는지 확인하기 위함입니다. 이제 아이디와 비밀번호를 입력해서 로그인합니다. 그러면 크롬 개발자도구에서 아래와 같은 내용이 보일 것입니다.

화면 하단에서 Name의 첫 번째 항목이 Sign_in이며, POST 방식으로 HTTP 요청을 하였습니다. 주의하셔야 할 점은 로그인하기 전에 Preserve log 버튼을 체크하지 않으면 이 내용이 보이지 않습니다. 이제 Sign_in 항목을 클릭하여 상세내용을 확인해볼까요?

Headers탭에는 크게 4가지가 보이는데요. 가장 처음 항목인 General은 HTTP 요청과 응답에서 공통으로 사용되는 내용이 보입니다. 우리는 여기에서 Request URL만 복사할 것입니다. 그리고 마우스로 화면을 맨 마지막으로 이동시킵니다. Request Payload에서 우리가 로그인할 때 사용한 아이디와 비밀번호가 보입니다. 즉, HTTP 요청을 할 때 email과 password의 인자로 아이디와 비밀번호를 지정해주는 것입니다.

여기까지 잘 따라왔나요? 이제 HTTP 요청을 할 때 로그인 정보를 함께 보낸 후 쿠키를 얻을 준비 과정이 끝났습니다. 이 쿠키를 이용하면 로그인 상태로 웹 페이지 이동이 가능하므로 기업리뷰 데이터를 수집할 수 있게 됩니다. 그런데 만약 여러분이 웹 크롤링 경험이 없거나 익숙하지 않다면 지금까지의 설명을 전혀 이해하지 못할 수 있습니다. 웹 크롤링은 관련 내용에 대한 공부도 필요하지만 경험도 필요하기 때문입니다. 이번 기회로 웹 크롤링에 관심이 생겼다면 공부해보시기 바랍니다.

이제 R코드를 이용하여 웹 데이터를 수집해보겠습니다.

R 코드 보기 
# 필요한 라이브러리를 불러옵니다. 
library(httr)
library(rvest)
library(tidyverse)
R 코드 보기 
# 로그인 화면의 URI를 복사하여 URI 객체에 지정합니다.
URI <- 'https://www.jobplanet.co.kr/users/sign_in'
R 코드 보기 
# 로그인 정보를 이용하여 HTTP 요청을 합니다. 
resp <- POST(url = URI,
             body = list('user[email]' = '본인의 아이디를 입력합니다',
                         'user[password]' = '본인의 비밀번호를 입력합니다'))
R 코드 보기 
# 응답 상태코드를 확인합니다. 200이면 정상입니다.
status_code(x = resp)

## [1] 200
R 코드 보기 
# 쿠키만 수집하여 myCookies 객체에 할당합니다. 
# 앞으로 HTTP 요청할 때 myCookies를 활용하면 로그인 상태로 HTML을 받을 수 있습니다. 
myCookies <- set_cookies(.cookies = unlist(x = cookies(x = resp)))

참고로 myCookies는 결과가 출력되지 않도록 설정했습니다. 실습을 하면서 직접 확인하시기 바랍니다.

특정 회사의 기업리뷰 수집하기

여러분은 어떤 회사에 대해 관심이 많은가요? 이번 예제에서는 저의 첫 번째 직장인 삼성화재로 정했습니다. 잡플래닛 메인 페이지에서 탐색창에 삼성화재를 조회해보면 다음과 같은 화면이 열립니다.

화면 상단에 회사 아이콘이 4개 보입니다. 그 중에서 첫 번째 아이콘을 클릭하면 새로운 화면이 열리면서 아래 그림과 같이 삼성화재의 기업리뷰 평균 점수를 조회할 수 있습니다.

마우스를 조금 내리면 개별 기업리뷰를 확인할 수 있습니다. 지금 보이는 이미지는 로그인하기 전의 웹 페이지이지만 만약 기업리뷰를 작성했다면 로그인했을 때 기업리뷰 텍스트 데이터가 화면에 표시됩니다.

우리는 쿠키를 가지고 있으므로 따로 로그인하지 않아도 텍스트 데이터를 수집할 수 있습니다. 이제 개별 기업리뷰 데이터를 수집에 앞서 기업리뷰 수를 가져오겠습니다.

R 코드 보기 
# 수집할 기업명을 지정합니다.
compNm <- '삼성화재해상보험'

# 잡플래닛 웹 페이지에서 삼성화재 기업리뷰를 확인할 수 있는 URI을 복사하여 붙입니다.
# 분명 웹 브라우저에서는 '삼성화재해상보험'이라고 한글로 보였을 것입니다. 
# 그런데 RStudio로 붙여넣기 하면 이상한 코드로 바뀝니다. 이것은 'URL인코딩'입니다. 
# 한글은 사람이 읽을 수 있지만 컴퓨터는 읽지 못하므로 컴퓨터가 읽을 수 있도록 변환해준 것입니다. 
URI <- 'https://www.jobplanet.co.kr/companies/30056/reviews/%EC%82%BC%EC%84%B1%ED%99%94%EC%9E%AC%ED%95%B4%EC%83%81%EB%B3%B4%ED%97%98'


# 쿠키를 이용하여 로그인 상태 가장하여 HTTP 요청을 합니다.
resp <- GET(url = URI, config = list(cookies = myCookies))

# 응답 상태코드를 확인합니다.
status_code(x = resp)

## [1] 200
R 코드 보기 
# 기업리뷰 수를 추출합니다. (2018년 10월 25일 기준 : 279건)
# 아래 코드에서 CSS Selector를 확인하려면 크롬 개발자도구를 이용해야 합니다. 
# 이 과정을 설명하려면 내용이 길어지므로 이번 포스팅에서는 생략합니다. 
reviewCnt <- resp %>% 
  read_html() %>% 
  html_nodes(css = 'li.viewReviews > a > span.num.notranslate') %>% 
  html_text() %>% 
  as.numeric()

# 결과를 출력합니다.
print(x = reviewCnt)

## [1] 279

현재 웹 브라우저에는 5개의 개별 기업리뷰가 표시되어 있을 것입니다. 이 내용을 모두 수집해보겠습니다. CSS Selector를 확인하는 방법은 생략합니다. 양해 바랍니다.

R 코드 보기 
# 잡플래닛에 저장된 회사이름을 추출합니다.
resp %>% read_html() %>% html_node(css = 'h2.tit') %>% html_text()

## [1] "삼성화재해상보험(주)"
R 코드 보기 
# 기업리뷰가 포함된 가장 상위의 HTML 요소를 지정합니다. (5개만 추출됨)
items <- resp %>% read_html() %>% html_nodes(css = 'section.content_ty4')
length(x = items)

## [1] 5
R 코드 보기 
# 회사코드와 리뷰코드를 추출합니다. (잡플래닛에서 부여)
items %>% html_attr(name = 'data-company_id')

## [1] "30056" "30056" "30056" "30056" "30056"
R 코드 보기 
items %>% html_attr(name = 'data-content_id')

## [1] "849559" "847215" "847067" "846461" "840800"
R 코드 보기 
# 개별 기업리뷰 상단에 있는 직종구분, 재직상태, 근무지역, 등록일자를 추출합니다.
items %>% html_nodes(css = 'div.content_top_ty2 span:nth-child(2)') %>% html_text()

## [1] "금융/재무" "영업/제휴" "금융/재무" "인사/총무" "IT/인터넷"
R 코드 보기 
items %>% html_nodes(css = 'div.content_top_ty2 span:nth-child(4)') %>% html_text()

## [1] "현직원" "전직원" "전직원" "전직원" "현직원"
R 코드 보기 
items %>% html_nodes(css = 'div.content_top_ty2 span:nth-child(6)') %>% html_text()

## [1] "서울" "서울" "서울" "서울" "서울"
R 코드 보기 
items %>% html_nodes(css = 'div.content_top_ty2 span.txt2') %>% html_text()

## [1] "2018/10/16" "2018/10/14" "2018/10/14" "2018/10/14" "2018/10/9"
R 코드 보기 
# 개별 기업리뷰 왼쪽에 있는 별점(총점, 승진기회, 복지급여, 워라밸, 사내문화, 경영진)을 추출합니다.
# 꺽쇠 사이에 텍스트로 존재하는 대신 HTML 요소의 속성값으로 존재하고 있으며, 
# 'width:100%'와 같은 형태이므로 나중에 정규식을 활용하여 숫자만 추출해야 합니다.
items %>% html_nodes(css = 'div.star_score') %>% html_attr(name = 'style')

## [1] "width:80%;"  "width:20%;"  "width:60%;"  "width:100%;" "width:80%;"
R 코드 보기 
items %>% html_nodes(css = 'dl dd:nth-child(3) div div') %>% html_attr(name = 'style')

## [1] "width:80%;" "width:60%;" "width:40%;" "width:80%;" "width:80%;"
R 코드 보기 
items %>% html_nodes(css = 'dl dd:nth-child(5) div div') %>% html_attr(name = 'style')

## [1] "width:100%;" "width:100%;" "width:80%;"  "width:100%;" "width:100%;"
R 코드 보기 
items %>% html_nodes(css = 'dl dd:nth-child(7) div div') %>% html_attr(name = 'style')

## [1] "width:60%;" "width:20%;" "width:40%;" "width:80%;" "width:80%;"
R 코드 보기 
items %>% html_nodes(css = 'dl dd:nth-child(9) div div') %>% html_attr(name = 'style')

## [1] "width:80%;"  "width:20%;"  "width:60%;"  "width:100%;" "width:80%;"
R 코드 보기 
items %>% html_nodes(css = 'dl dd:nth-child(11) div div') %>% html_attr(name = 'style')

## [1] "width:80%;"  "width:20%;"  "width:60%;"  "width:100%;" "width:80%;"
R 코드 보기 
# 개별 기업리뷰 오른쪽에 있는 내용(장점, 단점, 바라는점, 성장예상, 추천여부)을 추출합니다.
items %>% html_nodes(css = 'dl dd:nth-child(2) span') %>% html_text()

## [1] "그룹 인센티브(흔히 PS) 포함하면 꽤 많은 급여. 네임밸류"                                                 
## [2] "연봉은 정말 많이 준다... 연봉이 1순위이며 자기생활은 주오오하지 않은 사람에게 최고의 회사"              
## [3] "무엇보다 연봉과 복지등이 장점 이외의 것은 모르겠다..."                                                  
## [4] "본사의 위치가 좋아서 교통이 편하고직원들의 충성도가 높아서 같이 일하는 사람으로서 일할 맛이 났었습니다."
## [5] "보험기업 선두주자이며 복지와 급여가 상당히 만족스럽습니다."
R 코드 보기 
items %>% html_nodes(css = 'dl dd:nth-child(4) span') %>% html_text()

## [1] "단기 목표 지향적인 문화. 선진 외국 기업의 겉만 따라하려는 문화."                                                                                   
## [2] "영업쪽은 정말 자기 인생이 1도 없다. 야근이 없는 날이 드물며 실적 스트레스도 상당한편"                                                              
## [3] "승진은 역시나 힘들고 매우 잦은 야근과 조직문화가 딱딱함"                                                                                           
## [4] "구내식당 줄이 너무 길어서 밥을 먹을 때 기다렸다가 먹어야 하는 단점이 있습니다.업무 분담이 너무 확실해서 일이 조금 더디게 진행되는 부분이 있습니다."
## [5] "보수적인 분위기, MS 비율 하락되어 시장 경쟁력 확보 필요가 시급합니다."
R 코드 보기 
items %>% html_nodes(css = 'dl dd:nth-child(6) span') %>% html_text()

## [1] "임원분들의 계약기간때문에 장기적인 목표를 가져갈 수 없다는 현실은 이해하지만, 이를 보완할수있는 체계가 마련되어 더 발전했으면" 
## [2] "지점 실적을 줄이거나, 업무강도를 낮춰줘야한다"                                                                                 
## [3] "조직문화를 좀 더 유연하게 만들었으면 좋겠다고 생각함."                                                                         
## [4] "직원들과 대화 나누는 시간이나 직원 가족과 만남을 가져서 대기업이지만 개개인이 아닌 전체 직원이 하나된 마음이 될 수 있었습니다."
## [5] "1위 기업 유지하기 위해 많은 노력과 시장조사가 필요합니다."
R 코드 보기 
items %>% html_nodes(css = 'p.etc_box strong') %>% html_text()

## [1] "비슷" "비슷" "성장" "성장" "비슷"
R 코드 보기 
items %>% html_nodes(css = 'p.txt.recommend.etc_box') %>% html_text()

## [1] "이 기업을 추천 합니다!"       "이 기업을 추천하지 않습니다."
## [3] "이 기업을 추천 합니다!"       "이 기업을 추천 합니다!"      
## [5] "이 기업을 추천 합니다!"

이렇게 하면 한 페이지당 5개씩 보이는 기업리뷰를 빠짐없이 수집할 수 있습니다. 그런데 현재 등록된 기업리뷰는 모두 279건이므로 모든 기업리뷰를 수집하려면 페이지 네비게이션을 활용해야 합니다. 마우스를 이용하여 화면을 가장 아래로 내리면 1부터 5까지 숫자가 적힌 메뉴가 보일 것입니다. 그 중에서 2를 클릭해보면 URI가 바뀌어 있을 것입니다. 3도 누르고 4도 눌러보세요. 어떤 패턴이 보이죠? 아마 R 코드를 작성해 본 경험이 많은 분이라면 for() 함수를 이용하여 반복문을 만들어야 된다는 것을 짐작했을 것입니다. 그리고 HTTP 요청 과정에서 URI를 조금씩 바꿔주면 됩니다.

사용자 정의 함수 만들기

반복문을 사용하기 전에 데이터 수집 과정에서 반복되는 부분을 좀 더 간단하게 처리할 수 있도록 사용자 정의 함수를 3개 생성하겠습니다. 별로 어렵지 않습니다.

R 코드 보기 
# CSS Selector로 텍스트만 수집하는 함수를 생성합니다.
getHtmlText <- function(x, css) {
  
  result <- x %>% 
    html_node(css = css) %>% 
    html_text()
  
  return(result)
}


# CSS Selector로 별점을 수집하는 함수를 생성합니다.
getHtmlRate <- function(x, css, name) {
  
  result <- x %>% 
    html_node(css = css) %>% 
    html_attr(name = name) %>% 
    str_remove_all(pattern = '(width:)|(%;)') %>% 
    as.numeric()
  
  return(result)
}


# 개별 기업리뷰를 수집하고 데이터 프레임으로 반환하는 함수를 생성합니다.
getData <- function(x) {
  
  # 기업리뷰를 포함하는 HTML 요소를 추출하여 items 객체에 할당합니다.
  items <- x %>% read_html() %>% html_nodes(css = 'section.content_ty4')
  
  # 웹 데이터를 수집하여 df 객체에 할당합니다. 
  df <- 
    data.frame(
      회사이름 = x %>% read_html() %>% html_node(css = 'h2.tit') %>% html_text(),
      회사코드 = items %>% html_attr(name = 'data-company_id'),
      리뷰코드 = items %>% html_attr(name = 'data-content_id'),
      직종구분 = getHtmlText(x = items, css = 'div.content_top_ty2 span:nth-child(2)'),
      재직상태 = getHtmlText(x = items, css = 'div.content_top_ty2 span:nth-child(4)'),
      근무지역 = getHtmlText(x = items, css = 'div.content_top_ty2 span:nth-child(6)'),
      등록일자 = getHtmlText(x = items, css = 'div.content_top_ty2 span.txt2'),
      별점평가 = getHtmlRate(x = items, css = 'div.star_score', name = 'style'),
      승진기회 = getHtmlRate(x = items, css = 'dl dd:nth-child(3) div div', name = 'style'),
      복지급여 = getHtmlRate(x = items, css = 'dl dd:nth-child(5) div div', name = 'style'),
      워라밸   = getHtmlRate(x = items, css = 'dl dd:nth-child(7) div div', name = 'style'),
      사내문화 = getHtmlRate(x = items, css = 'dl dd:nth-child(9) div div', name = 'style'),
      경영진   = getHtmlRate(x = items, css = 'dl dd:nth-child(11) div div', name = 'style'),
      기업장점 = getHtmlText(x = items, css = 'dl dd:nth-child(2) span'),
      기업단점 = getHtmlText(x = items, css = 'dl dd:nth-child(4) span'),
      바라는점 = getHtmlText(x = items, css = 'dl dd:nth-child(6) span'),
      성장예상 = getHtmlText(x = items, css = 'p.etc_box strong'),
      추천여부 = getHtmlText(x = items, css = 'p.txt.recommend.etc_box')
    )
  
  return(df)
}

첫 번째 사용자 정의 함수는 CSS Selector 기준으로 HTML 요소를 찾고 여는 태그와 닫는 태그 사이에 있는 텍스트만 수집하는 기능을 합니다. 두 번째 사용자 정의 함수는 별점을 수집하기 위해 만든 것인데 HTML 요소의 속성명을 기준으로 속성값을 반환하는 함수입니다. 마지막 사용자 정의 함수는 개별 기업리뷰를 수집하여 데이터 프레임으로 반환하는 함수입니다. 3개의 사용자 정의 함수를 만들지 않고도 반복문을 만들 수 있지만 가독성이 떨어질 수 있습니다. 반면 사용자 정의 함수를 사용하면 반복문이 깔끔해집니다.

반복문으로 전체 데이터 수집하기

R 코드 보기 
# 총 페이지 수 계산하고 그 결과를 출력합니다. 
pages <- ceiling(x = reviewCnt / 5)
print(x = pages)

## [1] 56

모두 56 페이지를 수집하면 될 것입니다. 반복문 실행에 앞서 첫 번째 페이지의 5개를 저장하여 최종 데이터 객체를 생성합니다.

R 코드 보기 
# 결과를 저장할 객체 생성
result <- getData(x = resp)

# result 객체를 출력합니다. 
print(x = result)

##               회사이름 회사코드 리뷰코드  직종구분 재직상태 근무지역
## 1 삼성화재해상보험(주)    30056   849559 금융/재무   현직원     서울
## 2 삼성화재해상보험(주)    30056   847215 영업/제휴   전직원     서울
## 3 삼성화재해상보험(주)    30056   847067 금융/재무   전직원     서울
## 4 삼성화재해상보험(주)    30056   846461 인사/총무   전직원     서울
## 5 삼성화재해상보험(주)    30056   840800 IT/인터넷   현직원     서울
##     등록일자 별점평가 승진기회 복지급여 워라밸 사내문화 경영진
## 1 2018/10/16       80       80      100     60       80     80
## 2 2018/10/14       20       60      100     20       20     20
## 3 2018/10/14       60       40       80     40       60     60
## 4 2018/10/14      100       80      100     80      100    100
## 5  2018/10/9       80       80      100     80       80     80
##                                                                                                  기업장점
## 1                                                  그룹 인센티브(흔히 PS) 포함하면 꽤 많은 급여. 네임밸류
## 2               연봉은 정말 많이 준다... 연봉이 1순위이며 자기생활은 주오오하지 않은 사람에게 최고의 회사
## 3                                                   무엇보다 연봉과 복지등이 장점 이외의 것은 모르겠다...
## 4 본사의 위치가 좋아서 교통이 편하고직원들의 충성도가 높아서 같이 일하는 사람으로서 일할 맛이 났었습니다.
## 5                                              보험기업 선두주자이며 복지와 급여가 상당히 만족스럽습니다.
##                                                                                                                                             기업단점
## 1                                                                                    단기 목표 지향적인 문화. 선진 외국 기업의 겉만 따라하려는 문화.
## 2                                                               영업쪽은 정말 자기 인생이 1도 없다. 야근이 없는 날이 드물며 실적 스트레스도 상당한편
## 3                                                                                            승진은 역시나 힘들고 매우 잦은 야근과 조직문화가 딱딱함
## 4 구내식당 줄이 너무 길어서 밥을 먹을 때 기다렸다가 먹어야 하는 단점이 있습니다.업무 분담이 너무 확실해서 일이 조금 더디게 진행되는 부분이 있습니다.
## 5                                                                              보수적인 분위기, MS 비율 하락되어 시장 경쟁력 확보 필요가 시급합니다.
##                                                                                                                         바라는점
## 1  임원분들의 계약기간때문에 장기적인 목표를 가져갈 수 없다는 현실은 이해하지만, 이를 보완할수있는 체계가 마련되어 더 발전했으면
## 2                                                                                  지점 실적을 줄이거나, 업무강도를 낮춰줘야한다
## 3                                                                          조직문화를 좀 더 유연하게 만들었으면 좋겠다고 생각함.
## 4 직원들과 대화 나누는 시간이나 직원 가족과 만남을 가져서 대기업이지만 개개인이 아닌 전체 직원이 하나된 마음이 될 수 있었습니다.
## 5                                                                      1위 기업 유지하기 위해 많은 노력과 시장조사가 필요합니다.
##   성장예상                     추천여부
## 1     비슷       이 기업을 추천 합니다!
## 2     비슷 이 기업을 추천하지 않습니다.
## 3     성장       이 기업을 추천 합니다!
## 4     성장       이 기업을 추천 합니다!
## 5     비슷       이 기업을 추천 합니다!

이제 데이터 수집의 마지막 여정인 반복문을 만들어 실행하겠습니다. 현재 얼마나 진행되고 있는지 확인할 수 있으면 기다리는 시간이 지루하지 않겠죠? 실제로 이 포스팅에서는 진행경과가 출력되지 않습니다. 직접 실행해보세요.

R 코드 보기 
# 반복문을 실행합니다. 
for (page in 2:pages) {
  
  # 작업 시작시각을 저장합니다.
  startTime <- Sys.time()
  
  # 현재 진행사항을 출력합니다.
  cat('[', page, '/', pages, '] 현재 진행 중! ')
  
  # 웹 페이지 URI를 조립합니다.
  cURI <- str_c(URI, '?page=', page)
  
  # HTTP 요청을 합니다.
  resp <- GET(url = cURI, config = list(cookies = myCookies))
  
  # 해당 페이지의 기업리뷰를 추출하여 df 객체에 할당합니다.
  df <- getData(x = resp)
  
  # result 객체에 df 객체를 추가합니다.
  result <- rbind(result, df)
  
  # 작업 종료시각를 저장합니다.
  endTime <- Sys.time()
  
  # 작업에 소요된 시간을 출력합니다.
  (endTime - startTime) %>% print()
  
  # 불필요한 객체를 삭제합니다. 
  rm(resp, df)
  
}

개별 리뷰코드로 중복여부를 확인해볼까요?

R 코드 보기 
# 리뷰코드로 중복여부를 확인합니다.
duplicated(x = result$리뷰코드) %>% sum()

## [1] 0

다행하게도 중복이 없습니다. 이제 데이터를 RDS로 저장합니다.

R 코드 보기 
# 최종 데이터를 RDS로 저장합니다.
fileNm <- str_c('../data/Company_Review_Data_', compNm, '.RDS')
saveRDS(object = result, file = fileNm)
]]>나성호 (Seongho Na)로지스틱 회귀분석 (Logistic Regression)2018-06-29T00:00:00+00:002026-06-24T00:00:00+00:00https://www.hds.ai.kr/posts/classification-4

이 글은 2018~2019년에 작성한 R 기반 강의 노트를 옮긴 것입니다. 코드 일부는 현재 패키지 버전과 다를 수 있습니다.

이번 포스팅은 분류모형 네 번째 소개로 로지스틱 회귀분석입니다. 로지스틱 회귀분석은 범주형인 목표변수를 입력변수들의 선형결합으로 표현한 것입니다. 로지스틱 회귀모형을 적합하면 입력변수마다 회귀계수가 산출되고 목표변수의 추정값으로 0~1 값을 갖는 확률을 얻게 됩니다.

로지스틱 회귀분석은 목표변수의 범주 개수에 따라 이항(binomial) 또는 다항(multinomial) 로지스틱 회귀분석으로 구분할 수 있습니다. 목표변수의 범주 개수가 2개인 이항 로지스틱 회귀분석은 목표변수의 추정값에 대한 기준점(cut-off)으로 Labeling 합니다. 일반적으로 cut-off를 0.5로 설정하므로 추정값이 0.5 미만일 때는 ‘0’, 0.5 이상일 때는 ‘1’로 Labeling 하는 것이죠.[1] 다항 로지스틱 회귀분석의 경우 추정값(확률)이 가장 큰 범주로 Labeling 합니다.

로지스틱 회귀분석 알고리즘

앞에서 로지스틱 회귀분석에 대해 간단하게 설명한 바와 같이 로지스틱 회귀모형의 추정값은 0~1의 값을 갖습니다. 이항 로지스틱 회귀분석에서 추정값 p를 성공할 확률이라고 하면 1-p는 실패할 확률로 해석할 수 있습니다. 성공할 확률은 입력변수(열벡터) X가 주어졌을 때 y가 1일 확률이 되며, 이를 조건부 확률로 표현하면 다음과 같습니다.

\[P(y = 1| X)\]

한편, 로지스틱 회귀분석에서는 오즈(Odds) 개념이 중요합니다. 오즈는 성공할 확률(p)이 실패할 확률(1-p)의 몇 배인지를 의미합니다. 오즈를 수식으로 표현하면 다음과 같습니다.

\[\text {Odds} = \frac {p}{1-p} = \frac {P(y = 1 | X)}{P(y = 0 | X)}\]

오즈에 네이피어 상수(e)를 밑으로 하는 자연로그를 씌우면 로짓함수 (Logit Function)가 되며, 이 함수의 x축은 0~1, y축은 -∞ ~ ∞ 값을 갖습니다. (아래 왼쪽 그래프) 하지만 로지스틱 회귀모형의 추정값은 0~1의 값을 가지므로 로짓함수에 대해 y = x 대칭을 해줍니다. (아래 오른쪽 그래프) 마지막으로 로짓함수를 입력변수들의 선형결합으로 바꿔주면 비로소 로지스틱 회귀모형이 됩니다.

[2]

이상의 설명을 수식으로 표현하면 다음과 같습니다.

\[\ln {\biggl( \frac {p}{1-p} \biggl)} = \text {logit}(p)\]

위 식에서 로그를 벗기기 위해 네이피어 상수(e)를 밑으로 하는 지수함수로 씌워주면 아래와 같이 표현됩니다.

\[\frac {p}{1-p} = \exp \biggl( \text{logit}(p) \biggl)\]

편의상 로짓함수를 입력변수가 p개인 선형결합으로 바꾼 뒤, 위 식을 성공할 확률 p로 정리하면 첫 번째 식을 y = x 대칭을 한 것과 같습니다.

\[logit(p) = \beta_0 + \beta_1 x_1 + \beta_2 x_2 + ⋯ + \beta_p x_p = \beta^TX\] \[p = (1-p) \space e^{\beta^TX}\] \[(1 + e^{\beta^TX})p = e^{\beta^TX}\] \[p = \frac {e^{\beta^TX}}{1 + e^{\beta^TX}} = \frac {1}{1 + e^{-\beta^TX}}\]

가능도 함수 (Likelihood Function)

로지스틱 회귀분석은 회귀계수의 추정을 위해 가능도 함수를 사용합니다. 가능도 함수는 가지고 있는 데이터(표본)로 모수를 추정할 때 사용하는 것으로 다음과 같이 표현됩니다.

\[L(\theta | x) = P(X = x | \theta) \quad \text {(단, } X \text {는 확률변수이고 } \theta \text{는 모수)}\]

위 식에서 오른쪽 항을 풀어쓰면 다음과 같습니다.

\[P(X = x | \theta) = P(x_1, x_2, ⋯, x_n | \theta)\] \[= P(x_1 | \theta) \times P(x_2 | \theta) \times ⋯ \times P(x_n | \theta)\] \[L(\theta | x) = \prod_{i=1}^{n} P(x_i | \theta)\]

위 식의 양변에 자연로그를 씌우면 확률의 곱을 로그 확률의 합으로 바꿔 표현할 수 있습니다.

\[\ln L(\theta | x) = \ln \sum_{i=1}^{n} P(x_i | \theta)\]

최대 로그 가능도 방법 (Maxium Log Likelihood Method)

우리는 실제값 y가 1일 때 성공할 확률 p가 1에 가깝게 추정되고, 실제값 y가 0일 때 실패할 확률 1-p가 1에 가깝게 하는 회귀 계수를 추정해야 합니다. 따라서 로지스틱 회귀모형의 각 계수를 추정하기 위해 가능도 함수를 적용하면 다음과 같습니다.

\[P(Y_i = y_i | X_i) = \prod_{i=1}^n p_i^{y_i} (1−p_i)^{(1−y_i)} = L(\beta)\]

양변에 자연로그를 씌워 정리하면 다음과 같습니다.

\[\ln L(\beta) = \sum_{i=1}^n \biggl[ y_i \ln p_i + (1-y_i) \ln (1-p_i) \biggl]\] \[= \sum_{i=1}^n \biggl[ y_i \ln p_i - y_i \ln (1-p_i) + \ln (1-p_i) \biggl]\] \[= \sum_{i=1}^n \biggl[ y_i \ln \frac {p_i}{1-p_i} + \ln (1-p_i) \biggl]\] \[\ln \frac {p}{1-p} = \text {logit}(p) = \beta^TX, \quad \ln(1-p) = -\ln(1 + e^{\beta^TX}) \space \text {이므로}\] \[\ln L(\beta) = \sum_{i=1}^n \biggl[ y_i \beta^TX - \ln(1 + e^{\beta^TX}) \biggl]\]

따라서 로그 가능도(Log Likeihood, LL)를 최대로 하는 회귀계수를 계산하면 됩니다. 또는 -2LL을 최소화하는 문제로 바꿀 수 있습니다.

로지스틱 회귀모형의 유의성 검정

이 포스팅에서는 로지스틱 회귀모형의 유의성 검정 방법에 대해 다음과 같은 두 가지를 소개합니다.

1. 두 모형 간 편차(deviance) 비교 (카이제곱 검정)

로지스틱 회귀모형이 유의한지 여부는 상수항만 사용된 회귀모형(M0)과 입력변수가 사용된 회귀모형(Mp) 간 편차(deviance)를 비교함으로써 확인할 수 있습니다. R에서 로지스틱 회귀모형을 적합하면 두 모형의 편차를 제공합니다. Null deviance는 상수항만 사용된 회귀모형의 편차이고, Residual deviance는 입력변수가 사용된 회귀모형입니다. 이 두 편차의 차이를 카이제곱 통계량으로 사용하여 두 모형 간 유의한 차이가 있는지 확인하면 됩니다. 카이제곱 검정 시, 두 모형의 자유도 차이를 카이제곱 통계량의 자유도로 사용합니다. 검정 결과, 유의확률(p-value)이 0.05보다 작으면 두 모형 간 유의한 차이가 있으므로 입력변수가 사용된 회귀모형이 유의하다고 판단합니다. R에서 카이제곱 검정에 사용하는 함수는 pchisq()입니다.

2. 두 모형 간 로그 가능도 비(ratio) 통계량

상수항만 사용된 회귀모형과 입력변수가 사용된 회귀모형 간 로그 가능도 비 통계량을 이용하는 방법이 있습니다. 로그 가능도 비는 아래 식처럼 표현할 수 있습니다.

\[\text {Log Likelihood Ration} = -2(LL(M_0) - LL(M_p)) = -2 \ln \biggl( \frac {L(M_0)}{L(M_p)} \biggl)\]

두 모형이 완벽하게 일치하면 로그의 진수(= 가능도 비)는 1이 되므로, 로그 가능도 비는 0이 됩니다. R에서 로그 가능도 비 검정에 사용하는 함수는 lmtest 패키지의 lrtest() 함수입니다. 검정 결과, 유의확률(p-value)이 0.05보다 작으면 입력변수가 사용된 회귀모형(Mp)이 유의하다고 판단합니다.

로그 가능도 비 검정은 하나의 회귀계수에 대한 검정방법으로도 사용할 수 있습니다. 즉, 하나의 입력변수를 포함한 모형과 제외한 모형을 각각 적합한 수 로그 가능도 비 검정을 실시하면 해당 회귀계수의 유의성 검정이 되는 것이죠.

로지스틱 회귀계수의 유의성 검정

로지스틱 회귀계수의 유의성 검정은 z-검정 또는 Wald 검정을 통해 확인할 수 있습니다. z 통계량과 Wald 통계량은 다음의 공식을 이용합니다.

\[z = \frac {\hat \beta - \beta_0}{\sigma_{\hat \beta}} \sim N(0, 1), \quad W^2 = \frac {(\hat \beta - \beta_0)^2}{\sigma_{\hat \beta}^2} \sim \chi_1^2\]

z-검정과 Wald 검정은 선형회귀계수의 유의성 검정 방법인 t-검정의 역할을 합니다. 두 검증의 귀무가설은 회귀계수가 0이라고 가정합니다. 따라서 위 식에서 분자항에 있는 β0는 귀무가설에 의해 0으로 치환되므로 z-검정통계량은 회귀계수를 표준오차로 나눈 값으로 정규분포를 따르고, Wald 통계량은 회귀계수와 표준오차를 각각 제곱하여 나눈 값으로 카이제곱분포를 따릅니다. 두 검정의 유의확률은 같은 값을 출력합니다. 검증 결과, 유의확률이 0.05보다 작으면 귀무가설을 기각할 수 있으므로 회귀계수는 0이 아니라고 판단합니다.

로지스틱 회귀모형 활용하기 (오즈비의 해석)

입력변수가 하나인 로지스틱 회귀모형에서 오즈는 다음과 같이 표현됩니다.

\[\text {Odds} = \frac {p}{1-p} = e^{\beta_0 + \beta_1 x_1}\]

오즈비(Odds Ratio)는 2개의 오즈 간 비율이며, 다음과 같이 표현됩니다.

\[\text {Odds Ratio} = \frac {e^{\beta_0 + \beta_1 (x_1 + 1)}}{e^{\beta_0 + \beta_1 x_1}} = e^{\beta_1}\]

위 식을 통해, 입력변수가 1단위 증가할 때 회귀모형의 추정값이 오즈비만큼 증가한다는 것을 알 수 있습니다.

이항 로지스틱 회귀분석 따라하기

온라인에 공개되어 있는 binary.csv 파일을 내려받아 대학교 지원자들의 고등학교 성적으로 합격 또는 불합격 여부를 설명하는 이항 로지스틱 회귀모형을 적합하는 실습을 해보겠습니다. 데이터 컬럼별 상세는 다음과 같습니다.

  • admit : 합격 여부 (0, 1)
  • gre : 영어 성적
  • gpa : 학점
  • rank : 출신 고등학교 등급 (1~4)
# 데이터를 불러옵니다.
univ <- read.csv(file = 'https://stats.idre.ucla.edu/stat/data/binary.csv')

# 데이터의 구조를 파악합니다. 
str(object = univ)

## 'data.frame':    400 obs. of  4 variables:
##  $ admit: int  0 1 1 1 0 1 1 0 1 0 ...
##  $ gre  : int  380 660 800 640 520 760 560 400 540 700 ...
##  $ gpa  : num  3.61 3.67 4 3.19 2.93 3 2.98 3.08 3.39 3.92 ...
##  $ rank : int  3 3 1 4 4 2 1 2 3 2 ...

# 미리보기 합니다. 
head(x = univ, n = 10L)

##    admit gre  gpa rank
## 1      0 380 3.61    3
## 2      1 660 3.67    3
## 3      1 800 4.00    1
## 4      1 640 3.19    4
## 5      0 520 2.93    4
## 6      1 760 3.00    2
## 7      1 560 2.98    1
## 8      0 400 3.08    2
## 9      1 540 3.39    3
## 10     0 700 3.92    2

400행 4열로 이루어진 데이터셋임을 확인할 수 있습니다. 모든 컬럼이 숫자형 벡터인데요. 이 중에서 admit과 rank는 범주형 벡터로 변환하고 요약데이터를 확인하겠습니다.

# admit, rank를 범주형으로 변환합니다.
univ$admit <- as.factor(x = univ$admit)
univ$rank <- as.factor(x = univ$rank)

# 요약데이터를 확인합니다. 
summary(object = univ)

##  admit        gre             gpa        rank   
##  0:273   Min.   :220.0   Min.   :2.260   1: 61  
##  1:127   1st Qu.:520.0   1st Qu.:3.130   2:151  
##          Median :580.0   Median :3.395   3:121  
##          Mean   :587.7   Mean   :3.390   4: 67  
##          3rd Qu.:660.0   3rd Qu.:3.670          
##          Max.   :800.0   Max.   :4.000

전체 400명 중 합격자가 127명, 불합격자가 273명입니다. gre(영어성적)은 최소 220점부터 최대 800점까지 분포하고 있으며 평균은 587.7입니다. gpa(학점)의 경우 최소 2.26부터 최대 4.00까지 분포하고 있구요. 지원자의 출신 고등학교 rank(등급)은 2~3 등급에 집중되어 있음을 알 수 있습니다.

이번 예제의 목표변수는 admit입니다. 요약데이터를 확인하면서 합격/불합격 빈도수를 확인할 수 있었는데요. 비중은 얼마나 될까요?

# 목표변수(admit)의 비율을 확인합니다. 
univ$admit %>% table() %>% prop.table()

## .
##      0      1 
## 0.6825 0.3175

전체 400명 중 31.75%가 합격자라는 것을 알 수 있습니다.

분석할 데이터에 대한 파악은 이 정도로 마치고 로지스틱 회귀모형을 적합해보겠습니다. 로지스틱 회귀모형은 glm() 함수를 이용합니다. 로지스틱 회귀분석은 연결함수로 로짓함수를 사용하는 일반화 선형모형(Generalized Linear Model)의 일종입니다. 그래서인지 R함수명도 glm()을 사용하는 것 같습니다. 이 함수의 주요 인자는 다음과 같습니다.

  • formula : 목표변수와 입력변수 간 관계를 표현합니다.
  • data : 로지스틱 회귀모형에 사용될 데이터셋을 할당합니다.
  • family : glm은 목표변수의 분포에 따라 family를 지정해주어야 합니다. 로지스틱 회귀분석의 목표변수는 이항분포(binomial)를 따르므로 binomial을 할당합니다. 연결함수는 생략해도 무방하지만 제대로(?) 하기 위해 logit으로 설정합니다.

이상의 간단한 설정만으로 로지스틱 회귀모형을 쉽게 적합할 수 있습니다.

# 이항 로지스틱 회귀모형을 적합합니다. 
fitLR1 <- glm(formula = admit ~ ., 
              data = univ, 
              family = binomial(link = 'logit'))

# 모형 적합 결과를 확인합니다. 
summary(fitLR1)

## 
## Call:
## glm(formula = admit ~ ., family = binomial(link = "logit"), data = univ)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.6268  -0.8662  -0.6388   1.1490   2.0790  
## 
## Coefficients:
##              Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -3.989979   1.139951  -3.500 0.000465 ***
## gre          0.002264   0.001094   2.070 0.038465 *  
## gpa          0.804038   0.331819   2.423 0.015388 *  
## rank2       -0.675443   0.316490  -2.134 0.032829 *  
## rank3       -1.340204   0.345306  -3.881 0.000104 ***
## rank4       -1.551464   0.417832  -3.713 0.000205 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 499.98  on 399  degrees of freedom
## Residual deviance: 458.52  on 394  degrees of freedom
## AIC: 470.52
## 
## Number of Fisher Scoring iterations: 4

모형 적합 결과를 출력하면 여러 가지 정보를 확인할 수 있습니다. Call은 분석가가 설정해준 로지스틱 회귀모형입니다. Deviance Residuals는 목표변수의 실제값과 추정값 간의 차이인 오차의 4분위수를 확인할 수 있습니다. 중앙값이 0에 가깝고 최소값과 최대값의 폭이 일정하면 정규분포를 따른다고 가정할 수 있는 것이죠.

Coefficients는 로지스틱 회귀모형의 입력변수별 회귀계수가 어떻게 적합되었는지 알 수 있습니다. Intercept(y절편)는 신경쓰지 않아도 되고, 다른 입력변수에 대한 회귀계수가 유의한지 확인하면 됩니다. 이 표의 오른쪽 끝에 출력되는 * 개수가 3개이면 유의확률이 0.01 이하인 것을 의미하며, 1개이면 유의확률이 0.05 이하인 것을 의미합니다. 즉, *가 1개 이상 출력되어야 회귀계수가 0이 아니라고 판단할 수 있습니다.

그런데 왜 입력변수가 5개일까요? 우리는 입력변수로 gre, gpa, 그리고 rank 이렇게 3개만 할당했는데, 로지스틱 회귀모형을 적합해보니 rank는 사라지고 대신에 rank2, rank3, rank4와 같은 새로운 변수들이 생겼습니다. 그 이유는, rank가 1~4의 값을 갖는 범주형 벡터이기 때문입니다. 범주형은 숫자가 아니므로 1~4의 값을 1 또는 0으로 표현해야 하는데, 그렇게 하기 위해 3개의 더미변수들이 필요했던 것입니다. 글로 설명하기 어려우니 표를 그려 설명하도록 하겠습니다.

rank rank2 rank3 rank4
1 0 0 0
2 1 0 0
3 0 1 0
4 0 0 1

위 표를 보면, rank가 1일 때 모든 더미변수들은 0을 갖습니다. 그리고 rank가 2일 때는 더미변수 rank2이 1이고 나머지 두 개의 더미변수들은 0을 갖습니다. 이런 식으로 rank가 3 또는 4일 때 rank3와 rank4가 각각 1이 되는 것이죠. 더미변수가 1의 값을 갖는다는 것은 rank가 1일 때와 그렇지 않을 때를 서로 비교하는 것으로 이해해야 합니다. 예를 들어, 3개의 더미변수가 모두 0이면 rank가 1인 경우를 의미한다고 했으므로, 더미변수 rank2의 회귀계수는 rank가 1일 때와 2일 때의 차이를 의미합니다. 나중에 회귀모형을 해석하는 부분에서 좀 더 자세히 다루도록 하겠습니다.

다음으로, 출력된 내용의 맨 아래에 있는 2개의 deviance에 주목합시다. (선형이든 로지스틱이든) 일단 회귀모형을 적합하고 나면 회귀모형의 유의성 검정을 가장 먼저 확인해야 합니다. 회귀모형의 유의성 검정은 이 회귀모형에 사용된 모든 회귀계수 중 어느 하나라도 0이 아닌 것인 있는지 확인하는 것인데 왜 이것을 가장 먼저 확인해야 하냐면, 만약 모든 회귀계수가 유의하지 않다면 0이라고 할 수 있고, 그것은 곧 회귀모형이 어떠한 설명력도 갖지 못한다는 의미가 되기 때문입니다.

로지스틱 회귀모형의 유의성 검정 방법에는, 앞에서 설명한 바와 같이 2가지가 있는데요. 첫 번째는 카이제곱 검정으로, 입력변수가 사용되지 않은 null 모형(M0)의 편차와 입력변수가 사용된 모형(Mp)의 편차 간 차이를 카이제곱 통계량으로 설정하여 검정하는 방법입니다. 이번 예제에서 적합한 로지스틱 회귀모형의 Null deviance는 499.98이고, Residual deviance가 458.52이며, 두 모형의 자유도는 각각 399, 394입니다. 이 값들의 차를 가지고 카이제곱 검정을 실시합니다.

# 로지스틱 회귀모형의 유의성 검정을 위해 두 편차의 차를 계산합니다. 
devGap <- fitLR1$null.deviance - fitLR1$deviance

# 두 모형의 자유도 차를 계산합니다. 
dfGap <- fitLR1$df.null - fitLR1$df.residual

# 위의 통계량으로 카이제곱 검정을 합니다. (단측검정)
pchisq(q = devGap, df = dfGap, lower.tail = FALSE)

## [1] 0.00000007578194

유의확률이 0.05보다 작으므로 두 모형이 서로 같다고 할 수 없습니다. 그러므로 최소한 1개 이상의 회귀계수가 0이 아니라고 할 수 있습니다.

로지스틱 회귀모형의 유의성을 검정하는 두 번째 방법은, 로그 가능도 비를 사용하는 것입니다. 이 방법을 사용하려면 입력변수를 사용하지 않은 회귀모형(M0)을 따로 적합해야 합니다.

# 먼저 독립변수가 하나도 사용되지 않는 null 모형을 적합합니다. 
fitLR0 <- glm(formula = admit ~ 1, 
              data = univ, 
              family = binomial(link = logit))

# 필요 패키지를 불러옵니다.
library(lmtest)

# 두 모형의 가능도 비 검정을 합니다. 
lrtest(fitLR0, fitLR1)

## Likelihood ratio test
## 
## Model 1: admit ~ 1
## Model 2: admit ~ gre + gpa + rank
##   #Df  LogLik Df  Chisq    Pr(>Chisq)    
## 1   1 -249.99                            
## 2   6 -229.26  5 41.459 0.00000007578 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

역시 유의확률이 0.05보다 작으므로 입력변수가 사용된 로지스틱 회귀모형이 유의하다고 판단합니다. lrtest() 함수 대신 waldtest() 함수로도 회귀모형의 유의성 검정을 실시할 수 있습니다. 아래와 같이 두 가지 방법을 사용할 수 있습니다.

# lmtest 패키지의 waldtest() 함수로 회귀모형의 유의성을 검정합니다. 
# test 인자는 생략해도 무방합니다. 
waldtest(object = fitLR1, test = c('F', 'Chisq'))

## Wald test
## 
## Model 1: admit ~ gre + gpa + rank
## Model 2: admit ~ 1
##   Res.Df Df      F      Pr(>F)    
## 1    394                          
## 2    399 -5 7.2279 0.000001721 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

waldtest() 함수를 이용하면 특정 입력변수를 제외한 모형과 모두 포함한 모형 간 유의성 검증도 가능합니다. object2 인자에 제외할 입력변수를 지정하고 실행하면 됩니다.

# lmtest 패키지의 waldtest() 함수로 회귀모형의 유의성을 검정합니다 
waldtest(object = fitLR1, object2 = c('gre', 'gpa'))

## Wald test
## 
## Model 1: admit ~ gre + gpa + rank
## Model 2: admit ~ rank
##   Res.Df Df      F    Pr(>F)    
## 1    394                        
## 2    396 -2 7.6939 0.0005274 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

두 개의 입력변수(gre, gpa)를 제외한 모형과 포함한 모형 간 유의한 차이가 있음을 알 수 있습니다. 그런데 위와 같이 함수를 사용하여 회귀모형의 유의성을 검정하는 방법 대신, 두 모형의 로그 가능도를 각각 구한 다음 두 값의 차이를 가지고 카이제곱 검정을 실시할 수도 있습니다. 그러니까 맨 처음 소개한 방법과 비슷한 거죠.

# 두 모형의 로그 가능도를 각각 구해 차이를 계산합니다. (가능도 비)
LLR <- -2 * (logLik(object = fitLR0) - logLik(object = fitLR1))

# 카이제곱 검정을 실시합니다. (단측검정)
pchisq(q = LLR, df = dfGap, lower.tail = FALSE)

## 'log Lik.' 0.00000007578194 (df=1)

지금까지 로지스틱 회귀모형의 유의성 검정 결과 유의확률이 모두 똑같다는 것을 알 수 있습니다. 전체 회귀모형이 유의하다는 것을 알았으니 개별 회귀계수가 유의한지 확인해보겠습니다.[3]

회귀계수 유의성 검정 방법도 z-검정과 Wald 검정 2가지가 있다는 것을 앞에서 설명했습니다만, 여기에 회귀계수 신뢰구간을 확인하는 방법까지 추가하여 3가지를 소개하도록 하겠습니다.

첫 번째로, z-검정에 대해서 알아보겠습니다. 먼저 회귀모형을 적합한 결과 객체(fitLR1)에서 회귀계수와 표준오차 표를 추출합니다.

# 회귀모형 결과 객체에서 회귀계수와 표준오차 표를 추출합니다. 
coefTbl <- as.data.frame(summary(fitLR1)$coefficients)

# 컬럼명을 변경합니다. 
colnames(coefTbl) <- c('coef', 'se', 'z-stats', 'p-value')

# 회귀계수와 표준오차를 확인합니다. 
coefTbl

##                     coef          se   z-stats      p-value
## (Intercept) -3.989979073 1.139950936 -3.500132 0.0004650273
## gre          0.002264426 0.001093998  2.069864 0.0384651284
## gpa          0.804037549 0.331819298  2.423119 0.0153878974
## rank2       -0.675442928 0.316489661 -2.134171 0.0328288188
## rank3       -1.340203916 0.345306418 -3.881202 0.0001039415
## rank4       -1.551463677 0.417831633 -3.713131 0.0002047107

첫 번째 컬럼이 회귀계수, 두 번째 컬럼이 표준오차입니다. 각 입력변수마다 유의성 검정을 하려면 회귀계수(첫 번째 컬럼)를 표준오차(두 번째 컬럼)로 나눈 z-통계량을 구해야 합니다. z-통계량은 평균이 0, 표준편차가 1인 표준정규분포를 따릅니다. 따라서 z-통계량이 0이면, 표준정규분포의 확률밀도함수는 0.5를 반환합니다. z-통계량이 1.64보다 크면 누적확률이 0.95 이상이고, -1.64보다 작으면 누적확률이 0.05 미만임을 의미합니다.

# z-통계량을 계산하고 결과를 출력합니다. 
zStat <- coefTbl$coef / coefTbl$se
print(zStat)

## [1] -3.500132  2.069864  2.423119 -2.134171 -3.881202 -3.713131

Intercept(y절편)을 포함한 6개 회귀계수 모두 1.64보다 크거나 -1.64보다 작습니다. 그렇다면 유의확률을 구해보겠습니다. 이 때, pnorm() 함수를 이용합니다. 이 함수는 정규분포의 누적확률을 반환하는 함수입니다. 예를 들어, pnorm() 함수의 x 인자에 0, mean 인자에 0, sd 인자에 1을 할당하고 함수를 실행하면 0.5가 반환됩니다. 평균이 0, 표준편차가 1인 표준정규분포에서 z-통계량이 0일 때 누적확률이 0.5라는 의미입니다.

# z-통계량의 누적확률을 확인합니다. 
zProb <- pnorm(q = abs(x = zStat), mean = 0, sd = 1, lower.tail = TRUE)
print(zProb)

## [1] 0.9997675 0.9807674 0.9923061 0.9835856 0.9999480 0.9998976

숫자가 어지럽게 출력되었습니다만, 우리가 알아야 할 것은 1에서 누적확률을 뺀 값에 2를 곱한 것이 유의확률이라는 것입니다. 즉, z-통계량의 절대값을 구하고, 그 값에 대한 정규분포 누적확률을 산출한 다음 유의수준을 계산하기 위해 아래와 같이 처리합니다.

# z-검정 유의확률을 계산하고 소수점 둘째자리에서 반올림합니다.
round(x = (1 - zProb) * 2, digits = 2L)

## [1] 0.00 0.04 0.02 0.03 0.00 0.00

모든 회귀계수의 유의확률이 0.05보다 작습니다. 모든 회귀계수가 유의하다는 것이죠.

이번에는 Wald 검정을 해볼까요? Wald 검정 통계량은 회귀계수와 표준오차를 각각 제곱하여 나눈 값입니다. 이 통계량으로 카이제곱 검정을 하는 것이죠.

# 회귀계수와 표준오차를 각각 제곱한 뒤 나눈 Wald 통계량을 계산합니다.
wald2 <- (coefTbl$coef)^2 / (coefTbl$se)^2

# 카이제곱 검정을 하고, 유의확률을 소수점 둘째자리에서 반올림합니다.
round(x = pchisq(q = wald2, df = 1, lower.tail = FALSE), digits = 2L)

## [1] 0.00 0.04 0.02 0.03 0.00 0.00

Wald 검정 결과로도 모든 회귀계수가 유의하다는 것을 확인할 수 있었습니다.

회귀계수의 유의성 검정 방법으로 하나 더 추가하자면, 회귀계수의 신뢰구간(Confidence Intervals)을 확인함으로써 회귀계수가 0인지 아닌지 확인할 수 있습니다. 만약 회귀계수의 신뢰구간 양끝점(2.5%와 97.5%)의 부호가 서로 다르면 회귀계수의 신뢰구간이 0을 통과하므로 회귀계수가 0일 가능성이 있습니다. 회귀계수의 신뢰구간은 간단하게 confint() 함수로 확인할 수 있습니다.

# 회귀계수의 신뢰구간을 확인합니다. 
confint(object = fitLR1)

## Waiting for profiling to be done...

##                     2.5 %       97.5 %
## (Intercept) -6.2716202334 -1.792547080
## gre          0.0001375921  0.004435874
## gpa          0.1602959439  1.464142727
## rank2       -1.3008888002 -0.056745722
## rank3       -2.0276713127 -0.670372346
## rank4       -2.4000265384 -0.753542605

로지스틱 회귀모형을 적합하고 유의성 검증도 모두 마쳤으니 로지스틱 회귀모형의 결과를 해석하는 방법에 대해 살펴보겠습니다. 앞에서 오즈비에 대한 설명을 했었는데요. 일단 이번 예제에 사용된 입력변수들의 오즈비를 확인해보겠습니다.

# 모든 입력변수들의 오즈비를 확인합니다. 
coef(object = fitLR1) %>% exp() %>% round(digits = 2L)

## (Intercept)         gre         gpa       rank2       rank3       rank4 
##        0.02        1.00        2.23        0.51        0.26        0.21

Intercept(y절편)은 의미가 없으므로 생략하고, gre부터 하나씩 살펴보겠습니다. gre의 오즈비는 1.00입니다. 이것은 무엇을 의미하는 것일까요? 바로 다른 모든 조건이 그대로일 때 gre가 1단위 증가할 때마다 불합격 확률(1-p) 대비 합격할 확률(p)의 비율이 1.00배라는 것을 의미합니다. gre가 추정값(확률)에 미치는 영향이 거의 없다는 것이죠. gre의 회귀계수를 봐도 알 수 있습니다. 결국 영어성적과 대학교 합격은 거의 무관한 것으로 보입니다.

gpa의 오즈비는 2.23입니다. 그러니까 다른 모든 조건이 그대로일 때 gpa가 1단위 증가할 때마다 불합격 확률(1-p) 대비 합격할 확률(p)의 비율이 2.23배라는 것이죠. 모든 입력변수들 중에 gpa의 오즈비가 가장 높습니다. 즉, gpa가 대학교 합격을 판가름짓는 가장 영향력 높은 입력변수라는 것입니다. (이번 모형으로만 판단하면) 미국 대학교에 입학하려면 학점에 가장 많은 신경을 써야 할 것 같습니다.

rank2, rank3, rank4는 범주형 벡터인 rank 대신에 새로 생긴 더미변수들임을 앞에서 설명한 바 있습니다. 이 세 개의 회귀계수들에 대해서 오즈비를 구하면 다음과 같습니다. rank2의 오즈비가 0.51이므로 rank가 1인 학생에 비해서 2인 학생의 합격할 확률이 절반에 불과하다는 것을 알 수 있습니다. rank3의 오즈비는 0.26이니까 rank가 1인 학생에 비해서 3인 학생의 합격할 확률이 약 1/4에 불과하다는 것 알 수 있겠죠? 그리고 rank가 4인 학생은 1/5로 더 떨어지는 것을 확인할 수 있습니다. 요약하자면 지원자의 출신 고등학교 등급이 낮을수록 합격할 확률도 낮아집니다.

우리는 앞에서 Wald 검정을 통해 회귀계수의 유의성 검정을 했었는데요. 더미변수 간 유의성 검정도 Wald 검정을 통해 확인할 수 있습니다. 다만 사용하는 함수가 다른데요. aod 패키지의 wald.test() 함수를 사용합니다. Sigma 인자에는 회귀계수의 분산-공분산 행렬을 할당하고, b 인자에는 회귀계수 벡터를 할당합니다. 마지막으로 Terms 인자에는 검증할 회귀계수를 지정합니다. 더미변수는 4~6번째에 있으므로 4:6을 입력하면 됩니다.

# 필요 패키지를 불러옵니다. 
library(aod)

# wald.test() 함수를 이용하여 더미변수의 유의성 검정을 실시합니다. 
wald.test(Sigma = vcov(object = fitLR1), 
          b = fitLR1$coefficients, 
          Terms = 4:6)

## Wald test:
## ----------
## 
## Chi-squared test:
## X2 = 20.9, df = 3, P(> X2) = 0.00011

Wald 검정 결과, 유의확률(p-value)이 0.05보다 작으므로 더미변수 간 유의한 차이가 있음을 확인할 수 있습니다. 그럼 더미변수 간 회귀계수가 서로 같은지 아니면 다른지 확인은 어떻게 할 수 있을까요? 방금 사용한 wald.test() 함수에서 Terms 인자 대신에 L 인자를 사용하면 가능합니다. L 인자에는 비교하려는 회귀계수의 위치에 하나는 +1, 다른 하나는 -1, 나머지는 0으로 입력한 행벡터를 할당합니다. 함수를 실행하면, L과 b에 할당된 벡터의 행렬곱으로 검증하고자 하는 두 회귀계수의 차이를 통계량으로 하는 카이제곱 검정을 실시하게 됩니다.

# rank2와 rank3 간 회귀계수의 유의성 검정을 실시합니다. 
wald.test(Sigma = vcov(object = fitLR1), 
          b = fitLR1$coefficients, 
          L = cbind(0, 0, 0, 1, -1, 0))

## Wald test:
## ----------
## 
## Chi-squared test:
## X2 = 5.5, df = 1, P(> X2) = 0.019

이상으로 다양한 유의성 검증 방법에 대해서 소개해드렸습니다. 지금은 혼란스러울 수도 있겠지만, 여러 방법 중에서 가장 마음에 드는 걸 하나씩 골라서 사용하면 됩니다. 물론 모든 방법을 다 아는 것이 가장 좋겠습니다.

분류모형을 만들었으니 이제 모형의 분류 성능에 대해서 확인하도록 하겠습니다. 이항 로지스틱 회귀분석은 목표변수의 확률을 추정값으로 제공한다고 했습니다만, 그 확률을 가지고 실패냐 성공이냐로 Labeling 하는 기준점(cut-off)를 설정해야 합니다. 일반적으로 기준점을 0.5로 설정한다고 말씀드린 바 있습니다.

# 0.5를 cut-off로 하여 로지스틱 회귀모형의 추정값을 0과 1로 분류하고
# 범주형으로 변환합니다. 
pred <- ifelse(test = fitLR1$fitted.values >= 0.5, 
               yes = 1, 
               no = 0) %>% 
  as.factor()

혼동행렬과 F1 점수로 분류 성능지표를 확인해보겠습니다.

# 필요 패키지를 불러옵니다. 
library(caret)

# 혼동행렬을 확인합니다. 
# positive 인자에 레벨을 지정할 수 있습니다. 
confusionMatrix(data = pred, 
                reference = univ$admit, 
                positive = '1')

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 254  97
##          1  19  30
##                                             
##                Accuracy : 0.71              
##                  95% CI : (0.6628, 0.754)   
##     No Information Rate : 0.6825            
##     P-Value [Acc > NIR] : 0.1293            
##                                             
##                   Kappa : 0.1994            
##  Mcnemar's Test P-Value : 0.0000000000008724
##                                             
##             Sensitivity : 0.2362            
##             Specificity : 0.9304            
##          Pos Pred Value : 0.6122            
##          Neg Pred Value : 0.7236            
##              Prevalence : 0.3175            
##          Detection Rate : 0.0750            
##    Detection Prevalence : 0.1225            
##       Balanced Accuracy : 0.5833            
##                                             
##        'Positive' Class : 1                 
##

Positive가 1인 것을 확인하고 나서 차례로 민감도와 특이도 및 정밀도를 확인해보니 0.2362, 0.9304, 0.6122로 분류 성능이 상당히 나쁘게 나왔습니다. F1 점수도 마저 확인하겠습니다.

# 필요 패키지를 불러옵니다. 
library(MLmetrics)

## 
## Attaching package: 'MLmetrics'

## The following objects are masked from 'package:caret':
## 
##     MAE, RMSE

## The following object is masked from 'package:base':
## 
##     Recall

# F1 점수를 확인합니다. 
F1_Score(y_true = univ$admit, 
         y_pred = pred, 
         positive = '1')

## [1] 0.3409091

F1 점수도 0.3409091로 상당히 낮습니다. 이런 일이 발생하는 이유는 분석하려는 데이터의 목표변수가 한 쪽으로 치우친 불균형 데이터이기 때문입니다. 확률값을 오름차순으로 정렬하여 산점도를 그려보면 육안으로 확인하기 쉬울 것입니다.

# 한글 폰트를 설정합니다. 
par(family = 'NanumGothic')

# 로지스틱 회귀모형의 추정값(확률)을 오름차순으로 정렬한 뒤 산점도를 그립니다.
plot(x = fitLR1$fitted.values %>% sort(), 
     ylab = '추정확률 (fitted.value)', 
     main = '로지스틱 회귀모형의 추정값(확률)')

# 산점도 위에 기준점(cut-off)을 빨간 점선으로 추가합니다. 
abline(h = 0.5, col = 'red', lty = 2)

위 그림에서 알 수 있듯이, 목표변수에 0이 훨씬 많기 때문에 대부분의 추정값이 0.5보다 작게 산출되었고, 그렇다 보니 실제로 1인 학생들의 대부분이 0으로 분류되었습니다. 이 문제를 해결하려면 분류 기준점(cut-off)을 아래로 내려야 합니다.

그렇다면 기준점을 어느 수준까지 내리면 될까요? 비교적 손쉬운 방법을 먼저 해보겠습니다. 원래 데이터에서 목표변수의 범주별 비중을 확인하고, 합격한 학생의 비중으로 기준점을 낮춰서 예측 Labeling을 한 후 혼동행렬과 F1 점수를 확인하는 방법입니다.

# 목표변수의 범주별 비중을 확인합니다. 
univ$admit %>% table() %>% prop.table()

## .
##      0      1 
## 0.6825 0.3175

합격한 학생의 비중이 0.3175이므로 기준점을 이 값으로 변경합니다.

# cut-off를 변경하여 로지스틱 회귀모형의 추정값을 0과 1로 분류하고
# 범주형으로 변환합니다. 
pred <- ifelse(test = fitLR1$fitted.values >= 0.3175, 
               yes = 1, 
               no = 0) %>% 
  as.factor()

그리고 나서 혼동행렬과 F1 점수로 분류 성능지표를 확인해보겠습니다.

# 혼동행렬을 확인합니다. 
confusionMatrix(data = pred, 
                reference = univ$admit, 
                positive = '1')

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 174  46
##          1  99  81
##                                           
##                Accuracy : 0.6375          
##                  95% CI : (0.5883, 0.6847)
##     No Information Rate : 0.6825          
##     P-Value [Acc > NIR] : 0.9756          
##                                           
##                   Kappa : 0.2475          
##  Mcnemar's Test P-Value : 0.00001572      
##                                           
##             Sensitivity : 0.6378          
##             Specificity : 0.6374          
##          Pos Pred Value : 0.4500          
##          Neg Pred Value : 0.7909          
##              Prevalence : 0.3175          
##          Detection Rate : 0.2025          
##    Detection Prevalence : 0.4500          
##       Balanced Accuracy : 0.6376          
##                                           
##        'Positive' Class : 1               
## 

# F1 점수를 확인합니다. 
F1_Score(y_true = univ$admit, 
         y_pred = pred, 
         positive = '1')

## [1] 0.5276873

기준점을 단순하게 0.5로 설정한 것에 비해서는 분류성능이 조금 향상되었습니다.

조금 복잡한 방법은 매튜의 상관계수 (Matthew Correlation Coefficient, MCC)를 사용하는 것입니다. 매튜의 상관계수는 이진 데이터의 분류 성능을 비교하는 척도로 사용되는데요. 일반적인 상관계수처럼 -1~+1의 값을 갖습니다. 실제값과 예측값이 완벽하게 같으면 +1, 서로 상관이 없으면 0, 그리고 완벽하게 다르면 -1이 되는 거죠. 매튜의 상관계수 공식은 아래와 같습니다.

\[\text {MCC} = \frac {\text {TP} \times \text {TN} - \text {FP} \times \text {FN}}{(\text {TP} + \text {FP})(\text {TP} + \text {FN})(\text {TN} + \text {FP})(\text {TN} + \text {FN})}\]

위의 공식을 활용하여 MCC가 최대가 되는 분류 기준점을 탐색하는 방법을 소개하겠습니다. 분류 기준점을 0에서 시작하여 0.01 단위로 변경해가며 1까지 총 101번 실행하여 각 기준점에서의 MCC를 계산한 뒤, MCC가 최대가 되는 기준점을 찾는 방식입니다. 만약 MCC를 최대로 하는 기준점이 여러 개라면 최소값을 반환하도록 합니다. MCC는 mccr 패키지의 mccr() 함수를 사용하면 쉽게 계산할 수 있습니다.

# 기준점에 따라 매튜의 상관계수를 생성하는 함수를 만듭니다. 
getMccDf <- function(object) {
  
  # 실제값을 지정한 뒤 범주형으로 변환합니다. 
  real <- object$y %>% as.factor()
  
  # 기준점을 0에서 1까지 0.01 단위로 증가하도록 설정합니다. 
  cutoffs <- seq(from = 0, to = 1, by = 0.01)
  
  # 기준점과 매튜의 상관계수를 저장할 빈 객체를 생성합니다. 
  df <- data.frame()
  
  # 매튜의 상관계수가 최대가 되는 기준점을 찾습니다. 
  for (cutoff in cutoffs) {
    
    # 회귀모형의 추정값을 산출합니다. 
    pred <- ifelse(test = object$fitted.values >= cutoff, 
                   yes = '1', 
                   no = '0') %>% 
      factor(levels = c('0', '1'))
    
    # 매튜의 상관계수를 계산합니다. 
    mcc <- mccr::mccr(act = real, pred = pred)
    
    # MCC에 행 기준으로 추가합니다. 
    df <- rbind(df, data.frame(cutoff = cutoff, mcc = mcc))
  }
  
  # 최종 결과를 반환합니다. 
  return(df)
}

사용자 정의 함수를 생성하였으니 매튜의 상관계수 데이터 프레임을 만들고, 산점도를 그려서 매튜의 상관계수가 최대값일 때의 기준점을 확인해보겠습니다.

# 매튜의 상관계수 데이터 프레임을 생성합니다. 
MCC <- getMccDf(object = fitLR1)

# 매튜의 상관계수 최대값을 지정합니다. 
maxMCC <- max(MCC$mcc)

# 매튜의 상관계수가 최대값일 때 기준점을 지정합니다. 
minCutoff <- MCC$cutoff[MCC$mcc == maxMCC]

# 산점도를 그립니다. 
plot(x = MCC$cutoff, 
     y = MCC$mcc, 
     pch = 19, 
     col = 'gray30', 
     xlab = '기준점 (cut-off)', 
     ylab = '매튜의 상관계수 (mcc)', 
     main = '최적의 분류 기준점 찾기')

# 매튜의 상관계수 최대값을 기준으로 수평선과 수직선을 추가합니다. 
abline(h = maxMCC, 
       v = minCutoff, 
       lty = 2, 
       col = 'red')

# 매튜의 상관계수가 최대값일 때 기준점을 출력합니다. 
text(x = minCutoff, 
     y = min(MCC$mcc), 
     labels = str_c('cut-off=', minCutoff), 
     pos = 3)

이제 거의 다 왔습니다. 매튜의 상관계수가 최대값일 때 기준점은 0.36입니다. 이 기준점을 기준으로 로지스틱 회귀모형의 예측값을 생성하고 혼동행렬과 F1 점수를 확인해보겠습니다.

# cut-off를 변경하여 로지스틱 회귀모형의 추정값을 0과 1로 분류하고
# 범주형으로 변환합니다. 
pred <- ifelse(test = fitLR1$fitted.values >= 0.36, 
               yes = 1, 
               no = 0) %>% 
  as.factor()

# 혼동행렬을 확인합니다. 
confusionMatrix(data = pred, 
                reference = univ$admit, 
                positive = '1')

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 206  56
##          1  67  71
##                                           
##                Accuracy : 0.6925          
##                  95% CI : (0.6447, 0.7374)
##     No Information Rate : 0.6825          
##     P-Value [Acc > NIR] : 0.3556          
##                                           
##                   Kappa : 0.3065          
##  Mcnemar's Test P-Value : 0.3672          
##                                           
##             Sensitivity : 0.5591          
##             Specificity : 0.7546          
##          Pos Pred Value : 0.5145          
##          Neg Pred Value : 0.7863          
##              Prevalence : 0.3175          
##          Detection Rate : 0.1775          
##    Detection Prevalence : 0.3450          
##       Balanced Accuracy : 0.6568          
##                                           
##        'Positive' Class : 1               
## 

# F1 점수를 확인합니다. 
F1_Score(y_true = univ$admit, 
         y_pred = pred, 
         positive = '1')

## [1] 0.5358491

기준점을 0.3175로 설정했을 때보다 민감도는 조금 낮아졌지만(0.6378 -> 0.5591), 특이도(0.6374 -> 0.7546)와 정밀도(0.4500 -> 0.5145)에서 조금씩 향상되었습니다. F1 점수 역시 0.5276873에서 0.5358491로 소폭 증가하였습니다.

마무리는 ROC 커브를 그리고 AUROC를 계산하는 것으로 하겠습니다. 지난 분류모형2 포스팅에서 만들었던 checkROC() 사용자 정의 함수를 checkROC.R 파일로 저장해 두었는데, source() 함수를 이용하여 불러오도록 하겠습니다.[4]

# 사용자 정의 함수 checkROC()를 불러옵니다. 
source(file = '../rcodes/checkROC.R')

# 로지스틱 회귀모형의 확률값을 입력하여 ROC 커브를 그리고 AUROC를 출력합니다. 
checkROC(prob = fitLR1$fitted.values, 
         real = univ$admit, 
         title = 'ROC 커브 - 이항 로지스틱 회귀모형')

AUROC가 0.6928에 불과합니다. 로지스틱 회귀모형의 분류 성능이 상당히 낮습니다. 데이터의 문제가 되겠지만, 다른 분류 알고리즘을 사용한 모형과 분류 성능을 비교해보면 재미있을 것 같습니다. 도전해보시죠!

[1] 목표변수의 범주별 비중이 크게 차이나는 불균형(Imbalanced) 데이터셋에 대해서 cut-off를 0.5로 지정하는 것은 적당하지 않을 수 있습니다.

[2] 출처 : https://www.graphpad.com/support/faqid/1465/

[3] 사실 회귀계수의 유의성 검정은 따로 하지 않아도 됩니다. 우리가 로지스틱 회귀모형을 적합한 후 summary() 함수로 모형 적합 결과를 확인할 때 Coefficients에서 모든 회귀계수가 유의하다는 것을 이미 확인한 바 있기 때문입니다. 하지만 여러 가지를 배워서 나쁠 건 없겠죠?

[4] 여러분도 적당한 위치에 R파일로 저장해놓고 필요할 때마다 불러서 사용하기 바랍니다.

]]>나성호 (Seongho Na)의사결정나무 (Decision Tree)2018-06-22T00:00:00+00:002026-06-24T00:00:00+00:00https://www.hds.ai.kr/posts/classification-3

이 글은 2018~2019년에 작성한 R 기반 강의 노트를 옮긴 것입니다. 코드 일부는 현재 패키지 버전과 다를 수 있습니다.

이번 포스팅에서는 분류모형 세 번째 소개로 의사결정나무 (Decision Tree)에 대해서 알아보겠습니다. 의사결정나무는 목표변수가 범주형이면 분류모형, 연속형이면 회귀모형을 적합할 수 있습니다. 의사결정나무는 분류모형을 적합하기 위해 가장 많이 사용되는 알고리즘 중 하나이지만, 전체 과정을 끝까지 실행하는 분석가가 (생각보다) 많지 않은 것 같습니다.

의사결정나무는 순수도(Purity) 또는 불순도(Impurity) 기준으로 나무를 성장시킵니다. 즉, 부모마디로부터 자식마디로 분리될 때 부모마디보다 자식마디의 순수도가 높아지거나 불순도가 낮아져야 한다는 것이죠. 일단 모형을 적합하고 나면 나무를 보고 IF-THEN 규칙을 만들 수 있으므로 모형을 해석하고 활용하기에 좋기 때문에 널리 사용되고 있습니다. 아울러 의사결정나무는 비모수적 알고리즘이며, 이상치에 덜 민감하다는 장점도 가지고 있습니다. 그리고 결측값(NA)이 있어도 모형을 적합할 수 있습니다. 회귀분석은 결측값이 있을 때 해당 건을 삭제하거나 다른 값으로 대체해주어야 하거든요. 한편으로는 결측값 그 자체가 입력변수의 값으로 인정받을 수도 있습니다. 예컨데, 보험회사의 상품가입신청서에 의무사항이 아닌 선택사항을 입력하는 소비자들이 입력하지 않는 대다수와 다른 성향을 갖고 있다고 보는 거죠.

물론 의사결정나무는 과적합하기 쉽다는 단점이 있습니다. 따라서 의사결정나무를 활용하여 분류모형을 적합하고자 할 때 분석가가 정지규칙을 잘 설정해야 하며, 적합된 분류모형을 가지치기 함으로써 과적합될 위험을 줄여야 합니다. 이 포스팅에서 소개하는 함수는 교차검증 방법을 활용하여 가지치기합니다.

의사결정나무의 종류

의사결정나무 알고리즘은 크게 3가지 종류가 사용됩니다.

1. CART (Classification and Regression Tree)

  • 분류모형은 지니지수(Gini Index)를 이용하여 순수도를 계산합니다.
  • 예측모형의 경우, 분산의 감소량을 기준으로 나무를 성장시킵니다.
  • [예/아니오]와 같이 목표변수의 범주가 2개인 이진분리에 사용됩니다.
  • R에서는 rpart 패키지의 rpart() 함수를 사용합니다. 이 포스팅에서는 rpart() 함수만 설명합니다.

2. C5.0

  • 엔트로피(Enthropy)를 이용하여 순수도를 계산하는 알고리즘입니다.
  • 부모마디의 엔트로피에서 자식마디의 엔트로피 가중평균을 뺀 정보이익(Information Gain)을 이용합니다.
  • 목표변수가 3개 이상 범주를 갖는 다지분리가 가능합니다.
  • R에서는 C5.0 패키지의 C5.0.default() 함수를 사용합니다.

3. CHAID (Chisquared Automatic Interaction Detection)

  • 분류모형은 카이제곱 통계량을 이용하여 순수도를 계산합니다.
  • 예측모형의 경우, 분산분석의 F-통계량을 이용합니다.
  • 입력변수는 반드시 범주형이어야 하므로, 숫자형 벡터는 범주형으로 변환해주어야 합니다.
  • R에서는 party() 함수를 사용합니다.

의사결정나무의 구성요소

아래 그림처럼 의사결정나무는 뿌리마디(Root node), 부모마디(Parent node), 자식마디(Child node), 중간마디(Internal node), 끝마디(Terminal node), 깊이(Depth) 등으로 구성되어 있습니다.

decisiontree[1]

의사결정나무 프로세스

의사결정나무는 뿌리마디로부터 출발하여, 부모마디보다 자식마디의 순수도가 높아지거나 불순도가 낮아지는 최적의 분리규칙을 찾았을 때 나무를 성장시킵니다. 아울러 정지규칙을 만족할 때 성장을 중단합니다. 정지규칙은 각 마디에 포함되는 데이터 건수 기준 또는 나무의 깊이, 끝마디의 개수 등으로 설정할 수 있습니다.

나무를 적합하고 나면 과적합을 피해 불필요한 가지를 잘라내는 가지치기를 하여 모형을 완성합니다. 이런 방식으로 여러 가지 분류모형을 적합한 다음 이익표(Gains Chart) 또는 위험도표(Risk Chart), 교차검증(Cross-validation) 등으로 각각의 분류모형을 평가하고 최종모형을 결정합니다. 마지막으로 최종모형에 대해 해석하고 활용합니다.

1. 분리규칙

분리규칙은 각 마디에서 목표변수를 가장 잘 분리해주는 입력변수와 분리기준으로 정해집니다. 분리규칙을 정하는 기준은 순수도 또는 불순도를 사용합니다. 부모마디의 순수도에 비해 자식마디의 순수도가 높은 경우에만 분리됩니다. 아울러 자식마디의 순수도를 가장 크게 해주는 분리규칙이 우선 적용됩니다.

아래 그림을 보면, 부모마디에는 30명의 학생이 속해 있고 그 중 15명이 크리켓 선수입니다. 따라서 부모마디의 순수도는 지니지수 기준으로 50%입니다. 왼쪽 그림은 입력변수가 성별(Gender) 기준으로 분리되고, 오른쪽 그림은 학급(Class) 기준으로 분리되는 것을 보입니다. 분리된 이후 가중평균 순수도는 성별일 때 59%, 학급일 때 51%이므로 성별 기준으로 가지를 분리하게 됩니다. 그럼 이 예제로 각각의 분리규칙을 설명하겠습니다.

[2]

아래 실제값 표는 위 그림을 분할표(Contingency Table)로 표현한 것입니다. 그리고 실제값 표를 기준으로 기대값 표를 완성합니다. 기대값 표의 각 셀에 들어갈 숫자는 각 합계의 곱을 전체 관측치의 수로 나눈 것입니다. 예를 들어, 여학생 중 크리켓 선수일 기대값은 실제값 표의 첫 행의 합계(15)와 첫 열의 합계(10)를 곱한 것을 전체 관측치의 수(30)로 나눈 것입니다.

분할표

지니지수 (Gini Index)

지니지수의 공식은 아래와 같습니다.

\[\text {지니지수} = 1 - \sum {P_j^2}\]

Pj는 끝마디에 속한 목표변수의 확률(비율)을 의미합니다. 예제에서 부모마디에는 Yes와 No가 각각 15명씩 있으므로 각각의 Pj는 1/2입니다. 따라서 부모마디의 지니지수를 계산하면 아래와 같습니다.

\[\text {부모마디의 지니지수} = 1 - \biggl((\frac {1}{2})^2 + (\frac {1}{2})^2\biggl) = \frac {1}{2}\]

자식마디의 지니지수는 왼쪽마디와 오른쪽마디의 지니지수를 각각 계산한 후 관측치 기준으로 가중평균한 값입니다. 두 입력변수별 분리규칙으로 각각의 지니지수를 계산한 다음 부모마디의 지니지수와의 차이가 가장 큰 분리규칙을 선택하면 됩니다.

\[\text {자식마디의 지니지수(성별)} = \frac {10}{30} \times \biggl[ 1 - \biggl( (\frac {2}{10})^2 + (\frac {8}{10})^2 \biggl) \biggl] + \frac {20}{30} \times \biggl[ 1 - \biggl( (\frac {13}{20})^2 + (\frac {7}{20})^2 \biggl) \biggl] = 0.41\] \[\text {자식마디의 지니지수(학급)} = \frac {14}{30} \times \biggl[ 1 - \biggl( (\frac {6}{14})^2 + (\frac {8}{14})^2 \biggl) \biggl] + \frac {16}{30} \times \biggl[ 1 - \biggl( (\frac {9}{16})^2 + (\frac {7}{16})^2 \biggl) \biggl] = 0.4911\]

지니지수 기준으로는 성별로 분리할 때 부모마디와의 차이가 더 크므로, 성별을 기준으로 가지를 분리하게 됩니다.

엔트로피 (Enthropy)

엔트로피는 정보이론(Information Theory)에서 사용되는 용어로, 어떤 시스템에서 송신자가 메시지를 보내고 채널은 특정한 방식으로 메시지를 변경하며, 수신자는 어떤 메시지가 보내진 것인지 추론한다고 할 때, 각 메시지에 포함된 정보의 기대값(평균)을 정보 엔트로피라고 합니다.[3] 일반적으로 엔트로피는 무질서도 또는 불확실성을 가리키며, 0~1 값을 갖습니다.

엔트로피 계산식을 먼저 확인하고 설명을 이어나가겠습니다. 엔트로피는 목표변수의 각 범주별 확률(비율)에 밑이 2인 로그를 취하고 다시 확률을 곱하여 모두 더한 것입니다. 확률은 0~1 값을 갖기 때문에 로그를 취하면 음수가 되므로 맨 앞에 마이너스 부호를 추가해준 것입니다.

\[\text {엔트로피} = − \sum { P_j log_2 {P_j} }\]

위 식에서 알 수 있듯이 엔트로피는 목표변수의 추정값(labelled value)이 정확하게 같은 비율일 때 1이 되고, 목표변수의 추정값이 어느 한 쪽으로 완전하게 치우쳤을 때 0이 됩니다. 왜냐하면, 추정값의 비중이 같다는 것은 Pj가 각각 1/2이라는 것이므로 밑이 2인 로그를 취해주면 -1값을 가지게 되며 맨 앞에 붙은 마이너스 부호로 인해 전체 엔트로피는 1이 되는 것입니다. 그리고 어느 한 쪽으로 치우쳤다는 것은 Pj가 각각 0과 1이라는 것을 의미합니다. 따라서 전체 엔트로피는 0이 되는 것이죠.

이번 예제에서 부모마디의 엔트로피를 계산하면 다음과 같습니다.

\[\text {부모마디의 엔트로피} = - \biggl( \frac {1}{2} \log_2 {\frac {1}{2}} + \frac {1}{2} \log_2 {\frac {1}{2}} \biggl) = 1\]

이번에는 자식마디에서의 엔트로피 가중평균을 계산해보겠습니다.

\[\text {자식마디의 엔트로피(성별)} = \frac {10}{30} \times \biggl[ - \biggl( \frac {2}{10} \log_2 {\frac {2}{10}} + \frac {8}{10} \log_2 {\frac {8}{10}} \biggl) \biggl] + \frac {20}{30} \times \biggl[ - \biggl( \frac {13}{20} \log_2 {\frac {13}{20}} + \frac {7}{20} \log_2 {\frac {7}{20}} \biggl) \biggl] = 0.8634\] \[\text {자식마디의 엔트로피(학급)} = \frac {14}{30} \times \biggl[ - \biggl( \frac {6}{14} \log_2 {\frac {6}{14}} + \frac {8}{14} \log_2 {\frac {8}{14}} \biggl) \biggl] + \frac {16}{30} \times \biggl[ - \biggl( \frac {9}{16} \log_2 {\frac {9}{16}} + \frac {7}{16} \log_2 {\frac {7}{16}} \biggl) \biggl] = 0.9871\]

부모마디의 엔트로피에서 자식마디의 엔트로피를 뺀 값을 정보이득(Information Gain)이라고 합니다. 결국 정보이득이 큰 분리규칙을 찾는 것입니다. 각 분리규칙에 대한 정보이득을 계산해보겠습니다.

\[\text {정보이득(성별)} = 1 − 0.8634 = 0.1366\] \[\text {정보이득(학급)} = 1 − 0.9871 = 0.0129\]

정보이득을 계산해보니 성별을 기준으로 분리할 때 순수도를 높여준다는 것을 알 수 있습니다.

정보이득비 (Information Gain Ratio)

엔트로피는 범주형 입력변수가 사용될 때 비중이 큰 범주로 편향(bias)이 생기는 단점이 있습니다. 그리고 목표변수가 3개 이상의 범주를 갖는 다지분리에서는 분리되는 가지의 수가 늘어날수록 엔트로피가 감소합니다. 다지분리 모형에서 정도이득을 기준으로 순수도를 평가하면 가지를 많아지게 하는 경향이 발생합니다. 가지가 많아지면 해석과 활용에 불편하므로 나무는 단순할수록 좋습니다. 따라서 C5.0과 같은 다지분리 알고리즘에서에서는 정보이득비를 대신 사용합니다. 정보이득비는 정보이득을 분리정보(Split Information)로 나눈 값입니다.

분리정보는 다음과 같은 공식이 적용됩니다.

\[\text {분리정보(D)} = - \sum {\frac {|D_j|}{D} log_2 {\frac {|D_j|}{D}}}\]

위 식에서 D는 부모마디에 속한 관측값의 수이고 $ D_j $는 각 자식마디에 속한 각각의 관측값의 수입니다. 이번 예제에서의 분리정보를 계산하면 다음과 같습니다.

\[\text {분리정보} = - \biggl[ \frac {10}{30} \log_2 {\frac {10}{30}} + \frac {20}{30} \log_2 {\frac {20}{30}} \biggl] = 0.9183\]

따라서 정보이득을 분리정보로 나눈 정보이득비를 계산하면 최적의 분리규칙을 정할 수 있습니다.

카이제곱 통계량 (Chi-square statistics)

카이제곱 통계량은 앞에서 보여드린 분할표(Contingency table)를 이용하여 두 범주로 나누는 것이 통계적으로 유의한지 검증할 때 사용됩니다. 카이제곱 통계량의 계산식은 다음과 같습니다.

\[\text {카이제곱 통계량} = \sum \frac {\text{(관측값-기대값)}^2} {\text{기대값}}\]

위 식을 이용하여 자식마디에서의 카이제곱 통계량을 각각 구해보겠습니다.

\[\text {자식마디의 카이제곱(성별)} = \frac {(2-5)^2}{5} + \frac {(8-5)^2}{5} + \frac {(13-10)^2}{10} + \frac {(7-10)^2}{10} = 5.4\] \[\text {자식마디의 카이제곱(학급)} = \frac {(6-7)^2}{7} + \frac {(8-7)^2}{7} + \frac {(9-8)^2}{8} + \frac {(7-8)^2}{8} = 0.5\]

카이제곱 통계량이 클수록 두 범주로 나누었을 때 통계적으로 유의한 결과가 나올 확률이 높습니다. 이번 예제에서는 카이제곱 통계량 기준으로 분리규칙을 비교할 때 역시 성별로 나누는 것이 맞습니다.

이상으로 의사결정나무로 분류모형을 적합할 때 순수도의 기준으로 3가지를 살펴보았습니다. 앞서 언급한 바와 같이 의사결정나무로 회귀모형도 적합할 수 있습니다. 이 경우, 순수도의 기준은 아래 기준으로 정해지는 데 이번 포스팅에서는 회귀나무를 다루지 않을 예정이므로 간단하게 설명만 하겠습니다.

분산분석의 F-통계량 (F-statistics) or t검정의 t-통계량

의사결정나무로 회귀모형을 적합할 때 순수도의 기준으로는 입력변수의 분리규칙이 3개 이상일 때는 분산분석의 F-통계량을, 2개일 때는 t검정의 t-통계량을 사용합니다. 통계량이 가장 큰 분리규칙을 정합니다.

분산의 감소량

분산의 감소량은 자식마디의 분산의 합이 가장 작은 분리규칙을 선택하는 것입니다.

2. 정지규칙

정지규칙은 더이상 가지의 분리가 일어나지 않도록 (나무가 성장하지 않도록) 하는 규칙입니다. 정지규칙은 분석가가 분류모형을 적합할 때 설정해주는 것입니다. 다음과 같은 조건을 만족할 때 나무의 성장이 정지됩니다.

  • 모든 관측값이 하나의 마디에 속할 때
  • 마디에 속하는 관측값의 수가 일정 기준 이하일 때
  • 뿌리마디로부터 나무의 깊이(Depth)가 기준값에 도달했을 때
  • 순수도의 증가량 또는 불순도의 감소량이 아주 작을 때

3. 가지치기

나무가 성장하면 할수록 분류모형은 과적합이 될 가능성이 높아집니다. 아래 그림을 보면 쉽게 이해할 수 있습니다.

분산 편향 그림[4]

가로축으로 분류모형이 복잡해질수록 훈련셋(Training dataset)의 에러는 감소합니다. 훈련셋에 과적합되므로 모형을 적합할 때 사용되지 않은 시험셋(Test dataset)을 적용하면 오차가 감소하다가 어느 시점 이후로는 다시 급격하게 증가하게 됩니다.

앞에서 설명한 바와 같이 의사결정나무는 과적합하는 경향이 있으므로 가지치기를 해주어야 합니다. 의사결정나무에서는 비용복잡도 가지치기 (Cost Complexity Pruning)이라고 하는데 다음과 같은 공식을 활용합니다.

\[\text {비용복잡도(T)} = \text {오분류율(T)} + \alpha \times |\text {T}|\] \[\begin{cases} \text {오분류율} : \text{전체 관측치의 수에서 잘못 분류된 관측치의 비중} \\ \alpha: \text{복잡도 파라미터로 0보다 큰 값으로 분석가가 정함} \\ |\text {T}|: \text{나무(T) 끝마디의 개수} \\ \end{cases}\]

위 공식은 다음과 같이 해석합니다. 일반적으로 나무가 커질수록 과적합하기 때문에 오분류율이 감소하므로 비용복잡도는 낮아집니다. 하지만 나무가 커진다는 것은 끝마디의 개수가 늘어난다는 것입니다. 그 결과 복잡도 파라미터를 곱한 값이 증가하게 되므로 비용복잡도는 오히려 증가할 수 있습니다. 따라서 가지치기란 비용복잡도 기준으로 끝마디의 개수를 조절하는 것이며, 이 때 모형 성능 향상에 기여도가 낮은 (불필요한) 가지를 잘라내게 됩니다.

4. 모형의 평가

  • 분류모형 : 각 끝마디에서 목표변수의 범주별 비중을 확인하고 가장 많은 범주로 라벨링(Labeling) 합니다. 예컨데 [Yes/No] 이진분리 모형을 적합했는데 어떤 끝마디에 속한 건수가 100이고, 그 중에서 [Yes]가 60, [No]가 40이면 해당 마디에 속한 100 건을 [Yes]로 추정하는 것입니다. 이 때 이 끝마디의 오분류율은 40%가 됩니다. 이렇게 전체 끝마디마다 Labeling한 뒤 전체 오분류율을 계산하여 모형의 분류성능을 평가할 수 있습니다.
\[\text{오분류율} = \sum \frac {\text {각 끝마디에서 추정값과 다른 관측치의 수}} {\text{각 끝마디 관측치의 수}} \times 100\]
  • 회귀모형 : 최종모형은 각 끝마디마다 목표변수의 평균을 추정값으로 제공합니다. 회귀모형의 성능을 평가하는 지표는 추정값과 실제값과의 차인 에러를 계산하는 방법을 주로 사용합니다. 따라서 MSE(Mean Squared Error), RMSE(Root Mean Squared Error), MAPE(Mean Absolute Percentage Error) 등을 계산합니다. 회귀모형의 성능을 평가하는 지표는 별도의 포스팅으로 정리할 예정입니다.

알고리즘에 관한 설명은 이정도로 마무리하고 실습을 통해 의사결정나무를 이해하는 시간을 가져보도록 하겠습니다.

의사결정나무 따라하기

이번 포스팅에서는 온라인에 공개되어 있는 UniversalBank.csv 파일을 불러와서 개인대출을 받은 고객을 골라내는 분류모형을 적합합니다. 데이터 컬럼별 상세는 다음과 같습니다.

  • ID : 고객번호 (1 ~ 5000)
  • Age : 나이 (23 ~ 67)
  • Experience : 경력 (-3 ~ 43)
  • Income : 소득 (8 ~ 224)
  • ZIP Code : 우편번호
  • Family : 가족수 (1 ~ 4)
  • CCAvg : 월별 신용카드 평균 사용금액 (0 ~ 10)
  • Education : 교육수준 (UG = 1, Grad = 2, Prof = 3)
  • Mortgage : 주택담보대출 잔액 (0 ~ 635)
  • PersonalLoan : 개인대출 보유여부 (yes = 1, no = 0)
  • SecuritiesAccount : 증권계좌 보유여부 (yes = 1, no = 0)
  • CDAccount : CD계좌 보유여부 (yes = 1, no = 0)
  • Online : 온라인뱅킹 이용여부 (yes = 1, no = 0)
  • CreditCard : 신용카드 이용여부 (yes = 1, no = 0)
# 데이터를 불러옵니다. 
# 원래 위치 : https://raw.githubusercontent.com/gchoi/Dataset/master/UniversalBank.csv
bank <- read.csv(file = 'https://goo.gl/vE8GyN')

# 데이터의 구조를 파악합니다. 
str(object = bank)

## 'data.frame':    5000 obs. of  14 variables:
##  $ ID               : int  1 2 3 4 5 6 7 8 9 10 ...
##  $ Age              : int  25 45 39 35 35 37 53 50 35 34 ...
##  $ Experience       : int  1 19 15 9 8 13 27 24 10 9 ...
##  $ Income           : int  49 34 11 100 45 29 72 22 81 180 ...
##  $ ZIP.Code         : int  91107 90089 94720 94112 91330 92121 91711 93943 90089 93023 ...
##  $ Family           : int  4 3 1 1 4 4 2 1 3 1 ...
##  $ CCAvg            : num  1.6 1.5 1 2.7 1 0.4 1.5 0.3 0.6 8.9 ...
##  $ Education        : int  1 1 1 2 2 2 2 3 2 3 ...
##  $ Mortgage         : int  0 0 0 0 0 155 0 0 104 0 ...
##  $ PersonalLoan     : int  0 0 0 0 0 0 0 0 0 1 ...
##  $ SecuritiesAccount: int  1 1 0 0 0 0 0 0 0 0 ...
##  $ CDAccount        : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ Online           : int  0 0 0 0 0 1 1 0 1 0 ...
##  $ CreditCard       : int  0 0 0 0 1 0 0 1 0 0 ...

# 미리보기 합니다. 
head(x = bank, n = 5L)

##   ID Age Experience Income ZIP.Code Family CCAvg Education Mortgage
## 1  1  25          1     49    91107      4   1.6         1        0
## 2  2  45         19     34    90089      3   1.5         1        0
## 3  3  39         15     11    94720      1   1.0         1        0
## 4  4  35          9    100    94112      1   2.7         2        0
## 5  5  35          8     45    91330      4   1.0         2        0
##   PersonalLoan SecuritiesAccount CDAccount Online CreditCard
## 1            0                 1         0      0          0
## 2            0                 1         0      0          0
## 3            0                 0         0      0          0
## 4            0                 0         0      0          0
## 5            0                 0         0      0          1

불러온 데이터는 5000행, 14개 컬럼으로 이루어진 데이터 프레임입니다. 모든 컬럼이 다 숫자형 벡터인 특징이 있습니다. 그런데 다섯 번째 컬럼인 ZIP.Code는 숫자가 아니므로 문자형 또는 범주형 벡터로 변환해주어야 하지만 이번 예제에서는 사용하지 않아도 될 것 같으므로 제거하도록 하겠습니다.

# 불필요한 컬럼 삭제합니다. (ID & ZIP.Code)
bank <- bank[, -c(1, 5)]

# 요약통계량을 확인합니다. 
summary(object = bank)

##       Age          Experience       Income           Family     
##  Min.   :23.00   Min.   :-3.0   Min.   :  8.00   Min.   :1.000  
##  1st Qu.:35.00   1st Qu.:10.0   1st Qu.: 39.00   1st Qu.:1.000  
##  Median :45.00   Median :20.0   Median : 64.00   Median :2.000  
##  Mean   :45.34   Mean   :20.1   Mean   : 73.77   Mean   :2.396  
##  3rd Qu.:55.00   3rd Qu.:30.0   3rd Qu.: 98.00   3rd Qu.:3.000  
##  Max.   :67.00   Max.   :43.0   Max.   :224.00   Max.   :4.000  
##      CCAvg          Education        Mortgage      PersonalLoan  
##  Min.   : 0.000   Min.   :1.000   Min.   :  0.0   Min.   :0.000  
##  1st Qu.: 0.700   1st Qu.:1.000   1st Qu.:  0.0   1st Qu.:0.000  
##  Median : 1.500   Median :2.000   Median :  0.0   Median :0.000  
##  Mean   : 1.938   Mean   :1.881   Mean   : 56.5   Mean   :0.096  
##  3rd Qu.: 2.500   3rd Qu.:3.000   3rd Qu.:101.0   3rd Qu.:0.000  
##  Max.   :10.000   Max.   :3.000   Max.   :635.0   Max.   :1.000  
##  SecuritiesAccount   CDAccount          Online         CreditCard   
##  Min.   :0.0000    Min.   :0.0000   Min.   :0.0000   Min.   :0.000  
##  1st Qu.:0.0000    1st Qu.:0.0000   1st Qu.:0.0000   1st Qu.:0.000  
##  Median :0.0000    Median :0.0000   Median :1.0000   Median :0.000  
##  Mean   :0.1044    Mean   :0.0604   Mean   :0.5968   Mean   :0.294  
##  3rd Qu.:0.0000    3rd Qu.:0.0000   3rd Qu.:1.0000   3rd Qu.:1.000  
##  Max.   :1.0000    Max.   :1.0000   Max.   :1.0000   Max.   :1.000

목표변수인 PersonalLoan 컬럼이 숫자형 벡터이므로 범주형으로 변경해주어야 합니다.

# 목표변수를 범주형 벡터로 변환합니다. (PersonalLoan)
bank$PersonalLoan <- as.factor(x = bank$PersonalLoan)

# 목표변수의 범주별 비중을 확인합니다. 
bank$PersonalLoan %>% table() %>% prop.table()

## .
##     0     1 
## 0.904 0.096

목표변수의 범주별 비중을 확인해보니, 개인대출을 받은 고객이 전체 고객의 10% 미만입니다. 목표변수가 한 쪽으로 치우친 불균형된 데이터라는 것을 알 수 있습니다. 그리고 레벨의 순서가 ‘0’, ‘1’입니다. caret 패키지의 confusionMatrix() 함수는 목표변수의 levels를 확인하여 먼저오는 것을 positive로 인식하므로 우리는 목표변수의 levels 순서를 변경해줄 필요가 있습니다.

# 목표변수의 레벨을 변경합니다. 
bank$PersonalLoan <- relevel(x = bank$PersonalLoan, ref = '1')

# 목표변수의 레벨이 잘 변경되었는지 확인합니다. 
levels(x = bank$PersonalLoan)

## [1] "1" "0"

우리는 불균형된 데이터를 어떻게 하면 좋을지 이미 살펴본 바 있습니다. 그런데 이번 포스팅에서는 훈련셋의 목표변수 균형화 작업을 하지 않습니다. 왜냐하면, 그렇게 해봤더니 가지치기를 할 필요가 없는 분류모형이 적합되었기 때문입니다. 가지치기 실습이 중요하니 균형화 작업을 생략하고 전체 데이터를 7대 3의 비율로 훈련셋과 시험셋으로 나누기만 하겠습니다.

# 전체 데이터셋의 70%를 훈련용, 30%를 시험용 데이터로 분리합니다. 
# 같은 결과를 얻기 위해 seed를 설정합니다. 
set.seed(seed = 1234)

# 전체 데이터를 임의로 샘플링하기 위해 다음과 같이 처리합니다. 
idx <- sample(x = 2, size = nrow(x = bank), prob = c(0.7, 0.3), replace = TRUE)

# idx가 1일 때 trainSet, 2일 때 testSet에 할당합니다.
trainSet <- bank[idx == 1, ]
testSet <- bank[idx == 2, ]

# 훈련용, 시험용 데이터셋의 목표변수 비중을 확인합니다.  
trainSet$PersonalLoan %>% table() %>% prop.table()

## .
##         1         0 
## 0.0964539 0.9035461

testSet$PersonalLoan %>% table() %>% prop.table()

## .
##          1          0 
## 0.09491525 0.90508475

이제 데이터 준비가 완료되었으니 의사결정나무 분류모형을 적합할 차례입니다. 앞에서 설명한 바와 같이 의사결정나무에는 여러 가지 알고리즘이 사용되고 있으며, R에서도 다양한 의사결정나무 함수들이 있습니다. 이번 포스팅에서는 rpart 패키지의 rpart() 함수만 활용하도록 하겠습니다. 이 함수에 사용되는 주요 인자들은 다음과 같습니다.

  • formula : 목표변수와 입력변수 간 관계식을 할당합니다.
  • data : 모형 적합에 사용할 훈련용 데이터셋을 할당합니다.
  • method : class(분류모형) 또는 anova(회귀모형) 중 하나를 할당하면 됩니다. 생략하면 목표변수의 속성을 확인하여 범주형일 때 class, 연속형일 때 anova가 자동으로 할당됩니다.
  • parms : method별로 파라미터를 지정할 수 있는데, anova는 별도의 파라미터가 필요없으며, class의 경우 순수도 기준(split)을 할당할 수 있습니다. 기본값은 gini이며, information도 가능합니다.
  • control : 정지규칙에 관한 설정을 rpart.control() 함수로 할당합니다.

rpart.control() 함수에 들어갈 주요 인자들도 함께 설명하겠습니다.

  • minsplit : 어느 마디의 관측값 개수가 이 설정값 이하일 때 더이상 분리되지 않습니다.
  • minbucket : 끝마디에 속한 관측값의 수의 최소값을 설정합니다. minsplit이 설정되면 1/3에 해당하는 숫자가 자동으로 할당됩니다.
  • cp : 비용복잡도에 사용할 파라미터(알파)를 설정합니다. 기본값은 0.01입니다.
  • maxdepth : 뿌리마디로부터 끝마디까지의 깊이(Depth) 최대값을 설정합니다. 기본값은 30입니다.
# 필요 패키지를 불러옵니다.
library(rpart)

# 분류모형을 적합합니다. 
fitTree <- rpart(formula = PersonalLoan ~ ., 
                 data = trainSet, 
                 method = 'class', 
                 parms = list(split = 'gini'),
                 control = rpart.control(minsplit = 20, 
                                         cp = 0.01, 
                                         maxdepth = 10))

# 적합된 모형을 살펴봅니다.
summary(object = fitTree)

## Call:
## rpart(formula = PersonalLoan ~ ., data = trainSet, method = "class", 
##     parms = list(split = "gini"), control = rpart.control(minsplit = 20, 
##         cp = 0.01, maxdepth = 10))
##   n= 3525 
## 
##           CP nsplit rel error    xerror       xstd
## 1 0.30441176      0 1.0000000 1.0000000 0.05155083
## 2 0.14117647      2 0.3911765 0.4147059 0.03421892
## 3 0.04117647      3 0.2500000 0.2823529 0.02842241
## 4 0.02647059      4 0.2088235 0.2235294 0.02536267
## 5 0.01029412      5 0.1823529 0.2029412 0.02419095
## 6 0.01000000      9 0.1382353 0.1911765 0.02349288
## 
## Variable importance
## Education    Income    Family     CCAvg CDAccount  Mortgage       Age 
##        30        28        20        13         5         3         1 
## 
## Node number 1: 3525 observations,    complexity param=0.3044118
##   predicted class=0  expected loss=0.0964539  P(node) =1
##     class counts:   340  3185
##    probabilities: 0.096 0.904 
##   left son=2 (770 obs) right son=3 (2755 obs)
##   Primary splits:
##       Income    < 110.5 to the right, improve=157.54890, (0 missing)
##       CCAvg     < 2.95  to the right, improve=123.98300, (0 missing)
##       CDAccount < 0.5   to the right, improve= 61.40191, (0 missing)
##       Mortgage  < 293.5 to the right, improve= 32.80038, (0 missing)
##       Education < 1.5   to the right, improve= 13.67929, (0 missing)
##   Surrogate splits:
##       CCAvg     < 3.225 to the right, agree=0.867, adj=0.390, (0 split)
##       Mortgage  < 294.5 to the right, agree=0.806, adj=0.110, (0 split)
##       CDAccount < 0.5   to the right, agree=0.783, adj=0.006, (0 split)
## 
## Node number 2: 770 observations,    complexity param=0.3044118
##   predicted class=0  expected loss=0.3792208  P(node) =0.2184397
##     class counts:   292   478
##    probabilities: 0.379 0.621 
##   left son=4 (275 obs) right son=5 (495 obs)
##   Primary splits:
##       Education < 1.5   to the right, improve=211.451400, (0 missing)
##       Family    < 2.5   to the right, improve=140.260400, (0 missing)
##       CDAccount < 0.5   to the right, improve= 48.317130, (0 missing)
##       Income    < 156.5 to the right, improve= 13.702040, (0 missing)
##       CCAvg     < 3.95  to the right, improve=  6.813474, (0 missing)
##   Surrogate splits:
##       Family    < 2.5   to the right, agree=0.744, adj=0.284, (0 split)
##       CDAccount < 0.5   to the right, agree=0.694, adj=0.142, (0 split)
##       CCAvg     < 8.85  to the right, agree=0.648, adj=0.015, (0 split)
##       Mortgage  < 568   to the right, agree=0.648, adj=0.015, (0 split)
##       Income    < 116.5 to the left,  agree=0.647, adj=0.011, (0 split)
## 
## Node number 3: 2755 observations,    complexity param=0.01029412
##   predicted class=0  expected loss=0.01742287  P(node) =0.7815603
##     class counts:    48  2707
##    probabilities: 0.017 0.983 
##   left son=6 (186 obs) right son=7 (2569 obs)
##   Primary splits:
##       CCAvg     < 2.95  to the right, improve=19.1570700, (0 missing)
##       Income    < 92.5  to the right, improve= 7.9237130, (0 missing)
##       CDAccount < 0.5   to the right, improve= 1.3044200, (0 missing)
##       Mortgage  < 325   to the right, improve= 1.3038900, (0 missing)
##       Age       < 62.5  to the right, improve= 0.1463884, (0 missing)
## 
## Node number 4: 275 observations,    complexity param=0.04117647
##   predicted class=1  expected loss=0.1236364  P(node) =0.07801418
##     class counts:   241    34
##    probabilities: 0.876 0.124 
##   left son=8 (221 obs) right son=9 (54 obs)
##   Primary splits:
##       Income     < 116.5 to the right, improve=34.407540, (0 missing)
##       CCAvg      < 2.75  to the right, improve=11.714120, (0 missing)
##       Experience < 38.5  to the left,  improve= 3.733753, (0 missing)
##       Age        < 63.5  to the left,  improve= 3.347071, (0 missing)
##       CDAccount  < 0.5   to the right, improve= 1.939394, (0 missing)
##   Surrogate splits:
##       Age        < 65.5  to the left,  agree=0.815, adj=0.056, (0 split)
##       Experience < 40.5  to the left,  agree=0.807, adj=0.019, (0 split)
## 
## Node number 5: 495 observations,    complexity param=0.1411765
##   predicted class=0  expected loss=0.1030303  P(node) =0.1404255
##     class counts:    51   444
##    probabilities: 0.103 0.897 
##   left son=10 (54 obs) right son=11 (441 obs)
##   Primary splits:
##       Family    < 2.5   to the right, improve=85.8242400, (0 missing)
##       CDAccount < 0.5   to the right, improve=10.5835000, (0 missing)
##       CCAvg     < 6.635 to the left,  improve= 1.5510780, (0 missing)
##       Mortgage  < 189   to the right, improve= 1.4346690, (0 missing)
##       Age       < 35.5  to the right, improve= 0.5672034, (0 missing)
## 
## Node number 6: 186 observations,    complexity param=0.01029412
##   predicted class=0  expected loss=0.2365591  P(node) =0.05276596
##     class counts:    44   142
##    probabilities: 0.237 0.763 
##   left son=12 (13 obs) right son=13 (173 obs)
##   Primary splits:
##       CDAccount  < 0.5   to the right, improve=7.931573, (0 missing)
##       Income     < 92.5  to the right, improve=7.537278, (0 missing)
##       Mortgage   < 277.5 to the right, improve=3.320066, (0 missing)
##       Age        < 61.5  to the right, improve=3.085095, (0 missing)
##       Experience < 36.5  to the right, improve=3.085095, (0 missing)
## 
## Node number 7: 2569 observations
##   predicted class=0  expected loss=0.001557026  P(node) =0.7287943
##     class counts:     4  2565
##    probabilities: 0.002 0.998 
## 
## Node number 8: 221 observations
##   predicted class=1  expected loss=0  P(node) =0.06269504
##     class counts:   221     0
##    probabilities: 1.000 0.000 
## 
## Node number 9: 54 observations,    complexity param=0.02647059
##   predicted class=0  expected loss=0.3703704  P(node) =0.01531915
##     class counts:    20    34
##    probabilities: 0.370 0.630 
##   left son=18 (11 obs) right son=19 (43 obs)
##   Primary splits:
##       CCAvg      < 3.5   to the right, improve=8.0181660, (0 missing)
##       Age        < 60    to the left,  improve=3.7898360, (0 missing)
##       Experience < 34.5  to the left,  improve=3.7898360, (0 missing)
##       CreditCard < 0.5   to the left,  improve=0.9204793, (0 missing)
##       Income     < 111.5 to the left,  improve=0.7407407, (0 missing)
## 
## Node number 10: 54 observations
##   predicted class=1  expected loss=0.05555556  P(node) =0.01531915
##     class counts:    51     3
##    probabilities: 0.944 0.056 
## 
## Node number 11: 441 observations
##   predicted class=0  expected loss=0  P(node) =0.1251064
##     class counts:     0   441
##    probabilities: 0.000 1.000 
## 
## Node number 12: 13 observations
##   predicted class=1  expected loss=0.2307692  P(node) =0.003687943
##     class counts:    10     3
##    probabilities: 0.769 0.231 
## 
## Node number 13: 173 observations,    complexity param=0.01029412
##   predicted class=0  expected loss=0.1965318  P(node) =0.04907801
##     class counts:    34   139
##    probabilities: 0.197 0.803 
##   left son=26 (56 obs) right son=27 (117 obs)
##   Primary splits:
##       Income     < 92.5  to the right, improve=5.274727, (0 missing)
##       Age        < 29.5  to the left,  improve=2.447491, (0 missing)
##       Experience < 3.5   to the left,  improve=1.954857, (0 missing)
##       CCAvg      < 4.85  to the left,  improve=1.746949, (0 missing)
##       Family     < 2.5   to the right, improve=1.426529, (0 missing)
##   Surrogate splits:
##       Age        < 58.5  to the right, agree=0.723, adj=0.143, (0 split)
##       Experience < 34.5  to the right, agree=0.723, adj=0.143, (0 split)
##       Mortgage   < 248.5 to the right, agree=0.699, adj=0.071, (0 split)
##       CCAvg      < 5.3   to the right, agree=0.694, adj=0.054, (0 split)
## 
## Node number 18: 11 observations
##   predicted class=1  expected loss=0.09090909  P(node) =0.003120567
##     class counts:    10     1
##    probabilities: 0.909 0.091 
## 
## Node number 19: 43 observations
##   predicted class=0  expected loss=0.2325581  P(node) =0.01219858
##     class counts:    10    33
##    probabilities: 0.233 0.767 
## 
## Node number 26: 56 observations,    complexity param=0.01029412
##   predicted class=0  expected loss=0.375  P(node) =0.01588652
##     class counts:    21    35
##    probabilities: 0.375 0.625 
##   left son=52 (26 obs) right son=53 (30 obs)
##   Primary splits:
##       Education < 1.5   to the right, improve=7.547436, (0 missing)
##       Family    < 2.5   to the right, improve=4.705556, (0 missing)
##       Income    < 104.5 to the left,  improve=2.710882, (0 missing)
##       CCAvg     < 4.25  to the left,  improve=2.704545, (0 missing)
##       Mortgage  < 40.5  to the right, improve=1.575000, (0 missing)
##   Surrogate splits:
##       Income   < 102.5 to the left,  agree=0.679, adj=0.308, (0 split)
##       Family   < 1.5   to the right, agree=0.679, adj=0.308, (0 split)
##       CCAvg    < 4.25  to the left,  agree=0.679, adj=0.308, (0 split)
##       Age      < 60.5  to the right, agree=0.643, adj=0.231, (0 split)
##       Mortgage < 40.5  to the right, agree=0.643, adj=0.231, (0 split)
## 
## Node number 27: 117 observations
##   predicted class=0  expected loss=0.1111111  P(node) =0.03319149
##     class counts:    13   104
##    probabilities: 0.111 0.889 
## 
## Node number 52: 26 observations
##   predicted class=1  expected loss=0.3461538  P(node) =0.007375887
##     class counts:    17     9
##    probabilities: 0.654 0.346 
## 
## Node number 53: 30 observations
##   predicted class=0  expected loss=0.1333333  P(node) =0.008510638
##     class counts:     4    26
##    probabilities: 0.133 0.867

summary() 함수로 분류모형을 출력하면, 여러 가지 정보가 나옵니다만 우리가 봐야 할 것은 두 번째와 세 번째 표입니다. 두 번째 표는 비용복잡도(CP) 파라미터별로 가지가 분리되는 횟수, 실제 오차와 교차검증 오차를 제시합니다. 우리는 모형을 적합할 때 비용복잡도 파라미터를 기본값인 0.01로 정했기 때문에 그 기준으로 분리된 개수가 9입니다. 이는 끝마디가 10개라는 것을 의미입니다.

세 번째 표는 변수별 중요도를 보여줍니다. 이번 예제에서는 Education, Income, Family, CCAvg 순으로 오분류율이 낮은 모형을 만드는 데 높은 기여를 했다는 것을 알 수 있습니다.

나머지 내용은 분류모형에 관한 설명을 한 것인데, 아무래도 텍스트로 되어 있다보니 한 눈에 들어오지 않습니다. 따라서 전체 분류모형은 그림을 그려서 설명하도록 하겠지만, 첫 분기되는 것을 설명하면 다음과 같습니다.

뿌리마디에는 3,525건의 관측값이 속해 있는데, ‘0’과 ‘1’ 중에서 ‘0’의 비중이 조금 더 높으므로 뿌리마디는 ‘0’으로 추정(Labeling)됩니다. 이 때 오분류율은 0.0964539입니다. 뿌리마디에 속한 데이터에 대해 여러 개의 분리규칙(Primary splits)을 만들어 비교해본 결과, 지니지수 기준으로 가장 순수도를 높일 수 있는 분리규칙은 [Income < 110.5]였습니다. 즉, Income이 110.5 미만인 3,185건이 오른쪽 자식마디로, 그리고 Income이 110.5 이상인 340건이 왼쪽 자식마디로 할당된 것이죠. 각각의 확률(비중)은 0.096, 0.904입니다.

나무모형을 텍스트로 간단하게 출력해보는 방법이 따로 있습니다. 적합된 분류모형을 출력하면 됩니다.

# 나무모형을 출력합니다.
print(fitTree)

## n= 3525 
## 
## node), split, n, loss, yval, (yprob)
##       * denotes terminal node
## 
##  1) root 3525 340 0 (0.096453901 0.903546099)  
##    2) Income>=110.5 770 292 0 (0.379220779 0.620779221)  
##      4) Education>=1.5 275  34 1 (0.876363636 0.123636364)  
##        8) Income>=116.5 221   0 1 (1.000000000 0.000000000) *
##        9) Income< 116.5 54  20 0 (0.370370370 0.629629630)  
##         18) CCAvg>=3.5 11   1 1 (0.909090909 0.090909091) *
##         19) CCAvg< 3.5 43  10 0 (0.232558140 0.767441860) *
##      5) Education< 1.5 495  51 0 (0.103030303 0.896969697)  
##       10) Family>=2.5 54   3 1 (0.944444444 0.055555556) *
##       11) Family< 2.5 441   0 0 (0.000000000 1.000000000) *
##    3) Income< 110.5 2755  48 0 (0.017422868 0.982577132)  
##      6) CCAvg>=2.95 186  44 0 (0.236559140 0.763440860)  
##       12) CDAccount>=0.5 13   3 1 (0.769230769 0.230769231) *
##       13) CDAccount< 0.5 173  34 0 (0.196531792 0.803468208)  
##         26) Income>=92.5 56  21 0 (0.375000000 0.625000000)  
##           52) Education>=1.5 26   9 1 (0.653846154 0.346153846) *
##           53) Education< 1.5 30   4 0 (0.133333333 0.866666667) *
##         27) Income< 92.5 117  13 0 (0.111111111 0.888888889) *
##      7) CCAvg< 2.95 2569   4 0 (0.001557026 0.998442974) *

출력 결과에서 오른쪽 끝에 *가 출력된 것이 끝마디입니다. 세어보니 10개입니다. 이걸로는 어떻게 나무가 어떤 형태를 갖는지 알기 어려우니 나무모형을 그림으로 그려보겠습니다.

# 한글 폰트를 설정합니다.
par(family = 'NanumGothic')

# 나무모형을 그립니다.
plot(x = fitTree, 
     compress = TRUE, 
     uniform = TRUE, 
     branch = 0.8, 
     margin = 0.1, 
     main = 'Classification Tree for Universal Bank')

# 분리기준을 추가로 출력합니다.
text(x = fitTree, 
     use.n = TRUE, 
     all = TRUE, 
     cex = 0.8)

확실하게 텍스트보다는 그림이 더 눈에 잘 들어옵니다. 끝마디의 개수를 세어보면 모두 10개라는 것을 알 수 있습니다. 그리고 끝마디별로 ‘1’ 또는 ‘0’으로 Labeling되어 있음을 알 수 있습니다. 가장 왼쪽에 있는 끝마디에 출력된 숫자 221/0는 목표변수의 범주 중 ‘1’이 221건이고, ‘0’이 0건이라는 의미입니다. 따라서 이 끝마디에 속한 관측값(데이터)은 ‘1’로 추정됩니다. 운이 좋게도 이 끝마디의 오분류율은 0입니다. 이런 식으로 각각의 끝마디마다 목표변수의 범주별 비중을 기준으로 Labeling을 해준 것입니다. 만약 의사결정나무 결과로 마케팅에 활용할 고객을 타겟팅한다면 끝마디의 추정 범주가 ‘1’인 것 중 오분류율이 낮은 순서대로 타겟팅하면 됩니다.

기본 그림이라 별로입니다. 그렇죠? 대안으로 rpart.plot 패키지에 속한 함수 두 가지를 소개해드리겠습니다.

# 보기 좋은 나무그림을 그릴 수 있습니다.
library(rpart.plot)
rpart.plot(x = fitTree)

이 그림은 한결 낫습니다. 비록 각 끝마디에 속한 관측값의 수는 알 수 없지만 Labeling 결과와 오분류율, 그리고 전체 관측값 중 비중을 한 번에 알 수 있습니다.

나무그림 하나만 더 그려볼까요? rpart.plot 패키지에 prp() 함수도 있는데요. faclen 인자에 0을 할당하면 범주형 목표변수의 레이블을 출력해줍니다. 그리고 extra 인자에 101을 할당하면 끝마디에 목표변수의 범주별 빈도수를 출력합니다. 앞에서 기본형 함수로 그림을 그렸을 때 text() 함수의 use.n = TRUE와 같은 기능을 하는 것이죠. box.pal을 지정하지 않으면 그냥 하얀색으로 출력되어 심심합니다. 각자 기호에 맞게 설정하면 되겠습니다.

# 나만의 팔레트를 설정합니다. 
library(RColorBrewer)
myPal <- brewer.pal(n = 3, name = 'Set2')

# 다른 나무그림도 소개합니다. 
prp(x = fitTree, 
    faclen = 0, 
    cex = 0.8, 
    extra = 101, 
    box.pal = myPal[fitTree$frame$yval])

다음으로 방금 적합한 분류모형에 대해 가지치기를 해야할지 판단해야 합니다. printcp() 함수를 실행해보겠습니다.

# 비용복잡도 표를 출력합니다. 
printcp(x = fitTree)

## 
## Classification tree:
## rpart(formula = PersonalLoan ~ ., data = trainSet, method = "class", 
##     parms = list(split = "gini"), control = rpart.control(minsplit = 20, 
##         cp = 0.01, maxdepth = 10))
## 
## Variables actually used in tree construction:
## [1] CCAvg     CDAccount Education Family    Income   
## 
## Root node error: 340/3525 = 0.096454
## 
## n= 3525 
## 
##         CP nsplit rel error  xerror     xstd
## 1 0.304412      0   1.00000 1.00000 0.051551
## 2 0.141176      2   0.39118 0.41471 0.034219
## 3 0.041176      3   0.25000 0.28235 0.028422
## 4 0.026471      4   0.20882 0.22353 0.025363
## 5 0.010294      5   0.18235 0.20294 0.024191
## 6 0.010000      9   0.13824 0.19118 0.023493

분류모형 출력했을 때 두 번째로 출력된 표와 같습니다. 여기에서 우리가 확인해야 할 것은 xerror가 가장 작은 행이 어떤 것인지 찾는 것입니다. 현재로는 최종 모형이 가장 좋습니다. 즉, 가지치기를 할 필요가 없다는 것이죠. 그래도 가지치기 실습을 꼭 해봐야 하니 처음 모형을 만들었을 때 코드에서 cp를 0.001, maxdepth를 30으로 바꿔서 분류모형을 다시 적합해보겠습니다. cp에 할당되는 값이 작을수록, maxdepth에 할당되는 값이 커질수록 가지의 수가 많아집니다.

# 분류모형을 다시 적합합니다. 
fitImsi <- rpart(formula = PersonalLoan ~ ., 
                 data = trainSet, 
                 method = 'class', 
                 parms = list(split = 'gini'),
                 control = rpart.control(minsplit = 20, 
                                         cp = 0.001, 
                                         maxdepth = 30))

# 적합된 모형을 살펴봅니다.
printcp(x = fitImsi)

## 
## Classification tree:
## rpart(formula = PersonalLoan ~ ., data = trainSet, method = "class", 
##     parms = list(split = "gini"), control = rpart.control(minsplit = 20, 
##         cp = 0.001, maxdepth = 30))
## 
## Variables actually used in tree construction:
## [1] CCAvg      CDAccount  Education  Experience Family     Income    
## [7] Online    
## 
## Root node error: 340/3525 = 0.096454
## 
## n= 3525 
## 
##          CP nsplit rel error  xerror     xstd
## 1 0.3044118      0   1.00000 1.00000 0.051551
## 2 0.1411765      2   0.39118 0.41765 0.034335
## 3 0.0411765      3   0.25000 0.28529 0.028566
## 4 0.0264706      4   0.20882 0.22941 0.025687
## 5 0.0102941      5   0.18235 0.20588 0.024362
## 6 0.0014706      9   0.13824 0.18529 0.023135
## 7 0.0010000     13   0.13235 0.22941 0.025687

나무모형이 더 커졌습니다. 끝마디의 개수가 14개인 것으로 보입니다. nsplit이 9일 때 xerror이 가장 낮습니다. 그러므로 끝마디의 개수가 10인 나무가 가장 좋다는 의미입니다. 그래프로 그려보면 더 보기 좋겠죠? plotcp() 함수가 있습니다. 이 그래프는 나무가 성장함에 따라, 끝마디 개수가 증가함에 따라 relative cross-validation error가 어떻게 변하는지 보여줍니다. 가로 점선보다 아래에 있는 나무모형을 선택하면 되는데요. 가장 낮은 값을 선택합니다.

# 교차확인 상대오차 도표를 확인합니다. 
plotcp(x = fitImsi)

그래프로 그려보니 끝마디의 개수가 10일 때가 가장 좋다는 것을 알 수 있습니다. xerror이 최소값일 때의 cp를 비용복잡도 파라미터로 갖는 나무모형으로 가지치기하러 갑시다!

# xerror이 가장 낮을 때의 비용복잡도 파라미터를 구합니다. 
bestCP <- fitImsi$cptable[which.min(fitImsi$cptable[ , 'xerror']), 'CP']

# bestCP를 출력합니다.
print(bestCP)

## [1] 0.001470588

# 가지치기(pruning)를 합니다. 
fitPrun <- prune.rpart(tree = fitImsi, cp = bestCP)

bestCP는 0.001470588이었습니다. 가지치기 전후 모형을 그림으로 확인해보도록 하죠.

# 가지치기 전 모형을 그림으로 출력합니다. 
prp(x = fitImsi, 
    faclen = 0, 
    cex = 0.8, 
    extra = 101, 
    box.pal = myPal[fitImsi$frame$yval])


# 가지치기 후 모형을 그림으로 출력합니다. 
prp(x = fitPrun, 
    faclen = 0, 
    cex = 0.8, 
    extra = 101, 
    box.pal = myPal[fitPrun$frame$yval])

가지치기를 한 모형이 좀 더 깔끔해진 (느낌 같은) 느낌이 듭니다. 실제로 현업에서 마케팅에 활용하기에도 가지치기를 한 심플한 모형이 더 낫습니다.

가지치기까지 했으니 cp에 0.001을 할당한 가지치기 전 모형과 가지치기 한 모형의 분류 성능을 비교하기 위해 혼동행렬과 ROC 커브를 그려보겠습니다.

# 각각의 모형에 시험셋을 적용하여 추정값을 만듭니다. 
predImsi <- predict(object = fitImsi, newdata = testSet, type = 'class')
predPrun <- predict(object = fitPrun, newdata = testSet, type = 'class')

# 혼동행렬에 필요한 패키지를 불러옵니다. 
library(caret)

# 첫 번째 모형의 혼동행렬 지표들을 확인합니다.
confusionMatrix(data = predImsi, reference = testSet$PersonalLoan)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction    1    0
##          1  130   14
##          0   10 1321
##                                           
##                Accuracy : 0.9837          
##                  95% CI : (0.9759, 0.9895)
##     No Information Rate : 0.9051          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.9065          
##  Mcnemar's Test P-Value : 0.5403          
##                                           
##             Sensitivity : 0.92857         
##             Specificity : 0.98951         
##          Pos Pred Value : 0.90278         
##          Neg Pred Value : 0.99249         
##              Prevalence : 0.09492         
##          Detection Rate : 0.08814         
##    Detection Prevalence : 0.09763         
##       Balanced Accuracy : 0.95904         
##                                           
##        'Positive' Class : 1               
##

민감도가 0.92857, 특이도가 0.98951, 그리고 정밀도는 0.90278로 모형의 분류 성능이 아주 뛰어납니다. 당연히 F1 점수도 높을 것 같습니다.

# F1 점수에 필요 패키지를 불러옵니다. 
library(MLmetrics)

# 첫 번째 모형의 추정 레이블과 실제값으로 F1 점수를 확인합니다.
F1_Score(y_pred = predImsi, y_true = testSet$PersonalLoan)

## [1] 0.915493

F1 점수는 0.915493으로 예상대로 아주 높은 값이 나왔습니다. ROC커브를 그리고 AUROC도 확인하겠습니다. 지난 포스팅에서 만든 함수를 사용하면 편리하겠죠?

# ROC 커브를 그리고, AUROC를 계산하는 사용자 정의 함수를 만듭니다. 
checkROC <- function(prob, real, title = 'ROC 커브') {
  
  # ROC 커브에 필요 패키지를 불러옵니다. 
  library(ROCR)
  
  # 추정값 및 실제값이 범주형인 경우, 숫자 벡터로 변환합니다. 
  if(class(x = prob) == 'factor') prob <- as.numeric(x = prob)
  if(class(x = real) == 'factor') real <- as.numeric(x = real)
  
  # ROC 커브를 그려서 분류 성능을 확인합니다.
  predObj <- prediction(predictions = prob, 
                        labels = real)
  
  # prediction 객체를 활용하여 performance 객체를 생성합니다. 
  perform <- performance(prediction.obj = predObj, 
                         measure = 'tpr', 
                         x.measure = 'fpr')
  
  # 한글이 제대로 출력되도록 설정합니다. 
  par(family = 'NanumGothic')
  
  # ROC 커브를 그립니다.
  plot(x = perform, main = title)
  
  # 왼쪽 아래 모서리에서 오른쪽 위 모서리를 잇는 대각선을 추가합니다. 
  lines(x = c(0, 1), y = c(0, 1), col = 'red', lty = 2)
  
  # AUROC에 필요 패키지를 불러옵니다.
  library(pROC)

  # AUROC를 계산하고 ROC 커브 위에 출력합니다.
  auroc <- auc(real, prob) %>% round(digits = 4L)
  text(x = 0.9, y = 0, labels = str_c('AUROC : ', auroc), col = 'red')
}

첫 번째 모형의 시험용 데이터셋으로 ROC 커브를 그리고 AUROC를 출력합니다.

# ROC 커브를 그리고 AUROC를 출력합니다. 
checkROC(prob = predImsi, 
         real = testSet$PersonalLoan, 
         title = 'ROC 커브 - 가지치기 하기 전 모형 (CP = 0.001)')

## Loading required package: gplots

## 
## Attaching package: 'gplots'

## The following object is masked from 'package:stats':
## 
##     lowess

## Type 'citation("pROC")' for a citation.

## 
## Attaching package: 'pROC'

## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var

AUROC가 0.959입니다. 상당히 양호한 것 같습니다.

그럼 가지치기한 두 번째 모형에 대해서 같은 평가 지표를 확인해보겠습니다.

# 두 번째 모형의 혼동행렬 지표들을 확인합니다.
confusionMatrix(data = predPrun, reference = testSet$PersonalLoan)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction    1    0
##          1  130    8
##          0   10 1327
##                                           
##                Accuracy : 0.9878          
##                  95% CI : (0.9808, 0.9928)
##     No Information Rate : 0.9051          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.9285          
##  Mcnemar's Test P-Value : 0.8137          
##                                           
##             Sensitivity : 0.92857         
##             Specificity : 0.99401         
##          Pos Pred Value : 0.94203         
##          Neg Pred Value : 0.99252         
##              Prevalence : 0.09492         
##          Detection Rate : 0.08814         
##    Detection Prevalence : 0.09356         
##       Balanced Accuracy : 0.96129         
##                                           
##        'Positive' Class : 1               
##

민감도가 0.92857, 특이도가 0.99401, 그리고 정밀도는 0.94203로 출력된 것으로 보아 가지치기 전 모형에 비해 분류 성능이 조금씩 더 개선된 것 같습니다. 그럼 F1 점수도 좋아졌겠죠?

# 두 번째 모형의 추정 레이블과 실제값으로 F1 점수를 확인합니다.
F1_Score(y_pred = predPrun, y_true = testSet$PersonalLoan)

## [1] 0.9352518

역시 F1 점수가 조금 더 올랐네요. 0.9352518입니다. 마지막으로 ROC 커브를 그리고 AUROC를 확인하겠습니다.

# ROC 커브를 그리고 AUROC를 출력합니다. 
checkROC(prob = predPrun, 
         real = testSet$PersonalLoan, 
         title = 'ROC 커브 - 가지치기 한 모형 (CP = 0.003)')

AUROC가 0.9613입니다. 분류성능이 소폭이나마 좋아졌습니다.

이번 포스팅에서 의사결정나무로 분류모형을 적합할 때 가지치기의 중요성까지 알고 가신다면 더할 나위 없을 것 같습니다.

[1] 출처 : https://www.packtpub.com/books/content/divide-and-conquer-%E2%80%93-classification-using-decision-trees-and-rules

[2] 출처 : https://www.analyticsvidhya.com/blog/2016/04/complete-tutorial-tree-based-modeling-scratch-in-python/

[3] 자세한 사항은 관련 위키백과를 참고하기 바랍니다.

[4] 출처 : http://www.luigifreda.com/2017/03/22/bias-variance-tradeoff/

]]>나성호 (Seongho Na)나이브 베이즈 (Naive Bayes)2018-06-15T00:00:00+00:002026-06-24T00:00:00+00:00https://www.hds.ai.kr/posts/classification-2

이 글은 2018~2019년에 작성한 R 기반 강의 노트를 옮긴 것입니다. 코드 일부는 현재 패키지 버전과 다를 수 있습니다.

이번 포스팅에서는 분류모형 두 번째 소개로 나이브 베이즈 (Naive Bayes)에 대해서 알아보겠습니다. 나이브 베이즈는 베이즈 정리를 이용한 알고리즘입니다. 베이즈 정리는 조건부 확률을 활용한 것이죠. 일단 조건부 확률과 베이즈 정리에 대해서 간단하게 살펴보겠습니다.

조건부 확률 (Conditional Probability)

조건부 확률은 어떤 사건 A가 일어났을 때 B가 일어날 확률을 의미합니다. 사건 B가 발생활 확률은 사건 A의 영향을 받아 변하는데 이를 조건부 확률이라고 합니다.[1] 조건부 확률을 수식으로 표현하면 아래와 같습니다.

\[P(B|A) = \frac {P(A \cap B)} {P(A)}\]

만약 사건 A와 사건 B가 서로 독립이라고 하면 두 확률의 곱은 교집합(곱사건)일 확률과 같습니다.

\[P(A) \times P(B) = P(A \cap B)\]

예를 들어, 주사위를 던지는 게임을 한다고 가정했을 때 2의 배수가 나올 확률은 1/2이고, 3의 배수가 나올 확률은 1/3입니다. 그리고 이 두 사건의 교집합의 원소는 6밖에 없으므로 확률은 1/6이 됩니다. 이렇게 간단한 예를 통해 두 사건이 독립이라는 것이 어떤 의미인지 알 수 있습니다.

따라서 두 사건이 독립일 때 조건부 확률을 이용하면 다음과 같은 관계가 성립됩니다.

\[P(A|B) = \frac {P(A \cap B)} {P(B)} = \frac {P(A) \times P(B)} {P(B)} = P(A)\] \[P(B|A) = \frac {P(A \cap B)} {P(A)} = \frac {P(A) \times P(B)} {P(A)} = P(B)\]

베이즈 정리 (Bayes’ Theorem)

베이즈 정리는 두 확률변수의 사전확률과 사후확률 사이의 관계를 나타내는 정리입니다.[2] 사건 A와 B의 곱사건일 확률은 조건부 확률을 이용하여 아래와 같이 두 개의 식으로 표현할 수 있습니다.

\[P(A \cap B) = P(A) \times P(B|A)\] \[P(A \cap B) = P(B) \times P(A|B)\]

두 식의 우항이 서로 같다는 것을 이용한 것이 베이즈 정리입니다.

\[P(A) \times P(B|A) = P(B) \times P(A|B)\] \[\therefore P(A|B) = \frac{P(A) \times P(B|A)} {P(B)}\] \[\begin{cases} P(A|B): \text{B일 때, A의 사후확률 (Posterior Probability)} \\ P(A): \text{A의 사전확률 (Prior Probability, Evidence)} \\ P(B|A): \text{A일 때, B의 가능도 (Likelihood)} \\ P(B): \text{정규화 상수 (Normalized Constant)} \\ \end{cases}\]

베이즈 정리를 처음 공부할 때 생소한 용어 때문에 막히는 경우가 있는 것 같습니다. (제가 그랬거든요. 후후) 익숙해질 때까지 반복해서 노출시킨다 생각하고 4가지 용어에 대해서 살펴보겠습니다.

  • 사후확률은 우리가 알고자 하는 확률입니다. 사건 B가 일어났을 때 A일 조건부 확률이죠.
  • 사전확률은 우리가 (경험적으로) 이미 알고 있는 확률입니다.
  • 가능도는 표본으로부터 모수를 추정하는 것인데, 여기에서는 B가 주어졌을 때 A일 가능도를 의미합니다. (A와 B의 순서에 주의하세요!)
  • 정규화 상수는 우항의 분자(사전확률과 가능도의 곱)를 전체집합이 아닌 부분집합 B로 압축하는 것을 의미합니다.

수식과 글로는 이해하기 어려우니 그림을 통해 베이즈 정리를 이해해보도록 하죠.

베이즈 정리[3]

위 그림에서 큰 직사각형을 전체집합이라고 하면, 전체집합은 A1, A2, A3, … , An이라는 n개의 부분집합의 합인 것을 알 수 있습니다. 그리고 역시 부분집합인 B가 여러 개의 A에 걸쳐 있다고 할 때, 예컨데 전체집합에서 A2일 확률과 집합 B에 속하면서 A2일 사후확률은 서로 다를 것입니다.

영화로 예를 들어보죠. 영화의 장르를 전체집합이라고 할 때, 액션(A1), 드라마(A2), 로맨스(A3), 코미디(A4) 등 n개의 부분집합으로 이루어져 있을 것입니다. 이런 가정 하에서 어떤 영화평을 읽었는데 만약 그 영화평에서 ‘사랑’이라는 단어가 사용되었다면, 그 영화의 장르는 ‘액션’에 가까울까요? 아니면 ‘로맨스’에 가까울까요?

상식적으로는 ‘로맨스’에 가깝겠죠? 베이즈 정리를 활용하면 ‘액션’일 사후확률과 ‘로맨스’일 사후확률을 계산할 수 있습니다. 영화평이 쓰여진 전체 영화 목록을 다 가져와서 장르별로 개수를 세면 각 장르별 사전확률을 알 수 있습니다. 그리고 각 장르별로 영화평에 쓰여진 단어(이 예시에서는 ‘사랑’)별 조건부 확률도 알 수 있습니다. 정규화 상수는 전체 영화평에서 ‘사랑’이라는 단어가 사용된 확률이 되겠죠. 이 세 가지를 가지고 영화평에서 ‘사랑’이라는 단어가 사용되었을 때 각 장르별 사후확률을 계산할 수 있는 것입니다.

다시 그림으로 돌아가서, 우리는 앞에서 A1의 장르를 ‘액션’이라고 가정했는데 전체 영화 장르 중에서 ‘액션’은 분명히 있습니다. 그렇죠? 그런데, 영화평에서 ‘사랑’이라는 단어가 사용(사건 B)되었을 때, A1과 B가 겹치는 부분이 없습니다. ‘사랑’이라는 단어가 영화평에 쓰였을 때 ‘액션’ 영화일 사후확률이 0이라는 것이죠.

베이즈 정리에 대해서 조금 더 가까워지셨나요? 잘 전달되었다면 다행이겠으나 그렇지 않다면 제가 설명을 제대로 못 한 것이니 너무 답답해하지 마시고, 다른 좋은 자료를 찾아 구글의 세계로 잠시 다녀오시지요.

나이브 베이즈 알고리즘

이제 부분집합 B가 여러 개인 베이즈 정리를 살펴볼 때가 왔습니다. 예컨데 영화평에서 ‘사랑’이라는 단어가 몇 번, ‘감동’이라는 단어가 몇 번, 이런 식으로 B가 여러 개일 때 각 장르별 사후확률을 계산한다고 생각하는 것이 타당합니다. 수식으로는 아래와 같이 표현할 수 있습니다. A는 Class의 ‘C’로, B는 입력변수를 의미하는 ‘x’로 바꿔서 표기하겠습니다.

\[P(C_k|x_1, x_2, ⋯, x_p) = P(C_k) P(x_1, x_2, ⋯, x_p|C_k)\]

위 식에서 정규화 상수가 빠졌는데요. 그 이유는 입력변수(영화평에 쓰인 단어)들이 주어졌을 때 특정 영화 장르일 사후확률값 그 자체를 아는 것보다 각각의 사후확률의 크기를 비교하는 것으로도 충분하기 때문입니다. 따라서 오른쪽 항의 분모는 상수이고, 모든 식에서 같은 크기로 사용되므로 제외하는 것입니다.

오른쪽 항의 조건부 확률이 꽤 복잡하게 생겼는데요. ‘나이브(Naive)’는 ‘단순한’, ‘순진한’의 뜻으로, 모든 입력변수(특성)이 서로 독립이라고 가정합니다. 사실 말이 안 되는 것이지만, 그렇게 가정하는 것입니다. ‘사랑’과 ‘감동’이 한 영화평에서 서로 독립적으로 발생한다고 생각하지는 않습니다만, 상호작용을 고려하면 수식이 매우매우 복잡해지기 때문에 ‘이 두 가지는 서로 독립이야’라고 하는거죠. 그렇게 하면 아래와 같이 식이 단순해집니다.

\[P(x_1, x_2, \cdots, x_p|C_k) = P(x_1|C_k) \times P(x_2|C_k) \times \cdots \times P(x_p|C_k) = \prod_{i=1}^{p} P(x_i|C_k)\] \[\therefore P(C_k|x_1, x_2, \cdots, x_p) = P(C_k) \prod_{i=1}^{p} P(x_i|C_k)\]

나이브 베이즈 예시[4]

아래 표와 같이 5행으로 된 영화평 데이터가 있다고 가정하고, 나이브 베이즈 알고리즘을 활용하여 영화 장르를 분류하는 모형을 만들어보겠습니다.

구분 장르 영화평(단어)
1 코미디 재미있는, 연인, 사랑, 사랑
2 액션 빠른, 맹렬한, 총격
3 코미디 연인, 날으는, 빠른, 재미있는, 재미있는
4 액션 맹렬한, 총격, 총격, 재미있는
5 액션 날으는, 빠른, 총격, 사랑
     

이제 ‘재미있는, 맹렬한, 빠른’이라는 세 가지 단어로 구성된 영화평 데이터로 영화 장르를 분류하겠습니다. 각 장르별로 영화평에 적힌 단어수를 세어 정리하면 다음과 같습니다.

  • 코미디에 쓰인 단어는 총 9개이며, 그 중 ‘재미있는’ 3개, ‘맹렬한’ 0개, 그리고 ‘빠른’ 1개입니다.
  • 액션에 쓰인 단어는 총 11이며, 그 중 ‘재미있는’ 1개, ‘맹렬한’ 2개, 그리고 ‘빠른’ 2개입니다.

위에서 정리한 내용을 가지고, 새로운 영화평이 주어졌을 때 코미디 또는 액션일 사후확률을 계산해보겠습니다.

  • 코미디일 사후확률
\[P(\text{코미디}|\text{영화평})\] \[= P(\text{코미디}) \times P(\text{재미있는}|\text{코미디}) \times P(\text{맹렬한}|\text{코미디}) \times P(\text{빠른}|\text{코미디})\] \[= \frac {2}{5} \times \frac {3}{9} \times \frac {0}{9} \times \frac {1}{9} = 0\]
  • 액션일 사후확률
\[P(액션|\text{영화평})\] \[= P(액션) \times P(\text{재미있는}|액션) \times P(\text{맹렬한}|액션) \times P(\text{빠른}|액션)\] \[= \frac {3}{5} \times \frac {1}{11} \times \frac {2}{11} \times \frac {2}{11} = 0.0018\]

위와 같이 영화평이 주어졌을 때 코미디일 사후확률은 0이고 액션을 사후확률은 0.0018이므로 새로운 영화평은 액션 영화로 분류됩니다.

라플라스 스무딩 (Laplace Smoothing)

위의 예제를 보면 ‘맹렬한’이라는 단어가 코미디 장르에 쓰이지 않았기 때문에 사후확률이 0이 되었습니다. 만약 ‘맹렬한’을 제외하고 2개의 단어로만 계산했다면 어떤 결과가 나왔을까요? 그 때는 ‘코미디’가 더 높은 사후확률값을 갖습니다.

나이브 베이즈 알고리즘은 훈련용 데이터에 포함되지 않은 특성(입력변수)이 추가되면 결과값(사후확률)은 모두 0으로 반환합니다. 이런 문제를 해결하기 위해 라플라스 스무딩 기법을 추가해주어야 합니다. 방법은 어렵지 않습니다. 각 특성별 사후확률을 계산할 때 아래 식과 같이 분자에 모두 +1을, 분모에는 중복을 제거한 단어의 종류(V)의 절대값을 더해줍니다.

\[P(x_i|C_k) = \frac {C_k \text{일 때 } x_i \text{의 개수} + 1} {C_k \text{일 때 } \mathbb {x} \text{의 개수} + |V|}\]

분자는 i번째 단어를 의미하고 분모는 전체 단어를 갖는 벡터를 의미합니다. 이번 예제에서 전체 단어의 종류는 [재미있는, 연인, 사랑, 빠른, 맹렬한, 총격, 날으는]으로 모두 7개입니다. 이제 라플라스 스무딩을 활용하여 위의 예제에서 분자에는 +1, 분모에는 +7을 더하여 사후확률을 계산해보겠습니다.

  • 코미디일 사후확률 (라플라스 스무딩 적용)
\[P(\text{코미디}|\text{영화평})\] \[= P(\text{코미디}) \times P(\text{재미있는}|\text{코미디}) \times P(\text{맹렬한}|\text{코미디}) \times P(\text{빠른}|\text{코미디})\] \[= \frac {2}{5} \times \frac {3+1}{9+7} \times \frac {0+1}{9+7} \times \frac {1+1}{9+7} = 0.0008\]
  • 액션일 사후확률 (라플라스 스무딩 적용)
\[P(액션|\text{영화평})\] \[= P(액션) \times P(\text{재미있는}|액션) \times P(\text{맹렬한}|액션) \times P(\text{빠른}|액션)\] \[= \frac {3}{5} \times \frac {1+1}{11+7} \times \frac {2+1}{11+7} \times \frac {2+1}{11+7} = 0.0019\]

‘액션’의 사후확률이 더 높게 나왔으나 ‘코미디’의 사후확률이 더이상 0이 아니라는 것을 알 수 있었습니다.

이 외에도 입력변수의 개수가 많을 경우, 0~1 값을 갖는 확률의 곱은 0으로 수렴하는 문제가 발생합니다. 이런 문제도 라플라스 스무딩을 통해 해결할 수 있습니다.

나이브 베이즈 따라하기

우리는 mlbench 패키지의 내장 데이터인 HouseVotes84를 가지고 나이브 베이즈를 활용한 분류모형을 적합하는 실습을 해보겠습니다. 이 데이터는 1984년에 실시된 16가지 주요 안건에 대한 미의회 투표 기록 데이터로 투표 결과에 따라 민주당원(A Democrat)인지 아니면 공화당원(A Republican)인지를 추정하는 분류모형을 만들 수 있습니다.

데이터를 불러온 후 데이터의 구조를 확인하고 미리보기 합니다.

# 데이터를 불러옵니다.
data(HouseVotes84, package = 'mlbench')

# 데이터의 구조를 확인합니다. 
str(object = HouseVotes84)

## 'data.frame':    435 obs. of  17 variables:
##  $ Class: Factor w/ 2 levels "democrat","republican": 2 2 1 1 1 1 1 2 2 1 ...
##  $ V1   : Factor w/ 2 levels "n","y": 1 1 NA 1 2 1 1 1 1 2 ...
##  $ V2   : Factor w/ 2 levels "n","y": 2 2 2 2 2 2 2 2 2 2 ...
##  $ V3   : Factor w/ 2 levels "n","y": 1 1 2 2 2 2 1 1 1 2 ...
##  $ V4   : Factor w/ 2 levels "n","y": 2 2 NA 1 1 1 2 2 2 1 ...
##  $ V5   : Factor w/ 2 levels "n","y": 2 2 2 NA 2 2 2 2 2 1 ...
##  $ V6   : Factor w/ 2 levels "n","y": 2 2 2 2 2 2 2 2 2 1 ...
##  $ V7   : Factor w/ 2 levels "n","y": 1 1 1 1 1 1 1 1 1 2 ...
##  $ V8   : Factor w/ 2 levels "n","y": 1 1 1 1 1 1 1 1 1 2 ...
##  $ V9   : Factor w/ 2 levels "n","y": 1 1 1 1 1 1 1 1 1 2 ...
##  $ V10  : Factor w/ 2 levels "n","y": 2 1 1 1 1 1 1 1 1 1 ...
##  $ V11  : Factor w/ 2 levels "n","y": NA 1 2 2 2 1 1 1 1 1 ...
##  $ V12  : Factor w/ 2 levels "n","y": 2 2 1 1 NA 1 1 1 2 1 ...
##  $ V13  : Factor w/ 2 levels "n","y": 2 2 2 2 2 2 NA 2 2 1 ...
##  $ V14  : Factor w/ 2 levels "n","y": 2 2 2 1 2 2 2 2 2 1 ...
##  $ V15  : Factor w/ 2 levels "n","y": 1 1 1 1 2 2 2 NA 1 NA ...
##  $ V16  : Factor w/ 2 levels "n","y": 2 NA 1 2 2 2 2 2 2 NA ...

# 미리보기 합니다.
head(x = HouseVotes84, n = 10L)

##         Class   V1 V2 V3   V4   V5 V6 V7 V8 V9 V10  V11  V12  V13 V14  V15
## 1  republican    n  y  n    y    y  y  n  n  n   y <NA>    y    y   y    n
## 2  republican    n  y  n    y    y  y  n  n  n   n    n    y    y   y    n
## 3    democrat <NA>  y  y <NA>    y  y  n  n  n   n    y    n    y   y    n
## 4    democrat    n  y  y    n <NA>  y  n  n  n   n    y    n    y   n    n
## 5    democrat    y  y  y    n    y  y  n  n  n   n    y <NA>    y   y    y
## 6    democrat    n  y  y    n    y  y  n  n  n   n    n    n    y   y    y
## 7    democrat    n  y  n    y    y  y  n  n  n   n    n    n <NA>   y    y
## 8  republican    n  y  n    y    y  y  n  n  n   n    n    n    y   y <NA>
## 9  republican    n  y  n    y    y  y  n  n  n   n    n    y    y   y    n
## 10   democrat    y  y  y    n    n  n  y  y  y   n    n    n    n   n <NA>
##     V16
## 1     y
## 2  <NA>
## 3     n
## 4     y
## 5     y
## 6     y
## 7     y
## 8     y
## 9     y
## 10 <NA>

435행, 17열로 된 데이터 프레임입니다. 모든 컬럼이 범주형 벡터입니다. 중간에 NA도 보이는군요. 어디가나 출석하지 않는 국회의원들이 존재하는군요. 데이터 컬럼별 상세 내용은 다음과 같습니다.

  • Class: democrat, republican
  • V01 (장애아동) : y, n
  • V02 (물프로젝트 비용 분담) : y, n
  • V03 (예산안 채택) : y, n
  • V04 (의료수가 동결) : y, n
  • V05 (엘살바도르 원조) : y, n
  • V06 (학교내 종교단체) : y, n
  • V07 (반위성 조사 금지) : y, n
  • V08 (콘트라 반군 원조) : y, n
  • V09 (MX 미사일) : y, n
  • V10 (이민) : y, n
  • V11 (합성연료 감축) : y, n
  • V12 (교육비 지출) : y, n
  • V13 (슈퍼펀드 청구권) : y, n
  • V14 (범죄) : y, n
  • V15 (면제 수출) : y, n
  • V16 (수출행정법) : y, n

민주당원과 공화당원의 비중, 즉 사전확률은 어떨까요?

# 목표변수의 비중을 확인합니다. 
HouseVotes84$Class %>% table() %>% prop.table()

## .
##   democrat republican 
##  0.6137931  0.3862069

민주당원이 약 61.4%, 공화당원이 약 38.6%입니다. 전체 데이터를 70:30의 비중으로 훈련용 데이터셋과 시험용 데이터셋으로 나누도록 하겠습니다.

# 전체 데이터셋의 70%를 훈련용, 30%를 시험용 데이터로 분리합니다. 
# 같은 결과를 얻기 위해 seed를 설정합니다. 
set.seed(seed = 1)

# 전체 데이터를 임의로 샘플링하기 위해 다음과 같이 처리합니다. 
idx <- sample(x = 2, size = nrow(x = HouseVotes84), prob = c(0.7, 0.3), replace = TRUE)

# idx가 1일 때 trainSet, 2일 때 testSet에 할당합니다.
trainSet <- HouseVotes84[idx == 1, ]
testSet <- HouseVotes84[idx == 2, ]

# 훈련용, 시험용 데이터셋의 목표변수 비중을 확인합니다.  
trainSet$Class %>% table() %>% prop.table()

## .
##   democrat republican 
##  0.6123779  0.3876221

testSet$Class %>% table() %>% prop.table()

## .
##   democrat republican 
##  0.6171875  0.3828125

훈련용 데이터셋에는 민주당원의 비중이 미세하고 낮고, 시험용 데이터셋에는 미세하게 높지만 전체 데이터와의 차이가 없다고 가정하고 훈련용 데이터셋으로 나이브 베이즈 분류모형을 만드는 실습을 하겠습니다. 먼저 관련 함수에 대해 알아보아야 되겠죠? 나이브 베이즈는 e1071 패키지의 naiveBayes() 함수를 사용합니다. 역시 아주 쉽습니다. 이 함수의 주요 인자는 다음과 같습니다.

  • x : 입력변수 특성을 할당합니다. 숫자형 행렬이나 범주형/숫자형 벡터로 이루어진 데이터 프레임을 할당하면 됩니다.
  • y : 종속변수를 할당합니다. 범주형 벡터로 할당하면 됩니다.
  • formula : 종속변수와 입력변수 간 관계식을 표기합니다. 데이터 인자에 할당된 종속변수 y와 나머지 모든 변수를 입력변수로 할당하려면 y ~ .와 같이 표기하면 됩니다.
  • data : 숫자형/범주형 벡터로 이루어진 데이터 프레임을 할당합니다.
  • laplace : 라플라스 스무딩에 사용될 값을 추가합니다. 기본값은 0이며, 앞에서 다룬 예제는 1을 입력한 것과 같습니다.
# 필요 패키지를 불러옵니다.
library(e1071)

라플라스 스무딩을 적용하기 전 분류모형 적합

# 라플라스 스무딩을 적용하기 전 분류모형을 적합합니다. 
fitL0 <- naiveBayes(formula = Class ~ ., data = trainSet, laplace = 0)

# fitL0 객체의 속성을 확인합니다. 
class(x = fitL0)

## [1] "naiveBayes"

# fitL0 객체의 구조를 확인합니다. 
str(object = fitL0)

## List of 4
##  $ apriori: 'table' int [1:2(1d)] 188 119
##   ..- attr(*, "dimnames")=List of 1
##   .. ..$ Y: chr [1:2] "democrat" "republican"
##  $ tables :List of 16
##   ..$ V1 : 'table' num [1:2, 1:2] 0.389 0.829 0.611 0.171
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y : chr [1:2] "democrat" "republican"
##   .. .. ..$ V1: chr [1:2] "n" "y"
##   ..$ V2 : 'table' num [1:2, 1:2] 0.515 0.505 0.485 0.495
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y : chr [1:2] "democrat" "republican"
##   .. .. ..$ V2: chr [1:2] "n" "y"
##   ..$ V3 : 'table' num [1:2, 1:2] 0.0934 0.8793 0.9066 0.1207
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y : chr [1:2] "democrat" "republican"
##   .. .. ..$ V3: chr [1:2] "n" "y"
##   ..$ V4 : 'table' num [1:2, 1:2] 0.9611 0 0.0389 1
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y : chr [1:2] "democrat" "republican"
##   .. .. ..$ V4: chr [1:2] "n" "y"
##   ..$ V5 : 'table' num [1:2, 1:2] 0.8034 0.0431 0.1966 0.9569
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y : chr [1:2] "democrat" "republican"
##   .. .. ..$ V5: chr [1:2] "n" "y"
##   ..$ V6 : 'table' num [1:2, 1:2] 0.514 0.111 0.486 0.889
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y : chr [1:2] "democrat" "republican"
##   .. .. ..$ V6: chr [1:2] "n" "y"
##   ..$ V7 : 'table' num [1:2, 1:2] 0.215 0.754 0.785 0.246
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y : chr [1:2] "democrat" "republican"
##   .. .. ..$ V7: chr [1:2] "n" "y"
##   ..$ V8 : 'table' num [1:2, 1:2] 0.157 0.855 0.843 0.145
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y : chr [1:2] "democrat" "republican"
##   .. .. ..$ V8: chr [1:2] "n" "y"
##   ..$ V9 : 'table' num [1:2, 1:2] 0.242 0.897 0.758 0.103
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y : chr [1:2] "democrat" "republican"
##   .. .. ..$ V9: chr [1:2] "n" "y"
##   ..$ V10: 'table' num [1:2, 1:2] 0.514 0.457 0.486 0.543
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y  : chr [1:2] "democrat" "republican"
##   .. .. ..$ V10: chr [1:2] "n" "y"
##   ..$ V11: 'table' num [1:2, 1:2] 0.466 0.866 0.534 0.134
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y  : chr [1:2] "democrat" "republican"
##   .. .. ..$ V11: chr [1:2] "n" "y"
##   ..$ V12: 'table' num [1:2, 1:2] 0.861 0.153 0.139 0.847
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y  : chr [1:2] "democrat" "republican"
##   .. .. ..$ V12: chr [1:2] "n" "y"
##   ..$ V13: 'table' num [1:2, 1:2] 0.713 0.14 0.287 0.86
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y  : chr [1:2] "democrat" "republican"
##   .. .. ..$ V13: chr [1:2] "n" "y"
##   ..$ V14: 'table' num [1:2, 1:2] 0.6389 0.0263 0.3611 0.9737
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y  : chr [1:2] "democrat" "republican"
##   .. .. ..$ V14: chr [1:2] "n" "y"
##   ..$ V15: 'table' num [1:2, 1:2] 0.347 0.882 0.653 0.118
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y  : chr [1:2] "democrat" "republican"
##   .. .. ..$ V15: chr [1:2] "n" "y"
##   ..$ V16: 'table' num [1:2, 1:2] 0.0543 0.3137 0.9457 0.6863
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y  : chr [1:2] "democrat" "republican"
##   .. .. ..$ V16: chr [1:2] "n" "y"
##  $ levels : chr [1:2] "democrat" "republican"
##  $ call   : language naiveBayes.default(x = X, y = Y, laplace = laplace)
##  - attr(*, "class")= chr "naiveBayes"

나이브 베이즈 분류모형을 적합한 결과 객체는 naiveBayes라는 속성을 가지고 있지만, 실제로는 4개의 원소로 이루어진 리스트형 자료이며, tables 원소에 16개의 입력변수(특성)에 관한 사후확률이 포함되어 있습니다. 이것은 무엇을 의미할까요? 바로 나이브 베이즈 알고리즘에서 오른쪽 항의 조건부 확률을 의미합니다. 우리가 이 분류모형을 통해 알고자 하는 것은 16개 투표 결과로 이 국회의원이 민주당원인지 공화당원인지 여부(사후확률)입니다. 그렇죠? 사전확률은 이미 확인하였고, 방금 출력된 분류모형의 결과가 바로 가능도입니다. 이 중에서 2개만 미리보기 해보겠습니다.

# 모형 적합 결과를 일부 출력합니다. 
print(fitL0$tables[1:2])

## $V1
##             V1
## Y                    n         y
##   democrat   0.3888889 0.6111111
##   republican 0.8290598 0.1709402
## 
## $V2
##             V2
## Y                    n         y
##   democrat   0.5147929 0.4852071
##   republican 0.5046729 0.4953271

V1 (장애아동) 항목에 대한 사후확률을 살펴보니, 민주당원이라면 y로 투표할 사후확률이 0.6111111인 반면, 공화당원이라면 0.1709402가 됩니다. 그리고 V2 (물프로젝트 비용 부담) 항목의 경우, 민주당원이라면 y로 투표할 사후확률이 0.4852071이고, 공화당원이라면 0.4953271이 되는 것이죠. 앞에서 나이브 베이즈 알고리즘을 설명할 때 가능도를 모두 곱했던 것 기억하시죠? 사전확률에 16가지 가능도를 모두 곱하면 사후확률이 계산되는 것입니다. 확률은 0~1 값을 가지므로 곱을 거듭할수록 숫자가 매우 작아지게 되므로 양변에 로그를 취하면 곱을 합으로 바꿀 수 있어 계산하기 편하게 되는 것이죠. 계산은 컴퓨터가 해주는 것이니 굳이 로그를 취하지 않아도 되겠죠.

그런데 실제로 사후확률이 제대로 계산되었는지 직접구해보겠습니다. table() 함수와 prop.table(margin = 1)를 활용하면 손쉽게 구할 수 있습니다.

# 실제로 V1 항목에 대한 각각의 사후확률이 맞는지 직접 계산해보겠습니다. 
table(trainSet$Class, trainSet$V1) %>% prop.table(margin = 1)

##             
##                      n         y
##   democrat   0.3888889 0.6111111
##   republican 0.8290598 0.1709402

똑같은 결과를 얻을 수 있음을 확인했습니다.

다음으로 넘어가서, 방금 적합한 분류모형으로 훈련용 데이터셋 307명의 국회의원에 대한 추정 레이블(predict label)을 구하고, 혼동행렬과 ROC 커브를 통해 분류 성능을 확인해보겠습니다.

# 훈련용 데이터셋으로 분류모형의 추정 레이블을 확인합니다. 
trPredL0 <- predict(object = fitL0, newdata = trainSet)

# 미리보기 합니다. 
head(x = trPredL0, n = 10L)

##  [1] republican republican republican democrat   republican republican
##  [7] democrat   republican republican democrat  
## Levels: democrat republican

# 혼동행렬에 필요한 패키지를 불러옵니다. 
library(caret)

# 라플라스 스무딩을 적용하지 않은 모형의 혼동행렬 지표들을 확인합니다.
confusionMatrix(data = trPredL0, reference = trainSet$Class)

## Confusion Matrix and Statistics
## 
##             Reference
## Prediction   democrat republican
##   democrat        172          9
##   republican       16        110
##                                           
##                Accuracy : 0.9186          
##                  95% CI : (0.8821, 0.9466)
##     No Information Rate : 0.6124          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.8303          
##  Mcnemar's Test P-Value : 0.2301          
##                                           
##             Sensitivity : 0.9149          
##             Specificity : 0.9244          
##          Pos Pred Value : 0.9503          
##          Neg Pred Value : 0.8730          
##              Prevalence : 0.6124          
##          Detection Rate : 0.5603          
##    Detection Prevalence : 0.5896          
##       Balanced Accuracy : 0.9196          
##                                           
##        'Positive' Class : democrat        
##

비록 쉬운 예제(Toy Example)이긴 하지만 분류모형 적합 결과가 매우 좋습니다. 일단 positive 범주가 ‘democrat’인 것을 확인한 후 지표를 살펴보니, 민감도가 0.9149이고 특이도가 0.9244입니다. ROC 커브가 왼쪽 상단 모서리에 가깝게 그려질 것 같습니다. 정밀도 역시 0.9503로 매우 높으니 F1 점수도 아주 높게 나올 것 같습니다. 말이 나온 김에 F1 점수를 확인해보죠.

# F1 점수에 필요 패키지를 불러옵니다. 
library(MLmetrics)

# 라플라스 스무딩을 적용하지 않은 모형의 추정 레이블과 실제값으로 F1 점수를 확인합니다.
F1_Score(y_pred = trPredL0, y_true = trainSet$Class)

## [1] 0.9322493

예상대로 F1 점수가 0.9322493으로 아주 높은 값이 출력되었습니다. ROC 커브와 AUROC는 어떨까요? 앞으로 자주 쓰일 것 같으니 ROC 커브를 그리고 AUROC를 구하는 사용자 정의 함수를 만들어보겠습니다.

# ROC 커브를 그리고, AUROC를 계산하는 사용자 정의 함수를 만듭니다. 
checkROC <- function(prob, real, title = 'ROC 커브') {
  
  # ROC 커브에 필요 패키지를 불러옵니다. 
  library(ROCR)
  
  # 추정값이 범주형인 경우, 숫자 벡터로 변환합니다. 
  if(class(x = prob) == 'factor') prob <- as.numeric(x = prob)
  
  # ROC 커브를 그려서 분류 성능을 확인합니다.
  predObj <- prediction(predictions = prob, 
                        labels = real)
  
  # prediction 객체를 활용하여 performance 객체를 생성합니다. 
  perform <- performance(prediction.obj = predObj, 
                         measure = 'tpr', 
                         x.measure = 'fpr')
  
  # 한글이 제대로 출력되도록 설정합니다. 
  par(family = 'NanumGothic')
  
  # ROC 커브를 그립니다.
  plot(x = perform, main = title)
  
  # 왼쪽 아래 모서리에서 오른쪽 위 모서리를 잇는 대각선을 추가합니다. 
  lines(x = c(0, 1), y = c(0, 1), col = 'red', lty = 2)
  
  # AUROC에 필요 패키지를 불러옵니다.
  library(pROC)

  # AUROC를 계산하고 ROC 커브 위에 출력합니다.
  auroc <- auc(real, prob) %>% round(digits = 4L)
  text(x = 0.9, y = 0, labels = str_c('AUROC : ', auroc), col = 'red')
}

라플라스 스무딩 적용하지 않은 모형의 훈련용 데이터셋으로 ROC 커브를 그리고 AUROC를 출력합니다.

# ROC 커브를 그리고 AUROC를 출력합니다. 
checkROC(prob = trPredL0, 
         real = trainSet$Class, 
         title = 'ROC 커브 - 라플라스 스무딩 적용하지 않은 모형 (훈련셋)')

## Loading required package: gplots

## 
## Attaching package: 'gplots'

## The following object is masked from 'package:stats':
## 
##     lowess

## Type 'citation("pROC")' for a citation.

## 
## Attaching package: 'pROC'

## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var

ROC 커브 역시 예상대로 왼쪽 상단 모서리에 가깝게 그려졌고, AUROC도 0.9196이라는 높은 값이 나왔습니다. 그런데 ROC 커브가 여전히 곡선보다는 꺽인 직선 모양이라 그다지 예쁘지는 않습니다. 사후확률의 추정 레이블 대신 연속형 확률값을 사용하면 좀 더 매끈한 곡선처럼 그릴 수 있습니다. AUROC도 더 커질 것이구요.

사후확률 추정값을 각각 구해보겠습니다.

# 분류모형의 사후확률 추정값을 계산합니다. 
trProbL0 <- predict(object = fitL0, newdata = trainSet, type = 'raw')

# 새로 생성한 컬럼의 속성을 확인합니다. 
class(x = trProbL0)

## [1] "matrix"

# 미리보기 합니다.
head(x = trProbL0, n = 10L)

##               democrat           republican
##  [1,] 0.00000004677796 0.999999953222038940
##  [2,] 0.00000002293080 0.999999977069200408
##  [3,] 0.00389140408710 0.996108595912898909
##  [4,] 0.99627202007395 0.003727979926047030
##  [5,] 0.00000275815155 0.999997241848445295
##  [6,] 0.00000003160032 0.999999968399682193
##  [7,] 0.99999999999491 0.000000000005094578
##  [8,] 0.00000038019219 0.999999619807810936
##  [9,] 0.00000263425427 0.999997365745727063
## [10,] 0.99999999940778 0.000000000592221585

이제 ROC 커브를 그리고 AUROC를 구해보겠습니다.

# ROC 커브를 그리고 AUROC를 출력합니다. 
# [주의] trProdL0이 행렬인 것을 감안하여야 합니다. 
checkROC(prob = trProbL0[, 2], 
         real = trainSet$Class, 
         title = 'ROC 커브 - 라플라스 스무딩 적용하지 않은 모형 (훈련셋)')

ROC 커브가 더욱 매끄럽게 그려지고, AUROC 또한 0.9829로 최대값인 1에 가까워졌습니다. 시험셋을 적용해보면 어떨까요? 차이가 많이 나면 과적합되었다는 것을 의미합니다.

# 시험용 데이터셋으로 분류모형의 추정 레이블을 확인합니다. 
tePredL0 <- predict(object = fitL0, newdata = testSet)

# 라플라스 스무딩을 적용하지 않은 모형의 혼동행렬 지표들을 확인합니다.
confusionMatrix(data = tePredL0, reference = testSet$Class)

## Confusion Matrix and Statistics
## 
##             Reference
## Prediction   democrat republican
##   democrat         69          4
##   republican       10         45
##                                            
##                Accuracy : 0.8906           
##                  95% CI : (0.8233, 0.9389) 
##     No Information Rate : 0.6172           
##     P-Value [Acc > NIR] : 0.000000000004005
##                                            
##                   Kappa : 0.7738           
##  Mcnemar's Test P-Value : 0.1814           
##                                            
##             Sensitivity : 0.8734           
##             Specificity : 0.9184           
##          Pos Pred Value : 0.9452           
##          Neg Pred Value : 0.8182           
##              Prevalence : 0.6172           
##          Detection Rate : 0.5391           
##    Detection Prevalence : 0.5703           
##       Balanced Accuracy : 0.8959           
##                                            
##        'Positive' Class : democrat         
##

민감도가 0.8734, 특이도가 0.9184, 정밀도가 0.9452로 훈련용 데이터셋과 큰 차이를 보이지 않습니다.

# 라플라스 스무딩을 적용하지 않은 모형의 추정 레이블과 실제값으로 F1 점수를 확인합니다.
F1_Score(y_pred = tePredL0, y_true = testSet$Class)

## [1] 0.9078947

F1 점수도 0.9078947로 여전히 높게 나왔구요.

# 분류모형의 사후확률 추정값을 계산합니다. 
# [주의] 이렇게 하는 경우, trainSet의 probL0 컬럼에는 매트릭스가 할당됩니다. 
teProbL0 <- predict(object = fitL0, newdata = testSet, type = 'raw')

# 미리보기 합니다.
head(x = teProbL0, n = 10L)

##              democrat             republican
##  [1,] 0.9997763478535 0.00022365214652916789
##  [2,] 0.9638223162090 0.03617768379102025839
##  [3,] 0.0000457353687 0.99995426463129177819
##  [4,] 0.0000001855101 0.99999981448994379463
##  [5,] 0.9999998148987 0.00000018510132781037
##  [6,] 0.9999999999900 0.00000000000999376147
##  [7,] 0.9999999999999 0.00000000000009037084
##  [8,] 0.9999999999886 0.00000000001137084100
##  [9,] 0.0199827554190 0.98001724458104821913
## [10,] 0.9999999999993 0.00000000000066888936

# ROC 커브를 그리고 AUROC를 출력합니다. 
# [주의] prodL0이 행렬인 것을 감안하여야 합니다. 
checkROC(prob = teProbL0[, 2], 
         real = testSet$Class, 
         title = 'ROC 커브 - 라플라스 스무딩 적용하지 않은 모형 (시험셋)')

ROC 커브도 매끄럽게 잘 그려졌고, AUROC도 0.9672로 여전히 높게 나왔습니다. 전체적으로 모든 지표에서 조금씩 숫자가 작아지긴 했지만, 큰 차이를 보이지 않는다고 할 수 있습니다.

라플라스 스무딩을 적용한 분류모형 적합

이번에는 라플라스 스무딩 기법을 적용하도록 하겠습니다. naiveBayes() 함수의 laplace 인자에 1을 할당해보겠습니다.

# 라플라스 스무딩을 적용하기 전 분류모형을 적합합니다. 
fitL1 <- naiveBayes(formula = Class ~ ., data = trainSet, laplace = 1)

# fitL1 객체의 속성을 확인합니다. 
class(x = fitL1)

## [1] "naiveBayes"

# fitL1 객체의 구조를 확인합니다. 
str(object = fitL1)

## List of 4
##  $ apriori: 'table' int [1:2(1d)] 188 119
##   ..- attr(*, "dimnames")=List of 1
##   .. ..$ Y: chr [1:2] "democrat" "republican"
##  $ tables :List of 16
##   ..$ V1 : 'table' num [1:2, 1:2] 0.39 0.824 0.61 0.176
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y : chr [1:2] "democrat" "republican"
##   .. .. ..$ V1: chr [1:2] "n" "y"
##   ..$ V2 : 'table' num [1:2, 1:2] 0.515 0.505 0.485 0.495
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y : chr [1:2] "democrat" "republican"
##   .. .. ..$ V2: chr [1:2] "n" "y"
##   ..$ V3 : 'table' num [1:2, 1:2] 0.0978 0.8729 0.9022 0.1271
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y : chr [1:2] "democrat" "republican"
##   .. .. ..$ V3: chr [1:2] "n" "y"
##   ..$ V4 : 'table' num [1:2, 1:2] 0.95604 0.00847 0.04396 0.99153
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y : chr [1:2] "democrat" "republican"
##   .. .. ..$ V4: chr [1:2] "n" "y"
##   ..$ V5 : 'table' num [1:2, 1:2] 0.8 0.0508 0.2 0.9492
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y : chr [1:2] "democrat" "republican"
##   .. .. ..$ V5: chr [1:2] "n" "y"
##   ..$ V6 : 'table' num [1:2, 1:2] 0.514 0.118 0.486 0.882
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y : chr [1:2] "democrat" "republican"
##   .. .. ..$ V6: chr [1:2] "n" "y"
##   ..$ V7 : 'table' num [1:2, 1:2] 0.219 0.75 0.781 0.25
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y : chr [1:2] "democrat" "republican"
##   .. .. ..$ V7: chr [1:2] "n" "y"
##   ..$ V8 : 'table' num [1:2, 1:2] 0.16 0.848 0.84 0.152
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y : chr [1:2] "democrat" "republican"
##   .. .. ..$ V8: chr [1:2] "n" "y"
##   ..$ V9 : 'table' num [1:2, 1:2] 0.244 0.89 0.756 0.11
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y : chr [1:2] "democrat" "republican"
##   .. .. ..$ V9: chr [1:2] "n" "y"
##   ..$ V10: 'table' num [1:2, 1:2] 0.513 0.458 0.487 0.542
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y  : chr [1:2] "democrat" "republican"
##   .. .. ..$ V10: chr [1:2] "n" "y"
##   ..$ V11: 'table' num [1:2, 1:2] 0.467 0.86 0.533 0.14
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y  : chr [1:2] "democrat" "republican"
##   .. .. ..$ V11: chr [1:2] "n" "y"
##   ..$ V12: 'table' num [1:2, 1:2] 0.857 0.159 0.143 0.841
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y  : chr [1:2] "democrat" "republican"
##   .. .. ..$ V12: chr [1:2] "n" "y"
##   ..$ V13: 'table' num [1:2, 1:2] 0.711 0.147 0.289 0.853
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y  : chr [1:2] "democrat" "republican"
##   .. .. ..$ V13: chr [1:2] "n" "y"
##   ..$ V14: 'table' num [1:2, 1:2] 0.6374 0.0345 0.3626 0.9655
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y  : chr [1:2] "democrat" "republican"
##   .. .. ..$ V14: chr [1:2] "n" "y"
##   ..$ V15: 'table' num [1:2, 1:2] 0.349 0.875 0.651 0.125
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y  : chr [1:2] "democrat" "republican"
##   .. .. ..$ V15: chr [1:2] "n" "y"
##   ..$ V16: 'table' num [1:2, 1:2] 0.0611 0.3173 0.9389 0.6827
##   .. ..- attr(*, "dimnames")=List of 2
##   .. .. ..$ Y  : chr [1:2] "democrat" "republican"
##   .. .. ..$ V16: chr [1:2] "n" "y"
##  $ levels : chr [1:2] "democrat" "republican"
##  $ call   : language naiveBayes.default(x = X, y = Y, laplace = laplace)
##  - attr(*, "class")= chr "naiveBayes"

아직은 차이를 모르겠습니다. 앞에서 했던 것처럼 방금 적합한 분류모형으로 훈련용 데이터셋 307명의 국회의원에 대한 추정 레이블(predict label)을 구하고, 혼동행렬과 ROC 커브를 통해 분류 성능을 확인해보겠습니다.

# 훈련용 데이터셋으로 분류모형의 추정 레이블을 확인합니다. 
trPredL1 <- predict(object = fitL1, newdata = trainSet)

# 라플라스 스무딩을 적용한 모형의 혼동행렬 지표들을 확인합니다.
confusionMatrix(data = trPredL1, reference = trainSet$Class)

## Confusion Matrix and Statistics
## 
##             Reference
## Prediction   democrat republican
##   democrat        169          9
##   republican       19        110
##                                           
##                Accuracy : 0.9088          
##                  95% CI : (0.8709, 0.9385)
##     No Information Rate : 0.6124          
##     P-Value [Acc > NIR] : < 2e-16         
##                                           
##                   Kappa : 0.8108          
##  Mcnemar's Test P-Value : 0.08897         
##                                           
##             Sensitivity : 0.8989          
##             Specificity : 0.9244          
##          Pos Pred Value : 0.9494          
##          Neg Pred Value : 0.8527          
##              Prevalence : 0.6124          
##          Detection Rate : 0.5505          
##    Detection Prevalence : 0.5798          
##       Balanced Accuracy : 0.9117          
##                                           
##        'Positive' Class : democrat        
##

민감도 0.8989, 특이도 0.9244, 정밀도 0.9494로 라플라스 스무딩 적용하지 않은 모형보다 조금씩 낮게 나왔습니다.

# 라플라스 스무딩을 적용하지 않은 모형의 추정 레이블과 실제값으로 F1 점수를 확인합니다.
F1_Score(y_pred = trPredL1, y_true = trainSet$Class)

## [1] 0.9234973

F1 점수도 0.9234973로 조금 낮게 출력되었구요.

사후확률 추정값을 계산하고 ROC 커브를 그려보겠습니다.

# 분류모형의 사후확률 추정값을 계산합니다. 
trProbL1 <- predict(object = fitL1, newdata = trainSet, type = 'raw')

# ROC 커브를 그리고 AUROC를 출력합니다. 
checkROC(prob = trProbL1[, 2], 
         real = trainSet$Class, 
         title = 'ROC 커브 - 라플라스 스무딩 적용한 모형 (훈련셋)')

AUROC 역시 조금 낮은 것을 확인할 수 있습니다.

이상으로 나이브 베이즈 알고리즘을 활용한 분류모형 적합 방법에 대해 알아보았습니다.

[1] 자세한 내용은 위키백과를 참조하시기 바랍니다.

[2] 자세한 내용은 위키백과를 참조하시기 바랍니다.

[3] 출처 : http://tendollarbux.com/07/post18/bayes-theorem-venn-diagram/

[4] 출처: http://bcho.tistory.com/1010

]]>나성호 (Seongho Na)K-근접이웃 (K-nearest neighbors)2018-06-01T00:00:00+00:002026-06-24T00:00:00+00:00https://www.hds.ai.kr/posts/classification-1

이 글은 2018~2019년에 작성한 R 기반 강의 노트를 옮긴 것입니다. 코드 일부는 현재 패키지 버전과 다를 수 있습니다.

이전 포스팅에서 기계학습 알고리즘에 대해 간략하게 소개했습니다. 이번 포스팅에서는 목표변수가 있는 지도학습 중 분류(Classification) 모형에 대해 알아보도록 하겠습니다. 분류모형은 목표변수(Target Variable)가 범주형일 때 사용되는 알고리즘입니다. 예를 들어, 신용카드사의 Fraud Detection System와 같이 이상거래를 탐지하는 모형이 분류모형이라고 할 수 있습니다. 이 경우, 목표변수는 이상거래 여부(Yes/No)가 될 것입니다. 목표변수는 방금 예로 든 것과 같이 2가지 범주를 갖는 이진분리와 3개 이상의 범주를 갖는 다지분리로 나눌 수 있습니다. 이 블로그에서는 이진분리를 주로 다루도록 하겠습니다.

(제가 알고 있는 알고리즘 중에서) 분류모형에 사용되는 알고리즘을 열거해보면 다음과 같습니다.

  • K-근접이웃 (K-nearest neighbors)
  • 나이브 베이즈 (Naive Bayes)
  • 의사결정나무 (Decision Tree)
  • 로지스틱 회귀분석 (Logistic Regression)
  • 랜덤 포레스트 (Random Forest)
  • 서포트 벡터 머신 (Support Vector Machine)

K-근접이웃 알고리즘

이 중에서 가장 간단하지만 괜찮은 알고리즘부터 소개해드릴까 합니다. 바로 사례 기반 추론(Case Based Reasoning)에 속하는 K-근접이웃 알고리즘입니다. 위키백과에 따르면, 사례 기반 추론은 과거에 있었던 사례들의 결과를 바탕으로 새로운 사례의 결과를 예측하는 기법입니다.[1] K-근접이웃은 (목표변수가 있는) 기존 데이터와 (목표변수가 없는) 새로운 데이터 간 유사도를 측정하여 가장 가까운 데이터의 목표변수를 기준으로 새로운 데이터의 범주를 추론하는 방법입니다. 데이터 간 유사도는 보통 거리를 많이 사용합니다. 거리를 측정하는 방법에는 맨하탄, 유클리디안, 민코프스키 및 코사인유사도 등이 주로 사용됩니다.

K-근접이웃은 사실 분류모형 뿐만 아니라 회귀모형에도 사용할 수 있는 비모수적 알고리즘입니다. 비모수적이라는 말에서 모집단에 대한 어떠한 가정이 없다는 것을 알 수 있습니다. 즉, 모집단의 형태와 관계 없다는 것이죠. 다만, K-근접이웃은 하나의 관측값(observation)은 거리가 가까운 K개의 이웃 관측값들과 비슷한 특성을 갖는다라고 가정합니다. 따라서 분류모형에서 사용될 경우, K개 이웃의 목표변수 중 다수결로 가장 많은 범주에 속한 값을 결과로 반환합니다. 그리고 회귀모형의 경우, K개 이웃의 목표변수값의 평균을 반환합니다.

KNN[2]

그렇기 때문에 KNN 알고리즘에서 가장 중요한 것은 K를 얼마로 설정하느냐에 따라 결과가 달라집니다.

  • K를 작은 숫자로 설정하면 참고하는 데이터의 범위가 작아지므로 인접한 소수의 값들에 크게 영향을 받습니다. (이상치에 민감)
  • 반대로 K를 큰 숫자로 설정하면 참고하는 데이터의 범위가 커지므로 인접한 값들의 영향도가 감소합니다.
  • 일반적으로 훈련용 데이터(Training Dataset) 건수의 제곱근을 사용합니다.

한 가지 추가로 말씀드릴 것은, 인접한 K개의 이웃에 대해 가중치를 부여하거나 부여하지 않을 수 있습니다. 이를테면 거리가 가까울수록 더 긴밀한 관계를 갖는다고 판단이 드는 경우 가까울수록 높은 가중치를 부여하는 것이 좋을 것입니다. 이 때, 가중치로는 거리의 역순을 사용할 수 있습니다.

이제 알고리즘에 대한 설명은 이것으로 마치고 분석 사례로 들어가겠습니다.

K-근접이웃 따라하기

우리는 온라인에 공개된 와인 데이터를 사용하여 와인의 품질을 목표변수로 하는 분류모형을 적합하고자 합니다. 먼저 데이터를 불러온 후 데이터의 구조를 살펴보도록 하겠습니다.

# 데이터를 볼러옵니다. 
wine <- read.csv(file = 'https://archive.ics.uci.edu/ml/machine-learning-databases/wine-quality/winequality-white.csv',
                 sep = ";")

# 데이터의 구조를 파악합니다. 
str(object = wine)

## 'data.frame':    4898 obs. of  12 variables:
##  $ fixed.acidity       : num  7 6.3 8.1 7.2 7.2 8.1 6.2 7 6.3 8.1 ...
##  $ volatile.acidity    : num  0.27 0.3 0.28 0.23 0.23 0.28 0.32 0.27 0.3 0.22 ...
##  $ citric.acid         : num  0.36 0.34 0.4 0.32 0.32 0.4 0.16 0.36 0.34 0.43 ...
##  $ residual.sugar      : num  20.7 1.6 6.9 8.5 8.5 6.9 7 20.7 1.6 1.5 ...
##  $ chlorides           : num  0.045 0.049 0.05 0.058 0.058 0.05 0.045 0.045 0.049 0.044 ...
##  $ free.sulfur.dioxide : num  45 14 30 47 47 30 30 45 14 28 ...
##  $ total.sulfur.dioxide: num  170 132 97 186 186 97 136 170 132 129 ...
##  $ density             : num  1.001 0.994 0.995 0.996 0.996 ...
##  $ pH                  : num  3 3.3 3.26 3.19 3.19 3.26 3.18 3 3.3 3.22 ...
##  $ sulphates           : num  0.45 0.49 0.44 0.4 0.4 0.44 0.47 0.45 0.49 0.45 ...
##  $ alcohol             : num  8.8 9.5 10.1 9.9 9.9 10.1 9.6 8.8 9.5 11 ...
##  $ quality             : int  6 6 6 6 6 6 6 6 6 6 ...

# 첫 10 행을 미리보기 합니다.
head(x = wine, n = 10L)

##    fixed.acidity volatile.acidity citric.acid residual.sugar chlorides
## 1            7.0             0.27        0.36           20.7     0.045
## 2            6.3             0.30        0.34            1.6     0.049
## 3            8.1             0.28        0.40            6.9     0.050
## 4            7.2             0.23        0.32            8.5     0.058
## 5            7.2             0.23        0.32            8.5     0.058
## 6            8.1             0.28        0.40            6.9     0.050
## 7            6.2             0.32        0.16            7.0     0.045
## 8            7.0             0.27        0.36           20.7     0.045
## 9            6.3             0.30        0.34            1.6     0.049
## 10           8.1             0.22        0.43            1.5     0.044
##    free.sulfur.dioxide total.sulfur.dioxide density   pH sulphates alcohol
## 1                   45                  170  1.0010 3.00      0.45     8.8
## 2                   14                  132  0.9940 3.30      0.49     9.5
## 3                   30                   97  0.9951 3.26      0.44    10.1
## 4                   47                  186  0.9956 3.19      0.40     9.9
## 5                   47                  186  0.9956 3.19      0.40     9.9
## 6                   30                   97  0.9951 3.26      0.44    10.1
## 7                   30                  136  0.9949 3.18      0.47     9.6
## 8                   45                  170  1.0010 3.00      0.45     8.8
## 9                   14                  132  0.9940 3.30      0.49     9.5
## 10                  28                  129  0.9938 3.22      0.45    11.0
##    quality
## 1        6
## 2        6
## 3        6
## 4        6
## 5        6
## 6        6
## 7        6
## 8        6
## 9        6
## 10       6

불러온 데이터는 12개의 컬럼, 4898 행을 갖는 데이터 프레임입니다. 컬럼별 상세는 다음과 같습니다.

  • fixed.acidity : 고정 산도
  • volatile.acidity : 변동 산도
  • citric.acid : 구연산
  • residual.sugar : 당도
  • chlorides : 염화물
  • free.sulfur.dioxide : 이산화황
  • total.sulfur.dioxide : 총 이산화황
  • density : 밀도(무게감, 바디감)
  • pH : 수소이온농도 (낮을수록 산성)
  • sulphates : 황산염
  • alcohol : 알콜 함유량
  • quality : 와인의 품질

맨 마지막 컬럼인 quality만 정수형이고 다른 모든 컬럼들은 숫자형 벡터입니다. 와인의 속성에 해당하는 변수들임을 알 수 있습니다. 분류모형에 사용하려면 범주형 목표변수가 필요한데, 이 데이터에는 범주형 벡터가 없으므로 새로 만들어 주어야 합니다. quality 컬럼을 활용하여 새로운 목표변수를 만들어보도록 하겠습니다. 먼저 데이터의 분포를 확인하겠습니다.

# quality 컬럼의 빈도수를 확인합니다. 
table(wine$quality)

## 
##    3    4    5    6    7    8    9 
##   20  163 1457 2198  880  175    5

# 누적상대도수를 확인합니다.
table(wine$quality) %>% 
  prop.table() %>% 
  cumsum() %>% 
  round(digits = 4L) * 100

##      3      4      5      6      7      8      9 
##   0.41   3.74  33.48  78.36  96.33  99.90 100.00

quality 컬럼은 3~9의 값을 갖습니다. 누적상대도수를 확인해보니 3~6점인 건이 전체의 약 78% 정도 됩니다.

# 한글이 제대로 출력되도록 폰트를 설정합니다.
par(family = 'NanumGothic')

# quality 컬럼으로 막대그래프를 그려 분포를 확인합니다. 
bp <- barplot(height = table(wine$quality), 
              ylim = c(0, 2400), 
              xlab = '와인 품질')
# 빈도수를 추가합니다.
text(x = bp, 
     y = table(wine$quality), 
     labels = table(wine$quality), 
     pos = 3)

막대그래프로 그려보니 왼쪽으로 치우친 정규분포 형태로 보입니다. 아무튼, quality 컬럼값이 6점 이하면 Good 7점 이상이면 Best의 값을 갖는 목표변수를 새로 만들도록 하겠습니다.

# 목표변수를 새로 만듭니다. 
# quality 값이 3~6점이면 'good', 7~9점이면 'best'를 할당합니다. 
wine$grade <- ifelse(test = wine$quality >= 7, yes = 'best', no = 'good')

# 새로 만든 목표변수를 범주형으로 변환합니다.
wine$grade <- as.factor(x = wine$grade)

# 새로 만든 목표변수와 기존 품질 컬럼의 빈도수를 확인합니다.
table(wine$grade, wine$quality)

##       
##           3    4    5    6    7    8    9
##   best    0    0    0    0  880  175    5
##   good   20  163 1457 2198    0    0    0

KNN은 데이터 간 유사도를 측정하기 위해 거리를 이용한다고 하였습니다. 거리를 이용할 때 가장 중요한 전처리 작업은 무엇일까요? 바로 표준화입니다. 변수 간 척도(scale)가 다를 때 단위가 큰 변수가 거리에 지배적인(dominant) 영향을 끼칠 수 있기 때문입니다. 표준화를 거치면 모든 변수가 평균이 0, 표준편차가 1인 표준정규분포를 따르게 됩니다. 그럼 표준화를 해보도록 하겠습니다.

# 목표변수를 제외한 나머지 입력변수를 표준화하고 데이터 프레임으로 변환합니다.
wineScaled <- scale(x = wine[, 1:11], center = TRUE, scale = TRUE) %>% as.data.frame()

# 표준화된 데이터에 목표변수를 추가합니다. 
wineScaled <- cbind(wineScaled, grade = wine$grade)

scale() 함수를 이용하여 데이터 표준화를 하면 결과 객체가 행렬로 반환됩니다. 그런데 나중에 knn() 함수를 실행하려면 아무래도 데이터 프레임 객체가 더 편리하므로 결과 객체를 변환해줍니다. 데이터 표준화 작업을 할 때 주의할 점은 반드시 숫자 컬럼만 포함해야 한다는 것입니다. 앞에서 새로 만든 목표변수는 표준화 작업이 종료된 후 cbind() 함수로 추가하면 됩니다.

데이터 표준화가 완료되면 이전 포스팅에서 살펴본 바와 같이 자료분할(Hold-out Validation) 방법을 이용하여 전체 데이터를 훈련용(training) 데이터셋과 시험용(test) 데이터셋으로 나눕니다.

이번 예제에서는 전체 데이터의 70%를 훈련용 데이터셋으로 할당하고, 나머지 30%는 시험용 데이터셋으로 할당하겠습니다.

# 전체 데이터셋의 70%를 훈련용, 30%를 시험용 데이터로 분리합니다. 
# 같은 결과를 얻기 위해 seed를 설정합니다. 
set.seed(seed = 123)

# 전체 데이터를 임의로 샘플링하기 위해 다음과 같이 처리합니다. 
idx <- sample(x = 2, size = nrow(x = wineScaled), prob = c(0.7, 0.3), replace = TRUE)

# idx가 1일 때 trainSet, 2일 때 testSet에 할당합니다.
trainSet <- wineScaled[idx == 1, ]
testSet <- wineScaled[idx == 2, ]

sample() 함수에 대해서 간단하게 설명을 하자면 x 인자에 정수 n를 입력하면 1:n과 같은 효과를 가집니다. 그러므로 위와 같이 2를 할당한 경우, x에는 1과 2 두 개의 정수를 갖는 숫자형 벡터가 할당된 것과 마찬가지가 됩니다. size 인자에는 반환할 데이터의 개수를 입력합니다. 이번 예제에서는 wineScaled 데이터의 행 개수를 할당하였습니다. 그 이유는 x 인자에 할당된 1 또는 2를 wineScaled의 행 개수만큼 생성하여 1일 때 trainSet에 할당하고 2일 때 testSet에 할당하기 위함입니다. prob 인자에는 각각의 숫자가 생성될 비중을 지정합니다. 전체 데이터의 70%를 trainSet에 할당하려고 하니 0.7을 넣고, 나머지 30%는 testSet에 할당하기로 하였으니 0.3을 지정합니다. 마지막 replace 인자는 복원추출 여부를 묻는 것입니다. x 인자에 할당된 벡터의 길이(여기에서는 2)가 size에 할당된 숫자(여기에서는 wineScaled 데이터의 행 개수인 4898)보다 작으니 반드시 TRUE를 지정해주어야 합니다. 그렇지 않으면 에러가 발생합니다.

# 훈련용, 시험용 데이터셋의 목표변수 비중을 확인합니다.  
trainSet$grade %>% table() %>% prop.table()

## .
##      best      good 
## 0.2102355 0.7897645

testSet$grade %>% table() %>% prop.table()

## .
##      best      good 
## 0.2309801 0.7690199

훈련용 데이터셋과 시험용 데이터셋이 임의로 잘 나뉘었는지 확인해보았습니다. 그럭저럭 비슷한 비중으로 잘 들어가 있습니다. 여기까지 데이터 전처리를 마치고 KNN을 이용한 분류모형을 적합해보겠습니다.

가중치 없는 KNN 분류모형 적합하기

새로운 데이터와 인접 이웃 간 거리와 상관없이 모두 똑같은 비중으로 참조하려면 가중치 없는 분류모형을 적합하면 됩니다. 가중치 없는 KNN 알고리즘은 class 패키지의 knn() 함수를 사용합니다. 주요 인자에 대한 설명을 간단하게 하도록 하겠습니다.

  • train : 훈련용 데이터셋을 할당합니다. 주의할 점은 입력변수만 포함시켜야 한다는 것입니다.
  • test : 시험용 데이터셋을 할당합니다. 마찬가지로 입력변수만 포함시킵니다.
  • cl : 훈련용 데이터셋의 목표변수를 할당합니다. 범주형 벡터로 할당해야 합니다!
  • k : 참고할 이웃의 수를 할당합니다. 임의로 넣어도 되고, 데이터 행 개수의 제곱근을 할당해도 됩니다. 이 때 제곱근은 대개 무리수이므로, ceiling() 또는 floor() 등을 사용하여 정수로 바꿔주어야 합니다.
  • prob : 목표변수 범주에 속할 확률을 반환할지 여부를 TRUE 또는 FALSE로 할당합니다. 만약 TRUE로 할당하면 prob 속성(attribute)으로 확률값이 저장됩니다.
# 필요 패키지를 불러옵니다.
library(class)

# set.seed를 지정합니다. 
set.seed(seed = 123)

# 가중치 없는 KNN 분류모형을 적합합니다. 
fitKnn <- 
  knn(train = trainSet[, 1:11], 
      test = testSet[, 1:11], 
      cl = trainSet$grade, 
      k = trainSet %>% nrow() %>% sqrt() %>% ceiling(), 
      prob = TRUE)

# 예측값의 첫 100개만 미리보기 합니다. 
fitKnn[1:100]

##   [1] good good good good good good good best good good good good good good
##  [15] good good good good good good good good good good good good good good
##  [29] good good good good good good good good good good good good good good
##  [43] good good good good good good good good good best good good good good
##  [57] good good good good good good good good good good good good good good
##  [71] good good good good good good good good good good good good good good
##  [85] good good good good good good good good good good good good good good
##  [99] good good
## Levels: best good

# 예측값의 확률도 첫 100개만 미리보기 합니다. 
attr(x = fitKnn, which = 'prob')[1:100]

##   [1] 0.9500000 0.9833333 0.9833333 0.6949153 0.8135593 0.6440678 1.0000000
##   [8] 0.5084746 1.0000000 1.0000000 0.9152542 0.8474576 0.7333333 0.9491525
##  [15] 0.8666667 0.7288136 0.9830508 0.9830508 0.8000000 0.5084746 0.9322034
##  [22] 0.5423729 1.0000000 0.8305085 0.9491525 0.9830508 0.9322034 0.9833333
##  [29] 0.9830508 0.6833333 0.8305085 0.9491525 0.9322034 1.0000000 1.0000000
##  [36] 0.7457627 0.5500000 0.8983051 0.9491525 0.6949153 0.9830508 0.7500000
##  [43] 0.8135593 0.9661017 0.6779661 0.9000000 0.7288136 0.6610169 1.0000000
##  [50] 0.9491525 0.7166667 0.6610169 1.0000000 0.5932203 0.9830508 0.7627119
##  [57] 0.9661017 0.9661017 1.0000000 0.6949153 1.0000000 0.7118644 0.9152542
##  [64] 0.9830508 0.9491525 0.7966102 0.7966102 0.8305085 0.8983051 0.7118644
##  [71] 0.6779661 0.7166667 0.7000000 0.9677419 1.0000000 1.0000000 0.9322034
##  [78] 0.9322034 0.6101695 0.8305085 1.0000000 0.8474576 0.9666667 0.7627119
##  [85] 0.7627119 0.7627119 0.7796610 0.8135593 0.9661017 0.7796610 0.7457627
##  [92] 0.6949153 0.8135593 0.7000000 0.7333333 0.7627119 0.8813559 0.6271186
##  [99] 0.7966102 0.5084746

# 예측값을 시험용 데이터셋에 pred 컬럼으로 만듭니다.
testSet$pred <- fitKnn

# 시험용 데이터셋의 grade와 pred의 빈도수를 비교합니다. 
table(testSet$grade, testSet$pred) %>% addmargins()

##       
##        best good  Sum
##   best   83  254  337
##   good   45 1077 1122
##   Sum   128 1331 1459

시험용 데이터셋의 실제 목표변수인 grade와 분류모형의 결과로 추정된 pred 간 빈도수를 비교해보니 원래 best인 337건 중에서 254건이 good으로 다르게 분류되었음을 알 수 있습니다. 하지만 원래 good인 1122건 중에서 1077건이 제대로 분류되었습니다. 왜 이런 일이 발생할까요? 이 문제는 바로 샘플링에 있습니다.

원데이터의 good과 best의 비중이 78%, 22%로 대다수가 good에 몰려있습니다. 마찬가지로 trainSet과 testSet에서도 목표변수의 두 범주가 원데이터와 비슷한 비중을 보이고 있습니다. 데이터셋이 이와 같을 때 기계학습 알고리즘은 학습을 하는 과정에서 다수(majority)를 차지하는 범주(이번 예제에서는 good)로 더 많이 치우치는 경향을 보입니다. 그리고 일반적으로 (경험이 많지 않은) 분석가들은 분류모형의 성능을 판단하는 기준으로 정확성(accuracy)를 확인하는 경향이 강합니다. 하지만 앞서 말씀드린 이유로 정확성을 기준으로 분류모형의 성능을 판단하면 안됩니다. 분류모형 성능 평가 방법에 대해서는 나중에 따로 살펴보기로 하고, 지금은 trainSet과 testSet을 어떻게 만들면 되는지에 대하여 알아보도록 하겠습니다.

사실 방법은 간단합니다. trainSet의 목표변수의 두 범주인 good과 best의 비중을 50:50으로 맞춰주면 됩니다. 이렇게 하는 것을 표본 균형화(Sample Balancing)라고 합니다. 이번 예제에서는 best의 비중이 good의 비중보다 작으므로 best인 건을 여러 번 복사하여 good의 건수만큼 맞춰주는 Oversampling을 하든가, 아니면 반대로 good의 건수를 best의 건수에 맞도록 Undersampling을 하면 됩니다. 두 범주의 비중 차이가 큰 경우에는 Oversampling과 Undersampling을 혼합한 방법(예를 들면 SMOTE)을 사용하기도 합니다.[3]

R에서는 ROSE 패키지의 ovun.sample() 함수를 사용하여 Oversampling 또는 Undersampling, 아니면 두 가지 방법을 섞은 균형화 작업을 간단하게 해결할 수 있습니다. 이 함수에 필요한 주요 인자들을 설명하겠습니다.

  • formula : 목표변수와 입력변수 간 관계를 설정합니다. 중간에 tilde(~)를 삽입하면 됩니다. 일반적으로는 목표변수 ~ .처럼 간략하게 표현합니다. tilde 오른쪽의 .은 모든 입력변수를 의미합니다.
  • data : 데이터셋을 할당합니다. 이번 예제에서는 trainSet을 할당하면 됩니다.
  • method : ‘over’, ‘under’, ‘both’ 중 하나를 할당합니다. ‘both’는 SMOTE가 됩니다.
  • N : 원하는 데이터 크기를 지정할 수 있습니다. 생략하면 method와 p 인자를 참조하여 생성합니다.
  • p : 목표변수의 범주형 비중을 설정합니다. 같은 비중의 데이터를 얻으려면 0.5를 할당하면 됩니다.
  • seed : 여러 번 반복하여 실행하더라도 같은 결과를 얻기 위해 seed를 지정합니다.
# 필요 패키지를 불러옵니다. 
library(ROSE)

# 훈련용 데이터셋을 다시 만듭니다. 
# ovun.sample() 함수는 3개의 원소를 갖는 리스트를 반환합니다. 
# 그 중에서 우리가 원하는 데이터셋은 'data' 원소입니다. 
trainSetBal <- 
  ovun.sample(formula = grade ~ ., 
              data = trainSet, 
              method = 'both', 
              p = 0.5, 
              seed = 123) %>% 
  `[[`('data')

# 목표변수의 비중을 재확인합니다. 
trainSetBal$grade %>% table() %>% prop.table()

## .
##      good      best 
## 0.5027624 0.4972376

새로 만들어진 trainSetBal의 건수는 기존 trainSet과 같지만, 목표변수의 비중이 50.3:49.7로 거의 비슷해졌음을 알 수 있습니다. 그럼 이 균형화된 데이터셋으로 KNN 분류모형을 다시 적합해보고 결과를 비교해보겠습니다.

# set.seed를 지정합니다. 
set.seed(seed = 123)

# 균형화된 훈련용 데이터셋으로 가중치 없는 KNN 분류모형을 적합합니다.
# 주의해야 할 점은 trainSet을 모두 trainSetBal로 바꿔주어야 한다는 것입니다.
fitKnnBal <-
  knn(train = trainSetBal[, 1:11], 
      test = testSet[, 1:11], 
      cl = trainSetBal$grade, 
      k = trainSetBal %>% nrow() %>% sqrt() %>% ceiling(), 
      prob = TRUE)

# 예측값을 시험용 데이터셋에 pred 컬럼으로 만듭니다.
testSet$predBal <- fitKnnBal

# 시험용 데이터셋의 grade와 predBal의 빈도수를 비교합니다. 
table(testSet$grade, testSet$predBal) %>% addmargins()

##       
##        good best  Sum
##   best   68  269  337
##   good  731  391 1122
##   Sum   799  660 1459

그런데 뭔가 좀 어색하네요. 아무래도 ovun.sample()을 하면서 범주형 벡터인 grade의 level 순서가 바뀐 것 같습니다. 이 문제를 해결하려면 testSet$predBal의 level을 확인하고 필요 시 순서를 변경해주어야 합니다.

# predBal의 level 순서를 확인합니다. 
levels(x = testSet$predBal)

## [1] "good" "best"

# predBal의 level 순서를 'best'가 먼저 오도록 변경합니다. 
testSet$predBal <- relevel(x = testSet$predBal, ref = 'best')

# 시험용 데이터셋의 grade와 predBal의 빈도수를 비교합니다. 
table(testSet$grade, testSet$predBal) %>% addmargins()

##       
##        best good  Sum
##   best  269   68  337
##   good  391  731 1122
##   Sum   660  799 1459

이제 제대로 원하는 결과를 얻었습니다. 첫 번째 결과와 크게 달라진 것을 알 수 있습니다. 그럼 지금까지 두 개의 분류모형을 적합한 결과를 가지고 어느 모형이 얼마나 더 우수한 성능을 보이는지 평가하는 방법에 대해 알아보도록 하겠습니다. 이 내용은 분류모형에 공통적으로 적용할 수 있으므로 별도의 포스팅으로 정리해두었습니다. 분류모형의 성능 평가 기준 바로가기를 클릭하여 해당 내용을 확인하고 다시 돌아오도록 하겠습니다.

분류모형 성능 비교하기

이전 포스팅에서 소개해드린 바와 같이 분류모형의 성능을 평가하는 여러 기준 중에서 혼동행렬의 여러 지표들과 AUROC 기준으로 와인 품질을 분류하는 모형의 성능을 비교해보도록 하겠습니다.

혼동행렬 (Confusion Matrix)

caret 패키지의 confusionMatrix() 함수로 간단하게 확인할 수 있습니다. 이 함수에서 사용되는 주요 인자 2가지를 설명하겠습니다.

  • data : 예측값을 할당합니다.
  • reference : 실제값을 할당합니다.
# 필요 패키지를 불러옵니다. 
library(caret)

# 첫 번째 예측값과 실제값으로 혼동행렬과 지표들을 확인합니다.
confusionMatrix(data = testSet$pred, reference = testSet$grade)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction best good
##       best   83   45
##       good  254 1077
##                                           
##                Accuracy : 0.7951          
##                  95% CI : (0.7734, 0.8155)
##     No Information Rate : 0.769           
##     P-Value [Acc > NIR] : 0.009245        
##                                           
##                   Kappa : 0.2633          
##  Mcnemar's Test P-Value : < 2.2e-16       
##                                           
##             Sensitivity : 0.24629         
##             Specificity : 0.95989         
##          Pos Pred Value : 0.64844         
##          Neg Pred Value : 0.80917         
##              Prevalence : 0.23098         
##          Detection Rate : 0.05689         
##    Detection Prevalence : 0.08773         
##       Balanced Accuracy : 0.60309         
##                                           
##        'Positive' Class : best            
##

표본 균형화 작업을 하지 않은 첫 번째 훈련용 데이터셋으로 예측한 값과 실제값으로 만든 혼동행렬 결과를 간단하게 확인해보겠습니다. 가장 먼저 확인해야 할 것은 맨 마지막 줄에 있는 Positive의 범주입니다. 이번 예제에서는 best입니다.

  • 정확도(Accuracy)는 0.7951로 상당히 높게 나왔습니다. 하지만 정확도는 중요한 지표가 아니라는 사실을 아시죠?
  • 민감도(Sensitivity)는 0.24629에 불과합니다. 실제값이 best인 개수 중에서 모형이 best라고 제대로 예측한 비율이 24.6% 밖에 안 된다는 것입니다. 좋은 모형이 아닙니다.
  • 특이도(Specificity)는 0.95989로 매우 높습니다. 실제값이 good인 개수 중에서 모형이 good이라고 제대로 예측한 비율이 96.0%나 된다는 것입니다.
  • 정밀도(Precision 또는 Pro Pred Value)는 0.64844입니다. 모형이 best라고 예측한 것 중 실제로 best인 비중이 64.8% 정도 된다고 하는 것입니다.

위와 같이 confusionMatrix() 함수로 확인할 수 있는 주요 지표들을 확인해봤습니다. 그럼 제가 가장 중요하다고 강조한 F1 점수는 어떻게 확인할 수 있을까요? 사실 그동안은 table() 함수의 결과값으로 직접 만들었는데, 이번 포스팅을 작성하면서 구글링해보니 MLmetrics 패키지의 F1_Score() 함수로 간단하게 해결이 가능하다는 것을 알았습니다. confusionMatrix() 함수와 인자명만 바뀌었을 뿐 예측값과 실제값을 할당하는 순서는 같아서 좋네요.

# 필요 패키지를 불러옵니다. 
library(MLmetrics)

# 첫 번째 예측값과 실제값으로 F1 점수를 확인합니다.
F1_Score(y_pred = testSet$pred, y_true = testSet$grade)

## [1] 0.3569892

F1 점수가 0.3569892로 상당히 낮다는 것을 알 수 있습니다. 직접 계산하는 것도 한 번 해볼까요? 혼동행렬의 경우 행 기준으로 예측값, 열 기준으로 실제값이 사용되었음을 감안하여 table() 함수에도 예측값, 실제값 순서로 할당하도록 합니다.

# 실제값과 예측값 빈도행렬을 만들고 tbl 객체에 할당합니다.
tbl <- table(testSet$pred, testSet$grade)

# tbl 객체를 출력합니다. 
print(tbl)

##       
##        best good
##   best   83   45
##   good  254 1077

tbl 객체를 출력해보니 혼동행렬과 비슷하다는 것을 알 수 있습니다. 이제 tbl 객체의 4가지 원소에 대해 TP, FP, FN, TN을 지정합니다.

# tbl 객체의 4가지 원소에 대해 TP, FP, FN, TN을 지정합니다. 
TP <- tbl[1, 1]
FP <- tbl[1, 2]
FN <- tbl[2, 1]
TN <- tbl[2, 2]

# 공식을 이용하여 F1 점수를 계산합니다. 
F1 <- 2*TP / (2*TP + FP + FN)
print(F1)

## [1] 0.3569892

F1_Score() 함수를 사용한 것과 똑같은 결과를 보입니다. 혹시 혼동행렬의 여러 지표들을 직접 만들어보고 싶다는 생각이 들지 않나요?

이제 두 번째 모형과 비교해보도록 하겠습니다.

# 두 번째 예측값과 실제값으로 혼동행렬과 지표들을 확인합니다.
confusionMatrix(data = testSet$predBal, reference = testSet$grade)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction best good
##       best  269  391
##       good   68  731
##                                           
##                Accuracy : 0.6854          
##                  95% CI : (0.6609, 0.7092)
##     No Information Rate : 0.769           
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.3368          
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.7982          
##             Specificity : 0.6515          
##          Pos Pred Value : 0.4076          
##          Neg Pred Value : 0.9149          
##              Prevalence : 0.2310          
##          Detection Rate : 0.1844          
##    Detection Prevalence : 0.4524          
##       Balanced Accuracy : 0.7249          
##                                           
##        'Positive' Class : best            
##

먼저 Positive 범주가 best인 것을 확인한 후 주요 지표들을 하나씩 확인해보겠습니다.

  • 정확도는 0.6854로 첫 번째 모형보다 다소 낮아졌습니다.
  • 민감도는 0.7982로 크게 향상되었습니다. 표본 균형화 작업은 이렇게 중요합니다!
  • 특이도는 0.6515로 낮아졌지만 그래도 괜찮습니다. 민감도가 더 중요하니까요.
  • 정밀도가 0.4076으로 낮아진 건 조금 아쉽습니다. 이 값이 높아야 F1 점수도 높아지거든요.
# 두 번째 예측값과 실제값으로 F1 점수를 확인합니다.
F1_Score(y_pred = testSet$predBal, y_true = testSet$grade)

## [1] 0.5396189

두 번째 모형의 F1 점수는 0.5396189로 첫 번째 모형에 비해 크게(?) 향상되었습니다. 비록 정밀도가 조금 낮아졌지만 민감도가 크게 향상되었기 때문입니다.

ROC 커브와 AUROC

ROC 커브는 민감도와 1-특이도를 기준으로 분류모형의 예측 정확도를 평가하는데 사용되는 곡선이라고 설명한 바 있습니다. ROC 커브는 ROCR 패키지의 prediction() 함수와 performance() 함수를 이용하여 그릴 수 있습니다.

prediction() 함수에 예측값과 실제값을 순서대로 지정하여 실행한 후 그 결과를 predObj에 할당합니다. 이 함수는 혼동행렬의 각 지표들을 표준화된 값으로 반환합니다. 그런데 주의해야 할 점은 예측값을 할당하는 predictions 인자에 숫자 벡터를 지정해야 한다는 것입니다. 이번 예제처럼 범주형 벡터를 숫자 벡터로 변환하면 정수값이 할당되므로 ROC 커브가 몇 개의 직선으로 그려집니다. 하지만 확률값을 할당하면 완만한 곡선이 그려집니다.

performance() 함수에는 바로 앞에서 만든 predObj를 이용하여 ROC 커브를 그릴 각 지점을 잡아냅니다. measure 인자에는 y축에 해당하는 민감도(tpr), x.measure 인자에는 x축에 해당하는 1-특이도(fpr)을 할당합니다.

# 필요 패키지를 불러옵니다. 
library(ROCR)

# 첫 번째 예측값과 실제값으로 표준화된 prediction 객체를 생성합니다. 
# [주의] 예측값은 숫자 벡터로 변환하여 할당해야 합니다! 
predObj <- prediction(predictions = as.numeric(testSet$pred), 
                      labels = testSet$grade)

# prediction 객체를 활용하여 performance 객체를 생성합니다. 
perform <- performance(prediction.obj = predObj, 
                       measure = 'tpr', 
                       x.measure = 'fpr')

# ROC 커브를 그립니다.
plot(x = perform, main = 'ROC 커브 - 첫 번째 모형')

# 왼쪽 아래 모서리에서 오른쪽 위 모서리를 잇는 대각선을 추가합니다. 
lines(x = c(0, 1), y = c(0, 1), col = 'red', lty = 2)

(생애 처음으로 그려본) ROC 커브가 생각보다 예쁘지 않네요. 검정색 곡선이 왼쪽 위 모서리에 가까울수록 좋은 모형이라는 것은 앞에서 설명을 드렸습니다. 그럼 pROC 패키지의 auc() 함수에 실제값과 예측값을 할당하여 AUROC를 확인해보도록 하겠습니다. 이 함수도 예측값은 숫자 벡터로 할당해주어야 한다는 점을 주의하기 바랍니다.

# 필요 패키지를 불러옵니다.
library(pROC)

## Type 'citation("pROC")' for a citation.

## 
## Attaching package: 'pROC'

## The following objects are masked from 'package:stats':
## 
##     cov, smooth, var

# 첫 번째 분류모형의 AUROC를 확인합니다.
# [주의] 예측값은 숫자 벡터로 변환하여 할당해야 합니다! 
auc(testSet$grade, as.numeric(testSet$pred))

## Area under the curve: 0.6031

분류모형의 성능 평가 기준 포스팅에서 AUROC는 0.5 ~ 1 사이의 값을 갖는다고 설명했는데, 이 모형의 AUROC는 0.6031이므로 분류 성능이 매우 낮다는 것을 AUROC로도 확인할 수 있습니다.

그럼 두 번째 모형의 성능은 어떨까요? ROC 커브를 그리고 AUROC도 바로 확인해보겠습니다.

# 두 번째 예측값과 실제값으로 표준화된 prediction 객체를 생성합니다. 
# [주의] 예측값은 숫자 벡터로 변환하여 할당해야 합니다! 
predObj <- prediction(predictions = as.numeric(testSet$predBal), 
                      labels = testSet$grade)

# prediction 객체를 활용하여 performance 객체를 생성합니다. 
perform <- performance(prediction.obj = predObj, 
                       measure = 'tpr', 
                       x.measure = 'fpr')

# ROC 커브를 그립니다.
plot(x = perform, main = 'ROC 커브 - 두 번째 모형')

# 왼쪽 아래 모서리에서 오른쪽 위 모서리를 잇는 대각선을 추가합니다. 
lines(x = c(0, 1), y = c(0, 1), col = 'red', lty = 2)

첫 번째 모형에 비해 뭔가 더 볼록해진 기분이 듭니다.

# 두 번째 분류모형의 AUROC를 확인합니다.
# [주의] 예측값은 숫자 벡터로 변환하여 할당해야 합니다! 
auc(testSet$grade, as.numeric(testSet$predBal))

## Area under the curve: 0.7249

두 번째 모형의 AUROC는 0.7249로 첫 번째 모형에 비해 크게 증가했습니다. 이로써 분류모형의 성능을 평가하는 여러 지표들을 확인하는 방법과 여러 분류모형들의 성능을 비교하는 방법에 대해서 충분히 이해했을 것으로 믿습니다.

가중치 있는 KNN 분류모형 적합하기

유유상종이라든가 끼리끼리 논다라는 속담에서 알 수 있듯이 비슷한 성질을 가질수록 서로 가깝다라고 생각할 수 있습니다. 이러한 점을 착안하여 KNN에서는 예측하고자 하는 데이터와 가까울수록 결과에 더 큰 영향을 미치는 중요한 이웃이라고 판단할 수 있습니다. 더 중요한 이웃으로 판단한다는 것은 가중치를 크게 부여한다는 것이므로, 거리의 역수를 가중치로 설정함으로써 간단하게 해결할 수 있습니다.

가중치 있는 KNN 분류모형은 kknn 패키지의 kknn() 함수를 이용하여 적합할 수 있습니다. 주요 인자는 다음과 같습니다.

  • formula : 입력변수와 목표변수 간의 관계를 표현한 식을 할당합니다.
  • train : 훈련용 데이터셋을 할당합니다.
  • test : 시험용 데이터셋을 할당합니다.
  • k : 참고할 이웃의 수를 할당합니다. 이번에도 데이터 행 개수의 제곱근을 할당합니다.
  • distance : Minkowski 거리에서의 p값을 정수로 입력합니다. (1:맨하탄, 2:유클리디안)
  • kernel : 가중치를 부여하는 방법을 할당합니다. ‘rectangular’(가중치 없는 모형), ‘triangular’, ‘epanechnikov’, ‘biweight’, ‘triweight’, ‘cos’, ‘inv’, ‘gaussian’, ‘rank’, ‘optimal’ 중 하나를 선택합니다.
# 필요 패키지를 불러옵니다.
library(kknn)

# 유클리디안 거리의 역수로 가중치를 준 knn 분류모형을 적합합니다. 
fitKnnW <- 
  kknn(formula = grade ~ ., 
       train = trainSetBal, 
       test = testSet, 
       k = trainSetBal %>% nrow() %>% sqrt() %>% ceiling(), 
       distance = 2, 
       kernel = 'triangular')

# 모형 결과의 속성을 확인합니다. 
class(x = fitKnnW)

## [1] "kknn"

kknn() 함수는 kknn 속성의 객체를 결과로 반환합니다. 비록 익숙한 속성은 아니지만, 데이터 프레임처럼 $ 연산자를 사용하면 됩니다. 모형 예측값은 fitted.values라는 범주형 벡터입니다. 앞에서 했던 것과 동일하게 testSet에 predBalW라는 컬럼으로 저장하고, 실제값과 빈도수를 확인해보겠습니다.

# 예측값을 testSet에 predW 컬럼으로 저장합니다.
testSet$predBalW <- fitKnnW$fitted.values

# 실제값과 예측값의 빈도수를 확인합니다. 
table(testSet$grade, testSet$predBalW) %>% addmargins()

##       
##        good best  Sum
##   best   61  276  337
##   good  804  318 1122
##   Sum   865  594 1459

이번에도 예측값의 level이 바뀌어 있는 것 같습니다. level 순서를 변경하고 다시 확인해봅니다.

# predBalW의 level 순서를 확인합니다. 
levels(x = testSet$predBalW)

## [1] "good" "best"

# predBal의 level 순서를 'best'가 먼저 오도록 변경합니다. 
testSet$predBalW <- relevel(x = testSet$predBalW, ref = 'best')

# 시험용 데이터셋의 grade와 predBal의 빈도수를 비교합니다. 
table(testSet$grade, testSet$predBalW) %>% addmargins()

##       
##        best good  Sum
##   best  276   61  337
##   good  318  804 1122
##   Sum   594  865 1459

이제 제대로 나왔으니 가중치를 준 KNN 분류모형의 성능을 가중치 없는 모형과 비교해보겠습니다. 먼저 혼동행렬 주요 지표들 출력합니다.

# 가중치 있는 모형의 예측값과 실제값으로 혼동행렬과 지표들을 확인합니다.
confusionMatrix(data = testSet$predBalW, reference = testSet$grade)

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction best good
##       best  276  318
##       good   61  804
##                                           
##                Accuracy : 0.7402          
##                  95% CI : (0.7169, 0.7626)
##     No Information Rate : 0.769           
##     P-Value [Acc > NIR] : 0.9955          
##                                           
##                   Kappa : 0.4228          
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.8190          
##             Specificity : 0.7166          
##          Pos Pred Value : 0.4646          
##          Neg Pred Value : 0.9295          
##              Prevalence : 0.2310          
##          Detection Rate : 0.1892          
##    Detection Prevalence : 0.4071          
##       Balanced Accuracy : 0.7678          
##                                           
##        'Positive' Class : best            
##

먼저 Positive 범주가 best인 것을 확인한 후 주요 지표들을 하나씩 확인해보겠습니다.

  • 정확도는 0.7402로 두 번째 모형보다 조금 향상되었습니다.
  • 민감도는 0.8190으로 두 번째 모형보다 조금 향상되었습니다.
  • 특이도는 0.7166으로 두 번째 모형보다 조금 향상되었습니다.
  • 정밀도가 0.4646으로 두 번째 모형보다 조금 향상되었습니다.

가중치가 있는 KNN 분류모형이 가중치가 없는 모형보다 더 좋은 성능을 보인다는 것을 알 수 있습니다. 그럼 F1 점수는 어떨까요?

# 가중치 있는 모형의 예측값과 실제값으로 F1 점수를 확인합니다.
F1_Score(y_pred = testSet$predBalW, y_true = testSet$grade)

## [1] 0.5929108

가중치 없는 두 번째 모형의 F1 점수는 0.5396189였는데, 가중치 있는 모형의 F1 점수는 0.5929108로 이 또한 소폭 향상되었습니다. 유유상종이 맞네요!!

이번에는 ROC 커브를 그리고 AUROC를 확인해보겠습니다.

# 가중치 있는 모형의 예측값과 실제값으로 표준화된 prediction 객체를 생성합니다. 
# [주의] 예측값은 숫자 벡터로 변환하여 할당해야 합니다! 
predObj <- prediction(predictions = as.numeric(testSet$predBalW), 
                      labels = testSet$grade)

# prediction 객체를 활용하여 performance 객체를 생성합니다. 
perform <- performance(prediction.obj = predObj, 
                       measure = 'tpr', 
                       x.measure = 'fpr')

# ROC 커브를 그립니다.
plot(x = perform, main = 'ROC 커브 - 가중치 모형')

# 왼쪽 아래 모서리에서 오른쪽 위 모서리를 잇는 대각선을 추가합니다. 
lines(x = c(0, 1), y = c(0, 1), col = 'red', lty = 2)

가중치 없는 두 번째 모형보다 더욱 볼록해진 것 같습니다.

# 가중치 있는 분류모형의 AUROC를 확인합니다.
# [주의] 예측값은 숫자 벡터로 변환하여 할당해야 합니다! 
auc(testSet$grade, as.numeric(testSet$predBalW))

## Area under the curve: 0.7678

가중치 없는 두 번째 모형의 AUROC는 0.7249였는데, 가중치 있는 모형의 AUROC는 0.7678입니다. AUROC 기준으로도 가중치 있는 모형의 분류 성능이 더 뛰어나다는 것을 확인하였습니다.

이상으로 K-근접이웃에 대한 소개를 마치고, 다음 포스팅에서는 나이브 베이즈(Naive Bayes) 알고리즘을 활용한 분류모형을 소개해드리겠습니다.

[1] 자세한 내용은 위키백과를 참조하시기 바랍니다.

[2] 출처 : https://www.researchgate.net/figure/260612049_fig2_The-principle-diagram-of-the-kNN-classification-algorithm

[3] 자세한 내용은 관련 위키피디아를 참조하기 바랍니다.

]]>나성호 (Seongho Na)기계학습 알고리즘의 종류와 데이터셋 분할2018-05-31T00:00:00+00:002026-06-24T00:00:00+00:00https://www.hds.ai.kr/posts/machine-learning-overview-1

이 글은 2018~2019년에 작성한 R 기반 강의 노트를 옮긴 것입니다. 코드 일부는 현재 패키지 버전과 다를 수 있습니다.

이번 포스팅부터 기계학습 알고리즘을 소개해드리겠습니다. 기계학습 모형은 목표변수(Target Variable)의 유무에 따라서 지도학습(Supervised Learning)과 비지도학습(Unsupervised Learning)으로 나뉩니다. 제가 간략하게 그린 그림을 보여드리겠습니다.

기계학습 알고리즘의 종류

기계학습 알고리즘

지도학습은 목표변수의 종류에 따라서 분류(Classification)와 추정(Estimation)으로 나뉘는데요. 추정은 회귀(Regression)와 혼용해서 언급되기도 합니다. 분류모형은 목표변수가 범주형일 때 사용되며, 추정(회귀)모형은 목표변수가 연속형일 때 사용됩니다. 그리고 입력변수들과 목표변수가 같은 시점일 때는 추정모형이지만, 목표변수가 입력변수보다 미래시점일 때는 예측(Prediction)모형이 됩니다.

비지도학습은 목표변수가 없다는 특징이 있습니다. 차원축소(Dimension Reduction)는 p개의 (입력)변수를 p보다 작은 m개로 줄여서 다른 알고리즘을 적용할 때 사용하며, 군집화(Clustering)는 전체 데이터를 몇 개의 세부 군집으로 나눌 때 사용합니다. 연관성 규칙(Association Rule)은 장바구니 분석(MBA, Market Basket Analysis)처럼 서로 연관성 높은 규칙을 발견할 때 사용합니다.

우리가 해결하고자 하는 문제와 가지고 있는 데이터의 속성에 따라 어떤 알고리즘을 사용해야 하는지를 정하는 것이 중요합니다. 맨 오른쪽에 보이는 알고리즘들의 대부분을 이 블로그에서 다룰텐데요. 다만 실제 회사에서 다루는 데이터를 사용하기 어려우므로 R 또는 온라인에서 제공되는 데이터 및 크롤링을 통해 수집한 데이터를 사용하여 간략한 원리와 코드로 직접 구현해보는 것으로 만족해야 할 것입니다. 실제로 업무에 기계학습 알고리즘을 적용할 때 여러 가지 어려움과 맞닥뜨릴 것입니다. 그럴 때에는 상황에 맞는 최선의 알고리즘을 직접 찾아 해결하시는 수밖에 없습니다만, 세상에 할 수 없는 일은 없습니다.

기계학습에 사용할 데이터셋의 분할

우리가 기계학습 알고리즘으로 어떤 모형을 적합한다고 할 때, 전체 데이터를 그대로 사용하는 대신 다음과 같은 두 가지 방법을 통해 여러 개의 데이터셋으로 적당히 나누어 상황에 맞게 사용해야 합니다.

자료분할 (Hold-out Validation)

우리가 보유하고 있는 데이터의 양이 많을 때에는 자료분할 (Hold-out Validation)을 주로 사용합니다. 전체 데이터를 훈련용(training) 데이터셋과 검증용(validation) 데이터셋, 그리고 시험용(test) 데이터셋으로 나눕니다. 세 가지 데이터셋으로 나누는 비중은 분석가가 임의로 정할 수 있습니다.

자료분할을 하는 이유는 훈련용(training) 데이터셋으로 만든 모형에 시험용(test) 데이터셋을 적용하여 모형이 과적합되었는지 여부를 판단하기 위함입니다. 하나의 모형에 대해서는 위와 같이 훈련용, 시험용 데이터셋 두 가지만 필요하지만, 만약 여러 개의 모형을 만들고 그 중에서 최적의 모형을 선택하려면 별도의 검증용(validation) 데이터셋이 필요합니다. 그러니까 훈련용 데이터셋으로 각각의 모형을 적합하고, 검증용 데이터셋을 적용하여 성능이 가장 우수한 모형을 선택한 다음 마지막으로 모형을 적합할 때 사용하지 않은(unseen) 시험용 데이터셋으로 최종모형을 사용할 수 있는지 여부를 판단합니다.

분류모형의 성능 평가는 혼동행렬(Confusion Matrix)의 F1 Score 또는 ROC 커브와 AUROC 값을 기준으로 하는 것이 일반적입니다. 그리고 회귀모형의 성능 평가는 MSE(Mean Squared Error), RMSE(Root Mean Squared Error), MAPE(Mean Absolute Percentage Error) 등 여러 가지가 있습니다. 공통적으로 실제값과 추정값과의 차이인 오차(error)를 기준으로 평가합니다. 각 모형의 성능 평가 기준에 대해서는 별도의 포스팅에서 다루도록 하겠습니다.

자료분할 이미지[1]

교차검증 (Cross Validation)

자료분할과 달리 보유하고 있는 데이터의 양이 적을 때 교차검증 (Cross Validation) 방법을 사용합니다. 먼저 전체 데이터를 훈련용(training) 데이터셋과 시험용(test) 데이터셋으로 나눕니다. 그리고나서 훈련용(training) 데이터셋을 k개로 균등하게 다시 나눈 다음, k-1개의 데이터셋으로 모형을 적합하고 나머지 1개의 데이터셋으로 검증합니다. 이 때, 모형 적합에 사용하는 데이터셋을 순차적으로 바꿔가며 k번 반복한다는 특징이 있습니다.

모두 k개의 모형이 만들어지면 검증용 데이터셋으로 목표변수를 추정하고, 그 결과를 합산하여 k로 나눈 평균을 구합니다. 이 평균을 기준으로 해당 모형의 성능을 비교하는 것입니다. 최적의 모형이 선택되면 자료분할과 마찬가지로 시험용 데이터셋으로 최종모형을 사용할 수 있는지 확인합니다. 훈련용 데이터셋을 k개로 균등하게 나눈다는 점에서 K-겹 교차검증 (K-Fold Cross Validation)이라고도 합니다.

교차검증 이미지[2]

이상으로 기계학습 알고리즘의 종류와 데이터셋을 분할하는 방법에 대해 알아보았습니다.

[1] 출처 : http://prog3.com/sbdm/blog/google19890102/article/details/50276693

[2] 출처 : https://sebastianraschka.com/faq/docs/evaluate-a-model.html

]]>나성호 (Seongho Na)분류모형의 성능 평가 기준2018-05-31T00:00:00+00:002026-06-24T00:00:00+00:00https://www.hds.ai.kr/posts/machine-learning-overview-2

이 글은 2018~2019년에 작성한 R 기반 강의 노트를 옮긴 것입니다. 코드 일부는 현재 패키지 버전과 다를 수 있습니다.

분류모형의 성능을 평가하는 기준은 여러 가지가 있겠으나 일반적으로 많이 사용되는 두 가지 방법에 대해서 소개해드리겠습니다.

혼동행렬 (Confusion Matrix)

이전 포스팅에서 정확성(Accuracy)을 기준으로 분류모형의 성능을 평가하면 안 되는 점에 대해서 말씀드렸습니다. 분류모형의 성능을 나타내는 여러 가지 지표를 한 번에 확인할 수 있는 것으로 혼동행렬 (Confusion Matrix)을 사용합니다.

혼동행렬 그 자체는 비교적 이해하기 쉬운 편이라 할 수 있지만, 각종 평가 지표들은 처음 보는 사람들에게 다소 복잡해 보입니다. 먼저 혼동행렬이 어떻게 생겼는지 확인한 후 각종 지표들에 대해서 소개해드리겠습니다.

혼동행렬 이미지[1]

위의 이미지를 보면, table() 함수를 이용하여 목표변수의 실제값(Actual)과 추정값(Estimated) 또는 예측값(Predicted)으로 빈도수를 확인하는 것과 같다는 것을 알 수 있습니다. 다만, 4개의 칸을 True Positive, False Positive, False Negative, 그리고 True Negative로 지정하고 이 4가지 항목을 가지고 다양한 지표들을 계산한다는 특징이 있습니다. 하나씩 살펴보도록 하겠습니다.

  • TP (True Positive) : 앞의 True는 실제값과 예측값이 같다는 것을 의미하고 뒤의 Positive는 예측값의 범주를 의미합니다. 목표변수에서 어떤 범주가 Positive인지는 혼동행렬을 실행한 결과 메시지에서 확인할 수 있습니다.
  • FP (False Positive) : 앞의 False는 실제값과 에측값이 서로 다르고, 모형은 Positive로 예측했다는 것을 의미합니다. 즉, 모형이 부정적인 사실을 긍정적인 것으로 오분류했다는 것이죠. 이것을 제1종 오류 (Type 1 Error)라고도 합니다. 예를 들어 암 검진을 한다고 했을 때 실제로 암환자가 정상으로 분류되는 경우를 말합니다.
  • FN (False Negative) : 앞의 False는 실제값과 에측값이 서로 다르고, 모형은 Negative로 예측했다는 것을 의미합니다. 이것을 제2종 오류 (Type 2 Error)라고도 하는데, 암 검진의 예를 들면 정상인을 암환자로 분류하는 경우를 말합니다. 재검을 받으면 정상으로 분류될 가능성이 높겠죠? 제1종 오류와 제2종 오류는 Positive가 어떤 범주인지에 따라 경중이 정해진다고 할 수 있습니다.
  • TN (True Negative) : 앞의 True는 실제값과 예측값이 같다는 것이고, 모형은 Negative로 예측했다는 것을 의미합니다.

이렇게 4가지 항목에 대해 충분히 이해를 했다면 다음의 내용을 반드시 알아두어야 합니다.

  • 실제값이 긍정인 건수의 합 (P) = TP + FN
  • 실제값이 부정인 건수의 합 (N) = FP + TN
  • 전체 건수의 합 (T) = TP + FN + FP + TN = P + N

혼동행렬을 보면 쉽게 고개를 끄덕일 수 있지만 혼동행렬 없이 기호만 봐서는 언뜻 이해가 되지 않을 수 있습니다. (실은 제가 그랬습니다. ㅎㅎ) 그러니 반복 확인하여 꼭 암기하기 바랍니다.

혼동행렬을 통해 계산되는 분류 성능 평가 지표들[2]

  • 정확도 : 예측값과 실제값이 서로 같은 개수를 전체 합으로 나눈 것
\[\text {Accuracy(ACC)} = \frac {\text {TP + TN}} {\text {P + N}}\]
  • 민감도 : 실제값이 긍정인 것 중에서 모형이 맞춘 비율
\[\text {Sensitivity or True Positive Rate(TPR)} = \frac {\text {TP}} {\text {P}}\]
  • 정밀도 : 모형이 긍정이라고 한 것 중에서 실제값이 긍정인 비율
\[\text {Precision or Positive Predictive Value(PPV)} = \frac {\text {TP}} {\text {TP + FP}}\]
  • 특이도 : 실제값이 부정인 것 중에서 모형이 맞춘 비율
\[\text {Specificity 또는 True Negative Rate(TNR)} = \frac {\text {TN}} {\text {N}}\]
  • 1-특이도 : 실제값이 부정인 것 중에서 모형이 긍정으로 오분류한 비율
\[\text {False Positive Rate(FPR)} = \frac {\text {FP}} {\text {N}}\]
  • F1 점수 : 민감도와 정밀도의 조화평균
\[\text {F1 Score} = \frac {2}{\frac {1}{\text{민감도}} + \frac {1}{\text{정밀도}}} = \frac {2}{\frac{\text{TP+FN}} {\text{TP}} + \frac {\text{TP+FP}}{\text{TP}}} = \frac {2 \text{TP}} {2\text {TP} + \text {FP} + \text {FN}}\]

이 6가지 평가 지표들은 반드시 암기하는 수준으로 알고 있어야 합니다. (사실 정확도는 암기하지 않아도 자연스럽게 알고 있는 것이지만, 이 중에서 가장 쓸모없는 것입니다.) 특히 F1 점수는 분류모형의 성능 평가 지표가 많이 사용되는 것 중 하나이며, 제가 가장 중요하다고 생각하는데요. 그 이유는 다음과 같습니다.

만약 분류모형이 민감도를 100%로 만들려면 어떻게 하면 될까요? 바로 모두 Positive로 예측하면 됩니다. 그렇게 되면 혼동행렬은 TP 또는 FP만 생길텐데요. 민감도의 분모에 해당하는 FN은 0이 되므로 민감도는 100%가 됩니다. 그런데 이렇게 하면 정밀도가 매우 낮은 숫자가 됩니다. 따라서 민감도와 정밀도 모두 좋은 모델이 되러면 TP와 TN을 늘리는 모형이어야 합니다. 결국 F1 점수가 클수록 분류모형의 성능이 좋습니다.

그런데 왜 산술평균 대신 조화평균을 사용할까요? 만약 산술평균로 계산한다고 가정해보겠습니다. 이 경우, 어느 한 쪽이 높은 갑슬 가지면 (예를 들어 민감도가 100%이면) 비록 다른 한 쪽이 낮은 값을 가지게 되더라도 높은 쪽의 영향을 크게 받으므로 산술평균값은 비교적 큰 값을 갖기 때문입니다. 하지만, 조화평균은 어느 한 쪽이 낮을 경우, 그 결과도 크게 낮아집니다. 조화평균이 평균속도를 내는 방식이라는 점을 상기하면 이해하기 쉽습니다. 예를 들어, 100km 거리를 100km/h로 갔다가 돌아올 때는 25km/h로 왔다면 평균시속은 얼마가 될까요? 직접 계산해보시기 바랍니다.

비록 설명은 장황하였지만, 위의 지표들을 계산하는 함수는 아주 간단합니다. caret 패키지의 confusionMatrix() 함수를 사용하면 혼동행렬과 각종 지표들을 한 번에 확인할 수 있습니다. 다만 F1 점수는 이 함수로 얻을 수 없으므로 table()의 결과값을 사용하여 직접 계산해야 합니다. R 코드는 분류모형 예제에서 다루도록 하겠습니다.

ROC 커브와 AUROC

ROC는 Receiver Operating Characteristic의 머릿글자인데, 쉽게 말하면 x축은 1-특이도 (FPR), y축은 민감도 (TPR)로 놓고 이진분류 모형의 예측 정확도를 평가하는데 사용되는 곡선입니다. FPR과 TPR은 반비례 관계에 있습니다. 그러니까 분류모형이 Positive로 예측한 것 중 TP가 증가하면 FP는 감소합니다.

ROC 커브[3]

위 그림에서 보는 바와 같이 2차원 평면에서 왼쪽 아래 모서리에서 오른쪽 위 모서리까지 점선이 있습니다. 만약 분류모형의 성능이 임의로 뽑는 것과 다르지 않다면 ROC 커브는 이 직선과 겹치게 됩니다. 반대로 분류모형의 성능이 뛰어날수록 ROC 커브는 왼쪽 위 모서리에 가까워집니다. y축이 TRP인 것을 감안하면 실제값이 긍정인 것 중에서 예측모형이 긍정으로 맞춘 비율이 100%에 가까워지기 때문입니다.

AUROC는 Area Under ROC 커브의 머릿글자로 ROC 커브 아래 면적을 의미합니다. 최대값이 1이고, 최소값은 0.5가 됩니다. AUROC 역시 F1 점수처럼 클수록 분류모형의 성능이 좋다는 것을 의미합니다. ROC 커브는 ROCR 패키지의 prediction() 함수와 performance() 함수를 사용하여 그릴 수 있으며, AUROC는 pROC 패키지의 auc() 함수를 계산할 수 있습니다.

이상으로 분류모형의 성능을 비교하는 주요 지표 2가지를 알아보았습니다. 분류모형을 소개하는 포스팅에서 R 코드를 상세하게 소개하도록 하겠습니다.

[1] 출처 : https://www.youtube.com/watch?v=AOIkPnKu0YA

[2] 보다 자세한 내용은 관련 위키피디아를 참고하기 바랍니다.

[3] 출처 : https://goo.gl/1bGcLa

]]>나성호 (Seongho Na)유사도의 척도, 거리의 종류2018-05-31T00:00:00+00:002026-06-24T00:00:00+00:00https://www.hds.ai.kr/posts/machine-learning-overview-3

이 글은 2018~2019년에 작성한 R 기반 강의 노트를 옮긴 것입니다. 코드 일부는 현재 패키지 버전과 다를 수 있습니다.

일부 기계학습 알고리즘은 데이터 간 유사도 혹은 비유사도를 측정하는 경우가 있습니다. 유사도의 기준으로는 주로 거리(Distance)를 이용하는데요. 예를 들어 군집분석의 경우, 데이터 간 거리가 가까울수록 유사도가 높다고 판단하여 같은 군집으로 묶습니다. 지도학습의 K-근접이웃 역시 데이터 간 거리를 측정하고 가장 가까운 이웃들의 목표변수를 기준으로 새로운 데이터의 목표변수를 추론합니다.

거리(Distance)의 특징

함수 \(d(x, y)\)를 두 점 x와 y의 거리는 반환하는 함수라고 가정했을 때, \(d(x, y)\)는 다음과 같은 특징을 갖습니다.

  • 모든 거리는 0보다 크거나 같습니다.
\[d(x, y) ≥ 0\]
  • 교환법칙이 성립합니다.
\[d(x, y) = d(y, x)\]
  • 다른 한 점 z를 경유하는 거리의 합보다 작거나 같습니다. (삼각 부등식)
\[d(x, y) ≤ d(x, z) + d(y, z)\]

데이터 표준화와 정규화

기계학습 알고리즘에서 거리 계산이 포함되는 경우, 반드시 데이터 전처리 과정에서 표준화 (Standardizatoin)를 해주어야 합니다. 표준화는 데이터 x를 평균이 0이고, 표준편차가 1인 표준정규분포를 따르는 z-score로 변환하는 것을 의미합니다.

\[\text {z-score} = \frac {x - \mu}{\sigma}\]

R에서는 scale() 함수를 사용하여 손쉽게 표준화할 수 있습니다. scale() 함수의 주요 인자로는 x, center, scale 등 3가지가 있습니다.

  • x : 변환하려는 숫자형 벡터를 할당합니다.
  • center : 위 식에서 분자의 \(\mu\)에 해당하는 x의 평균을 할당합니다. 기본값으로 TRUE가 설정되어 있는데, 표준화 데이터의 평균을 0으로 할 때는 생략해도 무방합니다.
  • scale : 위 식에서 분자의 \(\sigma\)에 해당하는 x의 표준편차를 할당합니다. 기본값으로 TRUE가 설정되어 있는데, 표준화 데이터의 표준편차를 1로 할 때는 생략해도 무방합니다.

그런데 표준화 대신 정규화를 하는 경우가 있으니 참고로 소개해드리겠습니다. 정규화는 데이터 x를 0~1 사이의 값을 갖도록 변환하는 것입니다. 위 식에서 분자의 \(\mu\) 대신 최소값을 넣고, 분모의 \(\sigma\) 대신 (최대값 - 최소값)을 넣으면 됩니다.

\[\text {x-normalized} = \frac {x - \text{min}}{\text {max - min}}\]

정규화 역시 scale() 함수를 이용하면 되며, 표준화와 달리 center, scale 인자에 반드시 해당하는 데이터를 할당해주어야 합니다.

  • center : min(x)를 할당합니다.
  • scale : (max(x) - min(x))를 할당합니다.

거리의 종류

p차원의 공간에 두 점 \(A(x_1, x_2, \cdots, x_p)\)와 \(B(y_1, y_2, \cdots, y_p)\)가 있다고 할 때, 두 점 사이의 거리는 종류에 따라 다음과 같이 계산할 수 있습니다.

  • 맨하탄 거리 : 두 점 간 차의 절대값을 합한 값으로 \(\text {L}_1\) norm이라고 합니다. 격자 모양의 거리를 자동차로 운행하는 거리를 연상하면 됩니다. 택시거리라는 별칭을 가지고 있습니다.
\[d(A, B) = \| x_i - y_i \|_1 = \sum_{i=1}^{p} | x_i - y_i |\]
  • 유클리드 거리 : 두 점 간 차를 제곱하여 모두 더한 값의 양의 제곱근으로 \(\text {L}_2\) norm이라고 합니다.
\[d(A, B) = \| x_i - y_i \|_2 = \sqrt [2] {\sum_{i=1}^{p} (x_i - y_i)^2} = \biggl[ \sum_{i=1}^{p} (x_i - y_i)^2 \biggl]^{\frac {1}{2}}\]
  • 민코프스키 거리 : m차원 민코프스키 공간에서의 거리입니다. m=1일 때 맨하탄 거리와 같고, m=2일 때 유클리드 거리와 같습니다. m이 정수가 아니어도 되지만 반드시 1보다 커야 합니다.
\[d(A, B) = \sqrt [m] {\sum_{i=1}^{p} (x_i - y_i)^m} = \biggl[ \sum_{i=1}^{p} (x_i - y_i)^m \biggl]^{\frac {1}{m}}\]
  • 맥시멈 거리 : 민코프스키 거리에서 m을 무한대로 확장한 거리입니다. 체비셰프(Chebyshev) 거리라고도 하며, 두 집단에서 가장 긴 지점에서의 거리를 의미합니다.
\[d(A, B) = \lim_{m \to \infty} \biggl[ \sum_{i=1}^{p} (x_i - y_i)^m \biggl]^{\frac {1}{m}} = \max \biggl( {| x_1 - y_1 |}, \; {| x_2 - y_2 |}, \; \cdots \; , \; {| x_p - y_p |} \biggl)\]
  • 표준화 거리 : 유클리드 거리를 공분산으로 나눈 거리입니다. 공분산을 원소로 갖는 대각행렬(\(D\))을 이용합니다.
\[d(A, B) = \biggl[ \sum_{i=1}^{p} \frac {(x_i - y_i)^2}{\sigma_{ii}} \biggl]^{\frac {1}{2}} = \biggl[ (X - Y)^T D^{-1} (X - Y) \biggl]^{\frac{1}{2}}\] \[D = \left[ \begin{array}{ccc} \sigma_{11} & 0 & \cdots & 0 \\ 0 & \sigma_{22} & \cdots & 0 \\ \vdots & \vdots & \ddots & \vdots \\ 0 & 0 & \cdots & \sigma_{pp} \\ \end{array} \right]\]
  • 캔버라 거리 : 가중치 있는 맨하탄 거리입니다. 원점 주변에 흩어져 있는 데이터에 주로 사용됩니다.
\[\text {d(A, B)} = \sum_{i=1}^{p} \frac { | x_i - y_i | } { | x_i | + | y_i | }\]
  • 마할라노비스 거리 : 확률분포를 고려해야 할 때, 공분산 행렬(\(\Sigma^{-1}\))을 이용합니다.
\[\text {d(A, B)} = \biggl[ (X - Y)^T \Sigma^{-1} (X - Y) \biggl]^{\frac {1}{2}}\] \[\Sigma = \left[ \begin{array}{ccc} \sigma_{11} & \sigma_{12} & \cdots & \sigma_{1p} \\ \sigma_{21} & \sigma_{22} & \cdots & \sigma_{2p} \\ \vdots & \vdots & \ddots & \vdots \\ \sigma_{p1} & \sigma_{p2} & \cdots & \sigma_{pp} \\ \end{array} \right]\]
  • 코사인 유사도 : 두 벡터이 내적을 각 벡터의 크기로 나눈 값을 1에서 뺀 것입니다. 코사인은 0 ~ 1 사이의 값을 갖는데, 0도 일 때 1, 90도일 때 0의 값을 갖는다는 점을 착안한다면 두 벡터의 사이각이 0에 가까울수록 두 벡터의 거리가 가깝다고 판단할 수 있습니다.
\[d(A, B) = 1 - \frac { \langle x, \; y \rangle} {\| x \|_2 \|y\|_2} = 1 - \frac {\sum_{i=1}^{p} x_i y_i}{\sqrt [2] {\sum_{i=1}^{p} x_i^2} \sqrt [2] {\sum_{i=1}^{p} y_i^2} }\]
  • 피어슨 거리 : 피어슨 상관계수가 -1 ~ 1 사이의 값을 가지므로, 피어슨 상관계수를 1에서 뺀 값은 0 ~ 2 사이의 값을 갖게 됩니다.
\[d(A, B) = 1 − \text {Corr} (x, y)\]

이상으로 기계학습에서 유사도의 기준으로 삼는 거리의 특징과 종류를 알아봤습니다.

]]>나성호 (Seongho Na)