Support Vector Machine based on Tidymodels

Machine Learning

R code using Tidymodels Package for Support Vector Machine

Yeongeun Jeon , Jung In Seo
04-23-2022

Package tidymodels (Ver 0.2.0)는 R에서 머신러닝(Machine Learning)을 tidyverse principle로 수행할 수 있게끔 해주는 패키지 묶음이다. 특히, 모델링에 필요한 필수 패키지들을 대부분 포함하고 있기 때문에 데이터 전처리부터 시각화, 모델링, 예측까지 모든 과정을 tidy framework로 진행할 수 있다. 또한, Package caret을 완벽하게 대체하며 보다 더 빠르고 직관적인 코드로 모델링을 수행할 수 있다. Package tidymodels를 이용하여 Support Vector Machine을 수행하는 방법을 설명하기 위해 “Heart Disease Prediction” 데이터를 예제로 사용한다. 이 데이터는 환자의 심장병을 예측하기 위해 총 918명의 환자에 대한 10개의 예측변수로 이루어진 데이터이다(출처 : Package MLDataR, Gary Hutson 2021). 여기서 TargetHeartDisease이다.



0. Schematic Diagram


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)   # Partition (Traning Data : Test Data = 7:3)/ initial_split(, strata = 층화추출할 변수)NAHD.train   <- training(data.split)
HD.test    <- testing(data.split)

3. Linear Kernel

3-1. 전처리 정의

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

3-2. 모형 정의

svm.li.tune.mod <- svm_linear(cost = tune()) %>%                       # cost : 데이터를 잘못 분류하는 선을 긋게 될 경우 지불해야 할 costNAset_mode("classification") %>%                                       # Target 유형 정의(classification /  regression)NAset_engine("kernlab")                                                # 사용하고자하는 패키지 정의(kernlab /  LiblineaR) NA# 실제 패키지에 어떻게 적용되는지 확인NAsvm.li.tune.mod %>% 
  translate()
Linear Support Vector Machine Specification (classification)

Main Arguments:
  cost = tune()

Computational engine: kernlab 

Model fit template:
kernlab::ksvm(x = missing_arg(), data = missing_arg(), C = tune(), 
    kernel = "vanilladot", prob.model = TRUE)

Caution! 함수 translate()를 통해 위에서 정의한 “svm.li.tune.mod”가 실제로 Package kernlab의 함수 ksvm()에 어떻게 적용되는지 확인할 수 있다.


3-3. Workflow 정의

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

3-4. 모수 범위 확인

svm.li.param <- extract_parameter_set_dials(svm.li.tune.wflow)         
svm.li.param        
Collection of 1 parameters for tuning

 identifier type    object
       cost cost nparam[+]

Result! object열에서 nparam은 모수값이 수치형임을 나타낸다. 또한, costobject열이 nparam[+]로 해당 모수의 범위가 명확하게 주어졌음을 의미한다.

svm.li.param %>%
  extract_parameter_dials("cost")
Cost (quantitative)
Transformer:  log-2 
Range (transformed scale): [-10, 5]
# 범위 수정
svm.li.param %<>%
  update(cost =  cost(c(0.0001, 1000)))

3-5. 모형 적합

3-5-1. Resampling 정의

set.seed(100)
train.fold    <- vfold_cv(HD.train, v = 5)                            

3-5-2. 최적의 모수 조합 찾기


3-5-2-1. Regular Grid

set.seed(100)
grid <-  svm.li.param %>%                                           
  grid_regular(levels = 2)
grid
# A tibble: 2 x 1
       cost
      <dbl>
1  0.000977
2 32       

Result! cost에 대해 후보 모수값 2개를 생성하였다.

# 모형 적합NAset.seed(100)
svm.li.tune.grid.fit <- svm.li.tune.wflow %>%                          # 3-3에서 정의tune_grid(
    train.fold,                                                        # 3-5-1에서 정의 : Resampling -> 5-Cross-Validationn
    grid = grid,                                                       # 3-5-2-1에서 정의 : 후보 모수 집합     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
  )

# 그래프
autoplot(svm.li.tune.grid.fit) + 
  scale_color_viridis_d(direction = -1) + 
  theme(legend.position = "top") +
  theme_bw()
# 지정된 Metric 측면에서 성능이 우수한 모형을 순서대로 확인NAshow_best(svm.li.tune.grid.fit, "roc_auc")                             # show_best(, "accuracy")
# A tibble: 2 x 7
       cost .metric .estimator  mean     n std_err .config            
      <dbl> <chr>   <chr>      <dbl> <int>   <dbl> <fct>              
1  0.000977 roc_auc binary     0.871     5 0.0123  Preprocessor1_Mode~
2 32        roc_auc binary     0.861     5 0.00919 Preprocessor1_Mode~
# 최적의 모수 조합 확인NAbest.svm.li.random <- svm.li.tune.grid.fit %>% 
  select_best("roc_auc")
best.svm.li.random 
# A tibble: 1 x 2
      cost .config             
     <dbl> <fct>               
1 0.000977 Preprocessor1_Model1

Result! cost = 0.000977일 때 “ROC AUC” 측면에서 가장 우수한 성능을 보여준다.


3-5-2-2. Latin Hypercube

set.seed(100)
random <- svm.li.param %>%                                             
  grid_latin_hypercube(size = 5)
random
# A tibble: 5 x 1
      cost
     <dbl>
1  0.00100
2  0.306  
3 16.4    
4  2.09   
5  0.0103 

