Proses mengimport data dalam format file csv dapat dilakukan
menggunakan fungsi read.csv() dan menyebutkan nama file
beserta folder tempat menyimpannya.
Data dapat diperoleh di : german_credit
kredit <- read.csv("D:/Kuliah/IPB 2025 Semester 3/Pemodelan Klasifikasi/Kuliah/01. Materi/Sesi UAS/RPUBS PAK BAGUS/german_credit.csv")
Dengan perintah di atas, pada workspace-R kita memiliki data frame
dengan mana kredit. Selanjutnya kita akan bekerja dengan
dataframe ini.
Mengetahui informasi dasar dari data yang kita miliki. Informasi dasar tersebut meliputi ukuran/banyaknya data dan nama-nama kolom atau variabel yang ada di dalamnya.
FUngsi dim() dapat digunakan untuk menampilkan berapa
banyak baris dan kolom pada dataframe kita, dan fungsi
colnames() dapat digunakan untuk menampilkan nama-nama
kolom pada data.
dim(kredit)
## [1] 1000 21
colnames(kredit)
## [1] "checking_status" "duration" "credit_history"
## [4] "purpose" "credit_amount" "savings_status"
## [7] "employment" "installment_commitment" "personal_status"
## [10] "other_parties" "residence_since" "property_magnitude"
## [13] "age" "other_payment_plans" "housing"
## [16] "existing_credits" "job" "num_dependents"
## [19] "own_telephone" "foreign_worker" "class"
#Ubah Variabel caracter menjai faktor
# Ubah semua kolom bertipe character menjadi factor
kredit[sapply(kredit, is.character)] <-
lapply(kredit[sapply(kredit, is.character)], as.factor)
sapply(kredit, class)
## checking_status duration credit_history
## "factor" "integer" "factor"
## purpose credit_amount savings_status
## "factor" "integer" "factor"
## employment installment_commitment personal_status
## "factor" "integer" "factor"
## other_parties residence_since property_magnitude
## "factor" "integer" "factor"
## age other_payment_plans housing
## "integer" "factor" "factor"
## existing_credits job num_dependents
## "integer" "factor" "integer"
## own_telephone foreign_worker class
## "factor" "factor" "factor"
Tampak bahwa ada sebanyak 1000 baris pada data dengan kolom sebanyak 21 buah. Nama-nama kolom sudah diberikan oleh output di atas.
Ada baiknya kita mengetahui berapa banyak nasabah yang statusnya tergolong BAD dan GOOD, karena variabel ini merupakan variabel yang akan kita gunakan dalam pemodelan sebagai variabel target.
Fungsi table() merupakan fungsi yang dapat menghasilkan
frekuensi dari setiap kategori, sedangkan prop.table()
dapat menghasilkan proporsi atau persentase-nya.
table(kredit$class)
##
## bad good
## 300 700
prop.table(table(kredit$class))
##
## bad good
## 0.3 0.7
Berdasarkan hasil di atas diperoleh bahwa yang BAD ada sebanyak 300 nasabah atau 30% dari keseluruhan yang ada.
Perintah di bawah ini adalah untuk melihat berapa resiko atau peluang terjadinya BAD pada nasabah berdasarkan jenis kelamin dan status pernikahan. Kita dapat menampilkannya dalam bentuk tabel, atau memvisualisasikannya dalam bentuk grafik sederhana seperti di bawah ini, dimana terlihat bahwa nasabah laki-laki (MALE) yang berstatus DIVORCE/SEPARATE memiliki resiko BAD yang lebih tinggi dibandingkan nasabah lain.
prop.table(table(kredit$class,kredit$personal_status), margin=2)
##
## 'female div/dep/mar' 'male div/sep' 'male mar/wid' 'male single'
## bad 0.3516129 0.4000000 0.2717391 0.2664234
## good 0.6483871 0.6000000 0.7282609 0.7335766
barplot(prop.table(table(kredit$class,kredit$personal_status), margin=2), col=c(2,4))
Ilustrasi di bawah ini melakukan hal serupa namun untuk variabel lain yaitu kepemilikan status perumahan, dan terlihat bahwa mereka yang sedang menempati rumah bebas sewa dan menyewa memiliki resiko jauh lebih besar dibandingkan nasabah yang memiliki rumah sendiri.
prop.table(table(kredit$class,kredit$housing), margin=2)
##
## 'for free' own rent
## bad 0.4074074 0.2608696 0.3910615
## good 0.5925926 0.7391304 0.6089385
barplot(prop.table(table(kredit$class,kredit$housing), margin=2), col=c(2,4))
Proses pemodelan akan diawali dengan membagi data menjadi dua bagian secara acak, yaitu data latih (training set) dan data uji (testing set). Data latih adalah data yang akan digunakan untuk melakukan pemodelan, sedangkan data uji adalah data untuk melihat kinerja prediksinya.
Fungsi yang bisa digunakan untuk memisahkan data menjadi dua bagian
adalah createDataPartition() pada package
caretsebagai berikut.
library(caret)
## Loading required package: ggplot2
## Loading required package: lattice
set.seed(100)
index_train <- createDataPartition(kredit$class,
p = 0.7,list = FALSE)
data.train <- kredit[index_train,]
data.test <- kredit[-index_train,]
Ada dua dataframe baru yang dihasilkan dari perintah di atas
yaitu data.train dan data.test, yang banyaknya
baris untuk masing-masing dapat diperoleh sebagai berikut.
dim(data.train)
## [1] 700 21
dim(data.test)
## [1] 300 21
Selanjutnya kita dapat menjalankan algoritma pohon klasifikasi
menggunakan fungsi rpart() yang tersedia pada package
dengan nama yang sama yaitu rpart.
Pada fungsi ini kita tinggal menyebutkan dataframe yang digunakan
sebagai sumber data yaitu data.train. Ekspresi
class~ . memiliki makna bahwa variabel target-nya adalah
status dan seluruh variabel lainnya digunakan sebagai prediktor. Jika
kita hanya menggunakan beberapa variabel saja, kita bisa mengganti tanda
“.” denga nama-nama variabel yang ingin digunakan.
library(rpart)
pohon <- rpart(data=data.train,
class~.,
control = rpart.control(cp=0.001, minsplit=20))
print(pohon)
## n= 700
##
## node), split, n, loss, yval, (yprob)
## * denotes terminal node
##
## 1) root 700 210 good (0.30000000 0.70000000)
## 2) checking_status='<0','0<=X<200' 375 169 good (0.45066667 0.54933333)
## 4) duration>=22.5 164 66 bad (0.59756098 0.40243902)
## 8) savings_status='<100','500<=X<1000' 112 36 bad (0.67857143 0.32142857)
## 16) credit_history='all paid','delayed previously','no credits/all paid' 28 2 bad (0.92857143 0.07142857) *
## 17) credit_history='critical/other existing credit','existing paid' 84 34 bad (0.59523810 0.40476190)
## 34) duration>=47.5 16 2 bad (0.87500000 0.12500000) *
## 35) duration< 47.5 68 32 bad (0.52941176 0.47058824)
## 70) age< 36.5 49 18 bad (0.63265306 0.36734694)
## 140) purpose='new car',other,repairs 14 2 bad (0.85714286 0.14285714) *
## 141) purpose='used car',business,education,furniture/equipment,radio/tv 35 16 bad (0.54285714 0.45714286)
## 282) job='unskilled resident' 7 1 bad (0.85714286 0.14285714) *
## 283) job='high qualif/self emp/mgmt',skilled 28 13 good (0.46428571 0.53571429)
## 566) installment_commitment>=3.5 15 6 bad (0.60000000 0.40000000) *
## 567) installment_commitment< 3.5 13 4 good (0.30769231 0.69230769) *
## 71) age>=36.5 19 5 good (0.26315789 0.73684211) *
## 9) savings_status='>=1000','100<=X<500','no known savings' 52 22 good (0.42307692 0.57692308)
## 18) credit_history='existing paid','no credits/all paid' 32 13 bad (0.59375000 0.40625000)
## 36) credit_amount< 2559.5 7 0 bad (1.00000000 0.00000000) *
## 37) credit_amount>=2559.5 25 12 good (0.48000000 0.52000000)
## 74) savings_status='>=1000','100<=X<500' 13 4 bad (0.69230769 0.30769231) *
## 75) savings_status='no known savings' 12 3 good (0.25000000 0.75000000) *
## 19) credit_history='all paid','critical/other existing credit','delayed previously' 20 3 good (0.15000000 0.85000000) *
## 5) duration< 22.5 211 71 good (0.33649289 0.66350711)
## 10) credit_history='all paid','no credits/all paid' 17 3 bad (0.82352941 0.17647059) *
## 11) credit_history='critical/other existing credit','delayed previously','existing paid' 194 57 good (0.29381443 0.70618557)
## 22) credit_history='existing paid' 124 46 good (0.37096774 0.62903226)
## 44) other_parties='co applicant',none 111 46 good (0.41441441 0.58558559)
## 88) duration>=8.5 98 45 good (0.45918367 0.54081633)
## 176) credit_amount< 1384.5 40 14 bad (0.65000000 0.35000000)
## 352) employment='<1',unemployed 12 0 bad (1.00000000 0.00000000) *
## 353) employment='>=7','1<=X<4','4<=X<7' 28 14 bad (0.50000000 0.50000000)
## 706) residence_since< 3.5 15 4 bad (0.73333333 0.26666667) *
## 707) residence_since>=3.5 13 3 good (0.23076923 0.76923077) *
## 177) credit_amount>=1384.5 58 19 good (0.32758621 0.67241379)
## 354) property_magnitude='no known property' 9 3 bad (0.66666667 0.33333333) *
## 355) property_magnitude='life insurance','real estate',car 49 13 good (0.26530612 0.73469388) *
## 89) duration< 8.5 13 1 good (0.07692308 0.92307692) *
## 45) other_parties=guarantor 13 0 good (0.00000000 1.00000000) *
## 23) credit_history='critical/other existing credit','delayed previously' 70 11 good (0.15714286 0.84285714)
## 46) purpose='new car',education 28 8 good (0.28571429 0.71428571)
## 92) age< 35.5 7 2 bad (0.71428571 0.28571429) *
## 93) age>=35.5 21 3 good (0.14285714 0.85714286) *
## 47) purpose='domestic appliance','used car',business,furniture/equipment,other,radio/tv,repairs,retraining 42 3 good (0.07142857 0.92857143) *
## 3) checking_status='>=200','no checking' 325 41 good (0.12615385 0.87384615)
## 6) other_payment_plans=bank 37 13 good (0.35135135 0.64864865)
## 12) purpose='new car','used car' 14 6 bad (0.57142857 0.42857143) *
## 13) purpose=business,education,furniture/equipment,radio/tv 23 5 good (0.21739130 0.78260870) *
## 7) other_payment_plans=none,stores 288 28 good (0.09722222 0.90277778)
## 14) checking_status='>=200' 44 10 good (0.22727273 0.77272727) *
## 15) checking_status='no checking' 244 18 good (0.07377049 0.92622951)
## 30) credit_amount>=6687.5 22 6 good (0.27272727 0.72727273)
## 60) purpose='new car',business,furniture/equipment 11 5 bad (0.54545455 0.45454545) *
## 61) purpose='used car',education,radio/tv 11 0 good (0.00000000 1.00000000) *
## 31) credit_amount< 6687.5 222 12 good (0.05405405 0.94594595)
## 62) age< 22.5 10 3 good (0.30000000 0.70000000) *
## 63) age>=22.5 212 9 good (0.04245283 0.95754717)
## 126) job='high qualif/self emp/mgmt','unskilled resident' 61 7 good (0.11475410 0.88524590)
## 252) installment_commitment>=3.5 32 7 good (0.21875000 0.78125000)
## 504) purpose=business,furniture/equipment 7 3 bad (0.57142857 0.42857143) *
## 505) purpose='new car','used car',education,radio/tv,retraining 25 3 good (0.12000000 0.88000000) *
## 253) installment_commitment< 3.5 29 0 good (0.00000000 1.00000000) *
## 127) job='unemp/unskilled non res',skilled 151 2 good (0.01324503 0.98675497) *
Hasil dari pemodelan di atas tersimpan pada objek dengan nama
pohon yang berisi model pohon klasifikasi yang
dihasilkan.
Perintah di bawah ini dapat digunakan untuk menampilkan pohon yang terbentuk. Terlihat bahwa partisi pertama adalah menggunakan variabel “checking status”.
rpart.plot::rpart.plot(pohon)
library(rpart)
library(rpart.plot)
library(caret)
set.seed(123)
# Misal data sudah dipisah:
# data.train, data.test
# Tentukan grid parameter yang ingin diuji
nilai_minsplit <- c(5, 10, 20, 50, 100)
nilai_cp <- c(0.0005, 0.001, 0.005, 0.01, 0.02)
# Siapkan data.frame untuk menyimpan hasil
hasil <- expand.grid(
minsplit = nilai_minsplit,
cp = nilai_cp
)
hasil$accuracy <- NA
# Loop untuk uji kombinasi parameter
for (i in 1:nrow(hasil)) {
pohon_i <- rpart(
class ~ .,
data = data.train,
control = rpart.control(
minsplit = hasil$minsplit[i],
cp = hasil$cp[i]
)
)
# Prediksi di data test
pred_i <- predict(pohon_i, data.test, type = "class")
# Hitung akurasi
hasil$accuracy[i] <- mean(pred_i == data.test$class)
}
# Urutkan hasil dari akurasi tertinggi
hasil <- hasil[order(-hasil$accuracy), ]
# Tampilkan kombinasi terbaik
print(hasil)
## minsplit cp accuracy
## 13 20 5e-03 0.7466667
## 18 20 1e-02 0.7466667
## 5 100 5e-04 0.7366667
## 10 100 1e-03 0.7366667
## 15 100 5e-03 0.7366667
## 19 50 1e-02 0.7366667
## 20 100 1e-02 0.7366667
## 25 100 2e-02 0.7366667
## 21 5 2e-02 0.7333333
## 22 10 2e-02 0.7333333
## 23 20 2e-02 0.7333333
## 24 50 2e-02 0.7333333
## 3 20 5e-04 0.7300000
## 8 20 1e-03 0.7300000
## 12 10 5e-03 0.7300000
## 4 50 5e-04 0.7266667
## 9 50 1e-03 0.7266667
## 11 5 5e-03 0.7266667
## 14 50 5e-03 0.7266667
## 16 5 1e-02 0.7266667
## 17 10 1e-02 0.7266667
## 2 10 5e-04 0.7066667
## 7 10 1e-03 0.7066667
## 1 5 5e-04 0.6733333
## 6 5 1e-03 0.6733333
# Ambil parameter terbaik
best_minsplit <- hasil$minsplit[1]
best_cp <- hasil$cp[1]
cat("Parameter terbaik:\n")
## Parameter terbaik:
cat("minsplit =", best_minsplit, ", cp =", best_cp, "\n")
## minsplit = 20 , cp = 0.005
#Melihat hasilnya dalam grafik (misal bagaimana akurasi berubah terhadap minsplit dan cp):
library(ggplot2)
ggplot(hasil, aes(x = factor(minsplit), y = accuracy, fill = factor(cp))) +
geom_bar(stat = "identity", position = "dodge") +
labs(x = "minsplit", y = "Akurasi", fill = "cp") +
theme_minimal()
Berikut ini adalah proses untuk menghasilkan beberapa ukuran kinerja berdasarkan prediksinya di data testing.
Beberapa ukuran yang dihasilkan adalah: Akurasi: 73% Sensitivity (BAD): 45,56% Specificity (GOOD): 84,76% AUC: 26,6%
#memprediksi data testing
prediksi <- predict(pohon, data.test, type = "class")
head(prediksi, n = 10)
## 4 7 9 13 14 23 31 36 40 47
## good good good good good good good bad bad good
## Levels: bad good
# Evaluasi akurasi
library(caret)
confusionMatrix(prediksi, data.test$class)
## Confusion Matrix and Statistics
##
## Reference
## Prediction bad good
## bad 41 32
## good 49 178
##
## Accuracy : 0.73
## 95% CI : (0.676, 0.7794)
## No Information Rate : 0.7
## P-Value [Acc > NIR] : 0.14179
##
## Kappa : 0.3205
##
## Mcnemar's Test P-Value : 0.07544
##
## Sensitivity : 0.4556
## Specificity : 0.8476
## Pos Pred Value : 0.5616
## Neg Pred Value : 0.7841
## Prevalence : 0.3000
## Detection Rate : 0.1367
## Detection Prevalence : 0.2433
## Balanced Accuracy : 0.6516
##
## 'Positive' Class : bad
##
akurasi <- mean(prediksi == data.test$class)
cat("Akurasi model =", round(akurasi * 100, 2), "%\n")
## Akurasi model = 73 %
library(ROCit)
## Warning: package 'ROCit' was built under R version 4.5.2
# Prediksi probabilitas (bukan kelas)
prediksi_tree <- predict(pohon, data.test, type = "prob")
head(prediksi_tree)
## bad good
## 4 0.26315789 0.7368421
## 7 0.01324503 0.9867550
## 9 0.00000000 1.0000000
## 13 0.26530612 0.7346939
## 14 0.26315789 0.7368421
## 23 0.14285714 0.8571429
prediksi.status.tree<- ifelse(prediksi_tree[,2] > 0.5, "GOOD", "BAD")
# Hitung ROC (ganti "bad" sesuai nama kelas positif)
ngitungROC <- rocit(score=prediksi_tree[,2],class=data.test$class)
plot(ngitungROC)
# Nilai AUC
ngitungROC$AUC
## [1] 0.7333598
Di bawah ini proses menjalankan algoritma Random Forest di R dan menghitung kinerja prediksinya, dan diperoleh Beberapa ukuran yang dihasilkan adalah: (hasilnya dapat berbeda karena proses random) Akurasi: 83.26% Sensitivity (BAD): 70.20% Specificity (GOOD): 89.92% AUC: 89.60%
library(randomForest)
## Warning: package 'randomForest' was built under R version 4.5.2
## randomForest 4.7-1.2
## Type rfNews() to see new features/changes/bug fixes.
##
## Attaching package: 'randomForest'
## The following object is masked from 'package:ggplot2':
##
## margin
set.seed(100)
forest <- randomForest(data=data.train,
as.factor(class)~.,
ntree=500)
#memprediksi data testing
prediksi.f <- predict(forest, data.test, type="class")
head(prediksi.f, n=10)
## 4 7 9 13 14 23 31 36 40 47
## bad good good bad good good good bad good good
## Levels: bad good
#menghitung ukuran kinerja prediksi
confusionMatrix(prediksi.f, data.test$class)
## Confusion Matrix and Statistics
##
## Reference
## Prediction bad good
## bad 37 26
## good 53 184
##
## Accuracy : 0.7367
## 95% CI : (0.683, 0.7856)
## No Information Rate : 0.7
## P-Value [Acc > NIR] : 0.091793
##
## Kappa : 0.3142
##
## Mcnemar's Test P-Value : 0.003442
##
## Sensitivity : 0.4111
## Specificity : 0.8762
## Pos Pred Value : 0.5873
## Neg Pred Value : 0.7764
## Prevalence : 0.3000
## Detection Rate : 0.1233
## Detection Prevalence : 0.2100
## Balanced Accuracy : 0.6437
##
## 'Positive' Class : bad
##
akurasi <- mean(prediksi.f == data.test$class)
cat("Akurasi model Random Forest =", round(akurasi * 100, 2), "%\n")
## Akurasi model Random Forest = 73.67 %
#menghitung ROC
library(ROCit)
# Prediksi probabilitas (bukan kelas)
prediksi.f <- predict(pohon, data.test, type = "prob")
head(prediksi.f)
## bad good
## 4 0.26315789 0.7368421
## 7 0.01324503 0.9867550
## 9 0.00000000 1.0000000
## 13 0.26530612 0.7346939
## 14 0.26315789 0.7368421
## 23 0.14285714 0.8571429
prediksi.status.f <- ifelse(prediksi.f[,2] > 0.5, "GOOD", "BAD")
# Hitung ROC (ganti "bad" sesuai nama kelas positif)
ngitungROC <- rocit(score=prediksi.f[,2],class=data.test$class)
plot(ngitungROC)
AUC <- ngitungROC$AUC
AUC
## [1] 0.7333598
Kesimpulan:
| Tree | Random Forest | |
|---|---|---|
| Akurasi | 73% | 75% |
| Sensitivity (BAD) | 45,56% | 34,44% |
| Specificity (GOOD) | 84,76% | 92,38% |
| AUC | 73,33% | 73,33% |
| Kappa | 32,05% | 31,07% |