Machine Learning Analysis using Tidymodels Package (Ver. 2 : Workflow)

Machine Learning

Overall R code Description using Tidymodels Package for Machine Learning Analysis (Ver. 2 : Workflow)

Yeongeun Jeon , Jung In Seo
05-23-2022

Package tidymodels (Ver 0.2.0)는 R에서 머신러닝(Machine Learning)을 tidyverse principle로 수행할 수 있게끔 해주는 패키지 묶음이다. 특히, 모델링에 필요한 필수 패키지들을 대부분 포함하고 있기 때문에 데이터 전처리부터 시각화, 모델링, 예측까지 모든 과정을 tidy framework로 진행할 수 있다. 또한, Package caret을 완벽하게 대체하며 보다 더 빠르고 직관적인 코드로 모델링을 수행할 수 있다.

출처 : https://cehs-research.github.io/PSY-6600_public/slides/ch0_getting_started_r.html#26
출처 : https://rpubs.com/hoanganhngo610/553547


Package tidymodels를 이용하여 머신러닝을 수행하는 방법을 설명하기 위해 “Heart Disease Prediction” 데이터를 예제로 사용한다. 이 데이터는 환자의 심장병을 예측하기 위해 총 918명의 환자에 대한 10개의 예측변수로 이루어진 데이터이다(출처 : Package MLDataR, Gary Hutson 2021). 여기서 TargetHeartDisease이다.



Ver.1과의 차이점으로는 Workflow를 이용한다는 점이다.


1. 데이터 불러오기

# install.packages("tidymodels")
pacman::p_load("MLDataR",                                              # For Data
               "data.table", "magrittr",
               "tidymodels",
               "doParallel", "parallel")

registerDoParallel(cores=detectCores())


data(heartdisease)
data <- heartdisease %>%
  mutate(HeartDisease = ifelse(HeartDisease==0, "no", "yes"))


cols <- c("Sex", "RestingECG", "Angina", "HeartDisease")

data   <- data %>% 
  mutate_at(cols, as.factor)                                           # 범주형 변수 변환

glimpse(data)                                                          # 데이터 구조
Rows: 918
Columns: 10
$ Age              <dbl> 40, 49, 37, 48, 54, 39, 45, 54, 37, 48, 37,~
$ Sex              <fct> M, F, M, F, M, M, F, M, M, F, F, M, M, M, F~
$ RestingBP        <dbl> 140, 160, 130, 138, 150, 120, 130, 110, 140~
$ Cholesterol      <dbl> 289, 180, 283, 214, 195, 339, 237, 208, 207~
$ FastingBS        <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0~
$ RestingECG       <fct> Normal, Normal, ST, Normal, Normal, Normal,~
$ MaxHR            <dbl> 172, 156, 98, 108, 122, 170, 170, 142, 130,~
$ Angina           <fct> N, N, N, Y, N, N, N, N, Y, N, N, Y, N, Y, N~
$ HeartPeakReading <dbl> 0.0, 1.0, 0.0, 1.5, 0.0, 0.0, 0.0, 0.0, 1.5~
$ HeartDisease     <fct> no, yes, no, yes, no, no, no, no, yes, no, ~

2. 데이터 분할

set.seed(100)                                                          # seed 고정
data.split <- initial_split(data, prop = 0.7, strata = HeartDisease)   # initial_split(, strata = 층화추출할 변수)NAHD.train   <- training(data.split)
HD.test    <- testing(data.split)

3. Workflow


3-1. Recipe 정의

rec <- recipe(HeartDisease ~ ., data = HD.train) %>%
  step_normalize(all_numeric_predictors()) %>%                       # 모든 수치형 예측변수들을 표준화  step_dummy(all_nominal_predictors(), one_hot = TRUE)               # 모든 범주형 예측변수들에 대해 원-핫 인코딩 더미변수 생성NA

3-2. 모형 정의

rf.mod <- rand_forest(mtry = 12, trees = 100) %>%                    # 모형 특정 -> 어떤 모형을 사용하겠다 정의NAset_mode("classification") %>%                                     # Target 유형 정의(classification /  regression)NAset_engine("randomForest",                                         # 사용하고자하는 패키지 정의(randomForest / ranger / spark)NA= TRUE)                                      # randomForest 패키지의 함수에 대한 옵션 지정NA

3-3. Workflow 정의

rf.wflow <- workflow() %>%                                             # Workflow 정의  add_recipe(rec) %>%                                                  # 3-1에서 정의 : Recipe 추가add_model(rf.mod)                                                    # 3-2에서 정의 : 모형 추가