Result! 후보 모수 5개를 랜덤하게 생성하였다.

# 모형 적합NAset.seed(100)
svm.li.tune.random.fit <- svm.li.tune.wflow %>%                        # 3-3에서 정의tune_grid(
    train.fold,                                                        # 3-5-1에서 정의 : Resampling -> 5-Cross-Validationn
    grid = random,                                                     # 3-5-2-2에서 정의 : 후보 모수 집합     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
  )

# 그래프
autoplot(svm.li.tune.random.fit) + 
  scale_color_viridis_d(direction = -1) + 
  theme(legend.position = "top") +
  theme_bw()
# 지정된 Metric 측면에서 성능이 우수한 모형을 순서대로 확인NAshow_best(svm.li.tune.random.fit, "roc_auc")                            # show_best(, "accuracy")
# A tibble: 5 x 7
      cost .metric .estimator  mean     n std_err .config             
     <dbl> <chr>   <chr>      <dbl> <int>   <dbl> <fct>               
1  0.0103  roc_auc binary     0.871     5 0.0124  Preprocessor1_Model5
2  0.00100 roc_auc binary     0.870     5 0.0122  Preprocessor1_Model1
3  2.09    roc_auc binary     0.863     5 0.0103  Preprocessor1_Model4
4  0.306   roc_auc binary     0.862     5 0.00916 Preprocessor1_Model2
5 16.4     roc_auc binary     0.860     5 0.00907 Preprocessor1_Model3
# 최적의 모수 조합 확인NAbest.svm.li.random <- svm.li.tune.random.fit %>% 
  select_best("roc_auc")
best.svm.li.random 
# A tibble: 1 x 2
    cost .config             
   <dbl> <fct>               
1 0.0103 Preprocessor1_Model5

Result! cost = 0.0103일 때 “ROC AUC” 측면에서 가장 우수한 성능을 보여준다.


3-5-2-3. Expand Grid

egrid <- expand.grid(cost = seq(0.01, 0.011, 0.0001))
egrid
     cost
1  0.0100
2  0.0101
3  0.0102
4  0.0103
5  0.0104
6  0.0105
7  0.0106
8  0.0107
9  0.0108
10 0.0109
11 0.0110

Result! 후보 모수값들의 집합이 생성되었다.

# 모형 적합NAset.seed(100)
svm.li.tune.egrid.fit <- svm.li.tune.wflow %>%                          # 3-3에서 정의tune_grid(
    train.fold,                                                         # 3-5-1에서 정의 : Resampling -> 5-Cross-Validationn
    grid = egrid,                                                       # 3-5-2-3에서 정의 : 후보 모수 집합     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
  )

# 그래프
autoplot(svm.li.tune.egrid.fit) + 
  scale_color_viridis_d(direction = -1) + 
  theme(legend.position = "top") +
  theme_bw()
# Ref. https://juliasilge.com/blog/svm.lioost-tune-volleyball/
svm.li.tune.egrid.fit %>%
  collect_metrics() %>%
  filter(.metric == "roc_auc") %>%
  select(mean, cost) %>%
  pivot_longer(cost,
               values_to = "value",
               names_to = "parameter"
  ) %>%
  ggplot(aes(value, mean, color = parameter)) +
  geom_point(alpha = 0.8, show.legend = FALSE) +
  facet_wrap(~parameter, scales = "free_x") +
  labs(x = NULL, y = "AUC") + 
  theme_bw()
# 지정된 Metric 측면에서 성능이 우수한 모형을 순서대로 확인NAshow_best(svm.li.tune.egrid.fit, "roc_auc")                                # show_best(, "accuracy")
# A tibble: 5 x 7
    cost .metric .estimator  mean     n std_err .config              
   <dbl> <chr>   <chr>      <dbl> <int>   <dbl> <fct>                
1 0.0104 roc_auc binary     0.871     5  0.0124 Preprocessor1_Model05
2 0.0103 roc_auc binary     0.871     5  0.0124 Preprocessor1_Model04
3 0.0102 roc_auc binary     0.871     5  0.0126 Preprocessor1_Model03
4 0.0109 roc_auc binary     0.871     5  0.0124 Preprocessor1_Model10
5 0.011  roc_auc binary     0.871     5  0.0123 Preprocessor1_Model11
# 최적의 모수 조합 확인NAbest.svm.li.egrid <- svm.li.tune.egrid.fit %>% 
  select_best("roc_auc")                                                   # select_best("accuracy")
best.svm.li.egrid 
# A tibble: 1 x 2
    cost .config              
   <dbl> <fct>                
1 0.0104 Preprocessor1_Model05

Result! cost = 0.0104일 때 “ROC AUC” 측면에서 가장 우수한 성능을 보여준다.


3-5-3. 최적의 모수 조합을 이용한 모형 적합

# Workflow에 최적의 모수값 업데이트final.svm.li.wflow <- svm.li.tune.wflow %>%                               # 3-3에서 정의finalize_workflow(best.svm.li.egrid)                                    # finalize_workflow : 최적의 모수 조합을 가지는 workflow로 업데이트NAfinal.svm.li.wflow
== Workflow ==========================================================
Preprocessor: Recipe
Model: svm_linear()

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

* step_normalize()
* step_dummy()

-- Model -------------------------------------------------------------
Linear Support Vector Machine Specification (classification)

Main Arguments:
  cost = 0.0104

Computational engine: kernlab 

