1 텍스트 저자 분류12

고전작가 중 제인 오스틴 ’오만과 편견’과 유사한 길이를 갖는 코난 도일의 ’셜록 홈즈의 모험’을 구텐베르그 웹사이트에서 가져와서 작가를 판별하는 예측모형을 구축해본다.

한국인이 가장 사랑하는 세계적인 작가는? - 현존 작가 베르나르 베르베르, 고전작가 생텍쥐페리

‘불멸의 고전 작가’ 투표에서는 ‘어린 왕자’의 앙투안 드 생텍쥐페리가 5,513표(7%)를 얻어 최고의 영예를 안았다. ’셜록 홈즈’ 시리즈의 아서 코난 도일은 4,366표(5.6%)로 2위, ’레 미제라블’의 빅토르 위고는 4,266표(5.4%)로 3위를 차지했다. 이어 헤르만 헤세가 5.4%로 4위에 올랐고, 윌리엄 셰익스피어(5.3%), 어니스트 헤밍웨이(5.1%), 제인 오스틴(4.7%), 조지 오웰(3.9%) 등이 5~8위로 뒤를 이었다.

2 데이터 가져오기

구텐베르그에 모든 고전 영문소설이 공개된 것은 아니다. 따라서 몇분정도 유명한 서양작가의 소설을 찾아 코난 도일과 제인 오스틴의 소설을 대표로 다운로드 받아 이를 분류하는 모형을 개발해 본다.

library(tidyverse)
library(tidymodels)
library(tidytext)

## 텍스트 데이터
library(gutenbergr)

titles <- c(
  "Pride and Prejudice",
  "The Adventures of Sherlock Holmes")

books <- gutenberg_works(title %in% titles) %>%
  gutenberg_download(meta_fields = "title") %>%
  mutate(title = as.factor(title)) %>%
  select(-gutenberg_id)

books %>% 
  count(title)
# A tibble: 2 x 2
  title                                 n
  <fct>                             <int>
1 Pride and Prejudice               13030
2 The Adventures of Sherlock Holmes 12648

3 훈련/시험 데이터 쪼개기3

rsample 팩키지 initial_split() 함수로 훈련/시험 데이터를 7:3으로 쪼갠다.

books_split <- initial_split(books, 
                             strata = "title", 
                             p = 0.70)

train_df <- training(books_split)
test_df <- testing(books_split)

4 피처 공학(feature engineering)

textrecipes 팩키지를 사용하여 텍스트에 대한 전처리 작업을 수행하여 피처 공학을 통해 basetable을 제작한다. textrecipes는 토큰화, 불용어 제거 등이 포함된다. max_tokens = tune()를 도입하여 최대 토큰수도 튜닝하여 결정한다.

library(textrecipes)
library(stopwords)

title_rec <- recipe(title ~ ., data = train_df) %>%
  step_filter(text != "") %>% 
  step_tokenize(text) %>% 
  step_ngram(text, num_tokens = 2, min_num_tokens = 1) %>%
  step_tokenfilter(text,  max_tokens = 250) %>%
  step_tfidf(text)

title_rec %>% prep() %>% juice()
# A tibble: 14,545 x 251
   title tfidf_text_a tfidf_text_a_ve… tfidf_text_about tfidf_text_after
   <fct>        <dbl>            <dbl>            <dbl>            <dbl>
 1 Prid…        0                    0                0                0
 2 Prid…        0                    0                0                0
 3 Prid…        0.401                0                0                0
 4 Prid…        0.361                0                0                0
 5 Prid…        0.201                0                0                0
 6 Prid…        0                    0                0                0
 7 Prid…        0                    0                0                0
 8 Prid…        0                    0                0                0
 9 Prid…        0                    0                0                0
