Import Library dan Data

library(readxl)
## Warning: package 'readxl' was built under R version 4.4.3
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.4.3
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
data1 <- read_excel("C:/Users/LENOVO/Downloads/G1401231034_Nandito Hernawan_Tugas Kuliah 11 TPG.xlsx", sheet = "Sheet1", range = "F1:I101")
data1
## # A tibble: 100 × 4
##    tanggungan pendapatan  Usia Status
##         <dbl>      <dbl> <dbl> <chr> 
##  1          6       10      43 Bad   
##  2          1        9      53 Bad   
##  3          2        4.8    39 Bad   
##  4          0        4.9    56 Bad   
##  5          1        4.7    38 Bad   
##  6          3        2.4    48 Bad   
##  7          3        4.6    41 Bad   
##  8          2        4.9    60 Bad   
##  9          4        8      39 Bad   
## 10          1        8.3    53 Bad   
## # ℹ 90 more rows

Studi Kasus

Sebuah perusahaan penjualan mobil meminta Anda untuk membantu membuatkan model yang dapat dijadikan sebagai acuan dalam penerimaan calon pembeli kredit. Penyusunan model didasarkan pada data karakteristik pembeli dengan status kelancaran pembayaran kreditnya yang telah lunas pada setahun terakhir. Karakteristik pembeli meliputi usia (tahun), pendapatan (juta rupiah), dan jumlah tanggungan dalam keluarga. Status kelancaran pembayaran dikategorikan menjadi dua, yaitu bad dan good. Good jika pembayaran kreditnya tergolong lancar dan Bad jika tidak lancar.

  1. Bagaimana model yang terbentuk?
  2. Bagaimana aturan klasifikasinya untuk mengklasifikasikan calon pembeli apakah calon pembeli tersebut akan menjadi penerima kredit yang bad atau good?
  3. Berapa besarnya kesalahan klasifikasi dari model yang terbentuk?

Pisahkan Data pe Kelompok

bad <- subset(data1, Status == "Bad") [,1:3]
good <- subset(data1, Status == "Good") [,1:3]

Hitung Mean dan Covariance Matrix

mean_bad <- colMeans(bad)
mean_good <- colMeans(good)
mean_bad; mean_good
## tanggungan pendapatan       Usia 
##   2.127660   7.129787  48.978723
## tanggungan pendapatan       Usia 
##   1.679245  11.388679  51.339623
cov_bad <- cov(bad)
cov_good <- cov(good)
cov_bad; cov_good
##            tanggungan pendapatan       Usia
## tanggungan  1.7224792   1.056984 -0.1059204
## pendapatan  1.0569843  10.073441 -1.6623959
## Usia       -0.1059204  -1.662396 50.5430157
##            tanggungan pendapatan       Usia
## tanggungan  1.5682148 -0.1633164  0.4187228
## pendapatan -0.1633164 16.0929463  2.1635341
## Usia        0.4187228  2.1635341 87.8824383

Hitung Covariance Pooled

n_bad <- nrow(bad)
n_good <- nrow(good)
cov_pooled <- ((n_bad - 1) * cov_bad + (n_good - 1) * cov_good) / (n_bad + n_good - 2)
cov_pooled
##            tanggungan pendapatan       Usia
## tanggungan  1.6406246  0.4094778  0.1724617
## pendapatan  0.4094778 13.2674643  0.3676894
## Usia        0.1724617  0.3676894 70.3557706

Hitung Invers Covariance Pooled

inv_cov_pooled <- solve(cov_pooled)
inv_cov_pooled
##              tanggungan    pendapatan          Usia
## tanggungan  0.614394862 -0.0189232584 -0.0014071580
## pendapatan -0.018923258  0.0759661039 -0.0003506236
## Usia       -0.001407158 -0.0003506236  0.0142187569

Hitung Koefisien a (Fisher LDA)

a <- inv_cov_pooled %*% (mean_bad - mean_good)
a
##                   [,1]
## tanggungan  0.35941771
## pendapatan -0.33118911
## Usia       -0.03270677

Hitung Nilai h