Caution! 함수 last_fit()은 최적의 모수 조합에 대해 Training Data를 이용한 모형 적합과 Test Data에 대한 예측을 한 번에 수행할 수 있지만 seed 고정이 되지 않아 Reproducibility (재생산성)가 만족되지 않는다. 따라서, 모형 적합(함수 fit())과 예측(함수 augment())을 각각 수행하였다.

# 모형 적합NAset.seed(100)
final.svm.li <- final.svm.li.wflow %>% 
  fit(data = HD.train)
 Setting default kernel parameters  
final.svm.li
== Workflow [trained] ================================================
Preprocessor: Recipe
Model: svm_linear()

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

* step_normalize()
* step_dummy()

-- Model -------------------------------------------------------------
Support Vector Machine object of class "ksvm" 

SV type: C-svc  (classification) 
 parameter : cost C = 0.0104 

Linear (vanilla) kernel function. 

Number of Support Vectors : 349 

Objective Function Value : -3.3389 
Training error : 0.191589 
Probability model included. 
# 최종 모형NAfinal.svm.li %>% 
  extract_fit_engine()
Support Vector Machine object of class "ksvm" 

SV type: C-svc  (classification) 
 parameter : cost C = 0.0104 

Linear (vanilla) kernel function. 

Number of Support Vectors : 349 

Objective Function Value : -3.3389 
Training error : 0.191589 
Probability model included. 

3-6. 예측

svm.li.pred <- augment(final.svm.li, HD.test)  
svm.li.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>

3-7. 모형 평가

3-7-1. 평가 척도

conf_mat(svm.li.pred, truth = HeartDisease, estimate = .pred_class)    # truth : 실제 클래스,  estimate : 예측 클래스 클래스
          Truth
Prediction  no yes
       no  101  29
       yes  22 124
conf_mat(svm.li.pred, truth = HeartDisease, estimate = .pred_class) %>%
  autoplot(type = "mosaic")                                            # autoplot(type = "heatmap")
classification_metrics <- metric_set(accuracy, mcc, 
                                     f_meas, kap,
                                     sens, spec, roc_auc)              # Test Data에 대한 Assessment Measure
classification_metrics(svm.li.pred, truth = HeartDisease,              # truth : 실제 클래스,  estimate : 예측 클래스 클래스
                       estimate = .pred_class,
                       .pred_yes, event_level = "second")              # For roc_auc
# A tibble: 7 x 3
  .metric  .estimator .estimate
  <chr>    <chr>          <dbl>
1 accuracy binary         0.815
2 mcc      binary         0.629
3 f_meas   binary         0.829
4 kap      binary         0.628
5 sens     binary         0.810
6 spec     binary         0.821
7 roc_auc  binary         0.883

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


3-7-2. 그래프

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

3-7-2-1. ROC Curve

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


3-7-2-2. Gain Curve

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


3-7-2-3. Lift Curve

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


3-7-2-4. Precision Recall Curve

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


4. Polynomial Kernel

4-1. 전처리 정의

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

4-2. 모형 정의

svm.po.tune.mod <- svm_poly(cost         = tune(),                         # cost : 데이터를 잘못 분류하는 선을 긋게 될 경우 지불해야 할 costNA= tune(),                         # degree : Polynomial Degree
                            scale_factor = tune()) %>%                     # scale_factor : Polynomial Scaling Factor
  set_mode("classification") %>%                                           # Target 유형 정의(classification /  regression)NAset_engine("kernlab")                                                    # 사용하고자하는 패키지 정의NA# 실제 패키지에 어떻게 적용되는지 확인NAsvm.po.tune.mod %>% 
  translate()
Polynomial Support Vector Machine Specification (classification)

Main Arguments:
  cost = tune()
  degree = tune()
  scale_factor = tune()

Computational engine: kernlab 

Model fit template:
kernlab::ksvm(x = missing_arg(), data = missing_arg(), C = tune(), 
    kernel = "polydot", prob.model = TRUE, kpar = list(degree = ~tune(), 
        scale = ~tune()))

Caution! 함수 translate()를 통해 위에서 정의한 “svm.po.tune.mod”가 실제로 Package kernlab의 함수 ksvm()에 어떻게 적용되는지 확인할 수 있다.


4-3. Workflow 정의

svm.po.tune.wflow <- workflow() %>%                                        # Workflow 이용  add_recipe(rec) %>%                                                      # 4-1에서 정의add_model(svm.po.tune.mod)                                               # 4-2에서 정의

4-4. 모수 범위 확인

# 모수의 범위 확인NAsvm.po.param <- extract_parameter_set_dials(svm.po.tune.wflow)             
svm.po.param          
Collection of 3 parameters for tuning

   identifier         type    object
         cost         cost nparam[+]
       degree       degree nparam[+]
 scale_factor scale_factor nparam[+]

Result! object열에서 nparam은 모수값이 수치형임을 나타낸다. 또한, 모든 모수에 대해 object열이 nparam[+]로 해당 모수의 범위가 명확하게 주어졌음을 의미한다.

svm.po.param %>%
  extract_parameter_dials("degree")
Degree of Interaction (quantitative)
Range: [1, 3]
# 범위 수정
svm.po.param %<>%
  update(degree =  degree(c(1, 1000)))

4-5. 모형 적합

4-5-1. Resampling 정의

set.seed(100)
train.fold    <- vfold_cv(HD.train, v = 5)                            

4-5-2. 최적의 모수 조합 찾기


4-5-2-1. Regular Grid

set.seed(100)
grid <-  svm.po.param %>%                                                  
  grid_regular(levels = 2)
