Analisa Naive Bayes dg Data Congressional Voting US
Penulis : Ismail Akbar | Prof. Dr. Drs.AGUS WIDODO,M.Kes | Magister Informatika | UIN Maulana Malik Ibrahim Malang
19 Maret 2021
Load Library
Dalam analisa bayesian dengan Data Congressional Voting US dapat dilakukan dengan memuat bebrapa library seperti dibawah ini.
library(e1071)## Warning: package 'e1071' was built under R version 4.0.4library(mlbench)## Warning: package 'mlbench' was built under R version 4.0.4library(ggplot2)
library(caret)## Warning: package 'caret' was built under R version 4.0.4## Loading required package: latticelibrary(gmodels)## Warning: package 'gmodels' was built under R version 4.0.4Analisis
Analisis Bayesian dengan menggunakan Kumpulan data United States Congressional Voting 1984 (HouseVotes84) diambil dari UCI Repository Of Machine Learning Database melalui mlbench package. Data meliputi 435 observasi dengan 17 variabel. 1 variabel class (demokrat, republik) dan 16 suara (ya, tidak) pada topik yang berbeda.
Mengambil dan Menampilkan Data
Mengambil data HouseVotes84 dengan fungsi sebagai berikut.
data("HouseVotes84")str(HouseVotes84)## 'data.frame': 435 obs. of 17 variables:
## $ Class: Factor w/ 2 levels "democrat","republican": 2 2 1 1 1 1 1 2 2 1 ...
## $ V1 : Factor w/ 2 levels "n","y": 1 1 NA 1 2 1 1 1 1 2 ...
## $ V2 : Factor w/ 2 levels "n","y": 2 2 2 2 2 2 2 2 2 2 ...
## $ V3 : Factor w/ 2 levels "n","y": 1 1 2 2 2 2 1 1 1 2 ...
## $ V4 : Factor w/ 2 levels "n","y": 2 2 NA 1 1 1 2 2 2 1 ...
## $ V5 : Factor w/ 2 levels "n","y": 2 2 2 NA 2 2 2 2 2 1 ...
## $ V6 : Factor w/ 2 levels "n","y": 2 2 2 2 2 2 2 2 2 1 ...
## $ V7 : Factor w/ 2 levels "n","y": 1 1 1 1 1 1 1 1 1 2 ...
## $ V8 : Factor w/ 2 levels "n","y": 1 1 1 1 1 1 1 1 1 2 ...
## $ V9 : Factor w/ 2 levels "n","y": 1 1 1 1 1 1 1 1 1 2 ...
## $ V10 : Factor w/ 2 levels "n","y": 2 1 1 1 1 1 1 1 1 1 ...
## $ V11 : Factor w/ 2 levels "n","y": NA 1 2 2 2 1 1 1 1 1 ...
## $ V12 : Factor w/ 2 levels "n","y": 2 2 1 1 NA 1 1 1 2 1 ...
## $ V13 : Factor w/ 2 levels "n","y": 2 2 2 2 2 2 NA 2 2 1 ...
## $ V14 : Factor w/ 2 levels "n","y": 2 2 2 1 2 2 2 2 2 1 ...
## $ V15 : Factor w/ 2 levels "n","y": 1 1 1 1 2 2 2 NA 1 NA ...
## $ V16 : Factor w/ 2 levels "n","y": 2 NA 1 2 2 2 2 2 2 NA ...Menampilkan data dalam bentuk grafik dari total suara yang diberikan.
plot(as.factor(HouseVotes84[,2]))
title(main="Total Suara yang diberkan", xlab="vote", ylab="# reps")
Menampilkan dalam bentuk grafik total suara yang diperoleh partai republic
plot(as.factor(HouseVotes84[HouseVotes84$Class=='republican',2]))
title(main="Total Suara yang diperoleh partai republic", xlab="vote", ylab="# reps")
Menampilkan dalam bentuk grafik total suara yang diperoleh partai democrat
plot(as.factor(HouseVotes84[HouseVotes84$Class=='democrat',2]))
title(main="Total Suara yang diperoleh partai Democrat", xlab="vote", ylab="# reps")
Membuat sebuah fungsi
Membuat fungsi untuk proses imputasi, dan fungsi tersebut digunakan untuk mengembalikan jumlah NA berdasarkan suara dan kelas (demokrat atau republic)
na_by_col_class <- function (col,cls){return(sum(is.na(HouseVotes84[,col]) & HouseVotes84$Class==cls))}Menghitung probabilitas bersyarat bahwa seorang anggota partai akan memberikan suara ‘Y’ untuk masalah tertentu, Kemungkinannya didasarakan pada semua anggota partai yang benar-benar memberikan suara pada masalah tersebut (mengabaikan NA)
p_y_col_class <- function(col,cls){
sum_y<-sum(HouseVotes84[,col]=='y' & HouseVotes84$Class==cls,na.rm = TRUE)
sum_n<-sum(HouseVotes84[,col]=='n' & HouseVotes84$Class==cls,na.rm = TRUE)
return(sum_y/(sum_y+sum_n))}Pada proses kali ini yaitu memperhitungkan nilai-nilai yang hilang
for (i in 2:ncol(HouseVotes84)) {
if(sum(is.na(HouseVotes84[,i])>0)) {
c1 <- which(is.na(HouseVotes84[,i])& HouseVotes84$Class=='democrat',arr.ind = TRUE)
c2 <- which(is.na(HouseVotes84[,i])& HouseVotes84$Class=='republican',arr.ind =TRUE)
HouseVotes84[c1,i] <- ifelse(runif(na_by_col_class(i,'democrat'))<p_y_col_class(i,'democrat'),'y','n')
HouseVotes84[c2,i] <- ifelse(runif(na_by_col_class(i,'republican'))<p_y_col_class(i,'republican'),'y','n')
}
}Pembagian Data
Pada pengujian kali ini, dilakukan pembagian 2 data menjadi data training dan data testing, dengan 80% (0.80) untuk data training, dan sisanya data testing.
dist## function (x, method = "euclidean", diag = FALSE, upper = FALSE,
## p = 2)
## {
## if (!is.na(pmatch(method, "euclidian")))
## method <- "euclidean"
## METHODS <- c("euclidean", "maximum", "manhattan", "canberra",
## "binary", "minkowski")
## method <- pmatch(method, METHODS)
## if (is.na(method))
## stop("invalid distance method")
## if (method == -1)
## stop("ambiguous distance method")
## x <- as.matrix(x)
## N <- nrow(x)
## attrs <- if (method == 6L)
## list(Size = N, Labels = dimnames(x)[[1L]], Diag = diag,
## Upper = upper, method = METHODS[method], p = p, call = match.call(),
## class = "dist")
## else list(Size = N, Labels = dimnames(x)[[1L]], Diag = diag,
## Upper = upper, method = METHODS[method], call = match.call(),
## class = "dist")
## .Call(C_Cdist, x, method, attrs, p)
## }
## <bytecode: 0x000000002a5a5460>
## <environment: namespace:stats>HouseVotes84[,"train"] <- ifelse(runif(nrow(HouseVotes84))<0.80,1,0)Mengambil kolom indikator untuk data training / testing
trainColNum <- grep("train",names(HouseVotes84))Memisahkan antara data training dengan data testing
trainHouseVotes84 <- HouseVotes84[HouseVotes84$train==1,-trainColNum]
testHouseVotes84 <- HouseVotes84[HouseVotes84$train==0,-trainColNum]Melatih Model Data dengan naive bayes
Pada proses kali ini menguji data training dengan naive bayes
nb_model <- naiveBayes(Class~.,data = trainHouseVotes84)
nb_model##
## Naive Bayes Classifier for Discrete Predictors
##
## Call:
## naiveBayes.default(x = X, y = Y, laplace = laplace)
##
## A-priori probabilities:
## Y
## democrat republican
## 0.611898 0.388102
##
## Conditional probabilities:
## V1
## Y n y
## democrat 0.3842593 0.6157407
## republican 0.7810219 0.2189781
##
## V2
## Y n y
## democrat 0.4907407 0.5092593
## republican 0.4963504 0.5036496
##
## V3
## Y n y
## democrat 0.1018519 0.8981481
## republican 0.8686131 0.1313869
##
## V4
## Y n y
## democrat 0.94444444 0.05555556
## republican 0.00729927 0.99270073
##
## V5
## Y n y
## democrat 0.78703704 0.21296296
## republican 0.05109489 0.94890511
##
## V6
## Y n y
## democrat 0.51388889 0.48611111
## republican 0.09489051 0.90510949
##
## V7
## Y n y
## democrat 0.2268519 0.7731481
## republican 0.7518248 0.2481752
##
## V8
## Y n y
## democrat 0.1759259 0.8240741
## republican 0.8394161 0.1605839
##
## V9
## Y n y
## democrat 0.2546296 0.7453704
## republican 0.8759124 0.1240876
##
## V10
## Y n y
## democrat 0.5277778 0.4722222
## republican 0.4379562 0.5620438
##
## V11
## Y n y
## democrat 0.5138889 0.4861111
## republican 0.8686131 0.1313869
##
## V12
## Y n y
## democrat 0.8518519 0.1481481
## republican 0.1167883 0.8832117
##
## V13
## Y n y
## democrat 0.7037037 0.2962963
## republican 0.1313869 0.8686131
##
## V14
## Y n y
## democrat 0.65277778 0.34722222
## republican 0.02919708 0.97080292
##
## V15
## Y n y
## democrat 0.36574074 0.63425926
## republican 0.91970803 0.08029197
##
## V16
## Y n y
## democrat 0.06018519 0.93981481
## republican 0.34306569 0.65693431summary(nb_model)## Length Class Mode
## apriori 2 table numeric
## tables 16 -none- list
## levels 2 -none- character
## isnumeric 16 -none- logical
## call 4 -none- callstr(nb_model)## List of 5
## $ apriori : 'table' int [1:2(1d)] 216 137
## ..- attr(*, "dimnames")=List of 1
## .. ..$ Y: chr [1:2] "democrat" "republican"
## $ tables :List of 16
## ..$ V1 : 'table' num [1:2, 1:2] 0.384 0.781 0.616 0.219
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ Y : chr [1:2] "democrat" "republican"
## .. .. ..$ V1: chr [1:2] "n" "y"
## ..$ V2 : 'table' num [1:2, 1:2] 0.491 0.496 0.509 0.504
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ Y : chr [1:2] "democrat" "republican"
## .. .. ..$ V2: chr [1:2] "n" "y"
## ..$ V3 : 'table' num [1:2, 1:2] 0.102 0.869 0.898 0.131
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ Y : chr [1:2] "democrat" "republican"
## .. .. ..$ V3: chr [1:2] "n" "y"
## ..$ V4 : 'table' num [1:2, 1:2] 0.9444 0.0073 0.0556 0.9927
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ Y : chr [1:2] "democrat" "republican"
## .. .. ..$ V4: chr [1:2] "n" "y"
## ..$ V5 : 'table' num [1:2, 1:2] 0.787 0.0511 0.213 0.9489
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ Y : chr [1:2] "democrat" "republican"
## .. .. ..$ V5: chr [1:2] "n" "y"
## ..$ V6 : 'table' num [1:2, 1:2] 0.5139 0.0949 0.4861 0.9051
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ Y : chr [1:2] "democrat" "republican"
## .. .. ..$ V6: chr [1:2] "n" "y"
## ..$ V7 : 'table' num [1:2, 1:2] 0.227 0.752 0.773 0.248
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ Y : chr [1:2] "democrat" "republican"
## .. .. ..$ V7: chr [1:2] "n" "y"
## ..$ V8 : 'table' num [1:2, 1:2] 0.176 0.839 0.824 0.161
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ Y : chr [1:2] "democrat" "republican"
## .. .. ..$ V8: chr [1:2] "n" "y"
## ..$ V9 : 'table' num [1:2, 1:2] 0.255 0.876 0.745 0.124
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ Y : chr [1:2] "democrat" "republican"
## .. .. ..$ V9: chr [1:2] "n" "y"
## ..$ V10: 'table' num [1:2, 1:2] 0.528 0.438 0.472 0.562
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ Y : chr [1:2] "democrat" "republican"
## .. .. ..$ V10: chr [1:2] "n" "y"
## ..$ V11: 'table' num [1:2, 1:2] 0.514 0.869 0.486 0.131
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ Y : chr [1:2] "democrat" "republican"
## .. .. ..$ V11: chr [1:2] "n" "y"
## ..$ V12: 'table' num [1:2, 1:2] 0.852 0.117 0.148 0.883
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ Y : chr [1:2] "democrat" "republican"
## .. .. ..$ V12: chr [1:2] "n" "y"
## ..$ V13: 'table' num [1:2, 1:2] 0.704 0.131 0.296 0.869
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ Y : chr [1:2] "democrat" "republican"
## .. .. ..$ V13: chr [1:2] "n" "y"
## ..$ V14: 'table' num [1:2, 1:2] 0.6528 0.0292 0.3472 0.9708
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ Y : chr [1:2] "democrat" "republican"
## .. .. ..$ V14: chr [1:2] "n" "y"
## ..$ V15: 'table' num [1:2, 1:2] 0.3657 0.9197 0.6343 0.0803
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ Y : chr [1:2] "democrat" "republican"
## .. .. ..$ V15: chr [1:2] "n" "y"
## ..$ V16: 'table' num [1:2, 1:2] 0.0602 0.3431 0.9398 0.6569
## .. ..- attr(*, "dimnames")=List of 2
## .. .. ..$ Y : chr [1:2] "democrat" "republican"
## .. .. ..$ V16: chr [1:2] "n" "y"
## $ levels : chr [1:2] "democrat" "republican"
## $ isnumeric: Named logi [1:16] FALSE FALSE FALSE FALSE FALSE FALSE ...
## ..- attr(*, "names")= chr [1:16] "V1" "V2" "V3" "V4" ...
## $ call : language naiveBayes.default(x = X, y = Y, laplace = laplace)
## - attr(*, "class")= chr "naiveBayes"Proses saat perhitungan
nb_test_predict <- predict(nb_model,testHouseVotes84[,-1])Menampilkan data dalam bentuk matriks
table(pred=nb_test_predict,true=testHouseVotes84$Class)## true
## pred democrat republican
## democrat 49 1
## republican 2 30Dari hasil diatas menampilkan matriks dengan 0 suara demokrat diidentifikasi sebagai republik dan 8 suara republik diidentifikasi sebagai demokrat.
Dan memiliki nilai prediksi dengan skor dibawah ini.
mean(nb_test_predict==testHouseVotes84$Class)## [1] 0.9634146Dalam proses selanjutnya, dibuat sebuah fungsi untuk menjalankan dan merekam hasil model.
nb_multiple_runs <- function(train_fraction,n){
fraction_correct <- rep(NA,n)
for (i in 1:n){
HouseVotes84[,"train"] <- ifelse(runif(nrow(HouseVotes84))<train_fraction,1,0)
trainColNum <- grep("train",names(HouseVotes84))
trainHouseVotes84 <- HouseVotes84[HouseVotes84$train==1,-trainColNum]
testHouseVotes84 <- HouseVotes84[HouseVotes84$train==0,-trainColNum]
nb_model <- naiveBayes(Class~.,data = trainHouseVotes84)
nb_test_predict <- predict(nb_model,testHouseVotes84[,-1])
fraction_correct[i] <- mean(nb_test_predict==testHouseVotes84$Class)
}
return(fraction_correct)
}Pengujian
Diambil dari 80% data dan dipilih secara acak untuk data training di setiap proses. Dan terdapat 20 Proses
fraction_correct_predictions <- nb_multiple_runs(0.8,20)
fraction_correct_predictions## [1] 0.8645833 0.8571429 0.8837209 0.9111111 0.9634146 0.9012346 0.9240506
## [8] 0.9036145 0.9473684 0.8846154 0.9629630 0.9204545 0.9010989 0.9333333
## [15] 0.9347826 0.9189189 0.9381443 0.9176471 0.9263158 0.8765432Hasil & Kesimpulan
summary(fraction_correct_predictions)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.8571 0.8970 0.9183 0.9136 0.9337 0.9634sd(fraction_correct_predictions)## [1] 0.02988817Kami melihat bahwa hasil dari proses tersebut cukup berdekatan, dalam kisaran 0,86 hingga 0,98 dengan standar Deviasi 0,026. jadi dari proses analisan data dengan naive bayes tersebut, bahwa algoritma Naive Bayes melakukan pekerjaan yang cukup baik dengan data ini (Congressional Voting US).