10 Prid…        0                    0                0                0
# … with 14,535 more rows, and 246 more variables: tfidf_text_again <dbl>,
#   tfidf_text_all <dbl>, tfidf_text_all_the <dbl>, tfidf_text_always <dbl>,
#   tfidf_text_am <dbl>, tfidf_text_an <dbl>, tfidf_text_and <dbl>,
#   tfidf_text_and_a <dbl>, tfidf_text_and_i <dbl>, tfidf_text_and_the <dbl>,
#   tfidf_text_any <dbl>, tfidf_text_anything <dbl>, tfidf_text_are <dbl>,
#   tfidf_text_as <dbl>, tfidf_text_as_i <dbl>, tfidf_text_as_to <dbl>,
#   tfidf_text_at <dbl>, tfidf_text_at_the <dbl>, tfidf_text_away <dbl>,
#   tfidf_text_back <dbl>, tfidf_text_be <dbl>, tfidf_text_been <dbl>,
#   tfidf_text_before <dbl>, tfidf_text_being <dbl>, tfidf_text_bennet <dbl>,
#   tfidf_text_bingley <dbl>, tfidf_text_but <dbl>, tfidf_text_but_i <dbl>,
#   tfidf_text_by <dbl>, tfidf_text_by_the <dbl>, tfidf_text_came <dbl>,
#   tfidf_text_can <dbl>, tfidf_text_cannot <dbl>, tfidf_text_case <dbl>,
#   tfidf_text_collins <dbl>, tfidf_text_come <dbl>, tfidf_text_could <dbl>,
#   tfidf_text_could_not <dbl>, tfidf_text_darcy <dbl>, tfidf_text_day <dbl>,
#   tfidf_text_dear <dbl>, tfidf_text_did <dbl>, tfidf_text_did_not <dbl>,
#   tfidf_text_do <dbl>, tfidf_text_do_not <dbl>, tfidf_text_done <dbl>,
#   tfidf_text_door <dbl>, tfidf_text_down <dbl>, tfidf_text_elizabeth <dbl>,
#   tfidf_text_enough <dbl>, tfidf_text_ever <dbl>, tfidf_text_every <dbl>,
#   tfidf_text_face <dbl>, tfidf_text_family <dbl>, tfidf_text_father <dbl>,
#   tfidf_text_first <dbl>, tfidf_text_for <dbl>, tfidf_text_for_the <dbl>,
#   tfidf_text_found <dbl>, tfidf_text_friend <dbl>, tfidf_text_from <dbl>,
#   tfidf_text_from_the <dbl>, tfidf_text_give <dbl>, tfidf_text_go <dbl>,
#   tfidf_text_good <dbl>, tfidf_text_great <dbl>, tfidf_text_had <dbl>,
#   tfidf_text_had_been <dbl>, tfidf_text_has <dbl>, tfidf_text_have <dbl>,
#   tfidf_text_have_been <dbl>, tfidf_text_having <dbl>, tfidf_text_he <dbl>,
#   tfidf_text_he_had <dbl>, tfidf_text_he_was <dbl>, tfidf_text_heard <dbl>,
#   tfidf_text_her <dbl>, tfidf_text_here <dbl>, tfidf_text_herself <dbl>,
#   tfidf_text_him <dbl>, tfidf_text_himself <dbl>, tfidf_text_his <dbl>,
#   tfidf_text_holmes <dbl>, tfidf_text_hope <dbl>, tfidf_text_house <dbl>,
#   tfidf_text_how <dbl>, tfidf_text_however <dbl>, tfidf_text_i <dbl>,
#   tfidf_text_i_am <dbl>, tfidf_text_i_had <dbl>, tfidf_text_i_have <dbl>,
#   tfidf_text_i_shall <dbl>, tfidf_text_i_should <dbl>,
#   tfidf_text_i_was <dbl>, tfidf_text_if <dbl>, tfidf_text_in <dbl>,
#   tfidf_text_in_a <dbl>, tfidf_text_in_his <dbl>, tfidf_text_in_the <dbl>,
#   tfidf_text_indeed <dbl>, …

5 모형 선정