grid
# A tibble: 8 x 3
       cost degree scale_factor
      <dbl>  <int>        <dbl>
1  0.000977      1 0.0000000001
2 32             1 0.0000000001
3  0.000977      3 0.0000000001
4 32             3 0.0000000001
5  0.000977      1 0.1         
6 32             1 0.1         
7  0.000977      3 0.1         
8 32             3 0.1         

Result! 각 모수별로 2개씩 후보값을 두어 총 8(2 \(\times\) 2 \(\times\) 2)개의 후보 모수 조합을 생성하였다.

# 모형 적합NAset.seed(100)
svm.po.tune.grid.fit <- svm.po.tune.wflow %>%                              # 4-3에서 정의tune_grid(
    train.fold,                                                            # 4-5-1에서 정의 : Resampling -> 5-Cross-Validationn
    grid = grid,                                                           # 4-5-2-1에서 정의 : 후보 모수 집합     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
  )

# 그래프
autoplot(svm.po.tune.grid.fit) + 
  scale_color_viridis_d(direction = -1) + 
  theme(legend.position = "top") +
  theme_bw()
# 지정된 Metric 측면에서 성능이 우수한 모형을 순서대로 확인NAshow_best(svm.po.tune.grid.fit, "roc_auc")                                 # show_best(, "accuracy")
# A tibble: 5 x 9
       cost degree scale_factor .metric .estimator  mean     n std_err
      <dbl>  <int>        <dbl> <chr>   <chr>      <dbl> <int>   <dbl>
1  0.000977      3 0.1          roc_auc binary     0.873     5  0.0115
2  0.000977      1 0.1          roc_auc binary     0.869     5  0.0122
3 32             1 0.0000000001 roc_auc binary     0.869     5  0.0114
4 32             3 0.0000000001 roc_auc binary     0.869     5  0.0114
5  0.000977      1 0.0000000001 roc_auc binary     0.869     5  0.0113
# ... with 1 more variable: .config <fct>
# 최적의 모수 조합 확인NAbest.svm.po.grid <- svm.po.tune.grid.fit %>% 
  select_best("roc_auc")
best.svm.po.grid 
# A tibble: 1 x 4
      cost degree scale_factor .config             
     <dbl>  <int>        <dbl> <fct>               
1 0.000977      3          0.1 Preprocessor1_Model7

Result! cost = 0.000977, degree = 3, scale_factor = 0.1일 때 “ROC AUC” 측면에서 가장 우수한 성능을 보여준다.


4-5-2-2. Latin Hypercube

set.seed(100)
random <- svm.po.param %>%                                                 
  grid_latin_hypercube(size = 10)
random
# A tibble: 10 x 3
       cost degree scale_factor
      <dbl>  <int>        <dbl>
 1  0.507        3     6.98e- 6
 2  8.85         1     1.89e- 3
 3  2.87         3     5.65e- 8
 4 23.2          2     3.98e- 9
 5  0.00112      2     1.47e- 2
 6  0.0163       2     2.74e- 5
 7  0.00327      1     4.63e- 7
 8  0.0456       2     4.89e-10
 9  0.136        2     4.11e- 8
10  0.235        3     4.86e- 4

Result! 10개의 후보 모수 조합을 랜덤하게 생성하였다.

# 모형 적합NAset.seed(100)
svm.po.tune.random.fit <- svm.po.tune.wflow %>%                             # 4-3에서 정의tune_grid(
    train.fold,                                                             # 4-5-1에서 정의 : Resampling -> 5-Cross-Validationn
    grid = random,                                                          # 4-5-2-2에서 정의 : 후보 모수 집합     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
  )

# 그래프
autoplot(svm.po.tune.random.fit) + 
  scale_color_viridis_d(direction = -1) + 
  theme(legend.position = "top") +
  theme_bw()
# 지정된 Metric 측면에서 성능이 우수한 모형을 순서대로 확인NAshow_best(svm.po.tune.random.fit, "roc_auc")                                # show_best(, "accuracy")
# A tibble: 5 x 9
     cost degree scale_factor .metric .estimator  mean     n std_err
    <dbl>  <int>        <dbl> <chr>   <chr>      <dbl> <int>   <dbl>
1 0.00112      2 0.0147       roc_auc binary     0.870     5  0.0122
2 2.87         3 0.0000000565 roc_auc binary     0.870     5  0.0122
3 0.235        3 0.000486     roc_auc binary     0.869     5  0.0122
4 0.00327      1 0.000000463  roc_auc binary     0.869     5  0.0123
5 0.0163       2 0.0000274    roc_auc binary     0.869     5  0.0121
# ... with 1 more variable: .config <fct>
# 최적의 모수 조합 확인NAbest.svm.po.random <- svm.po.tune.random.fit %>% 
  select_best("roc_auc")
best.svm.po.random 
# A tibble: 1 x 4
     cost degree scale_factor .config              
    <dbl>  <int>        <dbl> <fct>                
1 0.00112      2       0.0147 Preprocessor1_Model05

Result! cost = 0.00112, degree = 2, scale_factor = 0.0147일 때 “ROC AUC” 측면에서 가장 우수한 성능을 보여준다.


4-5-2-3. Expand Grid

egrid <- expand.grid(cost         = seq(0.00112, 0.0012, 0.00001),
                     degree       = 1:3,
                     scale_factor = 0.0147)
egrid
      cost degree scale_factor