rf.wflow
== Workflow ==========================================================
Preprocessor: Recipe
Model: rand_forest()

-- Preprocessor ------------------------------------------------------
2 Recipe Steps

* step_normalize()
* step_dummy()

-- Model -------------------------------------------------------------
Random Forest Model Specification (classification)

Main Arguments:
  mtry = 12
  trees = 100

Engine-Specific Arguments:
  importance = TRUE

Computational engine: randomForest 

Caution! 함수 add_formula()Recipe 정의에서 formula를 정의했기 때문에 사용할 필요가 없다. 만약, Recipe에서 정의를 하지 않았다면 함수 add_formula()를 이용하여 정의를 해야 한다.


3-4. 모형 적합

set.seed(100)  
rf.wflow.fit <- fit(rf.wflow, data = HD.train)
rf.wflow.fit
== Workflow [trained] ================================================
Preprocessor: Recipe
Model: rand_forest()

-- Preprocessor ------------------------------------------------------
2 Recipe Steps

* step_normalize()
* step_dummy()

-- Model -------------------------------------------------------------

Call:
 randomForest(x = maybe_data_frame(x), y = y, ntree = ~100, mtry = min_cols(~12,      x), importance = ~TRUE) 
               Type of random forest: classification
                     Number of trees: 100
No. of variables tried at each split: 12

        OOB estimate of  error rate: 19.63%
Confusion matrix:
     no yes class.error
no  226  61   0.2125436
yes  65 290   0.1830986
rf.wflow.fit %>% 
  extract_fit_engine()                                                 

Call:
 randomForest(x = maybe_data_frame(x), y = y, ntree = ~100, mtry = min_cols(~12,      x), importance = ~TRUE) 
               Type of random forest: classification
                     Number of trees: 100
No. of variables tried at each split: 12

        OOB estimate of  error rate: 19.63%
Confusion matrix:
     no yes class.error
no  226  61   0.2125436
yes  65 290   0.1830986

4. 예측

4-1. 예측 클래스

rf.pred.class <- predict(rf.wflow.fit, HD.test)
rf.pred.class
# A tibble: 276 x 1
   .pred_class
   <fct>      
 1 no         
 2 yes        
 3 no         
 4 no         
 5 yes        
 6 no         
 7 yes        
 8 no         
 9 no         
10 no         
# ... with 266 more rows

4-2. 예측 확률

rf.pred.prob  <- predict(rf.wflow.fit, HD.test, type = "prob")
rf.pred.prob
# A tibble: 276 x 2
   .pred_no .pred_yes
      <dbl>     <dbl>
 1     0.91      0.09
 2     0.3       0.7 
 3     0.99      0.01
 4     0.95      0.05
 5     0.29      0.71
 6     0.97      0.03
 7     0.45      0.55
 8     0.68      0.32
 9     0.99      0.01
10     0.95      0.05
# ... with 266 more rows

4-3. 모든 예측 결과 출력

rf.pred <- augment(rf.wflow.fit, HD.test)
rf.pred
# A tibble: 276 x 13
     Age Sex   RestingBP Cholesterol FastingBS RestingECG MaxHR Angina
   <dbl> <fct>     <dbl>       <dbl>     <dbl> <fct>      <dbl> <fct> 
 1    54 M           110         208         0 Normal       142 N     
 2    37 M           140         207         0 Normal       130 Y     
 3    37 F           130         211         0 Normal       142 N     
 4    39 M           120         204         0 Normal       145 N     
 5    49 M           140         234         0 Normal       140 Y     
 6    42 F           115         211         0 ST           137 N     
 7    60 M           100         248         0 Normal       125 N     
 8    36 M           120         267         0 Normal       160 N     
 9    43 F           100         223         0 Normal       142 N     
10    36 M           130         209         0 Normal       178 N     
# ... with 266 more rows, and 5 more variables:
#   HeartPeakReading <dbl>, HeartDisease <fct>, .pred_class <fct>,
#   .pred_no <dbl>, .pred_yes <dbl>
rf.pred %>%
  select(contains(".pred"))                                      # 예측 결과들만 추출
# A tibble: 276 x 3
   .pred_class .pred_no .pred_yes
   <fct>          <dbl>     <dbl>
 1 no              0.91      0.09
 2 yes             0.3       0.7 
 3 no              0.99      0.01
 4 no              0.95      0.05
 5 yes             0.29      0.71
 6 no              0.97      0.03
 7 yes             0.45      0.55
 8 no              0.68      0.32
 9 no              0.99      0.01
10 no              0.95      0.05
# ... with 266 more rows

5. 모형 평가