XGBoost 예측모형을 저작 분류문제를 해결하는데 사용할 수 도 있는데, 텍스트 데이터에 기반하여 분류기를 제작할 경우 다음 모형이 상대적으로 컴퓨팅 자원도 적게 소모하면서 더 좋은 성능을 보여준다. 이유는 Basetable 모형행렬이 매우 성긴 구조를 갖기 때문에 다음 모형이 XGBoost, Random Forest 와 같은 나무모형보다 권장된다.

  • glmnet: Regularized linear models
  • SVM: Support vector machines
  • 나이브 베이즈: naive Bayes
lasso_spec <- logistic_reg(penalty = tune(), mixture = 1) %>%
  set_mode("classification") %>%
  set_engine("glmnet")
lasso_spec
Logistic Regression Model Specification (classification)

Main Arguments:
  penalty = tune()
  mixture = 1

Computational engine: glmnet

5.1 CV & 초모수 격자탐색

glmnet Lasso 회귀모형을 적합시킬 때 초모수(hyper paramter) 하나를 특정해야한다. 이를 위해서 다음과 같이 격자탐색기를 특정하고 이를 교차검증표본(Cross Validation)으로 초모수를 특정한다.

param_grid <- grid_regular(
  penalty(range = c(-4, 0)),
  levels = 10
)
param_grid
# A tibble: 10 x 1
    penalty
      <dbl>
 1 0.0001  
 2 0.000278
 3 0.000774
 4 0.00215 
 5 0.00599 
 6 0.0167  
 7 0.0464  
 8 0.129   
 9 0.359   
10 1

초모수 특정을 위해서 빵과 버터, 김치와 밥처럼 함께 따라다니는 것이 교차검증표본(Cross Validation)이다. vfold_cv() 함수를 가장 많이 사용한다.

title_folds <- vfold_cv(train_df, strata = title)
title_folds
#  10-fold cross-validation using stratification 
# A tibble: 10 x 2
   splits               id    
   <list>               <chr> 
 1 <split [16.2K/1.8K]> Fold01
 2 <split [16.2K/1.8K]> Fold02
 3 <split [16.2K/1.8K]> Fold03
 4 <split [16.2K/1.8K]> Fold04
 5 <split [16.2K/1.8K]> Fold05
 6 <split [16.2K/1.8K]> Fold06
 7 <split [16.2K/1.8K]> Fold07
 8 <split [16.2K/1.8K]> Fold08
 9 <split [16.2K/1.8K]> Fold09
10 <split [16.2K/1.8K]> Fold10

6 작업흐름(workflow)

workflow()를 통해 앞서 훈련/시험 분리, 전처리, 예측모형, 모형 공식 등을 모듈화시킨 것을 한곳으로 연결시켜 자동화한다.

title_wf <- workflow() %>%
  add_recipe(title_rec) %>%
  add_model(lasso_spec)

title_wf
══ Workflow ═════════════════════════════════════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: logistic_reg()

── Preprocessor ─────────────────────────────────────────────────────────────────────────────────────
5 Recipe Steps

● step_filter()
● step_tokenize()
● step_ngram()
● step_tokenfilter()
● step_tfidf()

── Model ────────────────────────────────────────────────────────────────────────────────────────────
Logistic Regression Model Specification (classification)

Main Arguments:
  penalty = tune()
  mixture = 1

Computational engine: glmnet

6.1 초모수 특정

glmnet 모형에서 특정되지 않는 penalty =를 CV로 튜닝하여 최적 초모수를 잡아낸다.

library(tictoc)

tic()
doParallel::registerDoParallel() #윈도우에서 오류가 생김

lasso_rs <- tune_grid(
  title_wf,
  resamples = title_folds,
  grid = param_grid, 
  control = control_grid(save_pred = TRUE, verbose = TRUE)
) 
toc()
23.686 sec elapsed
lasso_rs %>% 
  write_rds("data/lasso_rs.rds")

7 모형 평가

2020-08-08 현재 윈도우10에서 돌릴 경우 여러 문제가 생기기 때문에 가능하면 맥이나 리눅스에서 직접 돌리는 것이 문제의 본질에 집중할 수 있을 것으로 보인다. 맥에서 돌린 모형 결과를 윈도우에서 가져와서 나머지 작업을 이어서 한다.