1  0.00112      1       0.0147
2  0.00113      1       0.0147
3  0.00114      1       0.0147
4  0.00115      1       0.0147
5  0.00116      1       0.0147
6  0.00117      1       0.0147
7  0.00118      1       0.0147
8  0.00119      1       0.0147
9  0.00120      1       0.0147
10 0.00112      2       0.0147
11 0.00113      2       0.0147
12 0.00114      2       0.0147
13 0.00115      2       0.0147
14 0.00116      2       0.0147
15 0.00117      2       0.0147
16 0.00118      2       0.0147
17 0.00119      2       0.0147
18 0.00120      2       0.0147
19 0.00112      3       0.0147
20 0.00113      3       0.0147
21 0.00114      3       0.0147
22 0.00115      3       0.0147
23 0.00116      3       0.0147
24 0.00117      3       0.0147
25 0.00118      3       0.0147
26 0.00119      3       0.0147
27 0.00120      3       0.0147

Result! 후보 모수값들의 집합이 생성되었다.

# 모형 적합NAset.seed(100)
svm.po.tune.egrid.fit <- svm.po.tune.wflow %>%                              # 4-3에서 정의tune_grid(
    train.fold,                                                             # 4-5-1에서 정의 : Resampling -> 5-Cross-Validationn
    grid = egrid,                                                           # 4-5-2-3에서 정의 : 후보 모수 집합     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
  )

# 그래프
autoplot(svm.po.tune.egrid.fit) + 
  scale_color_viridis_d(direction = -1) + 
  theme(legend.position = "top") +
  theme_bw()
# Ref. https://juliasilge.com/blog/svm.pooost-tune-volleyball/
svm.po.tune.egrid.fit %>%
  collect_metrics() %>%
  filter(.metric == "roc_auc") %>%
  select(mean, cost:scale_factor) %>%
  pivot_longer(cost:scale_factor,
               values_to = "value",
               names_to = "parameter"
  ) %>%
  ggplot(aes(value, mean, color = parameter)) +
  geom_point(alpha = 0.8, show.legend = FALSE) +
  facet_wrap(~parameter, scales = "free_x") +
  labs(x = NULL, y = "AUC") +
  theme_bw()
# 지정된 Metric 측면에서 성능이 우수한 모형을 순서대로 확인NAshow_best(svm.po.tune.egrid.fit, "roc_auc")                                   # show_best(, "accuracy")
# A tibble: 5 x 9
     cost degree scale_factor .metric .estimator  mean     n std_err
    <dbl>  <int>        <dbl> <chr>   <chr>      <dbl> <int>   <dbl>
1 0.00112      3       0.0147 roc_auc binary     0.870     5  0.0123
2 0.00113      3       0.0147 roc_auc binary     0.870     5  0.0123
3 0.00114      3       0.0147 roc_auc binary     0.870     5  0.0123
4 0.00115      3       0.0147 roc_auc binary     0.870     5  0.0123
5 0.00116      3       0.0147 roc_auc binary     0.870     5  0.0123
# ... with 1 more variable: .config <fct>
# 최적의 모수 조합 확인NAbest.svm.po.egrid <- svm.po.tune.egrid.fit %>% 
  select_best("roc_auc")                                                      # select_best("accuracy")
best.svm.po.egrid 
# A tibble: 1 x 4
     cost degree scale_factor .config              
    <dbl>  <int>        <dbl> <fct>                
1 0.00112      3       0.0147 Preprocessor1_Model19

Result! cost = 0.00112, degree = 3, scale_factor = 0.0147일 때 “ROC AUC” 측면에서 가장 우수한 성능을 보여준다.


4-5-3. 최적의 모수 조합을 이용한 모형 적합

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

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

* step_normalize()
* step_dummy()

-- Model -------------------------------------------------------------
Polynomial Support Vector Machine Specification (classification)

Main Arguments:
  cost = 0.00112
  degree = 3
  scale_factor = 0.0147

Computational engine: kernlab 

Caution! 함수 last_fit()은 최적의 모수 조합에 대해 Training Data를 이용한 모형 적합과 Test Data에 대한 예측을 한 번에 수행할 수 있지만 seed 고정이 되지 않아 Reproducibility (재생산성)가 만족되지 않는다. 따라서, 모형 적합(함수 fit())과 예측(함수 augment())을 각각 수행하였다.

# 모형 적합NAset.seed(100)
final.svm.po <- final.svm.po.wflow %>% 
  fit(data = HD.train)
final.svm.po
== Workflow [trained] ================================================
Preprocessor: Recipe
Model: svm_poly()

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

* step_normalize()
* step_dummy()

-- Model -------------------------------------------------------------
Support Vector Machine object of class "ksvm" 

SV type: C-svc  (classification) 
 parameter : cost C = 0.00112 

Polynomial kernel function. 
 Hyperparameters : degree =  3  scale =  0.0147  offset =  1 

Number of Support Vectors : 574 

Objective Function Value : -0.6346 
Training error : 0.44704 
Probability model included. 
# 최종 모형NAfinal.svm.po %>% 
  extract_fit_engine()
Support Vector Machine object of class "ksvm" 

SV type: C-svc  (classification) 
 parameter : cost C = 0.00112 

Polynomial kernel function. 
 Hyperparameters : degree =  3  scale =  0.0147  offset =  1 

Number of Support Vectors : 574 

Objective Function Value : -0.6346 
Training error : 0.44704 
Probability model included. 

4-6. 예측

svm.po.pred <- augment(final.svm.po, HD.test)  
svm.po.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>

4-7. 모형 평가

