Naive Bayes

Packages

library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(e1071)
library(caret)
## Loading required package: lattice
## Loading required package: ggplot2
library(classInt)
library(ggplot2)
library(gridExtra)
## 
## Attaching package: 'gridExtra'
## The following object is masked from 'package:dplyr':
## 
##     combine

Impor Data

steel <- read.csv("php9xWOpn.csv")
str(steel)
## 'data.frame':    1941 obs. of  34 variables:
##  $ V1   : int  42 645 829 853 1289 430 413 190 330 74 ...
##  $ V2   : int  50 651 835 860 1306 441 446 200 343 90 ...
##  $ V3   : int  270900 2538079 1553913 369370 498078 100250 138468 210936 429227 779144 ...
##  $ V4   : int  270944 2538108 1553931 369415 498335 100337 138883 210956 429253 779308 ...
##  $ V5   : int  267 108 71 176 2409 630 9052 132 264 1506 ...
##  $ V6   : int  17 10 8 13 60 20 230 11 15 46 ...
##  $ V7   : int  44 30 19 45 260 87 432 20 26 167 ...
##  $ V8   : int  24220 11397 7972 18996 246930 62357 1481991 20007 29748 180215 ...
##  $ V9   : int  76 84 99 99 37 64 23 124 53 53 ...
##  $ V10  : int  108 123 125 126 126 127 199 172 148 143 ...
##  $ V11  : int  1687 1687 1623 1353 1353 1387 1687 1687 1687 1687 ...
##  $ V12  : int  1 1 1 0 0 0 0 0 0 0 ...
##  $ V13  : int  0 0 0 1 1 1 1 1 1 1 ...
##  $ V14  : int  80 80 100 290 185 40 150 150 150 150 ...
##  $ V15  : num  0.0498 0.7647 0.971 0.7287 0.0695 ...
##  $ V16  : num  0.241 0.379 0.343 0.441 0.449 ...
##  $ V17  : num  0.1818 0.2069 0.3333 0.1556 0.0662 ...
##  $ V18  : num  0.0047 0.0036 0.0037 0.0052 0.0126 0.0079 0.0196 0.0059 0.0077 0.0095 ...
##  $ V19  : num  0.471 0.6 0.75 0.538 0.283 ...
##  $ V20  : num  1 0.967 0.947 1 0.989 ...
##  $ V21  : num  1 1 1 1 1 1 1 1 1 1 ...
##  $ V22  : num  2.43 2.03 1.85 2.25 3.38 ...
##  $ V23  : num  0.903 0.778 0.778 0.845 1.23 ...
##  $ V24  : num  1.64 1.46 1.26 1.65 2.41 ...
##  $ V25  : num  0.818 0.793 0.667 0.844 0.934 ...
##  $ V26  : num  -0.291 -0.176 -0.123 -0.157 -0.199 ...
##  $ V27  : num  0.582 0.298 0.215 0.521 1 ...
##  $ V28  : int  1 1 1 1 1 1 1 1 1 1 ...
##  $ V29  : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ V30  : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ V31  : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ V32  : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ V33  : int  0 0 0 0 0 0 0 0 0 0 ...
##  $ Class: int  1 1 1 1 1 1 1 1 1 1 ...

Steel Plates Faults Data Set

A dataset of steel plates’ faults, classified into 7 different types. The goal was to train machine learning for automatic pattern recognition.

The dataset consists of 27 features describing each fault (location, size, …) and 7 binary features indicating the type of fault (on of 7: Pastry, Z_Scratch, K_Scatch, Stains, Dirtiness, Bumps, Other_Faults). The latter is commonly used as a binary classification target (‘common’ or ‘other’ fault.)