h <- 0.5 * t(a) %*% (mean_bad + mean_good)
h
##           [,1]
## [1,] -4.022967

Menghitung Skor Fisher

X <- as.matrix(data1[, 1:3])
data1$Fisher_Score <- X %*% a
data1
## # A tibble: 100 × 5
##    tanggungan pendapatan  Usia Status Fisher_Score[,1]
##         <dbl>      <dbl> <dbl> <chr>             <dbl>
##  1          6       10      43 Bad               -2.56
##  2          1        9      53 Bad               -4.35
##  3          2        4.8    39 Bad               -2.15
##  4          0        4.9    56 Bad               -3.45
##  5          1        4.7    38 Bad               -2.44
##  6          3        2.4    48 Bad               -1.29
##  7          3        4.6    41 Bad               -1.79
##  8          2        4.9    60 Bad               -2.87
##  9          4        8      39 Bad               -2.49
## 10          1        8.3    53 Bad               -4.12
## # ℹ 90 more rows

Klasifikasi Berdasarkan Nilai h

h <- as.numeric(h)
data1$Predicted_manual <- ifelse(data1$Fisher_Score > h, "Bad", "Good")
data1
## # A tibble: 100 × 6
##    tanggungan pendapatan  Usia Status Fisher_Score[,1] Predicted_manual[,1]
##         <dbl>      <dbl> <dbl> <chr>             <dbl> <chr>               
##  1          6       10      43 Bad               -2.56 Bad                 
##  2          1        9      53 Bad               -4.35 Good                
##  3          2        4.8    39 Bad               -2.15 Bad                 
##  4          0        4.9    56 Bad               -3.45 Bad                 
##  5          1        4.7    38 Bad               -2.44 Bad                 
##  6          3        2.4    48 Bad               -1.29 Bad                 
##  7          3        4.6    41 Bad               -1.79 Bad                 
##  8          2        4.9    60 Bad               -2.87 Bad                 
##  9          4        8      39 Bad               -2.49 Bad                 
## 10          1        8.3    53 Bad               -4.12 Good                
## # ℹ 90 more rows

Evaluasi Model dengan Confusion Matrix

table(Actual = data1$Status, Pred = data1$Predicted_manual)
##       Pred
## Actual Bad Good
##   Bad   38    9
##   Good  12   41

Hitung Tingkat Kesalahan Klasifikasi

# Error Rate Bad
confusion_matrix <- table(Actual = data1$Status, Pred = data1$Predicted_manual)
error_bad <- confusion_matrix["Bad", "Good"] / sum(confusion_matrix["Bad", ])
error_bad
## [1] 0.1914894
# Error Rate Good
error_good <- confusion_matrix["Good", "Bad"] / sum(confusion_matrix["Good", ])
error_good
## [1] 0.2264151

Kesimpulan

Berdasarkan hasil perhitungan di atas, model klasifikasi Fisher LDA telah berhasil dibuat. Aturan klasifikasi yang digunakan adalah jika skor Fisher lebih besar dari nilai h, maka klasifikasinya adalah “Bad”, sebaliknya “Good”. Tingkat kesalahan klasifikasi untuk kategori “Bad” dan “Good” dapat dihitung dari confusion matrix yang dihasilkan.

LDA Menggunakan Package MASS

library(MASS)
## Warning: package 'MASS' was built under R version 4.4.3
## 
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
## 
##     select
lda_model <- lda(Status ~ ., data = data1[, 1:4])
lda_model
## Call:
## lda(Status ~ ., data = data1[, 1:4])
## 
## Prior probabilities of groups:
##  Bad Good 
## 0.47 0.53 
## 
## Group means:
##      tanggungan pendapatan     Usia
## Bad    2.127660   7.129787 48.97872
## Good   1.679245  11.388679 51.33962
## 
## Coefficients of linear discriminants:
##                   LD1
## tanggungan -0.2799010
## pendapatan  0.2579176
## Usia        0.0254708

Prediksi Menggunakan Model LDA

