1 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 da Bad jika tidak lancar.

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

2 Import data

library(readxl)
## Warning: package 'readxl' was built under R version 4.4.3
data_diskriminan <- read_excel("C:/Users/nyayu/Statistika/Semester 5/TPG (Teknik Peubah Ganda)/Data Diskriminan.xlsx")
head(data_diskriminan)
## # A tibble: 6 × 4
##   tanggungan pendapatan  Usia Status
##        <dbl>      <dbl> <dbl> <chr> 
## 1          6       10      39 Bad   
## 2          1        9      49 Bad   
## 3          2        4.8    35 Bad   
## 4          0        4.9    52 Bad   
## 5          1        4.7    34 Bad   
## 6          3        2.4    44 Bad
summary(data_diskriminan)
##    tanggungan     pendapatan          Usia          Status         
##  Min.   :0.00   Min.   : 2.400   Min.   :30.00   Length:100        
##  1st Qu.:1.00   1st Qu.: 6.500   1st Qu.:39.00   Class :character  
##  Median :2.00   Median : 9.000   Median :46.00   Mode  :character  
##  Mean   :1.89   Mean   : 9.387   Mean   :46.23                     
##  3rd Qu.:3.00   3rd Qu.:11.800   3rd Qu.:54.00                     
##  Max.   :6.00   Max.   :28.000   Max.   :60.00

3 Langkah pengerjaan manual

3.1 Menghitung model yang terbentuk

3.1.1 Menghitung \(\bar{x}bad\) dan \(\bar{x}good\)

bad <- subset(data_diskriminan, Status=="Bad")[,1:3]
good <- subset(data_diskriminan, Status=="Good")[,1:3]
mean_bad <- colMeans(bad)
mean_good <- colMeans(good)
cat("--- Rata-rata Grup Bad ---\n")
## --- Rata-rata Grup Bad ---
print(mean_bad)
## tanggungan pendapatan       Usia 
##   2.127660   7.129787  44.978723
cat("\n") 
cat("--- Rata-rata Grup Good ---\n")
## --- Rata-rata Grup Good ---
print(mean_good)
## tanggungan pendapatan       Usia 
##   1.679245  11.388679  47.339623

3.1.2 Menghitung matriks varians-kovarians \(Sbad\) dan \(Sgood\)

S_bad <- cov(bad)
S_good <- cov(good)
cat("--- Matriks varians-kovarians Grup Bad ---\n")
## --- Matriks varians-kovarians Grup Bad ---
print(S_bad)
##            tanggungan pendapatan       Usia
## tanggungan  1.7224792   1.056984 -0.1059204
## pendapatan  1.0569843  10.073441 -1.6623959
## Usia       -0.1059204  -1.662396 50.5430157
cat("\n") 
cat("--- Matriks varians-kovarians Grup Good ---\n")
## --- Matriks varians-kovarians Grup Good ---
print(S_good)
##            tanggungan pendapatan       Usia
## tanggungan  1.5682148 -0.1633164  0.4187228
## pendapatan -0.1633164 16.0929463  2.1635341
## Usia        0.4187228  2.1635341 87.8824383

3.1.3 Menghitung matriks varians-kovarians gabungan \(Sp\)