Daftar Peubah:

  • V1: X_Minimum

  • V2: X_Maximum

  • V3: Y_Minimum

  • V4: Y_Maximum

  • V5: Pixels_Areas

  • V6: X_Perimeter

  • V7: Y_Perimeter

  • V8: Sum_of_Luminosity

  • V9: Minimum_of_Luminosity

  • V10: Maximum_of_Luminosity

  • V11: Length_of_Conveyer

  • V12: TypeOfSteel_A300

  • V13: TypeOfSteel_A400

  • V14: Steel_Plate_Thickness

  • V15: Edges_Index

  • V16: Empty_Index

  • V17: Square_Index

  • V18: Outside_X_Index

  • V19: Edges_X_Index

  • V20: Edges_Y_Index

  • V21: Outside_Global_Index

  • V22: LogOfAreas

  • V23: Log_X_Index

  • V24: Log_Y_Index

  • V25: Orientation_Index

  • V26: Luminosity_Index

  • V27: SigmoidOfAreas

  • V28: Pastry

  • V29: Z_Scratch

  • V30: K_Scatch

  • V31: Stains

  • V32: Dirtiness

  • V33: Bumps

  • Class: Other_Faults

sapply(steel[,28:34],table)
##    V28  V29  V30  V31  V32  V33 Class
## 0 1783 1751 1550 1869 1886 1539  1268
## 1  158  190  391   72   55  402   673

Pada data tersebut, tersedia 7 peubah yang menggambarkan beberapa tipe dari “steel plates faults”. Pada panduan ini, peubah respon yang digunakan sebagai latihan adalah V13.

steel <- steel %>% select(-c(28:33)) %>% mutate_at(c(12,13,21,28),factor)
str(steel)
## 'data.frame':    1941 obs. of  28 variables:
##  $ V1   : int  42 645 829 853 1289 430 413 190 330 74 ...
##  $ V2   : int  50 651 835 860 1306 441 446 200 343 90 ...
##  $ V3   : int  270900 2538079 1553913 369370 498078 100250 138468 210936 429227 779144 ...
##  $ V4   : int  270944 2538108 1553931 369415 498335 100337 138883 210956 429253 779308 ...
##  $ V5   : int  267 108 71 176 2409 630 9052 132 264 1506 ...
##  $ V6   : int  17 10 8 13 60 20 230 11 15 46 ...
##  $ V7   : int  44 30 19 45 260 87 432 20 26 167 ...
##  $ V8   : int  24220 11397 7972 18996 246930 62357 1481991 20007 29748 180215 ...
##  $ V9   : int  76 84 99 99 37 64 23 124 53 53 ...
##  $ V10  : int  108 123 125 126 126 127 199 172 148 143 ...
##  $ V11  : int  1687 1687 1623 1353 1353 1387 1687 1687 1687 1687 ...
##  $ V12  : Factor w/ 2 levels "0","1": 2 2 2 1 1 1 1 1 1 1 ...
##  $ V13  : Factor w/ 2 levels "0","1": 1 1 1 2 2 2 2 2 2 2 ...
##  $ V14  : int  80 80 100 290 185 40 150 150 150 150 ...
##  $ V15  : num  0.0498 0.7647 0.971 0.7287 0.0695 ...
##  $ V16  : num  0.241 0.379 0.343 0.441 0.449 ...
##  $ V17  : num  0.1818 0.2069 0.3333 0.1556 0.0662 ...
##  $ V18  : num  0.0047 0.0036 0.0037 0.0052 0.0126 0.0079 0.0196 0.0059 0.0077 0.0095 ...
##  $ V19  : num  0.471 0.6 0.75 0.538 0.283 ...
##  $ V20  : num  1 0.967 0.947 1 0.989 ...
##  $ V21  : Factor w/ 3 levels "0","0.5","1": 3 3 3 3 3 3 3 3 3 3 ...
##  $ V22  : num  2.43 2.03 1.85 2.25 3.38 ...
##  $ V23  : num  0.903 0.778 0.778 0.845 1.23 ...
##  $ V24  : num  1.64 1.46 1.26 1.65 2.41 ...
##  $ V25  : num  0.818 0.793 0.667 0.844 0.934 ...
##  $ V26  : num  -0.291 -0.176 -0.123 -0.157 -0.199 ...
##  $ V27  : num  0.582 0.298 0.215 0.521 1 ...
##  $ Class: Factor w/ 2 levels "1","2": 1 1 1 1 1 1 1 1 1 1 ...
# Memisahkan training-testing
set.seed(100)
idx <- createDataPartition(steel$V13, p=0.3, list=FALSE)
steeltrain <- steel[-idx,]
steeltest <- steel[idx,]
steeltrain