출처 : https://velog.io/@hajeongjj/Eval-Metrics

5-1. 척도

5-1-1. ConfusionMatrix

conf_mat(rf.pred, truth = HeartDisease, estimate = .pred_class)        # truth : 실제 클래스,  estimate : 예측 클래스 클래스
          Truth
Prediction  no yes
       no   97  28
       yes  26 125
conf_mat(rf.pred, truth = HeartDisease, estimate = .pred_class) %>%
  autoplot(type = "mosaic")                                            # autoplot(type = "heatmap") 


5-1-2. Accuracy

accuracy(rf.pred, truth = HeartDisease, estimate = .pred_class)        # truth : 실제 클래스,  estimate : 예측 클래스 클래스
# A tibble: 1 x 3
  .metric  .estimator .estimate
  <chr>    <chr>          <dbl>
1 accuracy binary         0.804

5-1-3. 여러 척도를 한 번에 나타내기

classification_metrics <- metric_set(accuracy, mcc, 
                                     f_meas, kap,
                                     sens, spec, roc_auc)              # Test Data에 대한 Assessment Measure
classification_metrics(rf.pred, 
                       truth = HeartDisease, estimate = .pred_class,   # truth : 실제 클래스, estimate : 예측 클래스 클래스
                       .pred_yes, event_level = "second")              # For roc_auc                       
# A tibble: 7 x 3
  .metric  .estimator .estimate
  <chr>    <chr>          <dbl>
1 accuracy binary         0.804
2 mcc      binary         0.605
3 f_meas   binary         0.822
4 kap      binary         0.605
5 sens     binary         0.817
6 spec     binary         0.789
7 roc_auc  binary         0.869

Caution! “ROC AUC”를 계산하기 위해서는 관심 클래스에 대한 예측 확률이 필요하다. 예제 데이터에서 관심 클래스는 “yes”이므로 “yes”에 대한 예측 확률 결과인 .pred_yes가 사용되었다. 또한, Target인 “HeartDisease” 변수의 유형을 “Factor” 변환하면 알파벳순으로 클래스를 부여하기 때문에 관심 클래스 “yes”가 두 번째 클래스가 된다. 따라서 옵션 event_level = "second"을 사용하여 관심 클래스가 “yes”임을 명시해주어야 한다.


5-2. 그래프

Caution! 함수 “roc_curve(), gain_curve(), lift_curve(), pr_curve()”에서는 첫번째 클래스(Level)를 관심 클래스로 인식한다. R에서는 함수 Factor()를 이용하여 변수 유형을 변환하면 알파벳순(영어) 또는 오름차순(숫자)으로 클래스를 부여하므로 “HeartDisease” 변수의 경우 “no”가 첫번째 클래스가 되고 “yes”가 두번째 클래스가 된다. 따라서, 예제 데이터에서 관심 클래스는 “yes”이기 때문에 옵션 event_level = "second"을 사용하여 관심 클래스가 “yes”임을 명시해주어야 한다.

5-2-1. ROC Curve

rf.pred %>% 
  roc_curve(truth = HeartDisease, .pred_yes,                           # truth : 실제 클래스,  관심 클래스 예측 확률  확률 
            event_level = "second") %>%                                
  autoplot()


5-2-2. Gain Curve

rf.pred %>% 
  gain_curve(truth = HeartDisease, .pred_yes,                          # truth : 실제 클래스,  관심 클래스 예측 확률  확률 
             event_level = "second") %>%                               
  autoplot()

Caution! 관심 클래스의 예측 확률을 내림차순으로 정렬한 후 그래프로 나타낸다. 함수 gain_curve()에 대한 자세한 설명은 여기를 참조한다.
Result! x축인 %Tested은 Test Data의 분위수이며, y축인 %Found은 관심 클래스 대비 해당 분위수에서의 관심 클래스 비율(즉, 해당 분위수에서의 관심 클래스 빈도 / Test Data에서의 관심 클래스 빈도)을 나타낸다. 그리고 회색 영역의 삼각형은 ‘Perfect’ Gain Curve으로 정확도가 100%인 모형에 대한 Gain Curve이다.


5-2-3. Lift Curve

rf.pred %>% 
  lift_curve(truth = HeartDisease, .pred_yes,                          # truth : 실제 클래스,  관심 클래스 예측 확률  확률 
             event_level = "second") %>%                               
  autoplot()