lasso_rs <- read_rds("data/lasso_rs.rds")
lasso_rs %>% 
  collect_metrics()
# A tibble: 20 x 7
    penalty .metric  .estimator  mean     n   std_err .config
      <dbl> <chr>    <chr>      <dbl> <int>     <dbl> <chr>  
 1 0.0001   accuracy binary     0.689    10 0.00411   Model01
 2 0.0001   roc_auc  binary     0.790    10 0.00433   Model01
 3 0.000278 accuracy binary     0.689    10 0.00404   Model02
 4 0.000278 roc_auc  binary     0.790    10 0.00438   Model02
 5 0.000774 accuracy binary     0.692    10 0.00415   Model03
 6 0.000774 roc_auc  binary     0.791    10 0.00448   Model03
 7 0.00215  accuracy binary     0.695    10 0.00504   Model04
 8 0.00215  roc_auc  binary     0.791    10 0.00476   Model04
 9 0.00599  accuracy binary     0.687    10 0.00416   Model05
10 0.00599  roc_auc  binary     0.786    10 0.00470   Model05
11 0.0167   accuracy binary     0.671    10 0.00592   Model06
12 0.0167   roc_auc  binary     0.763    10 0.00452   Model06
13 0.0464   accuracy binary     0.602    10 0.00505   Model07
14 0.0464   roc_auc  binary     0.677    10 0.00569   Model07
15 0.129    accuracy binary     0.507    10 0.0000429 Model08
16 0.129    roc_auc  binary     0.5      10 0         Model08
17 0.359    accuracy binary     0.507    10 0.0000429 Model09
18 0.359    roc_auc  binary     0.5      10 0         Model09
19 1        accuracy binary     0.507    10 0.0000429 Model10
20 1        roc_auc  binary     0.5      10 0         Model10

7.1 라소모형 시각화

autoplot() 혹은 select_best() 함수를 사용해서 초모수 튜닝 결과를 다음 후속 모형평가와 예측에 사용할 수 있다.

lasso_rs %>% 
  autoplot()

7.2 ROC 시각화

ROC 곡선을 그려 모형 성능에 대한 시각화 작업을 수행한다.

best_roc_auc <- select_best(lasso_rs, "roc_auc")
best_roc_auc
# A tibble: 1 x 2
  penalty .config
    <dbl> <chr>  
1 0.00215 Model04

collect_predictions() 함수는 앞선 예측값에 더하여 ROC 곡선생성에 필요한 확률값도 함께 포함하고 있다. 이를 입력값으로 삼아 roc_curve()를 그릴 수 있다.

collect_predictions(lasso_rs, parameters = best_roc_auc) %>%
  group_by(id) %>%
  roc_curve(truth = title, `.pred_Pride and Prejudice`) %>%
  autoplot()

예측모형 성능에 대한 주요 측도를 뽑아본다.

collect_predictions(lasso_rs, parameters = best_roc_auc) %>%
  conf_mat(truth = title, `.pred_class`) %>% 
  summary() %>% 
  select(-.estimator) %>%
  filter(.metric %in% c("accuracy", "precision", "recall", "f_meas")) 
# A tibble: 4 x 2
  .metric   .estimate
  <chr>         <dbl>
1 accuracy      0.695
2 precision     0.685
3 recall        0.738
4 f_meas        0.711

roc_curve()와 autoplot()을 쭉 연결시켜 시각화를 빠르게 수행한다.

collect_predictions(lasso_rs, parameters = best_roc_auc) %>%
  roc_curve(title, `.pred_Pride and Prejudice`) %>%
  autoplot()

8 변수 중요도

title_wf에 초모수 튜닝 결과를 반영시켜 최종 작업흐름을 완성한다. 이를 위해서 사용되는 함수가 finalize_workflow()다.