4-7-1. 평가 척도

conf_mat(svm.po.pred, truth = HeartDisease, estimate = .pred_class)    # truth : 실제 클래스,  estimate : 예측 클래스 클래스
          Truth
Prediction  no yes
       no    0   0
       yes 123 153
conf_mat(svm.po.pred, truth = HeartDisease, estimate = .pred_class) %>%
  autoplot(type = "mosaic")                                            # autoplot(type = "heatmap")
classification_metrics <- metric_set(accuracy, mcc, 
                                     f_meas, kap,
                                     sens, spec, roc_auc)              # Test Data에 대한 Assessment Measure
classification_metrics(svm.po.pred, truth = HeartDisease,              # truth : 실제 클래스,  estimate : 예측 클래스 클래스
                       estimate = .pred_class,
                       .pred_yes, event_level = "second")              # For roc_auc
# A tibble: 7 x 3
  .metric  .estimator .estimate
  <chr>    <chr>          <dbl>
1 accuracy binary         0.554
2 mcc      binary        NA    
3 f_meas   binary         0.713
4 kap      binary         0    
5 sens     binary         1    
6 spec     binary         0    
7 roc_auc  binary         0.871

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


4-7-2. 그래프

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

4-7-2-1. ROC Curve

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


4-7-2-2. Gain Curve

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


4-7-2-3. Lift Curve

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


4-7-2-4. Precision Recall Curve

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


5. Radial Basis Kernel

5-1. 전처리 정의

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

5-2. 모형 정의

svm.rbf.tune.mod <- svm_rbf(cost      = tune(),                            # cost : 데이터를 잘못 분류하는 선을 긋게 될 경우 지불해야 할 costNA= tune()) %>%                        # rbf_sigma : Precision 모수(gamma = 1/2*sigma^2)
  set_mode("classification") %>%                                           # Target 유형 정의(classification /  regression)NAset_engine("kernlab")                                                    # 사용하고자하는 패키지 정의(kernlab /  liquidSVM)NA# 실제 패키지에 어떻게 적용되는지 확인NAsvm.rbf.tune.mod %>% 
  translate()
Radial Basis Function Support Vector Machine Specification (classification)

Main Arguments:
  cost = tune()
  rbf_sigma = tune()

Computational engine: kernlab 

Model fit template:
kernlab::ksvm(x = missing_arg(), data = missing_arg(), C = tune(), 
    kernel = "rbfdot", prob.model = TRUE, kpar = list(sigma = ~tune()))

Caution! 함수 translate()를 통해 위에서 정의한 “svm.rbf.tune.mod”가 실제로 Package kernlab의 함수 ksvm()에 어떻게 적용되는지 확인할 수 있다.


5-3. Workflow 정의

svm.rbf.tune.wflow <- workflow() %>%                                       # Workflow 이용  add_recipe(rec) %>%                                                      # 5-1에서 정의add_model(svm.rbf.tune.mod)                                              # 5-2에서 정의

5-4. 모수 범위 확인

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

 identifier      type    object
       cost      cost nparam[+]
  rbf_sigma rbf_sigma nparam[+]

Result! object열에서 nparam은 모수값이 수치형임을 나타낸다. 또한, 모든 모수에 대해 object열이 nparam[+]로 해당 모수의 범위가 명확하게 주어졌음을 의미한다.

svm.rbf.param %>%
  extract_parameter_dials("rbf_sigma")
Radial Basis Function sigma (quantitative)
Transformer:  log-10 
Range (transformed scale): [-10, 0]
# 범위 수정
svm.rbf.param %<>%
  update(rbf_sigma =  rbf_sigma(c(1, 1000)))

5-5. 모형 적합

5-5-1. Resampling 정의

set.seed(100)
train.fold    <- vfold_cv(HD.train, v = 5)                            

5-5-2. 최적의 모수 조합 찾기


5-5-2-1. Regular Grid

set.seed(100)
grid <-  svm.rbf.param %>%                                                
  grid_regular(levels = 3)
grid
# A tibble: 9 x 2
       cost    rbf_sigma
      <dbl>        <dbl>
1  0.000977 0.0000000001
2  0.177    0.0000000001
3 32        0.0000000001
4  0.000977 0.00001     
5  0.177    0.00001     
6 32        0.00001     
7  0.000977 1           
8  0.177    1           
9 32        1           

Result! 각 모수별로 3개씩 후보값을 두어 총 9(3 \(\times\) 3)개의 후보 모수 조합을 생성하였다.

# 모형 적합NAset.seed(100)
svm.rbf.tune.grid.fit <- svm.rbf.tune.wflow %>%                            # 5-3에서 정의tune_grid(
    train.fold,                                                            # 5-5-1에서 정의 : Resampling -> 5-Cross-Validationn
    grid = grid,                                                           # 5-5-2-1에서 정의 : 후보 모수 집합     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
  )

# 그래프
autoplot(svm.rbf.tune.grid.fit) + 
  scale_color_viridis_d(direction = -1) + 
  theme(legend.position = "top") +
  theme_bw()
# 지정된 Metric 측면에서 성능이 우수한 모형을 순서대로 확인NAshow_best(svm.rbf.tune.grid.fit, "roc_auc")                                 # show_best(, "accuracy")
# A tibble: 5 x 8
       cost   rbf_sigma .metric .estimator  mean     n std_err .config
      <dbl>       <dbl> <chr>   <chr>      <dbl> <int>   <dbl> <fct>  