Caution! 관심 클래스의 예측 확률을 내림차순으로 정렬한 후 그래프로 나타낸다. 함수 lift_curve()에 대한 자세한 설명은 여기를 참조한다.
Result! x축인 %Tested은 Test Data의 분위수이며, y축인 Lift는 전체 관심 클래스 비율 대비 해당 분위수의 관심 클래스 비율(함수 gain_curve()y축 %Found)을 x축 %Tested으로 나눈 값(함수 gain_curve()y축 %Found/x축 %Tested)을 나타낸다.


5-2-4. Precision Recall Curve

rf.pred %>% 
  pr_curve(truth = HeartDisease, .pred_yes,                            # truth : 실제 클래스,  관심 클래스 예측 확률  확률 
           event_level = "second") %>%                                 
  autoplot()


6. Resampling 방법

출처 : https://www.tmwr.org/resampling.html

6-1. K-Fold Cross-Vailidation

출처 : https://www.tmwr.org/resampling.html
출처 : https://www.tmwr.org/resampling.html
set.seed(100)
vfold_cv(data, v)      

6-2. Repeated K-Fold Cross-Vailidation

vfold_cv(data, v, repeats)     

6-3. Leave-One-Out Cross-Validation

loo_cv(data)   

6-4. Monte Carlo Cross-Validation

mc_cv(data, prop, times) 

6-5. Validation Set

출처 : https://www.tmwr.org/resampling.html
validation_split(data, prop)

6-6. Bootstrapping

bootstraps(data, times)   

6-7. Resampling 방법을 이용한 모형 적합

Caution! Resampling 방법을 통해 계산된 Assessment 그룹의 평가 척도값이 Workflow를 사용하지 않았을 때(tidymodels_Ver.1)와 결과가 다르다. 그래서, 모수 튜닝을 할 때, Workflow를 사용하지 않았을 때와 최적의 모수 조합이 다를 수 있다.


6-7-1. Resampling 방법 정의

set.seed(100)                                                          # seed 고정
train.fold <- vfold_cv(HD.train, v = 5)          
train.fold
#  5-fold cross-validation 
# A tibble: 5 x 2
  splits            id   
  <list>            <chr>
1 <split [513/129]> Fold1
2 <split [513/129]> Fold2
3 <split [514/128]> Fold3
4 <split [514/128]> Fold4
5 <split [514/128]> Fold5

Caution! 데이터를 먼저 5개의 Fold로 나눈 후, Analysis 그룹의 Dataset(4개의 Fold에 속한 513명의 환자)을 이용하여 모형을 구축하고 Assessment 그룹의 Dataset(1개의 Fold에 속한 129명의 환자)을 이용하여 구축된 모형을 평가한다.


6-7-2. 모형 적합

set.seed(100)
rf.fit.rs <- workflow() %>%                                            # Workflow 정의  add_recipe(rec) %>%                                                  # 3-1에서 정의add_model(rf.mod) %>%                                                # 3-2에서 정의fit_resamples(resamples = train.fold)                                # 6-7-1에서 정의 : Resampling 방법 적용 

rf.fit.rs
# Resampling results
# 5-fold cross-validation 
# A tibble: 5 x 4
  splits            id    .metrics         .notes          
  <list>            <chr> <list>           <list>          
1 <split [513/129]> Fold1 <tibble [2 x 4]> <tibble [0 x 3]>
2 <split [513/129]> Fold2 <tibble [2 x 4]> <tibble [0 x 3]>
3 <split [514/128]> Fold3 <tibble [2 x 4]> <tibble [0 x 3]>
4 <split [514/128]> Fold4 <tibble [2 x 4]> <tibble [0 x 3]>
5 <split [514/128]> Fold5 <tibble [2 x 4]> <tibble [0 x 3]>

Caution! 위에서 생성된 “rf.fit.rs”는 “fit_resamples(preprocessor = rec, object = rf.mod, resamples = train.fold)”와 동일한 결과를 출력한다.
Result! .metrics열은 Assessment 그룹의 평가 척도값이 포함되어 있으며, .notes열은 Resampling 동안에 생성되는 에러나 경고를 포함한다.

# Assessment 그룹에 대한 평균 Assessment Measurecollect_metrics(rf.fit.rs)     
# A tibble: 2 x 6
  .metric  .estimator  mean     n std_err .config             
  <chr>    <chr>      <dbl> <int>   <dbl> <fct>               