wf_spec_final <- finalize_workflow(title_wf, best_roc_auc)
wf_spec_final
══ Workflow ═════════════════════════════════════════════════════════════════════════════════════════
Preprocessor: Recipe
Model: logistic_reg()

── Preprocessor ─────────────────────────────────────────────────────────────────────────────────────
5 Recipe Steps

● step_filter()
● step_tokenize()
● step_ngram()
● step_tokenfilter()
● step_tfidf()

── Model ────────────────────────────────────────────────────────────────────────────────────────────
Logistic Regression Model Specification (classification)

Main Arguments:
  penalty = 0.00215443469003188
  mixture = 1

Computational engine: glmnet

vip 팩키지를 동원해서 변수중요도를 추출하는데 먼저 데이터프레임을 준비한다.

library(vip)

vi_data <- wf_spec_final %>%
  fit(train_df) %>%
  pull_workflow_fit() %>%
  vi(lambda = best_roc_auc$penalty) %>%
  mutate(Variable = str_remove_all(Variable, "tfidf_text_")) %>%
  filter(Importance != 0)

vi_data
# A tibble: 248 x 3
   Variable Importance Sign 
   <chr>         <dbl> <chr>
 1 holmes        19.6  POS  
 2 upon_the       3.19 POS  
 3 i_am           2.79 POS  
 4 to_me          2.44 POS  
 5 upon           2.40 POS  
 6 face           2.28 POS  
 7 i              2.16 POS  
 8 said_he        2.03 POS  
 9 down           1.93 POS  
10 we             1.81 POS  
# … with 238 more rows

오만과 편견(Pride and Prejudice), 셜록홈즈의 모험(The Adventures of Sherlock Holmes)으로 분류하는데 큰 영향을 주는 변수를 상위 20개만 뽑아 시각화해서 서로 비교해보자.

vi_data %>%
  mutate( Importance = abs(Importance)) %>%
  filter(Importance != 0) %>%
  group_by(Sign) %>%
  top_n(20, Importance) %>%
  ungroup() %>%
  mutate(Sign = factor(Sign, c("POS", "NEG"), c("Holmes", "Pride"))) %>%
  ggplot(aes(x = Importance,y = fct_reorder(Variable, Importance), fill = Sign)) +
    geom_col(show.legend = FALSE) +
    scale_x_continuous(expand = c(0, 0)) +
    facet_wrap(~Sign, scales = "free") +
    labs(y = NULL )

9 최종 모형 및 성능

이제 예측모형을 마지막 배포하기에 앞서 시험데이터(test data)를 통해서 최종 모형 성능화 예측모형을 완성시켜보자.

final_fit <- last_fit(wf_spec_final, books_split)
final_fit
# Resampling results
# Monte Carlo cross-validation (0.7/0.3) with 1 resamples  
# A tibble: 1 x 6
  splits        id          .metrics      .notes      .predictions     .workflow
  <list>        <chr>       <list>        <list>      <list>           <list>   
1 <split [18K/… train/test… <tibble [2 ×… <tibble [0… <tibble [7,703 … <workflo…

초모수 튜닝까지 끝난 최종 모형에 대한 평가측도는 다음과 같다.

final_fit %>%
  collect_metrics()
# A tibble: 2 x 3
  .metric  .estimator .estimate
  <chr>    <chr>          <dbl>
1 accuracy binary         0.695
2 roc_auc  binary         0.795

collect_predicions() 함수와 roc_curve() 함수를 사용해서 시각화하자.

final_fit %>%
  collect_predictions() %>%
  roc_curve(title, `.pred_Pride and Prejudice`) %>%
  autoplot()

  1. EMIL HVITFELDT, “Authorship classification with tidymodels and textrecipes”↩︎

  2. EMIL HVITFELDT, “Text Classification with Tidymodels”↩︎

  3. Emil Hvitfeldt, Julia Silge (24 July 2020), “Predictive modeling with text using tidy data principles”, Materials for our useR! 2020↩︎

 

데이터 과학자 이광춘 저작

kwangchun.lee.7@gmail.com