Code/Syntax : File.rmd
Pendahuluan
Deskripsi Tugas
Suatu perusahaan perbank-kan meneliti 75 jenis skema pinjaman yang
telah diberi rating oleh para customernya pada
data ann.csv.
Variabel yang digunakan ialah:
Besar pinjaman (dalam juta rupiah)
Lama pembayaran (dalam tahun)
Tambahan bunga yang ditetapkan (dalam %)
Pembayaran per bulan (dalam 10000)
Banyak cash back yang diterapkan pada skema tersebut
Tujuan penelitian yang dilakukan ialah memprediksi rating skema pinjaman berdasarkan variabel-variabel tersebut. Bantulah peneliti tersebut untuk memprediksi reating skema pinjaman dengan neural network, hitunglah RMSE prediksinya.
Ketentuan Tugas
Gunakan data ann.csv
Kerjakan prediksi rating skema pinjaman dengan neural network, hitunglah RMSE prediksinya
Kirimkan kode R beserta output dan interpretasinya pada file dengan format pdf
Batas waktu pengiriman adalah Hari Senin, tanggal 26 Februari 2024 jam 13:00 WIB
Data
data <- read.csv("data ann.csv")
#Data Type
str(data)## 'data.frame': 75 obs. of 6 variables:
## $ besar.pinjaman : int 70 120 70 50 110 110 130 90 90 120 ...
## $ lama.pembayaran : int 4 3 4 4 2 2 3 2 3 1 ...
## $ bunga : int 1 5 1 0 2 0 2 1 0 2 ...
## $ pembayaran.per.bulan: int 130 15 260 140 180 125 210 200 210 220 ...
## $ banyak.cash.back : num 10 2 9 14 1.5 1 2 4 5 0 ...
## $ rating : num 68.4 34 59.4 93.7 29.5 ...Semua peubah merupakan peubah numerik, tidak ada yang perlu diubah.
Missing Value
colSums(is.na(data))## besar.pinjaman lama.pembayaran bunga
## 0 0 0
## pembayaran.per.bulan banyak.cash.back rating
## 0 0 0Terlihat bahwa tidak ada missing value.
Sebaran Rating
install_load('ggtext')
chart <-
ggplot(data, aes(x=rating,
y='')) +
#Violin
geom_violin(scale="count", fill='#4692A0', color='black', alpha=.65,
trim = FALSE) +
#Boxplot
geom_boxplot(fill='#49535C', color='black',
outlier.size=4, outlier.color='#49535C',
notch=T, width=0.2) +
#Mean Marker
stat_summary(fun = mean, geom = "point", shape = 16, size = 4,
color = "#AB8264") +
theme(plot.title = element_text(hjust=0.5),legend.position = "none") +
labs(x = "\nRating", y='',
title = "Sebaran Rating Skema Pinjaman") + theme2 +
#Tambah Mean Value
geom_richtext(
data = data.frame(x = mean(data$rating), y = 1.25,
label = paste("Mean:",
round(mean(data$rating),
2))),
aes(x, y, label = label), size = 7, color = "white",
fill = "#AB8264", box.color = "white", parse = TRUE
) +
#Tambah panah
geom_segment(aes(x = mean(data$rating),
xend = mean(data$rating),
y = 1,
yend = 1.2225),
arrow = arrow(type = "closed", length = unit(0.1, "inches")),
lineend = "round", color = "#AB8264", size=1.5)
chart
#Export Chart
ggsave("01_Sebaran Rating Skema Pinjaman.png", chart, path = export.chart,
dpi = 300, height = 10, width = 20)Rating Skema pinjaman ternyata tidak terlalu bagus. Dari skala 0 sampai 100, median dan rata-rata rating nya berada dibawah 50.
Model Regresi - Tanh
Splitting Data & Scaling
Data perlu dilakukan scaling, agar skala dari setiap peubah sama.
set.seed(123)
# Train-Testing Split
train.index <- createDataPartition(data$rating, p = 0.8, list = FALSE)
train <- data[train.index, ]
test <- data[-train.index, ]
# Melakukan Feature Scaling min max (0, 1)
preprocessParams <- preProcess(train[, -ncol(data)], method=c("range"))
train_X <- as.matrix(predict(preprocessParams, train[, -ncol(data)]))
test_X <- as.matrix(predict(preprocessParams, test[, -ncol(data)]))
train_y <- train[, ncol(data)]
test_y <- test[, ncol(data)]Pemodelan
# Membuat model neural network
model.tanh <- keras_model_sequential() %>%
#Input
layer_dense(units = 128, activation = "tanh", input_shape = ncol(train_X)) %>%
layer_dropout(0.3) %>%
#Hidden layer 1
layer_dense(units = 128, activation = "tanh") %>%
layer_dropout(0.3) %>%
#Hidden layer 2
layer_dense(units = 128, activation = "tanh") %>%
layer_dropout(0.3) %>%
#Output
layer_dense(units = 1, activation = "linear")
# Mengkompilasi model
model.tanh %>% compile(
loss = "mean_squared_error",
optimizer = "adam",
metrics = list("mean_squared_error", "mean_absolute_error")
)
# Melakukan tahapan pelatihan model
history.tanh <- model.tanh %>% fit(
train_X, train_y,
shuffle = T,
epochs = 100,
batch_size = 32,
validation_split = 0.2
)print(model.tanh)## Model: "sequential"
## ________________________________________________________________________________
## Layer (type) Output Shape Param #
## ================================================================================
## dense_3 (Dense) (None, 128) 768
## dropout_2 (Dropout) (None, 128) 0
## dense_2 (Dense) (None, 128) 16512
## dropout_1 (Dropout) (None, 128) 0
## dense_1 (Dense) (None, 128) 16512
## dropout (Dropout) (None, 128) 0
## dense (Dense) (None, 1) 129
## ================================================================================
## Total params: 33921 (132.50 KB)
## Trainable params: 33921 (132.50 KB)
## Non-trainable params: 0 (0.00 Byte)
## ________________________________________________________________________________Dari hasil di atas, model ANN memiliki 2 hidden layer. Berikut merupakan informasi lengkapnya:
Model terdiri dari 3 lapisan Dense (fully connected) diikuti oleh Dropout.
Input Layer memiliki 64 unit dengan total parameter 384 (64*input_dim + 64 bias units)
Dropout pertama tidak menambahkan parameter apa pun. Ini hanya men-dropout sebagian unit saat training.
Lapisan Dense kedua memiliki 64 unit dengan total parameter 4160 (64*64 + 64 bias units)
Dropout kedua tidak menambahkan parameter lagi.
Lapisan Dense ketiga berfungsi sebagai output layer, memiliki 1 unit untuk regresi. Total parameter 65 (64*1 + 1 bias unit)
Secara keseluruhan model memiliki 4609 parameter latih yang dapat dipelajari melalui backpropagation gradient descent.
Model menerapkan regularization berupa dropout untuk mencegah overfitting ke data latih.
Arsitektur model cukup sederhana dengan 3 lapisan dense tetapi dropout membantunya menangani overfitting dengan baik.
Plot History
plot(history.tanh)
Overfitting terjadi ketika data training terus menurun sedangkan
validasi malah menaik. Ketiga plot di atas menunjukkan bahwa model tidak
mengalami overfitting. Ini berarti bisa dicobakan dengan
layer_dropout yang lebih kecil.
Prediksi
# Evaluasi Model dengan data Test
prediksi.tanh <- predict(model.tanh, test_X) %>% as.data.frame()## 1/1 - 0s - 88ms/epoch - 88ms/stepdatatable(prediksi.tanh, filter = 'top',
options = list(pageLength = 6))chart <-
ggplot(prediksi.tanh, aes(x=V1,
y='')) +
#Violin
geom_violin(scale="count", fill='#4692A0', color='black', alpha=.65,
trim = FALSE) +
#Boxplot
geom_boxplot(fill='#49535C', color='black',
outlier.size=4, outlier.color='#49535C',
notch=F, width=0.2) +
#Mean Marker
stat_summary(fun = mean, geom = "point", shape = 16, size = 4,
color = "#AB8264") +
theme(plot.title = element_text(hjust=0.5),legend.position = "none") +
labs(x = "\nPrediksi Rating", y='',
title = "Sebaran Prediksi Rating Skema Pinjaman") + theme2 +
#Tambah Mean Value
geom_richtext(
data = data.frame(x = mean(prediksi.tanh$V1), y = 1.25,
label = paste("Mean:",
round(mean(prediksi.tanh$V1),
2))),
aes(x, y, label = label), size = 7, color = "white",
fill = "#AB8264", box.color = "white", parse = TRUE
) +
#Tambah panah
geom_segment(aes(x = mean(prediksi.tanh$V1),
xend = mean(prediksi.tanh$V1),
y = 1,
yend = 1.2225),
arrow = arrow(type = "closed", length = unit(0.1, "inches")),
lineend = "round", color = "#AB8264", size=1.5)
chart
#Export Chart
ggsave("02_Sebaran Prediksi Rating Skema Pinjaman.png", chart, path = export.chart,
dpi = 300, height = 10, width = 20)Hasil prediksi nya justru lebih buruk daripada rating data aslinya, bahkan nilai tertinggi nya saja berada dibawah 35.
Evaluasi Model
# Mengevaluasi model menggunakan data uji
scores.tanh <- model.tanh %>% evaluate(test_X, test_y)## 1/1 - 0s - loss: 243.4090 - mean_squared_error: 243.4090 - mean_absolute_error: 11.6421 - 24ms/epoch - 24ms/stepprint(scores.tanh)## loss mean_squared_error mean_absolute_error
## 243.40898 243.40898 11.64215MSE dan MAE cukup tinggi, mengindikasikan error prediksi yang besar.
keras_train.tanh <- model.tanh %>% predict(train_X)## 2/2 - 0s - 23ms/epoch - 11ms/stepkeras_test.tanh <- model.tanh %>% predict(test_X)## 1/1 - 0s - 19ms/epoch - 19ms/step# Training Evaluation
postResample(keras_train.tanh[,1], train$rating)## RMSE Rsquared MAE
## 16.67533715 0.05749128 12.32506958# Testing Evaluation
postResample(keras_test.tanh[,1], test$rating)## RMSE Rsquared MAE
## 15.6015698 0.3001302 11.6421463Model dengan 3 hidden layer dengan 128 unit per layer nya yang dikombinasikan dengan fungsi aktifasi tanh menghasilkan RMSE sebesar 15.87, error cukup besar. Dikatakan bahwa fungsi aktivasi Sigmoid & Tanh Kurang direkomendasikan karena efek “vanishing gradient”, tapi kadang digunakan juga. R-squared sangat kecil, model hanya bisa menjelaskan 5,7% variansi target. MAE training 11,65, error absolut cukup tinggi.
Kesimpulan
Model memiliki performa buruk, ditunjukkan oleh error prediksi yang besar dan R-squared kecil. Terjadi overfitting yang ditunjukkan oleh gap antara metric training dan testing. Perlu dilakukan perbaikan arsitektur dan regularisasi model untuk meningkatkan performanya.
Model Regresi - ReLU
Pemodelan
# Membuat model neural network
model.relu <- keras_model_sequential() %>%
#Input
layer_dense(units = 128, activation = "relu", input_shape = ncol(train_X)) %>%
layer_dropout(0.3) %>%
#Hidden layer 1
layer_dense(units = 128, activation = "relu") %>%
layer_dropout(0.3) %>%
#Hidden layer 2
layer_dense(units = 128, activation = "relu") %>%
layer_dropout(0.3) %>%
#Output
layer_dense(units = 1, activation = "linear")
# Mengkompilasi model
model.relu %>% compile(
loss = "mean_squared_error",
optimizer = "adam",
metrics = list("mean_squared_error", "mean_absolute_error")
)
# Melakukan tahapan pelatihan model
history.relu <- model.relu %>% fit(
train_X, train_y,
shuffle = T,
epochs = 100,
batch_size = 32,
validation_split = 0.2
)print(model.relu)## Model: "sequential_1"
## ________________________________________________________________________________
## Layer (type) Output Shape Param #
## ================================================================================
## dense_7 (Dense) (None, 128) 768
## dropout_5 (Dropout) (None, 128) 0
## dense_6 (Dense) (None, 128) 16512
## dropout_4 (Dropout) (None, 128) 0
## dense_5 (Dense) (None, 128) 16512
## dropout_3 (Dropout) (None, 128) 0
## dense_4 (Dense) (None, 1) 129
## ================================================================================
## Total params: 33921 (132.50 KB)
## Trainable params: 33921 (132.50 KB)
## Non-trainable params: 0 (0.00 Byte)
## ________________________________________________________________________________Dari hasil di atas, model ANN memiliki 2 hidden layer. Berikut merupakan informasi lengkapnya:
Model neural network untuk regresi dengan 4 lapisan dense dan 3 lapisan dropout di antaranya.
Input layer memiliki 128 unit, hidden layer 1 dan 2 masing-masing 128 unit, output layer 1 unit.
Total parameter sebanyak 33,921 yang dilatihkan.
Dropout diterapkan untuk mencegah overfitting.
plot(history.relu)
Overfitting terjadi ketika data training terus menurun sedangkan
validasi malah menaik. Ketiga plot di atas menunjukkan bahwa model
beberapa kali mengalami overfitting (jarang). Ini berarti bisa dicobakan
dengan layer_dropout yang lebih besar.
Prediksi
# Evaluasi Model dengan data Test
prediksi.relu <- predict(model.relu, test_X) %>% as.data.frame()## 1/1 - 0s - 83ms/epoch - 83ms/stepdatatable(prediksi.relu, filter = 'top',
options = list(pageLength = 6))chart <-
ggplot(prediksi.relu, aes(x=V1,
y='')) +
#Violin
geom_violin(scale="count", fill='#4692A0', color='black', alpha=.65,
trim = FALSE) +
#Boxplot
geom_boxplot(fill='#49535C', color='black',
outlier.size=4, outlier.color='#49535C',
notch=F, width=0.2) +
#Mean Marker
stat_summary(fun = mean, geom = "point", shape = 16, size = 4,
color = "#AB8264") +
theme(plot.title = element_text(hjust=0.5),legend.position = "none") +
labs(x = "\nPrediksi Rating", y='',
title = "Sebaran Prediksi Rating Skema Pinjaman") + theme2 +
#Tambah Mean Value
geom_richtext(
data = data.frame(x = mean(prediksi.relu$V1), y = 1.25,
label = paste("Mean:",
round(mean(prediksi.relu$V1),
2))),
aes(x, y, label = label), size = 7, color = "white",
fill = "#AB8264", box.color = "white", parse = TRUE
) +
#Tambah panah
geom_segment(aes(x = mean(prediksi.relu$V1),
xend = mean(prediksi.relu$V1),
y = 1,
yend = 1.2225),
arrow = arrow(type = "closed", length = unit(0.1, "inches")),
lineend = "round", color = "#AB8264", size=1.5)
chart
#Export Chart
ggsave("03_Sebaran Prediksi Rating Skema Pinjaman.png", chart, path = export.chart,
dpi = 300, height = 10, width = 20)Berbeda dengan sebelumnya, walaupun hasil prediksi rating tidak lebih baik dari rating data aslinya, namun jauh lebih baik daripada model dengan fungsi aktivasi tanh. Bisa dilihat bahwa sebaran hasil prediksi dari model ANN dengan fungsi aktifvasi ReLU memiliki nilai minimal 26.83 dan maksimal 61.05. Dengan nilai rata-rata 39.36 dan nilai median berada dibawahnya.
Evaluasi Model
# Mengevaluasi model menggunakan data uji
scores.relu<- model.relu %>% evaluate(test_X, test_y)## 1/1 - 0s - loss: 36.7818 - mean_squared_error: 36.7818 - mean_absolute_error: 4.6342 - 23ms/epoch - 23ms/stepprint(scores.relu)## loss mean_squared_error mean_absolute_error
## 36.781811 36.781811 4.634151Loss selama pelatihan adalah MSE sebesar 39,35, cukup kecil. MAE sebesar 4,87 juga kecil, indikasi error prediksi rendah.
keras_train.relu <- model.relu %>% predict(train_X)## 2/2 - 0s - 23ms/epoch - 11ms/stepkeras_test.relu <- model.relu %>% predict(test_X)## 1/1 - 0s - 21ms/epoch - 21ms/step# Training Evaluation
postResample(keras_train.relu[,1], train$rating)## RMSE Rsquared MAE
## 6.5052177 0.8027502 5.3271687# Testing Evaluation
postResample(keras_test.relu[,1], test$rating)## RMSE Rsquared MAE
## 6.064802 0.838049 4.634151Model dengan 3 hidden layer dengan 128 unit per layer nya yang dikombinasikan dengan fungsi aktifasi ReLU menghasilkan RMSE testing = 6.27, R-squared = 0.85, MAE test = 4.87. Evaluasi model di data testing juga bagus. Tidak terdeteksi overfitting yang signifikan karena metric training dan testing sangat mirip. Dikatakan bahwa ReLU Sering menjadi pilihan default untuk hidden layer pada model regresi. Menghasilkan non-linearitas tanpa efek “vanishing gradient”.
Kesimpulan
Model regresi neural network memiliki performa sangat bagus ditunjukkan oleh RMSE dan MAE kecil serta R-squared tinggi mendekati 1. Tidak terjadi overfitting parah. Model telah berhasil memodelkan pola hubungan dengan sangat baik.