1 accuracy binary     0.808     5 0.0111  Preprocessor1_Model1
2 roc_auc  binary     0.862     5 0.00369 Preprocessor1_Model1
# 각 Assessment 그룹에 대한 Assessment Measuree
collect_metrics(rf.fit.rs, summarize = FALSE)  
# A tibble: 10 x 5
   id    .metric  .estimator .estimate .config             
   <chr> <chr>    <chr>          <dbl> <fct>               
 1 Fold1 accuracy binary         0.822 Preprocessor1_Model1
 2 Fold1 roc_auc  binary         0.869 Preprocessor1_Model1
 3 Fold2 accuracy binary         0.814 Preprocessor1_Model1
 4 Fold2 roc_auc  binary         0.868 Preprocessor1_Model1
 5 Fold3 accuracy binary         0.812 Preprocessor1_Model1
 6 Fold3 roc_auc  binary         0.861 Preprocessor1_Model1
 7 Fold4 accuracy binary         0.766 Preprocessor1_Model1
 8 Fold4 roc_auc  binary         0.848 Preprocessor1_Model1
 9 Fold5 accuracy binary         0.828 Preprocessor1_Model1
10 Fold5 roc_auc  binary         0.862 Preprocessor1_Model1

Caution! 함수 collect_metrics(, summarize = FALSE)을 이용하면 각 Assessment 그룹에 대한 모형 평가 척도값을 확인할 수 있다.


6-7-3. 각 Fold에 대한 결과

re.control <- control_resamples(save_pred = TRUE,                      # Resampling의 Assessment 결과 저장NA= "everything")          # 병렬 처리(http:://tune.tidymodels.org/reference/control_grid.html)l)
set.seed(100)
workflow() %>%  
  add_recipe(rec) %>%                                                  # 3-1에서 정의add_model(rf.mod) %>%                                                # 3-2에서 정의fit_resamples(resamples = train.fold,                                # 6-7-1에서 정의 : Resampling 방법 적용 
                control = re.control) %>%      
  collect_predictions()
# A tibble: 642 x 7
   id    .pred_no .pred_yes  .row .pred_class HeartDisease .config    
   <chr>    <dbl>     <dbl> <int> <fct>       <fct>        <fct>      
 1 Fold1     0.95      0.05     5 no          no           Preprocess~
 2 Fold1     0.99      0.01    11 no          no           Preprocess~
 3 Fold1     0.66      0.34    13 no          no           Preprocess~
 4 Fold1     0.65      0.35    14 no          no           Preprocess~
 5 Fold1     1         0       22 no          no           Preprocess~
 6 Fold1     1         0       28 no          no           Preprocess~
 7 Fold1     0.79      0.21    33 no          no           Preprocess~
 8 Fold1     0.77      0.23    39 no          no           Preprocess~
 9 Fold1     0.96      0.04    46 no          no           Preprocess~
10 Fold1     0.98      0.02    52 no          no           Preprocess~
# ... with 632 more rows

Caution! 함수 collect_predictions()을 이용하면 각 Assessment 그룹에 대한 예측 결과를 확인할 수 있다.


7. 모수 튜닝


7-1. Regular Grid

grid_regular(x, levels)                                    

7-2. Irregular Grid

7-2-1. Random Grid

grid_random(x, size)                                    

7-2-2. Latin Hypercube

grid_latin_hypercube(x, size)                                    

7-3. Expand Grid


7-4. 모수 튜닝을 이용한 모형 적합


7-4-1. 모형 정의

rf.tune.mod <- rand_forest(mtry = tune(), trees = tune()) %>%          # Tuning 하고 싶은 모수를 tune() 으로 설정set_mode("classification") %>%                                         
  set_engine("randomForest")     

# Workflow 정의 rf.tune.wflow <- workflow() %>%
  add_model(rf.tune.mod) %>%                                           
  add_recipe(rec)                                                      # 3-1에서 정의

7-4-2. 모수 범위 확인

rf.param    <- extract_parameter_set_dials(rf.tune.wflow)               
rf.param                                                                 
Collection of 2 parameters for tuning

 identifier  type    object
       mtry  mtry nparam[?]
      trees trees nparam[+]

Model parameters needing finalization:
   # Randomly Selected Predictors ('mtry')

See `?dials::finalize` or `?dials::update.parameters` for more information.

Result! object열에서 nparam은 모수값이 수치형임을 나타낸다. 또한, nparam[+]는 해당 모수의 범위가 명확하게 주어졌음을 의미하고, nparam[?]는 모수의 범위에서 상한 또는 하한의 값이 명확하지 않다는 것을 의미한다. 이러한 경우, 상한 또는 하한의 값을 명확하게 결정하여야 한다.

rf.param %>%
  extract_parameter_dials("mtry")                                       
# Randomly Selected Predictors (quantitative)
Range: [1, ?]

Caution! 함수 extract_parameter_dials()를 이용하여 모수 범위를 자세히 확인할 수 있다.
Result! mtry의 상한이 ?이므로 상한값을 결정하여야 한다.