1  0.177          1e- 5 roc_auc binary     0.870     5  0.0124 Prepro~
2 32              1e- 5 roc_auc binary     0.870     5  0.0122 Prepro~
3  0.000977       1e- 5 roc_auc binary     0.870     5  0.0122 Prepro~
4  0.177          1e-10 roc_auc binary     0.869     5  0.0113 Prepro~
5 32              1e-10 roc_auc binary     0.869     5  0.0114 Prepro~
# 최적의 모수 조합 확인NAbest.svm.rbf.grid <- svm.rbf.tune.grid.fit %>% 
  select_best("roc_auc")
best.svm.rbf.grid 
# A tibble: 1 x 3
   cost rbf_sigma .config             
  <dbl>     <dbl> <fct>               
1 0.177   0.00001 Preprocessor1_Model5

Result! cost = 0.177, rbf_sigma = 0.00001일 때 “ROC AUC” 측면에서 가장 우수한 성능을 보여준다.


5-5-2-2. Latin Hypercube

set.seed(100)
random <- svm.rbf.param %>%                                                 
  grid_latin_hypercube(size = 10)
random
# A tibble: 10 x 2
       cost rbf_sigma
      <dbl>     <dbl>
 1  0.0633   6.47e- 4
 2  0.0173   9.00e- 2
 3  0.358    1.12e- 5
 4  0.00200  7.21e- 8
 5  0.573    4.59e- 9
 6  2.95     4.60e- 3
 7  0.00327  2.53e- 7
 8  8.25     5.62e-10
 9 24.6      2.57e- 1
10  0.0293   4.86e- 6

Result! 10개의 후보 모수 조합을 랜덤하게 생성하였다.

# 모형 적합NAset.seed(100)
svm.rbf.tune.random.fit <- svm.rbf.tune.wflow %>%                           # 5-3에서 정의tune_grid(
    train.fold,                                                             # 5-5-1에서 정의 : Resampling -> 5-Cross-Validationn
    grid = random,                                                          # 5-5-2-2에서 정의 : 후보 모수 집합     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
  )

# 그래프
autoplot(svm.rbf.tune.random.fit) + 
  scale_color_viridis_d(direction = -1) + 
  theme(legend.position = "top") +
  theme_bw()
# 지정된 Metric 측면에서 성능이 우수한 모형을 순서대로 확인NAshow_best(svm.rbf.tune.random.fit, "roc_auc")                                # show_best(, "accuracy")
# A tibble: 5 x 8
    cost rbf_sigma .metric .estimator  mean     n std_err .config     
   <dbl>     <dbl> <chr>   <chr>      <dbl> <int>   <dbl> <fct>       
1 2.95    4.60e- 3 roc_auc binary     0.873     5 0.0112  Preprocesso~
2 0.0173  9.00e- 2 roc_auc binary     0.870     5 0.00849 Preprocesso~
3 8.25    5.62e-10 roc_auc binary     0.870     5 0.0114  Preprocesso~
4 0.573   4.59e- 9 roc_auc binary     0.870     5 0.0120  Preprocesso~
5 0.0633  6.47e- 4 roc_auc binary     0.870     5 0.0122  Preprocesso~
# 최적의 모수 조합 확인NAbest.svm.rbf.random <- svm.rbf.tune.random.fit %>% 
  select_best("roc_auc")
best.svm.rbf.random 
# A tibble: 1 x 3
   cost rbf_sigma .config              
  <dbl>     <dbl> <fct>                
1  2.95   0.00460 Preprocessor1_Model06

Result! cost = 2.95, rbf_sigma = 0.00460일 때 “ROC AUC” 측면에서 가장 우수한 성능을 보여준다.


5-5-2-3. Expand Grid

egrid <- expand.grid(cost      = seq(2.94, 2.95, 0.001),
                     rbf_sigma = seq(0.0046, 0.0047, 0.0001))
egrid
    cost rbf_sigma
1  2.940    0.0046
2  2.941    0.0046
3  2.942    0.0046
4  2.943    0.0046
5  2.944    0.0046
6  2.945    0.0046
7  2.946    0.0046
8  2.947    0.0046
9  2.948    0.0046
10 2.949    0.0046
11 2.950    0.0046
12 2.940    0.0047
13 2.941    0.0047
14 2.942    0.0047
15 2.943    0.0047
16 2.944    0.0047
17 2.945    0.0047
18 2.946    0.0047
19 2.947    0.0047
20 2.948    0.0047
21 2.949    0.0047
22 2.950    0.0047

Result! 후보 모수값들의 집합이 생성되었다.

set.seed(100)
svm.rbf.tune.egrid.fit <- svm.rbf.tune.wflow %>%                            # 5-3에서 정의tune_grid(
    train.fold,                                                             # 5-5-1에서 정의 : Resampling -> 5-Cross-Validationn
    grid = egrid,                                                           # 5-5-2-3에서 정의 : 후보 모수 집합     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
  )

# 그래프
autoplot(svm.rbf.tune.egrid.fit) + 
  scale_color_viridis_d(direction = -1) + 
  theme(legend.position = "top") +
  theme_bw()
# Ref. https://juliasilge.com/blog/svm.rbfoost-tune-volleyball/
svm.rbf.tune.egrid.fit %>%
  collect_metrics() %>%
  filter(.metric == "roc_auc") %>%
  select(mean, cost:rbf_sigma) %>%
  pivot_longer(cost:rbf_sigma,
               values_to = "value",
               names_to = "parameter"
  ) %>%
  ggplot(aes(value, mean, color = parameter)) +
  geom_point(alpha = 0.8, show.legend = FALSE) +
  facet_wrap(~parameter, scales = "free_x") +
  labs(x = NULL, y = "AUC") +
  theme_bw()