Eksplorasi Data

p <- ggplot(steel,aes(x=V15,fill=V13)) + theme(legend.position="bottom")
p1 <- p + geom_density(alpha=.3)
p2 <- p + geom_boxplot()
grid.arrange(p1, p2, ncol=2)

p <- ggplot(steel,aes(x=V23,fill=V13)) + theme(legend.position="bottom")
p1 <- p + geom_density(alpha=.3)
p2 <- p + geom_boxplot()
grid.arrange(p1, p2, ncol=2)

p <- ggplot(steel,aes(x=V22,fill=V13)) + theme(legend.position="bottom")
p1 <- p + geom_density(alpha=.3)
p2 <- p + geom_boxplot()
grid.arrange(p1, p2, ncol=2)

Pemodelan

model.nb1 <- naiveBayes(V13~V15+V22+V23,data=steeltrain)
model.nb1
## 
## Naive Bayes Classifier for Discrete Predictors
## 
## Call:
## naiveBayes.default(x = X, y = Y, laplace = laplace)
## 
## A-priori probabilities:
## Y
##         0         1 
## 0.4001474 0.5998526 
## 
## Conditional probabilities:
##    V15
## Y        [,1]      [,2]
##   0 0.3807827 0.3044267
##   1 0.2993698 0.2937863
## 
##    V22
## Y       [,1]      [,2]
##   0 2.174117 0.4750134
##   1 2.695784 0.8787542
## 
##    V23
## Y       [,1]      [,2]
##   0 1.174587 0.2945707
##   1 1.438542 0.5491770
pred.nb1 <- predict(model.nb1,steeltest)
caret::confusionMatrix(pred.nb1, steeltest$V13, positive="1")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction   0   1
##          0 198 202
##          1  36 148
##                                           
##                Accuracy : 0.5925          
##                  95% CI : (0.5514, 0.6326)
##     No Information Rate : 0.5993          
##     P-Value [Acc > NIR] : 0.6489          
##                                           
##                   Kappa : 0.2407          
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.4229          
##             Specificity : 0.8462          
##          Pos Pred Value : 0.8043          
##          Neg Pred Value : 0.4950          
##              Prevalence : 0.5993          
##          Detection Rate : 0.2534          
##    Detection Prevalence : 0.3151          
##       Balanced Accuracy : 0.6345          
##                                           
##        'Positive' Class : 1               
## 
# Membuat fungsi untuk mengeluarkan akurasi, sensitivitas, dan spesifisitas
perform <- function(pred,data){
  tabel <- caret::confusionMatrix(pred, data$V13, positive = "1")
  result <- c(tabel$overall[1],tabel$byClass[1:2])
  return(result)
}

perform(pred.nb1,steeltest)
##    Accuracy Sensitivity Specificity 
##   0.5924658   0.4228571   0.8461538

Kaidah peluang bersyarat pada algoritme Naive Bayes mendasarkan pada peluang titik, sehingga diskretisasi/binning bisa menjadi salah satu opsi dalam pemodelan. Maka dari itu, kita coba diskretisasi untuk membuat model alternatif. Model alternatif pertama, peubah V15 dibuat menjadi 10 kategori, peubah V22 menjadi 9 kategori, dan peubah V23 dibuat menjadi 9 kategori. Semuanya menggunakan equal width discretization pada fungsi classInt. Banyaknya kategori pada setiap peubah tersebut ditentukan secara subjektif.

# Membuat fungsi untuk melakukan equal width discretization
disk <- function(peubah,k){
 eqwid <-classIntervals(steel[,peubah], k, style = 'equal')
 disk <- cut(steel[,peubah], breaks=eqwid$brks, include.lowest=TRUE)
 return(disk)
}

steel$V15.1 <- disk("V15",10)
steel$V22.1 <- disk("V22",9)
steel$V23.1 <- disk("V23",9)
steeltrain <- steel[-idx,]
steeltest <- steel[idx,]

