Bayes Classification: So Sánh naiveBayes vs. stan_glm

Bài viết này sử dụng hàm naiveBayes() trong package e1071 để phân tích classification theo trường phái Bayes và so sánh với hàm stan_glm() của package rstan mà Bs Nhi đã trình bày trong bài trước.

Mục đích của bài viết này là so sánh kết quả của hai hàm cùng theo trường phái Bayes trong phân tích hồi qui logistic và phân loại.

Dữ liệu dùng để phân tích trong bài này chính là bộ dữ liệu trong bài trước của Bs Nhi. Bài viết gồm hai phần: stan_glm() và sau đó là naiveBayes()

1 Bayes Logistic Regression với stan_glm()

Chuẩn bị dữ liệu:

## # A tibble: 6 x 10
##   clumpthickness SizeUniformity ShapeUniformity Margin_adhesion
##            <int>          <int>           <int>           <int>
## 1              5              1               1               1
## 2              5              4               4               5
## 3              3              1               1               1
## 4              6              8               8               1
## 5              4              1               1               3
## 6              8             10              10               8
## # ... with 6 more variables: EpiCellSize <int>, Barenuclei <int>,
## #   BlandChromatin <int>, NormalNucleoli <int>, Mitoses <int>,
## #   Class <fctr>

Xây dựng mô hình hồi qui với hàm stan_glm:

library(caret)
set.seed(123)
id=createDataPartition(y=df2$Class, p=499/683,list=FALSE)
trainset=df2[id,]
testset=df2[-id,]

library(rstanarm)
library(rstan)
t_prior=student_t(df = 5, location = 0, scale = 2.5)
fml="Class~clumpthickness+
ShapeUniformity+
Margin_adhesion+
Barenuclei+
BlandChromatin"

fittprior=stan_glm(
  fml,
  data = trainset, 
  family = binomial(link = "logit"), 
  prior = t_prior,
  prior_intercept = t_prior,
  algorithm="sampling",
  chains = 2, iter = 1500,warmup = 500,
  cores=parallel::detectCores(),
  seed=123
)

Trình bày kết quả tóm tắt:

summary(fittprior,digits=5,probs=c(0.025,0.975))

## 
## Model Info:
## 
##  function:  stan_glm
##  family:    binomial [logit]
##  formula:   "Class~clumpthickness+\nShapeUniformity+\nMargin_adhesion+\nBarenuclei+\nBlandChromatin"
##  algorithm: sampling
##  priors:    see help('prior_summary')
##  sample:    2000 (posterior sample size)
##  num obs:   500
## 
## Estimates:
##                   mean      sd        2.5%      97.5%  
## (Intercept)      -9.38167   1.07077 -11.68469  -7.44547
## clumpthickness    0.60094   0.13871   0.34474   0.88336
## ShapeUniformity   0.51179   0.15944   0.22457   0.85374
## Margin_adhesion   0.32699   0.12201   0.09571   0.57412
## Barenuclei        0.36338   0.09578   0.18348   0.55757
## BlandChromatin    0.46135   0.17167   0.13267   0.81154
## mean_PPD          0.35059   0.01022   0.33000   0.37000
## log-posterior   -58.99672   1.70967 -63.18537 -56.54665
## 
## Diagnostics:
##                 mcse    Rhat    n_eff
## (Intercept)     0.02633 0.99935 1654 
## clumpthickness  0.00352 0.99904 1551 
## ShapeUniformity 0.00382 1.00010 1741 
## Margin_adhesion 0.00300 1.00143 1655 
## Barenuclei      0.00254 0.99905 1423 
## BlandChromatin  0.00395 0.99926 1888 
## mean_PPD        0.00023 1.00011 2000 
## log-posterior   0.06419 1.00059  709 
## 
## For each parameter, mcse is Monte Carlo standard error, n_eff is a crude measure of effective sample size, and Rhat is the potential scale reduction factor on split chains (at convergence Rhat=1).

testpred=predict(fittprior,newdata=testset,type="link")%>%exp()
testset$Truth=ifelse(testset$Class==1,"Malignant","Benign")
testset$Pred=testpred
testset$Pred=ifelse(testset$Pred>=0.5,"Malignant","Benign")

caret::confusionMatrix(testset$Pred,reference=testset$Truth,mode="everything",positive="Malignant")

## Confusion Matrix and Statistics
## 
##            Reference
## Prediction  Benign Malignant
##   Benign       119         1
##   Malignant      0        63
##                                           
##                Accuracy : 0.9945          
##                  95% CI : (0.9699, 0.9999)
##     No Information Rate : 0.6503          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.9879          
##  Mcnemar's Test P-Value : 1               
##                                           
##             Sensitivity : 0.9844          
##             Specificity : 1.0000          
##          Pos Pred Value : 1.0000          
##          Neg Pred Value : 0.9917          
##               Precision : 1.0000          
##                  Recall : 0.9844          
##                      F1 : 0.9921          
##              Prevalence : 0.3497          
##          Detection Rate : 0.3443          
##    Detection Prevalence : 0.3443          
##       Balanced Accuracy : 0.9922          
##                                           
##        'Positive' Class : Malignant       
## 

2 Bayes classification với naiveBayes()