n1 <- nrow(bad)
n2 <- nrow(good)
S_pooled <- ((n1-1)*S_bad + (n2-1)*S_good) / (n1+n2-2)
cat("--- Matriks varians-kovarians gabungan ---\n")
## --- Matriks varians-kovarians gabungan ---
print(S_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

3.1.4 Menghitung invers matriks varians-kovarians gabungan \(Sp\)

S_inv <- solve(S_pooled)
cat("--- Invers matriks varians-kovarians gabungan ---\n")
## --- Invers matriks varians-kovarians gabungan ---
print(S_inv)
##              tanggungan    pendapatan          Usia
## tanggungan  0.614394862 -0.0189232584 -0.0014071580
## pendapatan -0.018923258  0.0759661039 -0.0003506236
## Usia       -0.001407158 -0.0003506236  0.0142187569

3.1.5 menghitung koefisien a (fisher LDA) dan membentuk fungsi diskriminan linier

a <- S_inv %*% (mean_bad - mean_good)
cat("--- Koefisien a (fisher LDA) ---\n")
## --- Koefisien a (fisher LDA) ---
print(a)
##                   [,1]
## tanggungan  0.35941771
## pendapatan -0.33118911
## Usia       -0.03270677
t(a)
##      tanggungan pendapatan        Usia
## [1,]  0.3594177 -0.3311891 -0.03270677

tanggungan = \(x_1\)

pendapatan = \(x_2\)

usia = \(x_3\)

Sehingga model yang terbentuk adalah\[y = 0.359x_1 - 0.331x_2 - 0.0327x_3\]

3.2 Aturan Klasifikasi

  • Alokasikan \(x_0\) ke populasi 1 (kelompok bad) jika \(y_0=a'x_0 ≥ m\)

  • Alokasikan \(x_0\) ke populasi 2 (kelompok good) jika \(y_0=a'x0 < m\)

3.2.1 menghitung midpoint

m <- 0.5 * t(a) %*% (mean_bad + mean_good)
cat("--- Nilai midpoint (m) ---\n")
## --- Nilai midpoint (m) ---
print(m)
##          [,1]
## [1,] -3.89214

3.2.2 Menghitung skor diskriminan linier untuk setiap observasi

3.2.3 cara 1

X <- as.matrix(data_diskriminan[,1:3])
data_diskriminan$score <- X %*% a
head(data_diskriminan)
## # A tibble: 6 × 5
##   tanggungan pendapatan  Usia Status score[,1]
##        <dbl>      <dbl> <dbl> <chr>      <dbl>
## 1          6       10      39 Bad        -2.43
## 2          1        9      49 Bad        -4.22
## 3          2        4.8    35 Bad        -2.02
## 4          0        4.9    52 Bad        -3.32
## 5          1        4.7    34 Bad        -2.31
## 6          3        2.4    44 Bad        -1.16

3.2.4 cara 2 dengan library MASS

library(MASS)
## Warning: package 'MASS' was built under R version 4.4.3
model <- lda(Status ~ tanggungan + pendapatan + Usia, data=data_diskriminan)
model
## Call:
## lda(Status ~ tanggungan + pendapatan + Usia, data = data_diskriminan)
## 
## Prior probabilities of groups:
##  Bad Good 
## 0.47 0.53 
## 
## Group means:
##      tanggungan pendapatan     Usia
## Bad    2.127660   7.129787 44.97872
## Good   1.679245  11.388679 47.33962
## 
## Coefficients of linear discriminants:
##                   LD1
## tanggungan -0.2799010
## pendapatan  0.2579176
## Usia        0.0254708
pred <- predict(model)$class
table(Actual=data_diskriminan$Status, Pred=pred)
##       Pred
## Actual Bad Good
##   Bad   36   11
##   Good  11   42
# Mean masing-masing kelas
mu_bad <- as.numeric(model$means["Bad", ])
mu_good <- as.numeric(model$means["Good", ])


# Koefisien per kelas: b_k = S_inv %*% mu_k
b_bad <- S_inv %*% mu_bad
b_good <- S_inv %*% mu_good


# Konstanta per kelas: c_k = -1/2 * mu' * S_inv * mu + log(prior)
prior <- model$prior


c_bad <- -0.5 * t(mu_bad) %*% S_inv %*% mu_bad + log(prior["Bad"])
c_good <- -0.5 * t(mu_good) %*% S_inv %*% mu_good + log(prior["Good"])


# Tampilkan fungsi Bad
cat("--- fungsi Bad ---\n")
## --- fungsi Bad ---
a_bad <- c(c_bad, b_bad)
a_bad
## [1] -17.9252252   1.1090121   0.4855893   0.6340477
# Tampilkan fungsi Good
cat("--- fungsi Good ---\n")
## --- fungsi Good ---
a_good <- c(c_good, b_good)
a_good
## [1] -21.6972212   0.7495944   0.8167784   0.6667545

fungsi bad \[y bad = -17.925 + 1.109x_1 + 0.486x_2 + 0.634x_3\]

fungsi good \[ ygood = -21.697 + 0.750x_1 + 0.817x_2 + 0.667x_3\]

3.2.5 Menerapkan aturan klasifikasi

m <- as.numeric(m)

data_diskriminan$status_pada_fisher <- ifelse(data_diskriminan$score >= m, "Bad", "Good")

(data_diskriminan)
## # A tibble: 100 × 6
##    tanggungan pendapatan  Usia Status score[,1] status_pada_fisher[,1]
##         <dbl>      <dbl> <dbl> <chr>      <dbl> <chr>                 
##  1          6       10      39 Bad        -2.43 Bad                   
##  2          1        9      49 Bad        -4.22 Good                  
##  3          2        4.8    35 Bad        -2.02 Bad                   
##  4          0        4.9    52 Bad        -3.32 Bad                   
##  5          1        4.7    34 Bad        -2.31 Bad                   
##  6          3        2.4    44 Bad        -1.16 Bad                   
##  7          3        4.6    37 Bad        -1.66 Bad                   
##  8          2        4.9    56 Bad        -2.74 Bad                   
##  9          4        8      35 Bad        -2.36 Bad                   
## 10          1        8.3    49 Bad        -3.99 Good                  
## # ℹ 90 more rows

3.3 Menghitung kesalahan klasifikasi

3.3.1 Confussion Matrix

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

3.3.2 Menghitung tingkat kesalahan klasifikasi

cm <- table(Actual=data_diskriminan$Status, Pred=data_diskriminan$status_pada_fisher)
cm
##       Pred
## Actual Bad Good
##   Bad   38    9
##   Good  12   41

Kelompok bad yang diklasifikasikan ke dalam kelompok “good”

cm["Bad","Good"]
## [1] 9
# Error Bad = Bad predicted as Good
err_bad <- (cm["Bad","Good"] / sum(data_diskriminan$Status=="Bad"))*100

Kelompok good yang diklasifikasikan ke dalam kelompok “bad”

cm["Good","Bad"]
## [1] 12
# Error Good = Good predicted as Bad
err_good <- (cm["Good","Bad"] / sum(data_diskriminan$Status=="Good"))*100
cat("--- Kelompok bad yang diklasifikasikan ke dalam kelompok good (%) ---\n")
## --- Kelompok bad yang diklasifikasikan ke dalam kelompok good (%) ---
print(err_bad)
## [1] 19.14894
cat("--- Kelompok good yang diklasifikasikan ke dalam kelompok bad (%) ---\n")
## --- Kelompok good yang diklasifikasikan ke dalam kelompok bad (%) ---
print(err_good)
## [1] 22.64151