model.nb2 <- naiveBayes(V13~V15.1+V22.1+V23.1,data=steeltrain)
pred.nb2 <- predict(model.nb2,steeltest)
perform(pred.nb2,steeltest)
##    Accuracy Sensitivity Specificity 
##   0.6455479   0.5800000   0.7435897

Lalu untuk model alternatif kedua, peubah V15 dibuat menjadi 25 kategori, peubah V22 menjadi 15 kategori, dan peubah V23 dibuat menjadi 22 kategori. Semuanya menggunakan equal width discretization pada fungsi classInt.

steel$V15.2 <- disk("V15",25)
steel$V22.2 <- disk("V22",15)
steel$V23.2 <- disk("V23",22)
steeltrain <- steel[-idx,]
steeltest <- steel[idx,]

model.nb3 <- naiveBayes(V13~V15.2+V22.2+V23.2,data=steeltrain)
pred.nb3 <- predict(model.nb3,steeltest)
perform(pred.nb3,steeltest)
##    Accuracy Sensitivity Specificity 
##   0.6352740   0.5600000   0.7478632

Dibandingkan juga dengan model yang memasukkan semua peubah asli sebagai peubah penjelas.

model.nb4 <- naiveBayes(V13~.-V15.1-V22.1-V23.1-V15.2-V22.2-V23.2,data=steeltrain)
pred.nb4 <- predict(model.nb4,steeltest)
perform(pred.nb4,steeltest)
##    Accuracy Sensitivity Specificity 
##   0.8236301   0.7371429   0.9529915
data.frame(model1=perform(pred.nb1,steeltest),
           model2=perform(pred.nb2,steeltest),
           model3=perform(pred.nb3,steeltest),
           model4=perform(pred.nb4,steeltest))

Apa saja yang bisa dicoba-coba? Menggunakan kombinasi peubah lainnya sebagai peubah penjelas.

Melakukan diskretisasi lebih lanjut. Menggunakan banyaknya kategori (k) lainnya. Menggunakan metode diskretisasi lainnya. Melakukan diskretisasi pada peubah lainnya. Menggunakan peubah “steel plates faults” lainnya sebagai peubah respon.

Hint: untuk menentukan “predictive power” dari suatu peubah kategorik terhadap peubah respon, silakan pelajari terkait Weight of Evidence dan Information Value.

SVM

Package

library(dplyr)
library(e1071)
library(caret)
library(ggplot2)

Ilustrasi SVM

Completely Separated

set.seed(10)
x <- matrix(rnorm(20*2), ncol = 2)
y <- c(rep(-1,10), rep(1,10))
x[y==1,] <- x[y==1,] + 3/2
data1 <- data.frame(x=x, y=as.factor(y))

ggplot(data = data1, aes(x = x.2, y = x.1, color = y, shape = y)) + 
  geom_point(size = 2) + scale_color_manual(values=c(1,4)) +
  theme(legend.position = "none")

svmfit1 <- svm(y~., data = data1, kernel = "linear", scale = FALSE)
svmfit1
## 
## Call:
## svm(formula = y ~ ., data = data1, kernel = "linear", scale = FALSE)
## 
## 
## Parameters:
##    SVM-Type:  C-classification 
##  SVM-Kernel:  linear 
##        cost:  1 
## 
## Number of Support Vectors:  5
plot(svmfit1, data1, color.palette = rainbow, svSymbol=17, symbolPalette = c(1,4))

Not Completely Separated

# Generate Random Data Set
x <- matrix(rnorm(20*2), ncol = 2)
y <- c(rep(-1,10), rep(1,10))
x[y==1,] <- x[y==1,] + 1
data2 <- data.frame(x=x, y=as.factor(y))

ggplot(data = data2, aes(x = x.2, y = x.1, color = y, shape = y)) + 
  geom_point(size = 2) + scale_color_manual(values=c(1,4)) +
  theme(legend.position = "none")

svmfit2 <- svm(y~., data = data2, kernel = "linear", cost = 10)
plot(svmfit2, data2, color.palette = rainbow, svSymbol=17, symbolPalette = c(1,4))

Data IRIS

# Struktur Data