7-4-3. 모수 범위 수정

# 1. 직접 할당하는 방법NA## 전처리가 적용된 데이터의 예측변수 개수가 상한이 되도록 설정rf.param %<>%
  update(mtry =  mtry(c(1, 
                        ncol(select(juice(prep(rec)), -HeartDisease)) # juice(prep(rec)) : Recipe 적용 -> 전처리가 적용된 데이터셋 생성, ncol(select(., -Target)) : 전처리가 적용된 데이터의 예측변수 개수  ))) 

# ## 2. 데이터 기반으로 ?를 수정함# rf.param %<>%
#   finalize(HD.train)                                                 # 상한이 HD.train의 변수 개수 10개로 수정됨 

rf.param %>%
  extract_parameter_dials("mtry")                                     
# Randomly Selected Predictors (quantitative)
Range: [1, 13]

Result! mtry의 상한이 13으로 수정되었다.


7-4-4. 후보 모수 집합에 대한 모형 평가

set.seed(100)
train.fold <- vfold_cv(HD.train, v = 5)                                # 5-Cross-Validation                              
                           
                       
set.seed(100)
rf.tune.fit <- rf.tune.wflow %>%                                       # 7-4-1에서 정의 : Workfloww
  tune_grid(                                                           # 함수 tune_grid     resamples = train.fold,                                            # 위에서 정의한 Resampling -> 5-Cross-Validation
    grid =  rf.param %>%                                               # 후보 모수 집합 NAgrid_latin_hypercube(size = 10),
    control = control_grid(save_pred = TRUE,                           # Resampling의 Assessment 결과 저장NA= "everything")               # 병렬 처리(http:://tune.tidymodels.org/reference/control_grid.html) ) 
    # metrics = metric_set(roc_auc, accuracy)                            # Assessment 그룹에 대한 Assessment Measure
  )

rf.tune.fit
# Tuning results
# 5-fold cross-validation 
# A tibble: 5 x 5
  splits            id    .metrics          .notes   .predictions
  <list>            <chr> <list>            <list>   <list>      
1 <split [513/129]> Fold1 <tibble [20 x 6]> <tibble> <tibble>    
2 <split [513/129]> Fold2 <tibble [20 x 6]> <tibble> <tibble>    
3 <split [514/128]> Fold3 <tibble [20 x 6]> <tibble> <tibble>    
4 <split [514/128]> Fold4 <tibble [20 x 6]> <tibble> <tibble>    
5 <split [514/128]> Fold5 <tibble [20 x 6]> <tibble> <tibble>    

Caution! 위에서 생성된 “rf.tune.fit”은 “tune_grid(preprocessor = rec, object = rf.tune.mod, resamples = train.fold, grid = rf.param %>% grid_latin_hypercube(size = 10), control = control_grid(save_pred = TRUE, parallel_over =”everything“))”와 동일한 결과를 출력한다.

# Assessment 그룹에 대한 평균 Assessment Measurecollect_metrics(rf.tune.fit)
# A tibble: 20 x 8
    mtry trees .metric  .estimator  mean     n std_err .config        
   <int> <int> <chr>    <chr>      <dbl> <int>   <dbl> <fct>          
 1     6  1363 accuracy binary     0.821     5 0.00714 Preprocessor1_~
 2     6  1363 roc_auc  binary     0.871     5 0.00521 Preprocessor1_~
 3     4  1791 accuracy binary     0.822     5 0.0116  Preprocessor1_~
 4     4  1791 roc_auc  binary     0.873     5 0.00816 Preprocessor1_~
 5     8  1010 accuracy binary     0.813     5 0.00624 Preprocessor1_~
 6     8  1010 roc_auc  binary     0.869     5 0.00581 Preprocessor1_~
 7     2   572 accuracy binary     0.819     5 0.0180  Preprocessor1_~
 8     2   572 roc_auc  binary     0.877     5 0.00910 Preprocessor1_~
 9     8   333 accuracy binary     0.818     5 0.00548 Preprocessor1_~
10     8   333 roc_auc  binary     0.869     5 0.00543 Preprocessor1_~
11    10  1533 accuracy binary     0.816     5 0.00691 Preprocessor1_~
12    10  1533 roc_auc  binary     0.867     5 0.00407 Preprocessor1_~
13     2   681 accuracy binary     0.819     5 0.0142  Preprocessor1_~
14     2   681 roc_auc  binary     0.878     5 0.00922 Preprocessor1_~
15    11   151 accuracy binary     0.811     5 0.00856 Preprocessor1_~
16    11   151 roc_auc  binary     0.862     5 0.00479 Preprocessor1_~
17    13  1882 accuracy binary     0.812     5 0.00587 Preprocessor1_~
18    13  1882 roc_auc  binary     0.862     5 0.00388 Preprocessor1_~
19     5   938 accuracy binary     0.824     5 0.00961 Preprocessor1_~
20     5   938 roc_auc  binary     0.873     5 0.00569 Preprocessor1_~

Result! 각 후보 모수 조합별로 성능을 확인할 수 있다. 평가 척도는 기본적으로 “Accuracy”와 “ROC AUC”이다.

# 그래프
autoplot(rf.tune.fit) + 
  scale_color_viridis_d(direction = -1) + 
  theme(legend.position = "top") + 
  theme_bw()


7-4-5. 최적의 모수 조합 확인

# Metric 기준으로 예측 성능이 우수한 모수 조합 순서대로 확인NAshow_best(rf.tune.fit, "roc_auc")                                      # show_best(, "accuracy")
# A tibble: 5 x 8
   mtry trees .metric .estimator  mean     n std_err .config          
  <int> <int> <chr>   <chr>      <dbl> <int>   <dbl> <fct>            
1     2   681 roc_auc binary     0.878     5 0.00922 Preprocessor1_Mo~
2     2   572 roc_auc binary     0.877     5 0.00910 Preprocessor1_Mo~
3     5   938 roc_auc binary     0.873     5 0.00569 Preprocessor1_Mo~
4     4  1791 roc_auc binary     0.873     5 0.00816 Preprocessor1_Mo~
5     6  1363 roc_auc binary     0.871     5 0.00521 Preprocessor1_Mo~
# 최적의 모수 조합 확인NAbest.rf <- rf.tune.fit %>% 
  select_best("roc_auc")                                               # select_best("accuracy")
best.rf 
# A tibble: 1 x 3
   mtry trees .config              
  <int> <int> <fct>                
1     2   681 Preprocessor1_Model07

Result! mtry = 2, trees = 681일 때 “ROC AUC” 측면에서 모형의 예측 성능이 가장 좋다.


7-4-6. 최적의 모수 조합을 이용한 모형 적합

final.rf.wflow <- rf.tune.wflow %>%                                    # 7-4-1에서 정의finalize_workflow(best.rf)                                           # finalize_workflow : 최적의 모수 조합을 가지는 workflow로 업데이트NAfinal.rf.wflow
== Workflow ==========================================================
Preprocessor: Recipe
Model: rand_forest()

-- Preprocessor ------------------------------------------------------
2 Recipe Steps

* step_normalize()
* step_dummy()

-- Model -------------------------------------------------------------
Random Forest Model Specification (classification)

Main Arguments:
  mtry = 2
  trees = 681

Computational engine: randomForest 
# 모형 적합NAset.seed(100)
final.rf.fit   <- final.rf.wflow %>% 
  fit(data = HD.train)
final.rf.fit
== Workflow [trained] ================================================
Preprocessor: Recipe
Model: rand_forest()

-- Preprocessor ------------------------------------------------------
2 Recipe Steps

* step_normalize()
* step_dummy()

-- Model -------------------------------------------------------------

Call:
 randomForest(x = maybe_data_frame(x), y = y, ntree = ~681L, mtry = min_cols(~2L,      x)) 
               Type of random forest: classification
                     Number of trees: 681
No. of variables tried at each split: 2

        OOB estimate of  error rate: 17.45%
Confusion matrix:
     no yes class.error
no  234  53   0.1846690
yes  59 296   0.1661972
# 최종 모형NAfinal.rf.fit %>% 
  extract_fit_engine()

Call:
 randomForest(x = maybe_data_frame(x), y = y, ntree = ~681L, mtry = min_cols(~2L,      x)) 
               Type of random forest: classification
                     Number of trees: 681
No. of variables tried at each split: 2

        OOB estimate of  error rate: 17.45%
Confusion matrix:
     no yes class.error
no  234  53   0.1846690
yes  59 296   0.1661972

7-5. 예측

pred <- augment(final.rf.fit, HD.test)                                 # predict(final.rf.fit, HD.test) 
pred
# A tibble: 276 x 13
     Age Sex   RestingBP Cholesterol FastingBS RestingECG MaxHR Angina
   <dbl> <fct>     <dbl>       <dbl>     <dbl> <fct>      <dbl> <fct> 
 1    54 M           110         208         0 Normal       142 N     
 2    37 M           140         207         0 Normal       130 Y     
 3    37 F           130         211         0 Normal       142 N     
 4    39 M           120         204         0 Normal       145 N     
 5    49 M           140         234         0 Normal       140 Y     
 6    42 F           115         211         0 ST           137 N     
 7    60 M           100         248         0 Normal       125 N     
 8    36 M           120         267         0 Normal       160 N     
 9    43 F           100         223         0 Normal       142 N     
10    36 M           130         209         0 Normal       178 N     
# ... with 266 more rows, and 5 more variables:
#   HeartPeakReading <dbl>, HeartDisease <fct>, .pred_class <fct>,
#   .pred_no <dbl>, .pred_yes <dbl>

7-6. 모형 적합과 예측을 한 번에 하기

# Ref. https://github.com/tidymodels/tune/issues/300 (last_fit과 fit의 결과가 다름))
#      https://github.com/tidymodels/tune/pull/323 (last_fit seed X)

final.rf.last <- final.rf.wflow %>%
  last_fit(split = data.split)                                         # data.split : 데이터 분할할 때 initial_split에 의한 변수NAfinal.rf.last
# Resampling results
# Manual resampling 
# A tibble: 1 x 6
  splits            id       .metrics .notes   .predictions .workflow 
  <list>            <chr>    <list>   <list>   <list>       <list>    
1 <split [642/276]> train/t~ <tibble> <tibble> <tibble>     <workflow>
# 구축된 모형final.rf.last %>%
  extract_fit_engine()

Call:
 randomForest(x = maybe_data_frame(x), y = y, ntree = ~681L, mtry = min_cols(~2L,      x)) 
               Type of random forest: classification
                     Number of trees: 681
No. of variables tried at each split: 2

        OOB estimate of  error rate: 18.22%
Confusion matrix:
     no yes class.error
no  236  51   0.1777003
yes  66 289   0.1859155
# 예측 결과
final.rf.last %>%
  collect_predictions()  
# A tibble: 276 x 7
   id        .pred_no .pred_yes  .row .pred_class HeartDisease .config
   <chr>        <dbl>     <dbl> <int> <fct>       <fct>        <fct>  
 1 train/te~    0.902   0.0984      8 no          no           Prepro~
 2 train/te~    0.209   0.791       9 yes         yes          Prepro~
 3 train/te~    0.991   0.00881    11 no          no           Prepro~
 4 train/te~    0.960   0.0396     13 no          no           Prepro~
 5 train/te~    0.197   0.803      14 yes         yes          Prepro~
 6 train/te~    0.985   0.0147     15 no          no           Prepro~
 7 train/te~    0.490   0.510      19 yes         yes          Prepro~
 8 train/te~    0.686   0.314      20 no          yes          Prepro~
 9 train/te~    0.984   0.0162     21 no          no           Prepro~
10 train/te~    0.972   0.0279     26 no          no           Prepro~
# ... with 266 more rows
# Test Data에 대한 Assessment Measure
final.rf.last %>%
  collect_metrics()
# A tibble: 2 x 4
  .metric  .estimator .estimate .config             
  <chr>    <chr>          <dbl> <fct>               
1 accuracy binary         0.812 Preprocessor1_Model1
2 roc_auc  binary         0.881 Preprocessor1_Model1

Caution! 함수 last_fit()은 seed 고정이 되지 않아 Reproducibility (재생산성)가 만족되지 않는다.


7-7. Bayesian Optimization

tune_bayes(object, resamples, metrics, initial, param_info, iter, control)
ctrl <- control_bayes(verbose = TRUE
                      # no_improve = 20,                                 # no_improve 반복 내에서 개선된 모수가 발견되지 않으면 검색을 중지을 중지
                      # uncertain = 4,                                   # uncertainty 반복 내에서 개선이 없을 경우 불확실성 표본을 추출하는 정수(또는 Inf) -> 변동이 큰 다음 후보가 선택됨/ 평균 예측을 고려하지 않기 때문에 순수 탐색의 효과가 있음과가 있음
                      )

set.seed(100)
rf.tune.be <- rf.tune.wflow %>%
  tune_bayes(
    resamples  = train.fold,                                            # Resampling 방법
    metrics    = metric_set(roc_auc),                                   # Assessment 그룹에 대한 Assessment Measure
    initial    = rf.tune.fit,                                           # tune_grid()를 사용하여 생성된 객체/ 정수 / 초기값초기값
    param_info = rf.param,                                              # 모수 범위
    iter       = 25,                                                    # 최대 검색 반복 수
    control    = ctrl
  )

Reuse

Text and figures are licensed under Creative Commons Attribution CC BY 4.0. The figures that have been reused from other sources don't fall under this license and can be recognized by a note in their caption: "Figure from ...".