lda_predictions <- predict(lda_model)$class
table(Actual = data1$Status, Pred = lda_predictions)
##       Pred
## Actual Bad Good
##   Bad   36   11
##   Good  11   42

Fungsi Diskriminan per kelas (Bad & Good)

#Mean per kelas
mean_bad <- as.numeric(lda_model$means["Bad", ])
mean_good <- as.numeric(lda_model$means["Good", ])

# Koefisien per kelas :
b_bad <- inv_cov_pooled %*% mean_bad
b_good <- inv_cov_pooled %*% mean_good

#Konstanta per kelas :
prior <- lda_model$prior
const_bad <- -0.5 * t(b_bad) %*% mean_bad + log(prior["Bad"])
const_good <- -0.5 * t(b_good) %*% mean_good + log(prior["Good"])

# Menampilkan fungsi bad
const_bad <- c(const_bad, b_bad)
const_bad
## [1] -20.5751661   1.1033835   0.4841868   0.6909227
# Menampilkan fungsi good
const_good <- c(const_good, b_good)
const_good
## [1] -24.4779892   0.7439658   0.8153759   0.7236295

Prediksi Menggunakan Fungsi Diskriminan

predict_lda <- function(data_point) {
  score_bad <- const_bad[1] + sum(const_bad[-1] * data_point)
  score_good <- const_good[1] + sum(const_good[-1] * data_point)
  
  if (score_bad > score_good) {
    return("Bad")
  } else {
    return("Good")
  }
}
data1$Predicted_function <- apply(data1[, 1:3], 1, predict_lda)
data1$Predicted_function
##   [1] "Bad"  "Good" "Bad"  "Bad"  "Bad"  "Bad"  "Bad"  "Bad"  "Bad"  "Good"
##  [11] "Bad"  "Bad"  "Bad"  "Bad"  "Bad"  "Bad"  "Good" "Good" "Bad"  "Bad" 
##  [21] "Bad"  "Good" "Bad"  "Bad"  "Good" "Bad"  "Good" "Bad"  "Bad"  "Bad" 
##  [31] "Good" "Bad"  "Bad"  "Bad"  "Bad"  "Good" "Good" "Good" "Bad"  "Bad" 
##  [41] "Bad"  "Bad"  "Bad"  "Bad"  "Bad"  "Bad"  "Bad"  "Good" "Bad"  "Good"
##  [51] "Bad"  "Good" "Good" "Good" "Good" "Good" "Good" "Bad"  "Good" "Good"
##  [61] "Good" "Good" "Good" "Good" "Good" "Good" "Good" "Good" "Good" "Good"
##  [71] "Good" "Good" "Good" "Good" "Bad"  "Good" "Bad"  "Good" "Good" "Good"
##  [81] "Bad"  "Good" "Bad"  "Bad"  "Good" "Good" "Good" "Good" "Good" "Bad" 
##  [91] "Bad"  "Good" "Good" "Bad"  "Good" "Good" "Good" "Good" "Good" "Good"

Evaluasi Model dengan Confusion Matrix (Fungsi Diskriminan)

table(Actual = data1$Status, Pred = data1$Predicted_function)
##       Pred
## Actual Bad Good
##   Bad   36   11
##   Good  11   42

Hitung Tingkat Kesalahan Klasifikasi (Fungsi Diskriminan)

# Error Rate Bad
confusion_matrix_func <- table(Actual = data1$Status, Pred = data1$Predicted_function)
error_bad_func <- confusion_matrix_func["Bad", "Good"] / sum(confusion_matrix_func["Bad", ])
error_bad_func
## [1] 0.2340426
# Error Rate Good
error_good_func <- confusion_matrix_func["Good", "Bad"] / sum(confusion_matrix_func["Good", ])
error_good_func
## [1] 0.2075472

Kesimpulan Akhir

Model klasifikasi Fisher LDA yang dibuat secara manual dan menggunakan package MASS memberikan hasil yang berbeda. Aturan klasifikasi dan tingkat kesalahan klasifikasi dapat digunakan sebagai acuan dalam penerimaan calon pembeli kredit pada perusahaan penjualan mobil.