Đến đây chúng ta load package e1071 để chạy hàm naiveBayes() cho cùng một mô hình như trên. Pred2 là predictions cho test dataset. Hãy nhìn vào kết quả phân tích confusion matrix của Pred2 để so sánh với kết quả phân tích với hàm stan_glm().

library(e1071)

fml2 <- Class ~ clumpthickness + SizeUniformity + ShapeUniformity + Margin_adhesion +
  EpiCellSize + Barenuclei + BlandChromatin + NormalNucleoli + Mitoses

fit <- naiveBayes(fml2, data = trainset, laplace = 0, na.action = na.pass)

# trainset
pred1 <- predict(fit, newdata = trainset, type = "class" )
table(pred1,trainset$Class)

##      
## pred1   0   1
##     0 309   3
##     1  16 172

confusionMatrix(pred1, trainset$Class,  positive = "1")

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 309   3
##          1  16 172
##                                          
##                Accuracy : 0.962          
##                  95% CI : (0.9413, 0.977)
##     No Information Rate : 0.65           
##     P-Value [Acc > NIR] : < 2.2e-16      
##                                          
##                   Kappa : 0.9179         
##  Mcnemar's Test P-Value : 0.005905       
##                                          
##             Sensitivity : 0.9829         
##             Specificity : 0.9508         
##          Pos Pred Value : 0.9149         
##          Neg Pred Value : 0.9904         
##              Prevalence : 0.3500         
##          Detection Rate : 0.3440         
##    Detection Prevalence : 0.3760         
##       Balanced Accuracy : 0.9668         
##                                          
##        'Positive' Class : 1              
## 

#testset
pred2 <- predict(fit, newdata = testset, type = "class" )
table(pred2,testset$Class)

##      
## pred2   0   1
##     0 114   2
##     1   5  62

confusionMatrix(pred2, testset$Class,  positive = "1")

## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 114   2
##          1   5  62
##                                           
##                Accuracy : 0.9617          
##                  95% CI : (0.9228, 0.9845)
##     No Information Rate : 0.6503          
##     P-Value [Acc > NIR] : <2e-16          
##                                           
##                   Kappa : 0.9168          
##  Mcnemar's Test P-Value : 0.4497          
##                                           
##             Sensitivity : 0.9688          
##             Specificity : 0.9580          
##          Pos Pred Value : 0.9254          
##          Neg Pred Value : 0.9828          
##              Prevalence : 0.3497          
##          Detection Rate : 0.3388          
##    Detection Prevalence : 0.3661          
##       Balanced Accuracy : 0.9634          
##                                           
##        'Positive' Class : 1               
## 

Accuracy là 0.9617 so với 0.9945 của hàm stan_glm và Sensitivity cũng như Specificity đều thấp hơn một ít so với kết quả phân tích bằng hàm stan_glm().

3 ROC cho hai mô hình phân tích

ROC cho mô hình với naiveBayes

library(ROCR)
library(ggplot2)
# ROC for naiveBayes
xTest <- testset[,-10]
probs <- predict(fit, xTest, type="raw")
pred3 <- prediction(probs[, "1"], testset$Class)
perf_nb <- performance(pred3, measure='tpr', x.measure='fpr')
plot(perf_nb)

performance(pred3, 'auc')

## An object of class "performance"
## Slot "x.name":
## [1] "None"
## 
## Slot "y.name":
## [1] "Area under the ROC curve"
## 
## Slot "alpha.name":
## [1] "none"
## 
## Slot "x.values":
## list()
## 
## Slot "y.values":
## [[1]]
## [1] 0.9891019
## 
## 
## Slot "alpha.values":
## list()

ROC cho mô hình với Bayes Logistic Regression:

# ROC for logistic Bayes
pred <- prediction(testpred, testset$Class)
perf_lr <- performance(pred, measure='tpr', x.measure='fpr')
plot(perf_lr)

So sánh hai đường cong ROC cho hai mô hình ở trên: Đường cong ROC của mô hình bayes với hàm stan_glm() cho thấy có mức độ chính xác cao hơn.

roc_nb <- data.frame(fpr=unlist(perf_nb@x.values), tpr=unlist(perf_nb@y.values))
roc_nb$method <- "naive Bayes"
roc_lr <- data.frame(fpr=unlist(perf_lr@x.values), tpr=unlist(perf_lr@y.values))
roc_lr$method <- "Bayes logistic regression"
rbind(roc_nb, roc_lr) %>%
  ggplot(data=., aes(x=fpr, y=tpr, linetype=method, color=method)) + 
  geom_line() +
  geom_abline(a=1, b=0, linetype=2) +
  scale_x_continuous(lim=c(0,1)) +
  scale_y_continuous(lim=c(0,1)) +
  theme(legend.position=c(0.8,0.2), legend.title=element_blank())

Việc phân tích và so sánh hai mô hình classification theo trường phái Bayes nhưng từ hai package khác nhau để mở rộng sự hiều biết của chúng ta về các hàm khác nhau về phương pháp phân tích. Chúng ta thấy phương pháp Naive Bayes classification thường cho kết quả phân loại với mức độ chính xác thấp hơn một ít so với phương pháp Logistic Regression, tuy rằng cùng trường phái Bayes.

Rất mong nhận được ý kiến của các anh chị, các bạn về sự so sánh trên để hiểu rõ hơn về chủ đề này và cám ơn mọi người đã dành thời gian đọc bài viết.