head(iris,3)
str(iris)
## 'data.frame':    150 obs. of  5 variables:
##  $ Sepal.Length: num  5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
##  $ Sepal.Width : num  3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
##  $ Petal.Length: num  1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
##  $ Petal.Width : num  0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
##  $ Species     : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...

Pada percobaan ini fitur yang digunakan hanya dua yaitu Sepal.length dan Sepal.width untuk prediksi variabel Species.

iris.part = iris[,c(1,2,5)]
attach(iris.part)
head(iris.part, 3)

Plot Data

plot(Sepal.Width, Sepal.Length, col=Species)
legend(x = 3.9, y=7.5, legend = c("Setosa", "versicolor", "verginica"),fill = c('white','red','green'))

Model

x <- subset(iris.part, select=-Species) #fitur yang digunakan
y <- Species #fitur yang diprediksi


model <- svm(Species ~ ., data=iris.part)
summary(model)
## 
## Call:
## svm(formula = Species ~ ., data = iris.part)
## 
## 
## Parameters:
##    SVM-Type:  C-classification 
##  SVM-Kernel:  radial 
##        cost:  1 
## 
## Number of Support Vectors:  86
## 
##  ( 10 40 36 )
## 
## 
## Number of Classes:  3 
## 
## Levels: 
##  setosa versicolor virginica
#Prediksi Spesies
y_pred <- predict(model,x)
#Tuning SVM untuk memperoleh hyperparameter terbaik
tuning_svm <- tune(svm, train.x=x, train.y=y, 
              kernel="radial", ranges=list(cost=10^(-2:2), gamma=c(.25,.5,1,2)))
print(tuning_svm)
## 
## Parameter tuning of 'svm':
## 
## - sampling method: 10-fold cross validation 
## 
## - best parameters:
##  cost gamma
##    10     1
## 
## - best performance: 0.2133333
# Model dengan parameter hasil tuning
final_svm <- svm(Species ~ ., data=iris.part, kernel="radial", cost=1, gamma=0.25)

#Plot the results
plot(final_svm , iris.part)
legend(x = 3.37, y=7.5, legend = c("Setosa", "versicolor", "verginica"),fill = c('black','red','green'))

# ubah kernel menjadi linear
final_svm_linear <- svm(Species ~ ., data=iris.part, kernel="linear", cost=1, gamma=.25)

#Plot 
plot(final_svm_linear , iris.part)
legend(x = 3.37, y=7.5, legend = c("Setosa", "versicolor", "verginica"),fill = c('black','red','green'))

# ubah set parameter
final_svm1 <- svm(Species ~ ., data=iris.part, kernel="radial", cost=1, gamma=1)

#Plot 1

plot(final_svm1 , iris.part)
legend(x = 3.37, y=7.5, legend = c("Setosa", "versicolor", "verginica"),fill = c('black','red','green'))

final_svm2 <- svm(Species ~ ., data=iris.part, kernel="radial", cost=10, gamma=10)
#Plot 2
plot(final_svm2 , iris.part)
legend(x = 3.37, y=7.5, legend = c("Setosa", "versicolor", "verginica"),fill = c('black','red','green'))

final_svm3 <- svm(Species ~ ., data=iris.part, kernel="radial", cost=50, gamma=50)
#plot 3
plot(final_svm3 , iris.part)
legend(x = 3.37, y=7.5, legend = c("Setosa", "versicolor", "verginica"),fill = c('black','red','green'))

final_svm4 <- svm(Species ~ ., data=iris.part, kernel="radial", cost=100, gamma=100)
#plot 4
plot(final_svm4 , iris.part)
legend(x = 3.37, y=7.5, legend = c("Setosa", "versicolor", "verginica"),fill = c('black','red','green'))

final_svm5 <- svm(Species ~ ., data=iris.part, kernel="radial", cost=500, gamma=500)
#plot 5
plot(final_svm5 , iris.part)
legend(x = 3.37, y=7.5, legend = c("Setosa", "versicolor", "verginica"),fill = c('black','red','green'))

Dari hasil plot bisa dilihat bahwa semakin besar parameter yang diberikan maka akam membuat prediksi model overfitting.