UTS STATISTIKA EKONOMI DAN INDUSTRI
Dela Kurniawati
2024-10-17
1. Persiapan Data
1.1 Packages
Berikut ini beberapa packages yang akan digunakan dalam pengolahan dan visualisasi data pada analisis dengan model Random Forest
library(tidyverse)
library(readxl)
library(rsample)
library(randomForest)
library(gridExtra)
library(formattable)
library(ggthemes)
library(GGally)
library(caret)
library(yardstick)
library(vip)1.2 Import Data
Melakukan import data yang telah di simpan di file excel. Data yang di import menggunakan format ‘xlsx’
data_risk <- read_xlsx("data_risk.xlsx")
head(data_risk)## # A tibble: 6 × 15
## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 17.5 38675. 173. 0.68 1.22 1.79 -2.08 55 -26.5 2.86 8 23.1
## 2 18.2 40105. 104. 1.77 0.870 2.66 -0.725 103. -13.6 353. 8.15 24.9
## 3 18.7 76038. 31.0 2.63 1.49 1.85 -1.90 103. -56.2 200. 8.15 20.4
## 4 NA 27883. 24.8 1.29 1.75 2.23 -1.14 103. 24.8 10.1 NA 21.7
## 5 14 4251. 89.6 1.44 0.256 4.75 2.33 167. 47.3 12.6 6.6 19.4
## 6 NA 2034. 57.1 22.4 3.34 -0.878 -5.20 34.8 15.4 62.5 10.3 31.1
## # ℹ 3 more variables: X13 <dbl>, X14 <dbl>, risk_level <dbl>2 Pembersihan Data
2.1 Missing Data Melakukan pengecekan apakah terdapat missing data (data kosong) pada data yang telah di import. Kemudian dilanjutkan dengan melihaat letak dari missing data.
library(mice)
any(is.na(data_risk))## [1] TRUEmd.pattern(data_risk)
## X2 X3 X4 X5 X6 X7 X9 X10 X12 X13 risk_level X8 X14 X1 X11
## 67 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0
## 11 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1
## 6 1 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1
## 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 2
## 7 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1
## 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0 0 3
## 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 1 1
## 1 1 1 1 1 1 1 1 1 1 1 1 0 1 1 0 2
## 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 1 2
## 1 1 1 1 1 1 1 1 1 1 1 1 0 1 0 0 3
## 1 1 1 1 1 1 1 1 1 1 1 1 0 0 1 1 2
## 2 1 1 1 1 1 1 1 1 1 1 1 0 0 0 0 4
## 0 0 0 0 0 0 0 0 0 0 0 7 11 12 17 472.2 Mengatasi Missing Data
Kita telah melakukan pengecekan untuk melihat letak kolom yang mengalami missing data, diantaranya kolom X1, X8, X11, dan X14. Untuk melakukan analisis lebih lanjut maka perlu dilakukan tindakan untuk mengatasi missing data tersebut, dalam hal ini metode yang digunakan untuk mengatasi missing data ialah dengan menggunakan “Mean Inputation”
data_risk1 <- data_risk %>%
mutate(across(c(X1, X8, X11, X14), ~ifelse(is.na(.), mean(., na.rm = TRUE), .)))
data_risk1## # A tibble: 100 × 15
## X1 X2 X3 X4 X5 X6 X7 X8 X9 X10 X11 X12
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 17.5 38675. 173. 0.68 1.22 1.79 -2.08 55 -26.5 2.86e0 8 23.1
## 2 18.2 40105. 104. 1.77 0.870 2.66 -0.725 103. -13.6 3.53e2 8.15 24.9
## 3 18.7 76038. 31.0 2.63 1.49 1.85 -1.90 103. -56.2 2.00e2 8.15 20.4
## 4 19.0 27883. 24.8 1.29 1.75 2.23 -1.14 103. 24.8 1.01e1 5.53 21.7
## 5 14 4251. 89.6 1.44 0.256 4.75 2.33 167. 47.3 1.26e1 6.6 19.4
## 6 19.0 2034. 57.1 22.4 3.34 -0.878 -5.20 34.8 15.4 6.25e1 10.3 31.1
## 7 23.3 9203. 43.3 36.7 0.966 -0.237 -3.73 99.9 -5.01 3.75e2 10.6 16.7
## 8 18.6 53174. 159. 1.52 0.726 1.88 -0.300 116. 15.4 4.30e2 2.02 24.8
## 9 15.7 63972. 122. 1.65 1.48 2.45 0.0306 192. 58.0 1.36e3 0.96 24.3
## 10 33.5 24643. 92.8 1.22 0.797 2.06 -4.72 80.5 28.1 2.38e0 5 21.1
## # ℹ 90 more rows
## # ℹ 3 more variables: X13 <dbl>, X14 <dbl>, risk_level <dbl>2.3 Normalisasi Data
Selanjutnya dilakuakan normalisasi data terlebih dahulu, agar hasil yang akan didapatkan nantinya juga akan lebih bagus.
data_risk2 <- as.data.frame(scale(data_risk1))
data_risk2$risk_level <- data_risk1$risk_level
head(data_risk2)## X1 X2 X3 X4 X5 X6
## 1 -0.28991506 0.6452923 -0.02750584 -0.5309986 0.01764994 -0.5700293
## 2 -0.15201729 0.7028668 -0.12678694 -0.3077268 -0.31258627 -0.1843743
## 3 -0.05351889 2.1490800 -0.23073637 -0.1299812 0.27059882 -0.5414378
## 4 0.00000000 0.2109484 -0.23970053 -0.4047328 0.51884081 -0.3729179
## 5 -0.97940392 -0.7401607 -0.14672596 -0.3747495 -0.89021722 0.7382759
## 6 0.00000000 -0.8294098 -0.19342321 3.9254845 2.01488237 -1.7463734
## X7 X8 X9 X10 X11 X12
## 1 -0.8494699 -1.09410545 -0.0595941002 -0.3492613 0.5266928 -0.27916463
## 2 -0.3229352 0.06294736 -0.0000680741 -0.1382721 0.5598061 -0.01530186
## 3 -0.7783689 0.06294736 -0.1965181034 -0.2304799 0.5598061 -0.67811060
## 4 -0.4818372 0.06294736 0.1767636262 -0.3448909 0.0000000 -0.48617311
## 5 0.8616419 1.62786948 0.2803600388 -0.3433620 0.2276052 -0.82617547
## 6 -2.0579539 -1.58542469 0.1337540211 -0.3133214 1.0180510 0.91553342
## X13 X14 risk_level
## 1 0.3057805 -1.0904482 0
## 2 0.9914798 -1.2006777 0
## 3 0.8132834 0.0000000 0
## 4 -0.8880141 0.0000000 0
## 5 -1.1602588 2.0160199 1
## 6 -0.4836766 0.4126815 12.4 Struktur Data
Langkah pembersihan data yang selanjutnya ialah dengan melihat struktur data, dialanjutkan dengan mengubah struktur data apabila belum sesuai. Dalam data ini terdapat variabel kategorik maka struktur data yang benar adalah “factor”, terdapat pada kolom risk_level
str(data_risk2)## 'data.frame': 100 obs. of 15 variables:
## $ X1 : num -0.2899 -0.152 -0.0535 0 -0.9794 ...
## $ X2 : num 0.645 0.703 2.149 0.211 -0.74 ...
## $ X3 : num -0.0275 -0.1268 -0.2307 -0.2397 -0.1467 ...
## $ X4 : num -0.531 -0.308 -0.13 -0.405 -0.375 ...
## $ X5 : num 0.0176 -0.3126 0.2706 0.5188 -0.8902 ...
## $ X6 : num -0.57 -0.184 -0.541 -0.373 0.738 ...
## $ X7 : num -0.849 -0.323 -0.778 -0.482 0.862 ...
## $ X8 : num -1.0941 0.0629 0.0629 0.0629 1.6279 ...
## $ X9 : num -5.96e-02 -6.81e-05 -1.97e-01 1.77e-01 2.80e-01 ...
## $ X10 : num -0.349 -0.138 -0.23 -0.345 -0.343 ...
## $ X11 : num 0.527 0.56 0.56 0 0.228 ...
## $ X12 : num -0.2792 -0.0153 -0.6781 -0.4862 -0.8262 ...
## $ X13 : num 0.306 0.991 0.813 -0.888 -1.16 ...
## $ X14 : num -1.09 -1.2 0 0 2.02 ...
## $ risk_level: num 0 0 0 0 1 1 1 0 0 1 ...data_risk2$risk_level <- as.factor(data_risk2$risk_level)3. Analisis Eksplorasi Data
data_risk2 %>%
group_by(risk_level) %>%
summarise(freq = n()) %>%
mutate(percent = freq / sum(freq) * 100) %>%
ggplot(aes(x = "", y = freq, fill = risk_level)) +
geom_bar(stat = "identity", width = 1) +
coord_polar("y", start = 0) +
geom_text(aes(label = paste0(round(percent), "%")),
position = position_stack(vjust = 0.5)) +
labs(title = "Data Proportion by Risk Level") +
theme_minimal() +
theme(axis.text = element_blank(),
axis.title = element_blank(),
plot.title = element_text(hjust = 0.5, face = "bold"))
Berdasarkan chart diatas, dapat diperoleh informasi bahwa level resiko dengan kategori ‘Low’ di representasikan dengan angka 0 memiliki proporsi sebesar 46% dan level resiko dengan kategori ‘High’ yang di representasikan dengan angka 1 memiliki proporasi sebesar 54%. Kemudian bagaimana dengan korelasi setiap variabelnya?
ggcorr(data_risk2,
label = TRUE,
label_size = 2,
low = "#E6CCB2",
high = "#E6B8B8") +
labs(title = "Correlation Matrix for Risk Analysis Variables") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, face = "bold"))
Matrik korelasi diatas menunjukkan beberapa variabel memiliki korelasi dengan variabel lain, baik berkorelasi secara positif maupun secara negatif, seperti:
- X1 dan X2 memikili korelasi positif sebesar 0,2
- X2 dan X3 memiliki korelasi positif sebesar 0,5
- X3 dan X9 memiliki korelasi negatif sebesar 0,9
- X6 dan X7 memiliki korelasi positif sebesar 0,8
- X12 dan X13 memiliki korelasi positif sebesar 0,6 dan seterusnya.
4. Split Data (Train dan Test)
Dari 100 data investasi, saya membagi 70% sebagai data train dan 30% sebagai data test. Data train digunakan untuk melakukan pemodelan dan data test digunakan untuk menguji seberapa baik model yang dibuat.
library(tidyverse)
library(tidymodels)
set.seed(123)
# Fungsi untuk menyeimbangkan dan membagi data
balance_and_split <- function(data, train_prop = 0.7) {
# Hitung jumlah sampel untuk setiap kelas
class_counts <- table(data$risk_level)
min_class <- min(class_counts)
# Hitung jumlah sampel untuk train dan test
train_samples <- floor(min_class * train_prop)
test_samples <- floor(min_class * (1 - train_prop))
# Buat dataset seimbang untuk train dan test
balanced_train <- data %>%
group_by(risk_level) %>%
slice_sample(n = train_samples) %>%
ungroup() %>%
mutate(type = "train")
balanced_test <- data %>%
group_by(risk_level) %>%
slice_sample(n = test_samples) %>%
ungroup() %>%
mutate(type = "test")
# Gabungkan dataset train dan test
bind_rows(balanced_train, balanced_test)
}
# Terapkan fungsi ke data
balanced_split_data <- balance_and_split(data_risk2, train_prop = 0.7)
# Pisahkan data train dan test
risk_train <- balanced_split_data %>% filter(type == "train")
risk_test <- balanced_split_data %>% filter(type == "test")
# Buat dataframe untuk visualisasi
df_split <- balanced_split_data %>%
group_by(risk_level, type) %>%
summarise(Freq = n(), .groups = "drop") %>%
group_by(type) %>%
mutate(Proportion = Freq / sum(Freq))
# Hitung total sampel untuk setiap tipe data
total_samples <- df_split %>%
group_by(type) %>%
summarise(Total = sum(Freq))
# Buat plot
ggplot(df_split, aes(x = risk_level, y = Freq, fill = type)) +
geom_col(position = "dodge") +
geom_text(aes(label = Freq),
position = position_dodge(width = 0.9),
vjust = -0.5) +
labs(x = "Risk Level", y = "Frequency", fill = "Data",
title = "Risk Level: Frequency Train vs Test",
subtitle = paste("Train:", total_samples$Total[total_samples$type == "train"],
"samples |",
"Test:", total_samples$Total[total_samples$type == "test"],
"samples")) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, face = "bold"),
plot.subtitle = element_text(hjust = 0.5)) +
scale_fill_manual(values = c("#E6B8B8", "#9DB4C0"))
Pada chart tersebut, setiap target variabel memiliki proporsi data train dan data test yang seimbang. Setiap target variabel memiliki data train sebanyak 32 observasi dan memiliki data test sebanyak 13 observasi. Karena proporsi kelas target sudah sesuai maka dapat langsung dilanjutkan ke tahap pemodelan.
5. Random Forest
5.1 Model Random Forest Model random forest akan memulai dengan inisialisasi random, maka perlu dilakukan set.seed supaya nilai yang dihasilkan konsisten. Berikut penerapan model random forest menggunakan 100 tree.
set.seed(777)
rf_model <- randomForest(risk_level ~ ., data = risk_train, importance = TRUE, ntree = 100)
print(rf_model)##
## Call:
## randomForest(formula = risk_level ~ ., data = risk_train, importance = TRUE, ntree = 100)
## Type of random forest: classification
## Number of trees: 100
## No. of variables tried at each split: 3
##
## OOB estimate of error rate: 15.62%
## Confusion matrix:
## 0 1 class.error
## 0 27 5 0.15625
## 1 5 27 0.15625Hasil output diatas merupakan informasi terkait model random forest yang dibuat. Model yang dibuat menggunakan 100 tree dan jumlah variabel yang dicoba setiap percabangan ada 3 variabel. Lalu dari seluruh percobaan tersebut terdapat nili OOB (Out Of Box) dengan estimasi error rate sebesar 15.62%.
plot(rf_model, main = "Random Forest")
legend("topright", colnames(rf_model$err.rate), col = 1:6, cex = 0.8, fill = 1:6)
Grafik diatas menunjukkan jumlah Tree dan Estimasi Error yang didapat. Dapat dilihat nilai error dengan menggunakan 100 tree sudah tergolong error minimum.
5.2 Prediksi Model Random Forest
# Prediksi
train_pred <- predict(rf_model, risk_train)
test_pred <- predict(rf_model, risk_test)
# Confusion Matrices
cfm_rf_train <- confusionMatrix(train_pred, risk_train$risk_level)
cfm_rf_test <- confusionMatrix(test_pred, risk_test$risk_level)
# Membuat plot untuk confusion matrix
plot_confusion_matrix <- function(cm, title) {
cm_d <- as.data.frame(cm$table)
ggplot(cm_d, aes(Prediction, Reference, fill = Freq)) +
geom_tile() +
geom_text(aes(label = Freq)) +
scale_fill_gradient(low = "#E6CCB2", high = "#E6B8B8") +
labs(title = title,
subtitle = paste("Accuracy:", round(cm$overall["Accuracy"], 4))) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, face = "bold"))
}
# Plot confusion matrices
p1 <- plot_confusion_matrix(cfm_rf_train, "Confusion Matrix - Train Data")
p2 <- plot_confusion_matrix(cfm_rf_test, "Confusion Matrix - Test Data")
grid.arrange(p1, p2, ncol = 2)
Berdasarkan Confusion Matrix diatas dapat diperoleh informasi. Pada data latih (Train Data) menunjukan model sempurna dalam membedakan investasi beresiko rendah dan tinggi karena tidak ada satupun data yang mengalami kesalahan, namun pada data uji (Test Data), terdapat kesalahan dalam mengklasifikasi 1 investasi beresiko tinggi sebagai beresiko rendah. Walupun begitu, kinerja model dalam memprediksi resiko investasi terbilang cukup bagus.
# Variable Importance
vip(rf_model, num_features = 20) +
theme_minimal() +
labs(title = "Variable Importance in Random Forest Model") +
theme(plot.title = element_text(hjust = 0.5, face = "bold"))
Dari grafik “Variable Importance in Random Forest Model” dapat ditarik beberapa kesimpulan, seperti: Variabel X2 menjadi variabel yang paling berpengaruh dalam model Random Forest, Lima variabel teratas yang paling berpengaruh daalam model Random Fores ialah X2, X11, X10, X4, dan X9, sedangakan yang kurang berpengaruh dalam model random forest ialah X6 dan X8 memiliki skor kepentingan yang sangat rendah.
5.3 Evaluasi Model Random Forest
library(tidyverse)
library(knitr)
library(yardstick)
# Mengubah prediksi menjadi faktor
train_pred <- factor(train_pred, levels = levels(risk_train$risk_level))
test_pred <- factor(test_pred, levels = levels(risk_test$risk_level))
# Membuat tibble untuk train results
train_results <- tibble(
truth = risk_train$risk_level,
estimate = train_pred
)
# Membuat tibble untuk test results
test_results <- tibble(
truth = risk_test$risk_level,
estimate = test_pred
)
# Menghitung Matriks
calc_metrics <- function(data, dataset_name) {
data %>%
summarize(
Dataset = dataset_name,
Accuracy = accuracy_vec(truth, estimate),
Kappa = kap_vec(truth, estimate),
Sensitivity = sens_vec(truth, estimate),
Specificity = spec_vec(truth, estimate),
Precision = precision_vec(truth, estimate)
)
}
# Menghitung matriks untuk train and test sets
metrics_summary <- bind_rows(
calc_metrics(train_results, "Train"),
calc_metrics(test_results, "Test")
)
# Menampilkan Tabel
kable(metrics_summary, digits = 3, caption = "Model Performance Metrics")| Dataset | Accuracy | Kappa | Sensitivity | Specificity | Precision |
|---|---|---|---|---|---|
| Train | 1.000 | 1.000 | 1 | 1.000 | 1.000 |
| Test | 0.962 | 0.923 | 1 | 0.923 | 0.929 |
Hasil evaluasi model Random Forest menggunakan Confussion Matrix di atas menunjukkan tingkat akurasi hasil klasifikasi yang cukup bagus, dimana tingkat akurasi pada data train sebesar 100% dan tingkat akurasi pada data test sebesar 96%.
Referensi: https://rpubs.com/datazerotohero/project3