# 지정된 Metric 측면에서 성능이 우수한 모형을 순서대로 확인NAshow_best(svm.rbf.tune.egrid.fit, "roc_auc")                                # show_best(, "accuracy")
# A tibble: 5 x 8
   cost rbf_sigma .metric .estimator  mean     n std_err .config      
  <dbl>     <dbl> <chr>   <chr>      <dbl> <int>   <dbl> <fct>        
1  2.95    0.0047 roc_auc binary     0.873     5  0.0112 Preprocessor~
2  2.94    0.0047 roc_auc binary     0.873     5  0.0112 Preprocessor~
3  2.94    0.0047 roc_auc binary     0.873     5  0.0112 Preprocessor~
4  2.94    0.0047 roc_auc binary     0.873     5  0.0112 Preprocessor~
5  2.94    0.0047 roc_auc binary     0.873     5  0.0112 Preprocessor~
# 최적의 모수 조합 확인NAbest.svm.rbf.egrid <- svm.rbf.tune.egrid.fit %>% 
  select_best("roc_auc")                                                    # select_best("accuracy")
best.svm.rbf.egrid 
# A tibble: 1 x 3
   cost rbf_sigma .config              
  <dbl>     <dbl> <fct>                
1  2.95    0.0047 Preprocessor1_Model18

Result! cost = 2.946, rbf_sigma = 0.0047일 때 “ROC AUC” 측면에서 가장 우수한 성능을 보여준다.


5-5-3. 최적의 모수 조합을 이용한 모형 적합

# Workflow에 최적의 모수값 업데이트final.svm.rbf.wflow <- svm.rbf.tune.wflow %>%                               # 5-3에서 정의finalize_workflow(best.svm.rbf.egrid)                                     # finalize_workflow : 최적의 모수 조합을 가지는 workflow로 업데이트NAfinal.svm.rbf.wflow
== Workflow ==========================================================
Preprocessor: Recipe
Model: svm_rbf()

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

* step_normalize()
* step_dummy()

-- Model -------------------------------------------------------------
Radial Basis Function Support Vector Machine Specification (classification)

Main Arguments:
  cost = 2.946
  rbf_sigma = 0.0047

Computational engine: kernlab 

Caution! 함수 last_fit()은 최적의 모수 조합에 대해 Training Data를 이용한 모형 적합과 Test Data에 대한 예측을 한 번에 수행할 수 있지만 seed 고정이 되지 않아 Reproducibility (재생산성)가 만족되지 않는다. 따라서, 모형 적합(함수 fit())과 예측(함수 augment())을 각각 수행하였다.

# 모형 적합NAset.seed(100)
final.svm.rbf <- final.svm.rbf.wflow %>% 
  fit(data = HD.train)
final.svm.rbf
== Workflow [trained] ================================================
Preprocessor: Recipe
Model: svm_rbf()

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

* step_normalize()
* step_dummy()

-- Model -------------------------------------------------------------
Support Vector Machine object of class "ksvm" 

SV type: C-svc  (classification) 
 parameter : cost C = 2.946 

Gaussian Radial Basis kernel function. 
 Hyperparameter : sigma =  0.0047 

Number of Support Vectors : 320 

Objective Function Value : -871.6852 
Training error : 0.193146 
Probability model included. 
# 최종 모형NAfinal.svm.rbf %>% 
  extract_fit_engine()
Support Vector Machine object of class "ksvm" 

SV type: C-svc  (classification) 
 parameter : cost C = 2.946 

Gaussian Radial Basis kernel function. 
 Hyperparameter : sigma =  0.0047 

Number of Support Vectors : 320 

Objective Function Value : -871.6852 
Training error : 0.193146 
Probability model included. 

5-6. 예측

svm.rbf.pred <- augment(final.svm.rbf, HD.test)  
svm.rbf.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>

5-7. 모형 평가

5-7-1. 평가 척도

conf_mat(svm.rbf.pred, truth = HeartDisease, estimate = .pred_class)   # truth : 실제 클래스,  estimate : 예측 클래스 클래스
          Truth
Prediction  no yes
       no   94  34
       yes  29 119
conf_mat(svm.rbf.pred, truth = HeartDisease, estimate = .pred_class) %>%
  autoplot(type = "mosaic")                                            # autoplot(type = "heatmap")
classification_metrics <- metric_set(accuracy, mcc, 
                                     f_meas, kap,
                                     sens, spec, roc_auc)              # Test Data에 대한 Assessment Measure
classification_metrics(svm.rbf.pred, truth = HeartDisease,             # truth : 실제 클래스,  estimate : 예측 클래스 클래스
                       estimate = .pred_class,
                       .pred_yes, event_level = "second")              # For roc_auc
# A tibble: 7 x 3
  .metric  .estimator .estimate
  <chr>    <chr>          <dbl>
1 accuracy binary         0.772
2 mcc      binary         0.540
3 f_meas   binary         0.791
4 kap      binary         0.540
5 sens     binary         0.778
6 spec     binary         0.764
7 roc_auc  binary         0.884

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


5-7-2. 그래프

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

5-7-2-1. ROC Curve

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


5-7-2-2. Gain Curve

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


5-7-2-3. Lift Curve

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


5-7-2-4. Precision Recall Curve

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

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 ...".