Level Risiko Investasi Menggunakan Berbagai Model dengan Analisis Pengaruh Variabel
Overview
Analisis ini akan mengklasifikasikan tingkat risiko investasi
menggunakan beberapa algoritma machine learning. Kita melakukan
prepocessing data, menerapkan SMOTE untuk menyeimbangkan kelas,
menggunakan beberapa model untuk melihat tingkat akurasi,
memvisualisasikan performansinya, dan membandingkannya berdasarkan
akurasi. Selain itu, kita akan menganalisis pengaruh variabel
X1 hingga X14 terhadap faktor
Risk.Level.
Data Preprocessing
Memuat Library yang Dibutuhkan dan Data
Memuat library yang diperlukan dan membaca data dari file CSV.
library(tidyverse)
library(caret)
library(DMwR)
library(class)
library(glmnet)
library(randomForest)
library(e1071)
library(caretEnsemble)
library(boot)
library(corrplot)data <- read.csv("Level Risiko Investasi_training.csv", stringsAsFactors = FALSE)
variable_descriptions <- read.csv("Level Risiko Investasi_ket.csv", stringsAsFactors = FALSE)
# Menghapus baris yang mengandung NA
data_clean <- na.omit(data)
# Mengubah Risk.Level menjadi faktor
data_clean$Risk.Level <- factor(data_clean$Risk.Level, levels = c("low", "high"))
# Menghapus Non-numerik kolom selain Risk.Level
numeric_cols <- sapply(data_clean, is.numeric)
data_clean <- data_clean[, c(which(numeric_cols), which(names(data_clean) == "Risk.Level"))]Preprocess the Data
Melakukan preprocessing data, seperti menghapus data yang hilang, mengubah tipe data, dan menormalisasi data.
# Cek nilai yang tak terhingga dan menggantinya dengan NA
data_clean[sapply(data_clean, is.infinite)] <- NA
# Hapus baris dengan nilai NA lagi (jika ada nilai tak terhingga)
data_clean <- na.omit(data_clean)
# Periksa prediktor varians yang mendekati nol
nzv <- nearZeroVar(data_clean[, -ncol(data_clean)], saveMetrics = TRUE)
print(nzv[nzv$nzv, ])## [1] freqRatio percentUnique zeroVar nzv
## <0 rows> (or 0-length row.names)# Menghapus prediktor varians yang mendekati nol
data_clean <- data_clean[, c(!nzv$nzv, TRUE)]
# Menormalkan fitur numerik
preprocess_range <- preProcess(data_clean[, -ncol(data_clean)], method = c("range"))
data_normalized <- predict(preprocess_range, data_clean)
# Memeriksa distribusi kelas
print(table(data_normalized$Risk.Level))##
## low high
## 35 31# Mencetak ringkasan data yang telah diproses sebelumnya
print(summary(data_normalized))## X1 X2 X3 X4
## Min. :0.0000 Min. :0.00000 Min. :0.000000 Min. :0.00000
## 1st Qu.:0.2757 1st Qu.:0.02784 1st Qu.:0.004677 1st Qu.:0.05104
## Median :0.3273 Median :0.10274 Median :0.009857 Median :0.09975
## Mean :0.3480 Mean :0.18602 Mean :0.030788 Mean :0.15176
## 3rd Qu.:0.4062 3rd Qu.:0.29863 3rd Qu.:0.017064 3rd Qu.:0.20938
## Max. :1.0000 Max. :1.00000 Max. :1.000000 Max. :1.00000
## X5 X6 X7 X8
## Min. :0.0000 Min. :0.0000 Min. :0.0000 Min. :0.0000
## 1st Qu.:0.2594 1st Qu.:0.3121 1st Qu.:0.5736 1st Qu.:0.1020
## Median :0.4334 Median :0.4106 Median :0.6506 Median :0.1464
## Mean :0.4133 Mean :0.4304 Mean :0.6494 Mean :0.1782
## 3rd Qu.:0.5074 3rd Qu.:0.5187 3rd Qu.:0.7589 3rd Qu.:0.2234
## Max. :1.0000 Max. :1.0000 Max. :1.0000 Max. :1.0000
## X9 X10 X11 X12
## Min. :0.0000 Min. :0.000000 Min. :0.00000 Min. :0.0000
## 1st Qu.:0.9297 1st Qu.:0.002202 1st Qu.:0.05524 1st Qu.:0.2480
## Median :0.9416 Median :0.010895 Median :0.10828 Median :0.3444
## Mean :0.9209 Mean :0.045677 Mean :0.15331 Mean :0.3867
## 3rd Qu.:0.9511 3rd Qu.:0.024342 3rd Qu.:0.20130 3rd Qu.:0.4789
## Max. :1.0000 Max. :1.000000 Max. :1.00000 Max. :1.0000
## X13 X14 Risk.Level
## Min. :0.0000 Min. :0.0000 low :35
## 1st Qu.:0.1927 1st Qu.:0.1959 high:31
## Median :0.2955 Median :0.2601
## Mean :0.3176 Mean :0.3279
## 3rd Qu.:0.4137 3rd Qu.:0.3867
## Max. :1.0000 Max. :1.0000# Feature engineering: Membuat fitur baru dengan menggabungkan fitur yang sudah ada
data_clean <- data_normalized %>%
mutate(
X_avg = rowMeans(select(., X1:X14), na.rm = TRUE),
X_sum = rowSums(select(., X1:X14), na.rm = TRUE),
X_ratio = X_sum / X_avg,
X_variance = apply(select(., X1:X14), 1, var, na.rm = TRUE),
X_range = apply(select(., X1:X14), 1, function(x) max(x, na.rm = TRUE) - min(x, na.rm = TRUE))
)
# Deteksi pencilan menggunakan metode IQR
numeric_data <- data_clean[, sapply(data_clean, is.numeric)]
outliers <- matrix(FALSE, nrow = nrow(numeric_data), ncol = ncol(numeric_data))
for (i in seq_along(numeric_data)) {
Q1 <- quantile(numeric_data[, i], 0.25, na.rm = TRUE)
Q3 <- quantile(numeric_data[, i], 0.75, na.rm = TRUE)
IQR <- Q3 - Q1
outliers[, i] <- numeric_data[, i] < (Q1 - 1.5 * IQR) | numeric_data[, i] > (Q3 + 1.5 * IQR)
}
# Menghapus baris dengan pencilan apa pun
data_clean <- data_clean[!rowSums(outliers), ]
# Skala fitur numerik
preProcValues <- preProcess(data_clean[, -ncol(data_clean)], method = c("center", "scale"))
data_scaled <- predict(preProcValues, data_clean)Analisis Variabel Berpengaruh
Menganalisis hubungan antara variabel-variabel dalam data.
# Analisis korelasi
correlation_matrix <- cor(data_scaled[, 1:14])
corrplot(correlation_matrix, method = "color", type = "upper", order = "hclust",
tl.col = "black", tl.srt = 45)
# Regresi logistik
logistic_model <- glm(Risk.Level ~ ., data = data_scaled, family = "binomial")## Warning: glm.fit: algorithm did not converge## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurredsummary(logistic_model)##
## Call:
## glm(formula = Risk.Level ~ ., family = "binomial", data = data_scaled)
##
## Coefficients: (2 not defined because of singularities)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.356e+03 2.979e+07 0 1
## X1 5.448e+00 2.351e+05 0 1
## X2 -1.930e+01 2.651e+05 0 1
## X3 -2.978e+01 2.220e+05 0 1
## X4 -1.217e+01 4.214e+05 0 1
## X5 3.849e+00 4.248e+05 0 1
## X6 -3.473e+00 2.662e+05 0 1
## X7 2.489e+01 4.734e+05 0 1
## X8 3.429e+01 2.910e+05 0 1
## X9 3.003e+01 4.653e+05 0 1
## X10 -3.829e+01 2.022e+05 0 1
## X11 1.410e+01 2.416e+05 0 1
## X12 2.805e+01 4.083e+05 0 1
## X13 -3.437e+01 4.944e+05 0 1
## X14 -1.148e+01 1.662e+05 0 1
## X_avg NA NA NA NA
## X_sum NA NA NA NA
## X_ratio -2.844e+01 1.791e+05 0 1
## X_variance -7.065e+00 4.236e+05 0 1
## X_range -1.460e+03 3.175e+07 0 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4.4361e+01 on 31 degrees of freedom
## Residual deviance: 5.9277e-10 on 14 degrees of freedom
## AIC: 36
##
## Number of Fisher Scoring iterations: 25# Random Forest
rf_importance <- randomForest(Risk.Level ~ ., data = data_scaled, importance = TRUE)
varImpPlot(rf_importance, main = "Variable Importance")
# ANOVA untuk variabel kategorik
anova_results <- aov(as.numeric(Risk.Level) ~ ., data = data_scaled)
summary(anova_results)## Df Sum Sq Mean Sq F value Pr(>F)
## X1 1 0.2347 0.2347 2.205 0.159769
## X2 1 2.6644 2.6644 25.024 0.000194 ***
## X3 1 0.0164 0.0164 0.154 0.700781
## X4 1 0.0327 0.0327 0.307 0.588408
## X5 1 0.3930 0.3930 3.691 0.075313 .
## X6 1 0.4908 0.4908 4.609 0.049805 *
## X7 1 0.0316 0.0316 0.297 0.594577
## X8 1 0.0199 0.0199 0.187 0.672265
## X9 1 1.6596 1.6596 15.587 0.001457 **
## X10 1 0.3023 0.3023 2.839 0.114160
## X11 1 0.0678 0.0678 0.637 0.438101
## X12 1 0.0243 0.0243 0.228 0.640114
## X13 1 0.0574 0.0574 0.539 0.474788
## X14 1 0.0002 0.0002 0.002 0.967628
## X_ratio 1 0.1744 0.1744 1.638 0.221458
## X_variance 1 0.0134 0.0134 0.126 0.727689
## X_range 1 0.3265 0.3265 3.066 0.101798
## Residuals 14 1.4906 0.1065
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Variabel dengan nilai Pr(>F) yang kecil (biasanya kurang dari
0.05) dianggap memiliki pengaruh yang signifikan. Berdasarkan output,
variabel X2, X6, X9, dan
X5 mungkin memiliki pengaruh yang signifikan. Peringatan
dalam output ANOVA menunjukkan bahwa model mungkin tidak dapat
diandalkan untuk menarik kesimpulan yang akurat tentang pengaruh
variabel prediktor terhadap Risk.Level karrena adanya
peringatan yang menunjukkan bahwa algoritma regresi logistik tidak dapat
mencapai solusi yang stabil dan estimasi probabilitas untuk kelas “high”
dan “low” mungkin mendekati 0 atau 1.
Mengaplikasikan SMOTE
Mengatasi masalah ketidakseimbangan kelas dalam data dengan menggunakan teknik SMOTE. SMOTE (Synthetic Minority Over-sampling Technique) adalah teknik yang digunakan dalam pembelajaran mesin untuk mengatasi masalah ketidakseimbangan kelas dalam data. Ketidakseimbangan kelas terjadi ketika jumlah data pada satu kelas jauh lebih banyak daripada kelas lainnya.
set.seed(42)
data_balanced <- SMOTE(Risk.Level ~ ., data = data_scaled, perc.over = 100, perc.under = 200)
# Deteksi distribusi kelas baru
print(table(data_balanced$Risk.Level))##
## low high
## 32 32jumlah data pada kelas “low” dan “high” sekarang sama, yaitu 32 data untuk masing-masing kelas.
Membagi Data (Split Data)
Membagi data menjadi data training (80%) dan data testing (20%). Data training digunakan untuk melatih model, sedangkan data testing digunakan untuk mengevaluasi performa model.
set.seed(42)
train_index <- createDataPartition(data_balanced$Risk.Level, p = 0.8, list = FALSE)
train_data <- data_balanced[train_index, ]
test_data <- data_balanced[-train_index, ]Model Training
Dalam model training, untuk mencari akurasi digunakan fungsi
ConfusionMatrix dari package caret. Confusion matrix adalah
sebuah tabel yang digunakan untuk mengevaluasi kinerja model klasifikasi
dengan membandingkan prediksi model dengan nilai sebenarnya dari
data.
K-Nearest Neighbors (KNN)
model K-Nearest Neighbors (KNN) menggunakan dataset latih
train_data dan metode train() dari package
caret. Parameter tuneLength = 10 digunakan untuk mencari
nilai optimal dari tetangga k, dan cross-validation dengan 10 fold
dilakukan untuk melatih model. Setelah model dilatih, prediksi dilakukan
pada data uji test_data, dan akurasi model dihitung
menggunakan confusion matrix.
set.seed(42)
knn_model <- train(Risk.Level ~ ., data = train_data, method = "knn", tuneLength = 10)
# Predictions
knn_predictions <- predict(knn_model, newdata = test_data)
knn_accuracy <- confusionMatrix(knn_predictions, test_data$Risk.Level)$overall['Accuracy']
print(knn_accuracy)## Accuracy
## 0.8333333Hasil model K-Nearest Neighbors (KNN) menunjukkan bahwa akurasi model adalah 0.8333 atau 83.33%. Model KNN dapat memprediksi dengan benar 83.33% dari total data uji yang digunakan.
Support Vector Machine (SVM)
Model Support Vector Machine (SVM) dengan kernel Radial Basis
Function (RBF). Data latih train_data digunakan bersama
dengan metode svmRadial dari package caret. Setelah model
SVM dilatih, prediksi dilakukan pada data uji, dan akurasi model
dihitung menggunakan confusion matrix untuk mengukur kinerja klasifikasi
pada data yang belum pernah dilihat.
set.seed(42)
svm_model <- train(Risk.Level ~ ., data = train_data, method = "svmRadial")
# Predictions
svm_predictions <- predict(svm_model, newdata = test_data)
svm_accuracy <- confusionMatrix(svm_predictions, test_data$Risk.Level)$overall['Accuracy']
print(svm_accuracy)## Accuracy
## 1Hasil model Support Vector Machine (SVM) menunjukkan bahwa akurasi model adalah 1 atau 100%, yang berarti model SVM berhasil memprediksi dengan benar semua data dalam dataset uji.
Random Forest
Model Random Forest menggunakan dataset train_data
dengan metode rf dari caret. Random Forest membangun banyak
pohon keputusan, dan hasil prediksi mereka digabungkan untuk
meningkatkan akurasi. Setelah model dilatih, prediksi dibuat pada
test_data, dan akurasi dihitung untuk mengukur performa
model.
set.seed(42)
rf_model <- train(Risk.Level ~ ., data = train_data, method = "rf")
# Predictions
rf_predictions <- predict(rf_model, newdata = test_data)
rf_accuracy <- confusionMatrix(rf_predictions, test_data$Risk.Level)$overall['Accuracy']
print(rf_accuracy)## Accuracy
## 0.9166667Hasil model Random Forest menunjukkan bahwa akurasi model adalah 0.9167 atau 91.67%. Ini berarti model Random Forest mampu memprediksi dengan benar 91.67% dari total data uji.
Tuned Random Forest
Model Random Forest dengan tuning hyperparameter menggunakan grid
search, mengeksplorasi kombinasi terbaik dari parameter
mtry (jumlah fitur yang digunakan pada setiap split) dan
min.node.size (ukuran node minimum) dengan
cross-validation (5 fold). Setelah kombinasi terbaik
ditemukan, model dilatih dan prediksi dilakukan pada data uji untuk
menghitung akurasi.
tuneGrid <- expand.grid(mtry = c(2, 4, 6),
min.node.size = c(1, 5, 10),
splitrule = "gini")
trainControl <- trainControl(method = "cv", number = 5)
rf_tuned <- train(Risk.Level ~ .,
data = train_data,
method = "ranger",
tuneGrid = tuneGrid,
trControl = trainControl)
# Predictions
rf_tuned_predictions <- predict(rf_tuned, newdata = test_data)
rf_tuned_accuracy <- confusionMatrix(rf_tuned_predictions, test_data$Risk.Level)$overall['Accuracy']
print(rf_tuned_accuracy)## Accuracy
## 1Hasil model Tuned Random Forest menunjukkan bahwa akurasi model adalah 1 atau 100%, yang berarti model ini berhasil memprediksi seluruh data uji dengan benar.
Logistic Regression
Model Logistic Regression dengan penalized regression menggunakan
metode glmnet untuk mencegah overfitting melalui
regularisasi Lasso atau Ridge. Cross-validation dengan 10 fold digunakan
untuk menemukan hyperparameter terbaik. Setelah model dilatih pada
train_data, prediksi dibuat pada test_data,
dan akurasi dihitung untuk mengevaluasi model.
set.seed(42)
# Use Lasso (alpha = 1) or Ridge (alpha = 0) regularization
logreg_model <- train(Risk.Level ~ .,
data = train_data,
method = "glmnet",
trControl = trainControl(method = "cv", number = 10),
tuneLength = 10)
# Predictions
logreg_predictions <- predict(logreg_model, newdata = test_data)
logreg_accuracy <- confusionMatrix(logreg_predictions, test_data$Risk.Level)$overall['Accuracy']
print(logreg_accuracy)## Accuracy
## 1Hasil model Logistic Regression menunjukkan bahwa akurasi model adalah 1 atau 100%, yang berarti model ini berhasil memprediksi seluruh data uji dengan benar.
Model Comparison
Membandingkan kinerja dari semua model yang telah dilatih (KNN, SVM,
Random Forest, Tuned Random Forest, dan Logistic Regression) berdasarkan
akurasi. Kemudian membuat tabel menggunakan ggplot2 untuk
memvisualisasikan perbandingan akurasi dalam bentuk bar plot, yang
memberikan representasi visual dari kinerja setiap model.
# Create a data frame for model comparison
model_comparison <- data.frame(
Model = c("KNN", "SVM", "Random Forest", "Tuned Random Forest", "Logistic Regression"),
Accuracy = c(knn_accuracy, svm_accuracy, rf_accuracy, rf_tuned_accuracy, logreg_accuracy)
)
# Display the comparison
print(model_comparison)## Model Accuracy
## 1 KNN 0.8333333
## 2 SVM 1.0000000
## 3 Random Forest 0.9166667
## 4 Tuned Random Forest 1.0000000
## 5 Logistic Regression 1.0000000# Visualize Model Comparison
ggplot(model_comparison, aes(x = Model, y = Accuracy, fill = Model)) +
geom_bar(stat = "identity") +
theme_minimal() +
labs(title = "Model Comparison based on Accuracy", y = "Accuracy", x = "Model") +
scale_fill_brewer(palette = "Set2") +
geom_text(aes(label = round(Accuracy, 2)), vjust = -0.5)
SVM, Tuned Random Forest, dan Logistic Regression mencapai akurasi sempurna (1.0000), menunjukkan bahwa mereka berhasil memprediksi semua instance dalam set uji. Random Forest juga berkinerja baik dengan akurasi 0.9167, menunjukkan kemampuan prediksi yang kuat. KNN memiliki akurasi terendah yaitu 0.8333, yang menunjukkan bahwa model ini mungkin tidak dapat digeneralisasi dengan baik dibandingkan dengan model lainnya.