P10 TPG

Denanda Aufadlan & Annisa Permata

2025-04-19

Analisis Diskriminan

Pengantar

Analisis diskriminan adalah salah satu analisis statistik peubah ganda yang digunakan untuk menentukan apakah suatu individu dapat diklasifikasikan berdasarkan variabel-variabel independen tertentu ke dalam kelompok tertentu. Analisis ini dapat membantu dalam memprediksi sebuah objek baru akan termasuk dalam kelompok mana.

Jika pada analisis gerombol sekumpulan individu dikelompokkan berdasarkan kemiripannya, maka pada analisis diskriminan sebuah fungsi dibentuk untuk menentukan perbedaan antar gerombol. Sehingga jika terdapat individu baru, maka fungsi diskriminan dapat digunakan untuk mengklasifikasikan individu tersebut ke dalam kelompok yang sesuai.

Fungsi diskriminan merupakan kombinasi linear dari variabel independen yang signifikan dalam membedakan kelompok-kelompok tersebut. Fungsi diskriminan adalah salah satu komponen kunci dalam analisis diskriminan, dan tujuannya adalah untuk menciptakan pemisahan yang optimal antara kelompok-kelompok yang berbeda berdasarkan karakteristik yang diamati.

Contoh penerapan analisis diskriminan meliputi menentukan penyakit seseorang dengan melihat gejala-gejala yang dialami atau faktor penyerta yang dimiliki, memprediksi penerimaan ke program pendidikan tertentu, dan memprediksi pilihan produk perbankan nasabah berdasarkan faktor-faktor yang mempengaruhi keputusan mereka.

Beberapa cara untuk menduga fungsi diskriminan:

Dengan pendekatan Fisher, jika banyak gerombol yang terbentuk hanya dua. Individu baru akan dikelompokkan ke dalam gerombol yang lebih dekat kemiripannya.
Dengan menggunakan konsep jarak, di mana individu baru akan dikelompokkan ke dalam gerombol yang jarak vektor rataan populasinya lebih dekat. Biasanya konsep jarak yang digunakan adalah dengan Jarak Mahalanobis.
Dengan konsep peluang posterior, di mana individu baru akan diklasifikasikan ke dalam gerombol yang peluang posteriornya lebih besar.

Beberapa jenis pendekatan analisis diskriminan:

Analisis Diskriminan Linear (Linear Discriminant Analysis / LDA) Pendekatan ini adalah pendekatan paling umum dalam analisis diskriminan. LDA mencoba untuk memisahkan kelompok-kelompok dengan mencari fungsi linear yang maksimalkan perbedaan antara kelompok-kelompok. Pendekatan ini bergantung pada asumsi bahwa: 1) sebaran data dalam setiap kelompok adalah normal ganda, 2) memiliki matriks ragam-peragam yang sama, serta 3) biaya salah klasifikasi sama besar untuk setiap populasi. LDA menghasilkan fungsi diskriminan linear.
Analisis Diskriminan Kuadratik (Quadratic Discriminant Analysis / QDA) QDA adalah variasi dari LDA yang mengizinkan matriks ragam-peragam yang berbeda untuk setiap kelompok, yang berarti fungsi diskriminan yang dihasilkan oleh QDA dapat menjadi fungsi kuadratik.
Analisis Diskriminan Kanonik (Canonical Discriminant Analysis / CDA) CDA adalah sebuah teknik statistik yang digunakan dalam analisis diskriminan untuk menemukan kombinasi linear baru dari variabel prediktif yang memiliki diskriminasi maksimal antara dua atau lebih kelompok yang berbeda. CDA adalah pengembangan dari LDA yang mengizinkan lebih dari satu fungsi diskriminan.

Dalam materi ini hanya dipelajari analisis diskriminan linear dan kuadratik.

Langkah-langkah Analisis Diskriminan

Analisis diskriminan dilakukan dengan langkah-langkah berikut:

Membagi data menjadi dua bagian: data latih (train data) dan data uji (test data) Cara untuk membagi dapat dilakukan dengan pengambilan acak. Proporsi data latih dapat sebesar 70% atau 80% dari data asal. Misal, jika memiliki data dengan 100 amatan, maka dipilih secara acak 70 atau 80 amatan sebagai data latihnya. Tujuan dari pembagian data adalah untuk mengukur dan memastikan seberapa baik model yang dibangun dalam memprediksi data yang tidak pernah dilakukan pemodelan sebelumnya. Data latih dipakai untuk membangun model, data uji dipakai untuk menguji kemampuan model yang dibangun.

Dengan menggunakan data latih, lakukan:

Uji normal ganda
Uji asumsi kesamaan ragam. Jika uji ini menghasilkan kesimpulan matriks ragam-peragam sama, maka digunakan Linear Discriminant Analisis (LDA). Jika tidak, maka digunakan Quadratic Discriminant Analisis (QDA).

Catatan:
Menurut Mattjik dan Sumertajaya pada buku Sidik Peubah Ganda, “umumnya sangat sulit sekali untuk dapat memenuhi persyaratan (a) dan (b), yang dalam praktek sering kali tidak diuji; hal mana akan membuat akurasi dari analisis dengan fungsi diskriminan akan berkurang. Namun demikian, fungsi diskriminan selalu menghasilkan estimasi yang kokoh (robust estimates) terutama yang berkaitan dengan prediksi pengelompokan”.

Menurut Mattjik dan Sumertajaya pada buku Sidik Peubah Ganda, “umumnya sangat sulit sekali untuk dapat memenuhi persyaratan (a) dan (b), yang dalam praktek sering kali tidak diuji; hal mana akan membuat akurasi dari analisis dengan fungsi diskriminan akan berkurang. Namun demikian, fungsi diskriminan selalu menghasilkan estimasi yang kokoh (robust estimates) terutama yang berkaitan dengan prediksi pengelompokan”.

Estimasi koefisien analisis diskriminan
Evaluasi kemampuan klasifikasi analisis diskriminan

Evaluasi kemampuan klasifikasi menggunakan data uji

Package yang dibutuhkan

# install.packages("rattle")
# install.packages("caret")
# install.packages("MVN")
# install.packages("heplots")

library(rattle)

## Warning: package 'rattle' was built under R version 4.3.3

## Loading required package: tibble

## Warning: package 'tibble' was built under R version 4.3.2

## Loading required package: bitops

## Warning: package 'bitops' was built under R version 4.3.3

## Rattle: A free graphical interface for data science with R.
## Version 5.5.1 Copyright (c) 2006-2021 Togaware Pty Ltd.
## Type 'rattle()' to shake, rattle, and roll your data.

library(caret)

## Warning: package 'caret' was built under R version 4.3.2

## Loading required package: ggplot2

## Warning: package 'ggplot2' was built under R version 4.3.3

## Loading required package: lattice

library(MVN)

## Warning: package 'MVN' was built under R version 4.3.3

library(heplots)

## Warning: package 'heplots' was built under R version 4.3.3

## Loading required package: broom

## Warning: package 'broom' was built under R version 4.3.3

library(MASS)

Studi Kasus 1

Dataset Wine ini berisi hasil analisis kimia anggur yang tumbuh di daerah tertentu di Italia. Tiga jenis anggur direpresentasikan dalam 178 sampel, dengan hasil dari 13 analisis kimia yang dicatat untuk setiap sampel. Peubah Type telah diubah menjadi peubah kategorik.

Menyiapkan Data

data(wine, package = "rattle")
head(wine)

##   Type Alcohol Malic  Ash Alcalinity Magnesium Phenols Flavanoids Nonflavanoids
## 1    1   14.23  1.71 2.43       15.6       127    2.80       3.06          0.28
## 2    1   13.20  1.78 2.14       11.2       100    2.65       2.76          0.26
## 3    1   13.16  2.36 2.67       18.6       101    2.80       3.24          0.30
## 4    1   14.37  1.95 2.50       16.8       113    3.85       3.49          0.24
## 5    1   13.24  2.59 2.87       21.0       118    2.80       2.69          0.39
## 6    1   14.20  1.76 2.45       15.2       112    3.27       3.39          0.34
##   Proanthocyanins Color  Hue Dilution Proline
## 1            2.29  5.64 1.04     3.92    1065
## 2            1.28  4.38 1.05     3.40    1050
## 3            2.81  5.68 1.03     3.17    1185
## 4            2.18  7.80 0.86     3.45    1480
## 5            1.82  4.32 1.04     2.93     735
## 6            1.97  6.75 1.05     2.85    1450

dim(wine)

## [1] 178  14

Diperoleh bahwa data terdiri dari 13 peubah prediktor dan 1 peubah respon sebagai berikut:

Nama peubah	Keterangan
`Type`	Tipe anggur, terdiri dari: 1 (59 amatan), 2 (71 amatan), dan 3 (48 amatan)
`Alcohol`	Kadar alkohol
`Malic`	Kadar asam malat
`Ash`	Abu
`Alcalinity`	Alkalinitas abu
`Magnesium`	Kadar Magnesium
`Phenols`	Total fenol
`Flavonoids`	Kadar fenol flavonoid
`Nonflavonoids`	Kadar fenol nonflavonoid
`Proanthocyanins`	Proantosianidin
`Color`	Intensitas warna
`Hue`	Spektrum warna
`Dilution`	Dilusi anggur D280/OD315
`Proline`	Kadar prolin

Menampilkan sebagian data dan tipe peubahnya sebagai berikut:

glimpse(wine)

## Rows: 178
## Columns: 14
## $ Type            <fct> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …
## $ Alcohol         <dbl> 14.23, 13.20, 13.16, 14.37, 13.24, 14.20, 14.39, 14.06…
## $ Malic           <dbl> 1.71, 1.78, 2.36, 1.95, 2.59, 1.76, 1.87, 2.15, 1.64, …
## $ Ash             <dbl> 2.43, 2.14, 2.67, 2.50, 2.87, 2.45, 2.45, 2.61, 2.17, …
## $ Alcalinity      <dbl> 15.6, 11.2, 18.6, 16.8, 21.0, 15.2, 14.6, 17.6, 14.0, …
## $ Magnesium       <int> 127, 100, 101, 113, 118, 112, 96, 121, 97, 98, 105, 95…
## $ Phenols         <dbl> 2.80, 2.65, 2.80, 3.85, 2.80, 3.27, 2.50, 2.60, 2.80, …
## $ Flavanoids      <dbl> 3.06, 2.76, 3.24, 3.49, 2.69, 3.39, 2.52, 2.51, 2.98, …
## $ Nonflavanoids   <dbl> 0.28, 0.26, 0.30, 0.24, 0.39, 0.34, 0.30, 0.31, 0.29, …
## $ Proanthocyanins <dbl> 2.29, 1.28, 2.81, 2.18, 1.82, 1.97, 1.98, 1.25, 1.98, …
## $ Color           <dbl> 5.64, 4.38, 5.68, 7.80, 4.32, 6.75, 5.25, 5.05, 5.20, …
## $ Hue             <dbl> 1.04, 1.05, 1.03, 0.86, 1.04, 1.05, 1.02, 1.06, 1.08, …
## $ Dilution        <dbl> 3.92, 3.40, 3.17, 3.45, 2.93, 2.85, 3.58, 3.58, 2.85, …
## $ Proline         <int> 1065, 1050, 1185, 1480, 735, 1450, 1290, 1295, 1045, 1…

Tahap #1 : Membagi data menjadi data latih dan data uji

Pembagian data dapat dilakukan dengan menggunakan fungsi createDataPartition() dari pacakge caret. Sintaks caret::createDataPartition() berarti kita memanggil fungsi createDataPartition() dari caret tanpa perlu memanggil package caret menggunakan library(caret). Argumen y merupakan peubah respon/gerombol, p merupakan proporsi data latih (dalam hal ini 0.7 atau 70%), list=FALSE berarti hasil output dari createDataPartition() disimpan dalam bentuk vektor (defaultnya list=TRUE)

set.seed(123)
index_train <- caret::createDataPartition(y = wine$Type, p = 0.7, list = FALSE)
wine_train <- wine[index_train,]
wine_test <- wine[-index_train,]

index_train berisi vektor dari urutan/indeks amatan (1, 2, …, dst) yang telah dilakukan pengambilan contoh secara acak.

Tahap #2 : Pembangunan model dengan data latih

Dengan menggunakan data latih yang telah diambil, dilakukan langkah berikut:

Uji normalitas ganda

H0: Data menyebar normal ganda H1: Data tidak menyebar normal ganda

Untuk menguji kenormalan ganda di R, bisa menggunakan fungsi mvn() dari package MVN. Fungsi mvn memiliki beberapa uji normal ganda yang bisa dilakukan. Pemilihan uji normal ganda bisa dilakukan melauli argumen mvnTest, seperti uji Mardia (mvnTest="mardia"), uji Henze-Zirkler (mvnTest="hz"), uji Royston (mvnTest="royston"), uji Doornik-Hansen (mvnTest="dh"), dan uji energy (mvnTest="energy"). Argumen subset diisi dengan kolom data yang menyatakan gerombol.

uji_normalGanda <- mvn(data = wine_train, subset="Type", mvnTest = "hz")
uji_normalGanda$multivariateNormality

## $`1`
##            Test        HZ   p value MVN
## 1 Henze-Zirkler 0.9917837 0.1761976 YES
## 
## $`2`
##            Test       HZ      p value MVN
## 1 Henze-Zirkler 1.008078 0.0003652993  NO
## 
## $`3`
##            Test        HZ   p value MVN
## 1 Henze-Zirkler 0.9909895 0.1661439 YES

Karena nilai dari p-value dari $1 dan $3 adalah 0.1761976 dan 0.1661439, yang mana lebih besar dari nilai α (0.05) maka dapat disimpulkan bahwa tidak cukup bukti untuk menolak H0. Artinya, untuk peubah-peubah penjelas pada wine tipe 1 dan tipe 3 berdistribusi normal ganda. Sementera itu, p-value dari $2 sangat kecil yaitu 0.0003652993 yang mana lebih kecil dari nilai α (0.05). Artinya peubah-puebah penjelas pada wine tipe 2 tidak berdistribusi normal ganda.

Catatan:
Jika salah satu uji normal ganda menyatakan Tolak H0 maka perlu dicoba uji kenormalan yang lain, karena berpotensi hasil dari uji normal ganda lainnya menghasilkan kesimpulan yang berbeda.
Walaupun ada satu gerombol yang tidak memenuhi asumsi normal ganda, analisis akan tetap dilanjutkan menggunakan analisis diskriminan karena berdasarkan Matjik dan Sumertajaya, fungsi diskriminan masih dapat menghasilkan kemampuan klasifikasi yang baik.

Uji kesamaan ragam

H0: Ragam antar populasi sama H1: Ragam antar populasi tidak sama

Uji kesamaan ragam bisa dilakukan dengan menggunkan fungsi boxM() yang berasal dari package heplots. Fungsi ini hanya membutuhkan 2 argumen, yaitu data dalam bentuk data.frame atau matrix tanpa kolom gerombol (dalam hal ini kolom Type) dan vektor gerombol yang diperoleh dari data (dalam hal ini kolom Type).
```
boxM(wine_train[,-1],wine_train$Type)
```
```
## 
##  Box's M-test for Homogeneity of Covariance Matrices
## 
## data:  wine_train[, -1]
## Chi-Sq (approx.) = 502.42, df = 182, p-value < 2.2e-16
```
Karena nilai dari p-value dari uji Box’s M adalah kurang dari 2.2e-16, yang mana lebih kecil dari nilai α (0.05) maka dapat disimpulkan bahwa cukup bukti untuk menolak H0. Artinya untuk peubah-puebah penjelas pada wine memiliki ragam yang tidak sama. Hal ini berarti model yang lebih cocok digunakan adalah QDA.

Untuk ilustrasi kita akan menggunakan LDA juga karena LDA juga berpotensi mengungguli QDA dalam hal kemampuan klasifikasi berdasarkan argumen dari Matjik dan Sumertajaya.
Estimasi koefisien analisis diskriminan

Estimasi LDA dan QDA dapat dilakukan dengan menggunakan fungsi lda() dan qda() dari package MASS. Argumen minimum yang dibutuhkan oleh kedua fungsi tersebut adalah formula dan data. Argumen formula berisi tentang rumus model yang digunakan tanpa koefisien, Type ~ . berarti kolom Type menjadi peubah respon dan . menandakan memakai semua kolom kecuali kolom Type sebagai peubah penjelas. Argumen data berisi tentang data yang kita gunakan.
```
# LDA
wine_lda <- lda(Type ~ ., data = wine_train)
coef(wine_lda)
```
```
##                          LD1          LD2
## Alcohol         -0.483076356  0.854816559
## Malic            0.224630564  0.354730236
## Ash             -0.672781084  2.639186194
## Alcalinity       0.152999471 -0.168693427
## Magnesium       -0.001907630 -0.004035584
## Phenols          0.705495150  0.523268740
## Flavanoids      -1.735333782 -0.868717551
## Nonflavanoids   -0.760204649 -1.589205566
## Proanthocyanins  0.092670993 -0.365830979
## Color            0.410568456  0.277565083
## Hue             -0.089314921 -1.096511470
## Dilution        -0.882807209  0.087609503
## Proline         -0.002645145  0.002808837
```
Karena terdapat tiga gerombol pada data wine maka fungsi diskriminan yang terbentuk sebanyak dua. Secara umum fungsi diskriminan yang terbentuk dari g gerombol adalah g − 1 gerombol.

Fungsi diskriminan pertama dapat ditulis:

\[D_1 = -0.483076356 * Alcohol + 0.224630564 * Malic - 0.672781084 * Ash + 0.152999471 * Alcalinity - 0.001907630 * Magnesium + 0.705495150 * Phenols - 1.735333782 * Flavonoids - 0.760204649 * Nonflavonoids + 0.092670993 * Proanthocyanins + 0.410568456 * Color - 0.089314921 * Hue - 0.882807209 * Dilution - 0.002645145 * Proline\]

Fungsi diskriminan kedua dapat ditulis:

\[D_2 = 0.854816559 * Alcohol + 0.354730236 * Malic + 2.639186194 * Ash - 0.168693427 * Alcalinity - 0.004035584 * Magnesium + 0.523268740 * Phenols - 0.868717551 * Flavonoids - 1.589205566 * Nonflavonoids - 0.365830979 * Proanthocyanins + 0.277565083 * Color - 1.096511470 * Hue + 0.087609503 * Dilution + 0.002808837 * Proline\]
```
# QDA
wine_qda <- qda(Type ~ ., data = wine_train)
coef(wine_qda)
```
```
## NULL
```
Berbeda dengan LDA, QDA tidak memiliki koefisien yang bisa ditampilkan.

Evaluasi kemampuan klasifikasi analisis diskriminan

Sebelum kita mengevaluasi kedua model, maka kita akan mengekstrak prediksi gerombol yang dihasilkan oleh kedua model.

predict_lda <- predict(wine_lda)
predict_qda <- predict(wine_qda)

predict_lda$posterior

##                1            2            3
## 2   9.999997e-01 3.144314e-07 8.513224e-16
## 3   9.999978e-01 2.171406e-06 1.675340e-13
## 5   9.648299e-01 3.516984e-02 2.343457e-07
## 6   1.000000e+00 1.034761e-11 5.403316e-17
## 7   1.000000e+00 1.111658e-11 7.071100e-17
## 8   1.000000e+00 9.296263e-11 2.058526e-15
## 9   1.000000e+00 3.118331e-08 3.761270e-15
## 10  9.999991e-01 9.406935e-07 1.021837e-12
## 12  9.999999e-01 8.699638e-08 1.370100e-13
## 13  1.000000e+00 1.601509e-08 4.143705e-14
## 14  1.000000e+00 5.426258e-11 1.403619e-20
## 15  1.000000e+00 8.030774e-14 7.226299e-20
## 17  1.000000e+00 6.740037e-09 1.494178e-13
## 19  1.000000e+00 2.521727e-13 7.649377e-19
## 21  9.999081e-01 9.189749e-05 2.234870e-13
## 23  9.999997e-01 3.049372e-07 1.964999e-17
## 24  9.998349e-01 1.651399e-04 6.545533e-12
## 25  9.996043e-01 3.956621e-04 8.947755e-13
## 26  9.768277e-01 2.317234e-02 2.046641e-09
## 27  1.000000e+00 4.528073e-09 1.683626e-15
## 28  9.999512e-01 4.880447e-05 4.193117e-11
## 29  9.999966e-01 3.361748e-06 1.782214e-13
## 31  9.999912e-01 8.777260e-06 2.184737e-12
## 35  9.999913e-01 8.735357e-06 5.530644e-12
## 37  9.999973e-01 2.697930e-06 1.072853e-11
## 38  9.996321e-01 3.679437e-04 9.452694e-10
## 40  1.000000e+00 8.197071e-09 5.757023e-13
## 42  9.982426e-01 1.757374e-03 2.258262e-09
## 43  1.000000e+00 6.482519e-11 4.008380e-18
## 44  8.169232e-01 1.830740e-01 2.793597e-06
## 46  1.000000e+00 3.443529e-08 2.190497e-10
## 47  1.000000e+00 1.468003e-08 1.836822e-14
## 48  9.999806e-01 1.936226e-05 1.560347e-13
## 50  9.999997e-01 3.240659e-07 6.871800e-13
## 51  9.999054e-01 9.463593e-05 2.303445e-12
## 52  1.000000e+00 4.156289e-09 2.010313e-16
## 53  1.000000e+00 5.851631e-10 5.447185e-16
## 54  1.000000e+00 5.501530e-10 2.319404e-13
## 56  9.994981e-01 5.018353e-04 2.545889e-08
## 57  9.999979e-01 2.055166e-06 1.685905e-11
## 58  1.000000e+00 1.010424e-08 3.726028e-14
## 59  1.000000e+00 2.962039e-09 3.428417e-15
## 62  6.709283e-09 9.750553e-01 2.494468e-02
## 63  1.871574e-04 9.998124e-01 4.493809e-07
## 64  1.484654e-07 9.999999e-01 3.212964e-10
## 65  1.326536e-08 1.000000e+00 3.293661e-08
## 66  5.913137e-04 9.994087e-01 1.074438e-08
## 67  2.031806e-05 9.999797e-01 1.726625e-12
## 71  1.424837e-06 9.999609e-01 3.767189e-05
## 72  3.181442e-04 9.996819e-01 2.634798e-09
## 73  1.151942e-06 9.999969e-01 1.901396e-06
## 74  9.308589e-04 9.990691e-01 2.292894e-10
## 75  3.546214e-04 9.996444e-01 9.625905e-07
## 76  8.658144e-11 9.999999e-01 8.015463e-08
## 78  1.033810e-07 9.999929e-01 7.007966e-06
## 80  1.162328e-06 9.999988e-01 4.437293e-09
## 81  4.063426e-11 1.000000e+00 2.838301e-13
## 82  2.309984e-03 9.976900e-01 2.363345e-10
## 84  1.484599e-07 9.741835e-01 2.581636e-02
## 85  7.479868e-05 9.999252e-01 1.835492e-09
## 88  1.089766e-09 1.000000e+00 7.010256e-09
## 89  4.285041e-07 9.999995e-01 9.817562e-08
## 90  3.347912e-08 1.000000e+00 1.220374e-09
## 91  1.958067e-08 1.000000e+00 2.463521e-08
## 93  8.777684e-09 9.999999e-01 1.160576e-07
## 94  1.901198e-07 9.999998e-01 2.830718e-10
## 96  9.827096e-05 9.999017e-01 1.219451e-11
## 97  1.860197e-06 9.879394e-01 1.205872e-02
## 98  1.069676e-07 9.999999e-01 5.391851e-12
## 100 6.005056e-08 9.999999e-01 1.331233e-13
## 101 1.274205e-07 9.999999e-01 3.040774e-11
## 102 8.158630e-08 9.999999e-01 3.487878e-09
## 103 2.523724e-05 9.999746e-01 1.660304e-07
## 104 8.288652e-12 1.000000e+00 1.215048e-08
## 106 4.983289e-09 1.000000e+00 2.135994e-10
## 107 4.458487e-07 9.999996e-01 1.054393e-10
## 108 1.843169e-08 1.000000e+00 1.745371e-08
## 111 6.232914e-11 1.000000e+00 1.086294e-09
## 112 2.672700e-08 1.000000e+00 3.287162e-09
## 113 2.836720e-04 9.997154e-01 9.173563e-07
## 114 2.217188e-10 1.000000e+00 1.140650e-08
## 115 1.264709e-07 9.999999e-01 1.207717e-09
## 116 4.140906e-14 1.000000e+00 1.628457e-14
## 118 4.293218e-10 1.000000e+00 7.219221e-12
## 119 6.749375e-07 9.925221e-01 7.477197e-03
## 121 3.511801e-05 9.999649e-01 2.348854e-10
## 122 1.149946e-04 9.998850e-01 1.333871e-16
## 123 1.410093e-07 9.999992e-01 6.501964e-07
## 126 3.757931e-08 1.000000e+00 1.009632e-11
## 128 4.735253e-11 1.000000e+00 6.184908e-09
## 129 1.527834e-10 1.000000e+00 2.932315e-12
## 130 1.110028e-06 9.998399e-01 1.589836e-04
## 134 1.816951e-10 2.355927e-04 9.997644e-01
## 135 2.995303e-10 1.335645e-03 9.986644e-01
## 136 1.029284e-11 1.612693e-05 9.999839e-01
## 137 1.696686e-11 4.256254e-06 9.999957e-01
## 140 5.756338e-12 7.288222e-06 9.999927e-01
## 141 8.879447e-08 1.222314e-04 9.998777e-01
## 142 1.361233e-06 3.238520e-05 9.999663e-01
## 144 4.853060e-09 9.570992e-06 9.999904e-01
## 145 8.710968e-12 6.101333e-08 9.999999e-01
## 146 2.877283e-08 6.010066e-04 9.993990e-01
## 147 1.866969e-13 1.830794e-08 1.000000e+00
## 150 2.349287e-14 1.758564e-08 1.000000e+00
## 151 1.990281e-12 3.060199e-07 9.999997e-01
## 152 1.145122e-16 8.024713e-10 1.000000e+00
## 153 1.002748e-14 5.489684e-07 9.999995e-01
## 154 5.222674e-16 3.274149e-11 1.000000e+00
## 156 3.253021e-16 6.592939e-11 1.000000e+00
## 157 1.745125e-15 1.731822e-11 1.000000e+00
## 158 2.208763e-15 9.076036e-09 1.000000e+00
## 159 1.301554e-17 5.530515e-14 1.000000e+00
## 160 1.012130e-17 9.092063e-13 1.000000e+00
## 163 1.072763e-10 3.917144e-05 9.999608e-01
## 164 1.776387e-08 4.136621e-05 9.999586e-01
## 165 2.873356e-15 2.803693e-10 1.000000e+00
## 166 2.852851e-14 5.153966e-08 9.999999e-01
## 167 7.877405e-17 1.562808e-12 1.000000e+00
## 168 1.549242e-16 1.381819e-11 1.000000e+00
## 169 1.058280e-12 2.883610e-09 1.000000e+00
## 172 4.314152e-18 1.022136e-10 1.000000e+00
## 174 1.722436e-13 3.124710e-12 1.000000e+00
## 175 1.551885e-13 1.785867e-09 1.000000e+00
## 176 5.920241e-16 1.019208e-12 1.000000e+00
## 177 3.938303e-13 1.210226e-09 1.000000e+00
## 178 4.388704e-17 1.095221e-13 1.000000e+00

predict_qda$posterior

##                 1            2             3
## 2    1.000000e+00 2.431863e-11  1.026640e-89
## 3    1.000000e+00 9.347747e-09 1.174939e-102
## 5    9.999223e-01 7.765144e-05  2.406939e-48
## 6    1.000000e+00 9.362588e-20 6.521932e-148
## 7    1.000000e+00 1.302118e-16  7.737585e-91
## 8    1.000000e+00 7.131311e-15  3.071051e-83
## 9    1.000000e+00 2.077463e-12 1.500519e-102
## 10   1.000000e+00 2.762708e-10 4.083939e-100
## 12   1.000000e+00 4.982123e-12  2.103386e-84
## 13   1.000000e+00 1.770033e-14 1.725156e-104
## 14   1.000000e+00 3.712035e-21 1.082856e-172
## 15   1.000000e+00 3.010085e-24 1.153540e-172
## 17   1.000000e+00 6.335471e-12 1.049981e-103
## 19   1.000000e+00 2.226067e-23 1.489785e-223
## 21   1.000000e+00 4.311541e-08  3.042648e-81
## 23   1.000000e+00 1.962227e-10  2.719553e-98
## 24   9.999997e-01 2.914222e-07  1.419186e-61
## 25   9.999982e-01 1.833105e-06  8.389216e-71
## 26   9.996648e-01 3.351963e-04  2.249975e-56
## 27   1.000000e+00 9.356151e-14 6.807154e-110
## 28   1.000000e+00 4.842266e-10  3.573356e-63
## 29   1.000000e+00 1.122566e-08  6.314969e-86
## 31   1.000000e+00 6.552977e-10 1.242564e-107
## 35   1.000000e+00 1.520038e-08  1.031539e-63
## 37   1.000000e+00 3.468277e-08  4.539438e-67
## 38   1.000000e+00 4.380499e-08  8.748969e-61
## 40   1.000000e+00 3.733146e-11  4.334609e-72
## 42   9.999998e-01 1.547521e-07  7.440926e-78
## 43   1.000000e+00 1.390172e-12 8.532311e-136
## 44   9.969324e-01 3.067607e-03  7.659689e-53
## 46   1.000000e+00 8.984126e-11  3.973240e-78
## 47   1.000000e+00 9.431096e-12 6.697565e-104
## 48   9.999999e-01 1.000860e-07 5.068389e-108
## 50   1.000000e+00 1.364448e-12 9.977645e-134
## 51   1.000000e+00 6.104937e-10 2.000196e-105
## 52   1.000000e+00 7.739263e-13 3.416056e-111
## 53   1.000000e+00 3.380512e-15 3.818011e-152
## 54   1.000000e+00 1.762438e-15  2.348201e-98
## 56   9.999974e-01 2.644682e-06  1.801792e-54
## 57   1.000000e+00 3.262986e-10  1.399427e-76
## 58   1.000000e+00 8.601804e-14 2.836322e-120
## 59   1.000000e+00 2.932804e-12 3.899426e-135
## 62   1.717382e-24 1.000000e+00  2.688739e-11
## 63   1.226533e-09 1.000000e+00  2.716216e-34
## 64   5.229511e-19 1.000000e+00  7.384809e-69
## 65   1.073119e-14 1.000000e+00  2.700475e-28
## 66   6.743108e-03 9.932569e-01  1.719059e-50
## 67   7.713928e-07 9.999992e-01  7.761000e-97
## 71   3.066406e-13 1.000000e+00  1.968930e-09
## 72   2.768941e-18 1.000000e+00  3.087583e-60
## 73   1.020695e-08 1.000000e+00  3.482805e-27
## 74   3.237256e-21 1.000000e+00  2.304321e-63
## 75   3.126492e-16 1.000000e+00  2.313092e-32
## 76   1.192329e-14 1.000000e+00  1.087141e-24
## 78   1.471389e-09 1.000000e+00  1.726665e-12
## 80   1.465588e-08 1.000000e+00  4.269884e-58
## 81   8.802759e-17 1.000000e+00  1.739147e-59
## 82   2.929634e-01 7.070366e-01  8.161333e-62
## 84   1.131729e-23 1.000000e+00  7.438520e-20
## 85   1.092823e-06 9.999989e-01  1.280864e-43
## 88   5.016643e-09 1.000000e+00  6.265273e-41
## 89   7.633067e-09 1.000000e+00  9.154378e-31
## 90   6.855944e-11 1.000000e+00  2.956198e-38
## 91   3.488727e-13 1.000000e+00  1.575216e-28
## 93   3.065764e-22 1.000000e+00  9.982236e-27
## 94   1.043307e-06 9.999990e-01  5.893477e-55
## 96   2.751174e-39 1.000000e+00  4.039245e-45
## 97   1.094362e-11 1.000000e+00  2.803946e-14
## 98   6.854214e-10 1.000000e+00  1.400273e-55
## 100  4.368616e-16 1.000000e+00  2.279242e-96
## 101  6.792747e-12 1.000000e+00  1.039336e-52
## 102  3.183549e-07 9.999997e-01  6.045868e-26
## 103  3.846802e-03 9.961532e-01  6.131959e-38
## 104  3.381940e-15 1.000000e+00  9.813457e-28
## 106  1.514621e-26 1.000000e+00  3.426630e-57
## 107  3.724238e-08 1.000000e+00  3.721417e-53
## 108  5.419781e-18 1.000000e+00  1.403323e-35
## 111  3.598533e-23 1.000000e+00  7.844289e-83
## 112  1.788085e-05 9.999821e-01  4.919688e-38
## 113  7.219998e-11 1.000000e+00  6.154649e-42
## 114  8.880428e-12 1.000000e+00  9.822856e-27
## 115  2.002195e-09 1.000000e+00  2.001769e-48
## 116  1.955372e-34 1.000000e+00  5.529710e-85
## 118  7.509520e-08 9.999999e-01  5.994603e-43
## 119  2.279344e-18 1.000000e+00  4.615601e-10
## 121  8.594643e-07 9.999991e-01  9.076572e-71
## 122  1.069614e-37 1.000000e+00 2.474087e-238
## 123  1.933288e-04 9.998067e-01  5.687343e-47
## 126  1.053902e-08 1.000000e+00  2.807786e-72
## 128  5.094235e-14 1.000000e+00  1.563930e-49
## 129  3.925282e-11 1.000000e+00  2.190713e-58
## 130  1.847332e-07 9.999998e-01  1.545375e-28
## 134  8.152584e-22 3.072357e-08  1.000000e+00
## 135  4.235410e-52 5.136971e-09  1.000000e+00
## 136  5.994476e-54 1.631317e-12  1.000000e+00
## 137  2.583512e-30 3.160117e-05  9.999684e-01
## 140  9.859983e-37 1.336714e-10  1.000000e+00
## 141  2.117249e-33 2.422567e-07  9.999998e-01
## 142  7.089073e-32 7.579848e-08  9.999999e-01
## 144  6.289695e-30 3.187701e-07  9.999997e-01
## 145  8.242577e-36 4.147562e-21  1.000000e+00
## 146  1.245905e-25 1.196096e-03  9.988039e-01
## 147  1.028356e-52 1.128078e-08  1.000000e+00
## 150  1.496748e-50 2.702471e-24  1.000000e+00
## 151  2.414970e-45 4.964268e-21  1.000000e+00
## 152  5.010010e-69 9.895045e-41  1.000000e+00
## 153  2.211864e-40 1.162981e-17  1.000000e+00
## 154  1.082706e-93 2.682426e-42  1.000000e+00
## 156  3.960269e-67 8.397210e-24  1.000000e+00
## 157  1.761916e-81 1.442312e-31  1.000000e+00
## 158  8.289653e-57 4.793581e-20  1.000000e+00
## 159 9.352829e-133 2.850232e-88  1.000000e+00
## 160 2.127316e-120 3.319343e-67  1.000000e+00
## 163  7.156711e-36 6.540185e-11  1.000000e+00
## 164  3.210934e-28 1.370294e-06  9.999986e-01
## 165  5.900181e-75 1.463113e-31  1.000000e+00
## 166  4.037611e-53 1.850255e-15  1.000000e+00
## 167  4.890889e-70 6.341767e-43  1.000000e+00
## 168  1.342315e-78 6.092491e-39  1.000000e+00
## 169  5.370434e-53 3.971053e-26  1.000000e+00
## 172  1.593879e-93 4.810338e-35  1.000000e+00
## 174  3.856416e-61 1.239510e-21  1.000000e+00
## 175  2.337474e-45 2.548186e-18  1.000000e+00
## 176  6.030837e-63 3.961186e-36  1.000000e+00
## 177  4.814528e-62 4.250456e-28  1.000000e+00
## 178  5.863177e-90 1.648242e-35  1.000000e+00

library(ggplot2)

# Membuat dataframe baru dengan nilai fungsi diskriminan
plot_lda <- data.frame(predict_lda$x, Status = predict_lda$class)

# Scatter plot dari dua fungsi diskriminan
ggplot(plot_lda, aes(x = LD1, y = LD2, color = Status)) +
  geom_point(size = 3) +
  labs(title = "LDA Scatter Plot", x = "Fungsi Diskriminan 1 (LD1)", y = "Fungsi Diskriminan 2 (LD2)") +
  theme_minimal()

Menggunakan histogram (khusus LDA)

# fungsi diskriminan pertama
ldahist(predict_lda$x[,1], g = wine_train$Type)

# fungsi diskriminan kedua
ldahist(predict_lda$x[,2], g = wine_train$Type)

Histogram fungsi diskriminan pertama, digunakan untuk melihat kemampuan fungsi diskriminan yang pertama dalam membedakan ketiga gerombol. Karena histogram kedua dan ketiga hanya beririsan di dipinggirnya saja, maka dapat dikatakan bahwa fungsi diskriminan pertama cukup baik untuk membedakan gerombol 2 dan gerombol 3. Sedangkan histogram pertama dan ketiga tidak beririsan sama sekali, yang berarti fungsi diskriminan pertama memiliki kemampuan membedakan gerombol 1 dan gerombol 3 dengan sangat baik. Di sisi lain histogram pertama dan histogram kedua relatif besar irisanya sehingga bisa dikatakan fungsi diskriminan pertama tidak terlalu baik dalam membedakan kelompok 1 dan kelompok 2.

Histogram fungsi diskriminan kedua memiliki interpretasi yang mirip seperti yang diatas. Berdasrkan histogram ini, fungsi diskriminan kedua tidak mampu membedakan gerombol 1 dan gerombol 3.

Tabel klasfikasi dan tingkat kesalahan klasifikasi

Tabel klasifikasi bisa dimunculkan dengan menggunakan fungsi table, yang argumen pertamanya merupakan gerombol asli dan argumen keduanya merupakan gerombol hasil prediksi.

# LDA
table(wine_train$Type, predict_lda$class)

##    
##      1  2  3
##   1 42  0  0
##   2  0 50  0
##   3  0  0 34

# QDA
table(wine_train$Type, predict_qda$class)

##    
##      1  2  3
##   1 42  0  0
##   2  0 50  0
##   3  0  0 34

Baris melambangkan gerombol asli dan kolom melambangkan gerombol hasil perdiksi. Contoh membaca tabel ini adalah sebagai berikut: misalnya saja banyaknya gerombol 1 yang terprediksi sebagai gerombol 1 juga adalah 42, banyaknya gerombol 2 yang terprediksi gerombol 3 adalah 0.

Berdasarkan kedua tabel klasifikasi ini bisa dilihat bahwa LDA dan QDA tidak memiliki kesalahan dalam memprediksi ketiga gerombol tersebut. Hal ini ditunjukkan dengan hanya diagonal tabel saja yang berisi nilai. Tingkat kesalahan klasifikasi dihitung dengan menjumlahkan berapa banyak kesalahan prediksi gerombol yang dilakukan oleh model dibagi dengan banyaknya amatan data.

Menghitung tingkat kesalahan klasifikasi dengan:

#LDA
sum(wine_train$Type != predict_lda$class)/length(predict_lda$class)

## [1] 0

#QDA
sum(wine_train$Type != predict_qda$class)/length(predict_qda$class)

## [1] 0

Hasil tingkat kesalahan klasifikasi 0, berarti model LDA mampu memprediksi gerombol untuk semua amatan dengan benar. Pada output selanjutnya, dapat disimpulkan bahwa kemampuan klasifikasi LDA dan QDA sama walaupun menurut uji kesamaan ragam model yang lebih cocok adalah model QDA.

Tahap #3 : Evaluasi kemampuan klasifikasi model dengan data uji

Pada tahap terakhir ini akan dilakukan evaluasi kemampuan klasifikasi jika seandainya terdapat data baru yang tidak terlibat dalam proses pemodelan. Sebelum mengevaluasi kedua model, maka akan dilakukan ekstraksi prediksi gerombol yang dihasilkan oleh kedua model pada data baru ini. Argumen newdata disi dengan data baru (data uji).

predict_lda_test <- predict(wine_lda, newdata = wine_test)
predict_qda_test <- predict(wine_qda, newdata = wine_test)

predict_lda_test$posterior

##                1            2            3
## 1   1.000000e+00 4.875557e-09 3.853483e-17
## 4   1.000000e+00 4.030399e-13 7.308811e-16
## 11  1.000000e+00 9.123041e-10 1.541239e-17
## 16  1.000000e+00 3.976066e-09 5.064375e-12
## 18  9.999904e-01 9.586290e-06 4.037998e-12
## 20  9.999997e-01 3.175914e-07 1.098276e-12
## 22  9.948804e-01 5.119299e-03 2.953033e-07
## 30  9.999955e-01 4.463270e-06 3.667419e-12
## 32  1.000000e+00 3.315867e-08 8.030066e-14
## 33  9.991647e-01 8.353158e-04 5.020180e-13
## 34  9.999997e-01 3.182214e-07 5.345069e-13
## 36  9.946068e-01 5.393228e-03 3.844406e-11
## 39  9.833359e-01 1.666415e-02 4.812709e-12
## 41  9.975139e-01 2.486100e-03 2.088430e-11
## 45  8.881642e-01 1.118358e-01 1.915182e-10
## 49  9.999257e-01 7.431778e-05 5.422472e-10
## 55  9.999953e-01 4.717471e-06 1.319253e-12
## 60  3.758505e-09 9.999695e-01 3.054486e-05
## 61  4.375811e-06 9.997505e-01 2.451573e-04
## 68  9.174159e-08 9.999999e-01 4.154126e-09
## 69  4.277056e-02 9.534430e-01 3.786418e-03
## 70  1.943036e-08 1.000000e+00 7.255338e-10
## 77  1.340028e-08 1.000000e+00 4.074888e-09
## 79  2.219266e-06 9.999978e-01 2.218766e-10
## 83  1.995432e-08 1.000000e+00 9.840721e-09
## 86  5.798251e-06 9.999942e-01 2.297832e-10
## 87  9.458718e-11 1.000000e+00 2.280826e-09
## 92  5.219414e-10 9.999985e-01 1.479101e-06
## 95  1.968927e-08 9.999999e-01 1.047231e-07
## 99  8.490222e-05 9.999151e-01 3.841232e-13
## 105 5.158619e-06 9.999948e-01 3.009125e-10
## 109 1.300684e-10 1.000000e+00 3.180283e-11
## 110 8.917824e-04 9.991082e-01 2.000794e-12
## 117 7.323682e-10 1.000000e+00 1.015509e-10
## 120 8.698355e-08 9.999999e-01 2.293229e-09
## 124 1.569591e-05 9.999836e-01 7.359999e-07
## 125 1.918698e-06 9.999981e-01 3.024600e-10
## 127 1.145950e-07 9.999999e-01 1.325622e-11
## 131 2.222924e-05 8.751528e-01 1.248250e-01
## 132 1.776100e-08 3.573497e-03 9.964265e-01
## 133 7.946472e-11 4.121354e-03 9.958786e-01
## 138 1.400401e-15 1.261608e-07 9.999999e-01
## 139 3.246613e-11 3.874020e-06 9.999961e-01
## 143 2.640284e-09 2.483637e-05 9.999752e-01
## 148 4.576547e-15 9.174096e-11 1.000000e+00
## 149 4.096206e-15 2.299287e-10 1.000000e+00
## 155 1.244048e-13 5.889080e-05 9.999411e-01
## 161 7.860148e-17 2.603112e-09 1.000000e+00
## 162 1.588767e-09 1.889476e-07 9.999998e-01
## 170 2.521964e-15 9.258072e-13 1.000000e+00
## 171 4.081469e-12 5.208364e-05 9.999479e-01
## 173 2.157793e-13 9.150515e-12 1.000000e+00

predict_qda_test$posterior

##                1            2             3
## 1   1.000000e+00 5.497691e-12  4.557152e-90
## 4   1.000000e+00 3.500303e-18 9.337822e-143
## 11  1.000000e+00 1.711624e-13 1.826141e-135
## 16  1.000000e+00 4.007365e-10 6.417266e-100
## 18  1.000000e+00 2.170210e-08 1.544736e-116
## 20  9.999993e-01 6.848566e-07  2.657149e-73
## 22  9.997013e-01 2.987156e-04  2.027040e-49
## 30  1.000000e+00 4.591563e-09  1.333242e-59
## 32  1.000000e+00 3.915954e-14 5.224939e-122
## 33  9.999986e-01 1.439511e-06  3.375716e-76
## 34  1.000000e+00 4.709420e-10  6.595713e-87
## 36  9.999503e-01 4.972514e-05  7.407401e-83
## 39  9.999772e-01 2.278152e-05  3.033734e-71
## 41  9.999969e-01 3.083904e-06  5.370129e-84
## 45  9.630834e-01 3.691664e-02  1.473569e-75
## 49  1.000000e+00 4.306093e-08  6.823038e-77
## 55  9.999979e-01 2.102593e-06  2.567375e-75
## 60  2.558430e-27 1.000000e+00  4.636512e-17
## 61  1.011578e-18 1.000000e+00  4.175928e-14
## 68  4.342076e-07 9.999996e-01  5.208573e-48
## 69  1.840384e-07 9.999998e-01  1.958750e-16
## 70  7.775942e-31 1.000000e+00  6.982064e-52
## 77  1.209390e-11 1.000000e+00  7.532973e-39
## 79  1.776445e-25 1.000000e+00  7.254365e-35
## 83  2.725795e-09 1.000000e+00  2.662808e-32
## 86  4.852779e-05 9.999515e-01  3.287247e-33
## 87  2.614869e-10 1.000000e+00  8.501033e-35
## 92  1.390051e-14 1.000000e+00  2.253381e-26
## 95  4.515627e-18 1.000000e+00  3.284571e-35
## 99  1.180989e-07 9.999999e-01 1.099966e-112
## 105 9.170073e-05 9.999083e-01  1.118680e-49
## 109 3.104087e-13 1.000000e+00  1.226360e-48
## 110 4.195687e-05 9.999580e-01  4.004338e-75
## 117 3.667146e-08 1.000000e+00  2.048740e-43
## 120 2.481544e-08 1.000000e+00  7.260516e-42
## 124 2.471431e-04 9.997529e-01  5.462604e-69
## 125 4.418492e-07 9.999996e-01 3.053074e-109
## 127 8.907983e-15 1.000000e+00  3.361255e-83
## 131 1.205242e-16 2.727966e-01  7.272034e-01
## 132 2.319248e-24 1.360369e-06  9.999986e-01
## 133 5.497860e-29 1.427388e-07  9.999999e-01
## 138 8.840781e-40 1.248979e-08  1.000000e+00
## 139 8.862490e-47 1.704884e-10  1.000000e+00
## 143 4.599628e-32 9.898604e-07  9.999990e-01
## 148 1.187779e-61 1.853041e-19  1.000000e+00
## 149 9.694692e-66 2.704327e-24  1.000000e+00
## 155 4.191219e-59 1.991188e-16  1.000000e+00
## 161 1.753467e-57 9.287509e-17  1.000000e+00
## 162 6.945272e-34 4.803561e-08  1.000000e+00
## 170 3.947690e-54 1.740066e-27  1.000000e+00
## 171 1.097478e-34 6.130567e-07  9.999994e-01
## 173 1.112461e-84 1.741051e-31  1.000000e+00

```{{r}} library(ggplot2)

Membuat dataframe baru dengan nilai fungsi diskriminan

plot_lda <- data.frame(predict_lda_test$x, Status = predict_lda_test$class)

Scatter plot dari dua fungsi diskriminan

ggplot(plot_lda, aes(x = LD1, y = LD2, color = Status)) + geom_point(size = 3) + labs(title = “LDA Scatter Plot”, x = “Fungsi Diskriminan 1 (LD1)”, y = “Fungsi Diskriminan 2 (LD2)”) + theme_minimal()


Diperoleh tabel klasifikasi berikut:


``` r
# LDA
table(wine_test$Type, predict_lda_test$class)

##    
##      1  2  3
##   1 17  0  0
##   2  0 21  0
##   3  0  1 13

# QDA
table(wine_test$Type,predict_qda_test$class)

##    
##      1  2  3
##   1 17  0  0
##   2  0 21  0
##   3  0  0 14

Berdasarkan tabel klasifikasi diatas, terlihat bahwa model LDA masih memiliki kesalahan prediksi gerombol. Kesahalahan prediksi ini terjadi pada gerombol 3, dimana diprediksi gerombolnya 2.

Kesalahan klasifikasi dihitung dengan:

#LDA
sum(wine_test$Type!=predict_lda_test$class)/length(predict_lda_test$class)

## [1] 0.01923077

#QDA
sum(wine_test$Type!=predict_qda_test$class)/length(predict_qda_test$class)

## [1] 0

Berdasarkan tingkat kesalahan klasifikasi model QDA memiliki tingkat kesalahan klasifikasi yang lebih kecil sehingga dapat dikatakan model QDA lebih baik daripada model LDA. Hal ini selaras dengan model QDA yang lebih cocok digunakan sesuai dengan uji keterpenuhan asumsi yang telah dilakukan sebelumnya.

Untuk melihat amatan mana yang disalahklasifikasikan oleh LDA, dilakukan dengan melihat kelas hasil prediksi data ujinya.

cbind(wine_test, Type_pred = predict_lda_test$class)[wine_test$Type != predict_lda_test$class,]

##     Type Alcohol Malic  Ash Alcalinity Magnesium Phenols Flavanoids
## 131    3   12.86  1.35 2.32         18       122    1.51       1.25
##     Nonflavanoids Proanthocyanins Color  Hue Dilution Proline Type_pred
## 131          0.21            0.94   4.1 0.76     1.29     630         2

Catatan:
Note Dalam praktiknya data baru yang dimaksud belum memiliki gerombol asli, sehingga tidak memungkinkan untuk dilakukan evaluasi.

Studi Kasus 2

Sebuah Program Pascasarjana di sebuah perguruan tinggi melakukan evaluasi terhadap keberhasilan studi mahasiswa S2 di semester pertama.
Data menunjukkan bahwa ada tiga pengelompokan status mahasiswa yang berkaitan dengan kelanjutan studi di semester 2, yaitu Lanjut ke semester 2, Pindah ke program studi lain, dan Drop Out.
Banyak mahasiswa yang tidak dapat melanjutkan ke semester dua dengan lancar, diduga karena kurang seleksinya kualitas input mahasiswa.
Oleh karena itu, Ketua Program Studi tersebut berencana membuat kriteria seleksi untuk menyaring mahasiswa yang berkualitas.
Variabel yang digunakan sebagai dasar penentuan kriteria seleksi adalah IPK S1 dan skor hasil tes masuk S2. Lakukan analisis yang sesuai untuk tujuan tersebut.

Menyiapkan Data

data_ipk <- read.csv("data-ipk.csv", sep = ";")
head(data_ipk)

##    IPK Skor.tes Status
## 1 2.96      596 Lanjut
## 2 3.14      473 Lanjut
## 3 3.22      482 Lanjut
## 4 3.29      527 Lanjut
## 5 3.69      505 Lanjut
## 6 3.46      693 Lanjut

# merubah "Status" menjadi peubah kategorik
data_ipk$Status <- as.factor(data_ipk$Status)
glimpse(data_ipk)

## Rows: 85
## Columns: 3
## $ IPK      <dbl> 2.96, 3.14, 3.22, 3.29, 3.69, 3.46, 3.03, 3.19, 3.63, 3.59, 3…
## $ Skor.tes <int> 596, 473, 482, 527, 505, 693, 626, 663, 447, 588, 563, 553, 5…
## $ Status   <fct> Lanjut, Lanjut, Lanjut, Lanjut, Lanjut, Lanjut, Lanjut, Lanju…

summary(data_ipk)

##       IPK           Skor.tes          Status  
##  Min.   :2.130   Min.   :313.0   Drop Out:28  
##  1st Qu.:2.600   1st Qu.:425.0   Lanjut  :31  
##  Median :3.010   Median :482.0   Pindah  :26  
##  Mean   :2.975   Mean   :488.4                
##  3rd Qu.:3.300   3rd Qu.:538.0                
##  Max.   :3.800   Max.   :693.0

Membagi data menjadi data latih dan data uji dengan proporsi 80:20 sebagai berikut:

set.seed(1)
index_train <- caret::createDataPartition(y = data_ipk$Status, p = 0.8, list = FALSE)
ipk_train <- data_ipk[index_train,]
ipk_test <- data_ipk[-index_train,]

Membangun model dengan data latih

Uji normalitas ganda

H0 : data menyebar normal ganda H1 : data tidak menyebar normal ganda

uji_normalGanda <- mvn(data = ipk_train, subset="Status", mvnTest = "hz")
uji_normalGanda$multivariateNormality

## $`Drop Out`
##            Test        HZ   p value MVN
## 1 Henze-Zirkler 0.4485793 0.3766922 YES
## 
## $Lanjut
##            Test        HZ   p value MVN
## 1 Henze-Zirkler 0.3426375 0.6622179 YES
## 
## $Pindah
##            Test        HZ  p value MVN
## 1 Henze-Zirkler 0.3265871 0.662475 YES

Diperoleh bahwa dari ketiga kelas (Lanjut, Drop out, dan Pindah), ketiganya menyebar normal ganda terlihat dari nilai p-value yang diperoleh sudah > alfa 5%. Asumsi normalitas ganda terpenuhi.

Uji kesamaan ragam

H0 : ragam antar populasi sama H1 : ragam antar populasi tidak sama
```
boxM(ipk_train[,-3], ipk_train$Status)
```
```
## 
##  Box's M-test for Homogeneity of Covariance Matrices
## 
## data:  ipk_train[, -3]
## Chi-Sq (approx.) = 12.769, df = 6, p-value = 0.04686
```
Karena p-value pengujian lebih kecil dari alfa 5%, maka dapat disimpulkan bahwa cukup bukti untuk menolak H0. Artinya untuk peubah-puebah penjelas pada status akademik memiliki ragam yang tidak sama sehingga metode yang lebih cocok adalah QDA. Namun karena p-value mendekati 5%, maka dicoba dilakukan analisis dengan LDA dan QDA.

Estimasi koefisien diskriminan

# LDA
ipk_lda <- lda(Status ~ .,data = ipk_train)
coef(ipk_lda)

##                   LD1        LD2
## IPK      -4.806460162 -1.9347744
## Skor.tes -0.008604346  0.0140985

Diperoleh dua fungsi diskriminan berikut:

\[D_1 = -4.806460162 * IPK - 0.008604346 * Skor.tes\]

\[D_2 = -1.9347744 * IPK + 0.0140985 * Skor.tes\]

# QDA
ipk_qda <- qda(Status ~ .,data = ipk_train)
coef(ipk_qda)

## NULL

Evaluasi model LDA dengan data latih dengan histogram

predict_lda2 <- predict(ipk_lda)
predict_qda2 <- predict(ipk_qda)

predict_lda2$posterior

##        Drop Out       Lanjut       Pindah
## 1  6.010758e-03 5.530971e-01 4.408921e-01
## 2  2.703700e-03 9.957129e-02 8.977250e-01
## 3  6.283322e-04 3.143801e-01 6.849916e-01
## 5  1.810241e-09 9.983287e-01 1.671283e-03
## 6  1.305981e-10 9.999775e-01 2.250099e-05
## 7  3.542416e-04 9.116191e-01 8.802663e-02
## 8  8.535903e-07 9.973305e-01 2.668632e-03
## 9  1.403429e-07 9.649836e-01 3.501630e-02
## 10 5.440891e-10 9.997554e-01 2.446013e-04
## 12 5.034090e-07 9.879671e-01 1.203237e-02
## 13 1.351173e-08 9.984798e-01 1.520201e-03
## 14 2.646778e-12 9.999827e-01 1.725241e-05
## 15 2.363138e-10 9.999694e-01 3.055559e-05
## 16 1.856777e-07 9.889483e-01 1.105155e-02
## 17 7.873304e-08 9.950452e-01 4.954681e-03
## 18 8.759457e-06 9.202776e-01 7.971361e-02
## 19 1.053286e-06 9.798109e-01 2.018803e-02
## 20 4.661994e-05 8.361729e-01 1.637805e-01
## 21 1.959673e-04 7.252447e-01 2.745593e-01
## 22 2.226995e-09 9.992836e-01 7.164423e-04
## 25 7.472119e-08 9.979374e-01 2.062490e-03
## 26 1.207703e-07 9.989895e-01 1.010394e-03
## 27 1.531798e-10 9.999061e-01 9.391222e-05
## 29 4.224700e-11 9.997940e-01 2.059869e-04
## 30 3.374158e-13 9.999974e-01 2.602619e-06
## 32 9.416828e-01 7.501200e-07 5.831643e-02
## 33 9.888664e-01 1.448501e-08 1.113359e-02
## 35 9.900557e-01 3.256796e-07 9.943951e-03
## 36 8.294738e-01 1.414343e-04 1.703847e-01
## 37 9.968486e-01 6.692460e-10 3.151364e-03
## 38 9.700159e-01 6.808224e-08 2.998401e-02
## 40 9.965784e-01 6.308773e-10 3.421562e-03
## 41 9.933023e-01 3.207100e-08 6.697716e-03
## 42 7.891323e-01 4.845728e-06 2.108628e-01
## 43 7.483026e-01 5.967987e-06 2.516915e-01
## 45 9.672348e-01 1.717740e-06 3.276352e-02
## 46 7.416552e-01 1.074259e-04 2.582374e-01
## 47 9.937623e-01 2.821736e-10 6.237681e-03
## 48 9.998506e-01 1.824880e-12 1.494247e-04
## 49 9.879634e-01 6.741745e-08 1.203656e-02
## 50 8.691692e-01 7.105266e-05 1.307597e-01
## 51 9.959682e-01 2.443491e-08 4.031733e-03
## 52 9.858675e-01 1.735079e-07 1.413235e-02
## 53 9.996466e-01 1.080968e-11 3.534460e-04
## 54 9.984188e-01 1.195432e-11 1.581198e-03
## 56 8.781611e-01 4.470083e-05 1.217942e-01
## 57 6.578508e-01 7.677865e-06 3.421415e-01
## 59 1.499949e-01 1.167958e-04 8.498883e-01
## 60 1.113305e-01 5.334356e-03 8.833351e-01
## 61 1.241497e-01 4.978162e-03 8.708722e-01
## 62 4.589657e-03 1.309148e-02 9.823189e-01
## 65 9.529324e-03 2.354911e-04 9.902352e-01
## 66 1.932720e-05 4.542638e-01 5.457169e-01
## 67 8.145840e-02 5.777177e-03 9.127644e-01
## 69 5.418132e-03 1.020579e-02 9.843761e-01
## 70 1.809294e-02 1.746440e-02 9.644427e-01
## 71 2.564512e-01 1.505708e-03 7.420431e-01
## 72 1.215307e-01 6.675731e-04 8.778017e-01
## 73 8.471544e-02 1.634404e-03 9.136502e-01
## 74 2.747428e-01 7.687976e-03 7.175693e-01
## 75 4.902376e-01 1.883677e-04 5.095740e-01
## 76 4.066912e-03 5.404103e-02 9.418921e-01
## 77 8.891805e-03 1.334427e-02 9.777639e-01
## 78 2.114160e-02 2.998778e-03 9.758596e-01
## 79 1.457713e-02 6.480628e-02 9.206166e-01
## 81 1.888765e-02 1.792657e-03 9.793197e-01
## 82 1.363766e-01 2.953985e-03 8.606694e-01
## 84 2.201139e-02 2.463693e-03 9.755249e-01
## 85 1.475688e-02 9.880427e-03 9.753627e-01

predict_qda2$posterior

##        Drop Out       Lanjut       Pindah
## 1  1.597479e-02 9.670619e-01 1.696328e-02
## 2  1.243250e-03 2.029784e-01 7.957783e-01
## 3  3.452859e-04 6.831384e-01 3.165163e-01
## 5  9.945591e-11 1.000000e+00 1.423380e-08
## 6  8.503401e-10 1.000000e+00 1.261185e-17
## 7  1.106149e-03 9.987946e-01 9.926503e-05
## 8  5.141705e-06 9.999949e-01 1.693500e-09
## 9  3.291430e-09 9.998261e-01 1.738889e-04
## 10 3.153460e-10 1.000000e+00 3.475792e-12
## 12 3.421347e-07 9.999976e-01 2.013677e-06
## 13 8.959766e-09 1.000000e+00 2.670012e-09
## 14 4.566014e-13 1.000000e+00 1.026201e-16
## 15 1.607270e-09 1.000000e+00 4.727255e-17
## 16 5.698215e-08 9.999974e-01 2.514532e-06
## 17 4.036834e-08 9.999998e-01 1.588625e-07
## 18 3.912733e-06 9.994758e-01 5.203215e-04
## 19 6.148872e-07 9.999893e-01 1.006233e-05
## 20 2.839387e-05 9.968861e-01 3.085475e-03
## 21 1.707636e-04 9.888364e-01 1.099284e-02
## 22 8.505764e-10 1.000000e+00 2.670765e-10
## 25 1.386839e-07 9.999999e-01 3.296740e-09
## 26 7.264777e-07 9.999993e-01 6.583697e-11
## 27 1.257639e-10 1.000000e+00 5.554924e-14
## 29 1.378834e-12 1.000000e+00 9.096255e-12
## 30 2.012492e-13 1.000000e+00 4.378657e-21
## 32 9.957735e-01 4.847373e-05 4.178016e-03
## 33 9.999660e-01 3.061304e-06 3.095909e-05
## 35 9.956510e-01 2.797275e-05 4.321060e-03
## 36 7.826651e-01 1.496261e-03 2.158386e-01
## 37 9.999993e-01 3.980782e-07 3.008369e-07
## 38 9.998343e-01 9.480064e-06 1.562127e-04
## 40 9.999994e-01 3.823758e-07 2.137979e-07
## 41 9.997251e-01 5.423827e-06 2.694470e-04
## 42 9.723555e-01 2.593680e-04 2.738511e-02
## 43 9.650919e-01 3.332804e-04 3.457478e-02
## 45 9.857700e-01 7.779181e-05 1.415216e-02
## 46 7.247840e-01 1.353699e-03 2.738623e-01
## 47 9.999997e-01 2.553082e-07 4.838180e-09
## 48 1.000000e+00 1.205168e-08 5.120293e-11
## 49 9.995335e-01 8.578464e-06 4.579595e-04
## 50 8.395310e-01 9.506804e-04 1.595183e-01
## 51 9.996773e-01 5.023234e-06 3.176729e-04
## 52 9.983899e-01 1.644140e-05 1.593670e-03
## 53 1.000000e+00 3.291736e-08 9.343113e-10
## 54 1.000000e+00 3.069753e-08 9.838404e-12
## 56 8.649888e-01 7.039515e-04 1.343072e-01
## 57 9.521484e-01 5.171992e-04 4.733441e-02
## 59 1.898008e-01 4.864297e-03 8.053349e-01
## 60 6.265972e-02 1.426115e-02 9.230791e-01
## 61 7.194111e-02 1.372450e-02 9.143344e-01
## 62 5.760181e-04 2.155428e-02 9.778697e-01
## 65 2.716792e-03 9.226938e-03 9.880563e-01
## 66 5.740060e-07 7.633978e-01 2.366016e-01
## 67 4.051608e-02 1.446122e-02 9.450227e-01
## 69 6.795659e-04 1.777262e-02 9.815478e-01
## 70 6.782577e-03 3.246077e-02 9.607567e-01
## 71 1.660756e-01 6.543516e-03 8.273808e-01
## 72 6.545462e-02 4.849874e-03 9.296955e-01
## 73 3.494190e-02 6.505185e-03 9.585529e-01
## 74 2.674947e-01 2.480520e-02 7.077001e-01
## 75 4.752985e-01 2.404348e-03 5.222972e-01
## 76 1.350608e-03 9.634538e-02 9.023040e-01
## 77 1.797627e-03 2.289360e-02 9.753088e-01
## 78 4.494541e-03 8.465156e-03 9.870403e-01
## 79 1.400738e-02 1.571712e-01 8.288215e-01
## 81 3.719136e-03 6.955599e-03 9.893253e-01
## 82 7.261884e-02 9.364354e-03 9.180168e-01
## 84 4.712469e-03 7.745375e-03 9.875422e-01
## 85 3.560081e-03 1.840177e-02 9.780382e-01

library(ggplot2)

# Membuat dataframe baru dengan nilai fungsi diskriminan
plot_lda <- data.frame(predict_lda2$x, Status = predict_lda2$class)

# Scatter plot dari dua fungsi diskriminan
ggplot(plot_lda, aes(x = LD1, y = LD2, color = Status)) +
  geom_point(size = 3) +
  labs(title = "LDA Scatter Plot", x = "Fungsi Diskriminan 1 (LD1)", y = "Fungsi Diskriminan 2 (LD2)") +
  theme_minimal()

# fungsi pertama
ldahist(predict_lda2$x[,1], g = ipk_train$Status)

# fungsi kedua
ldahist(predict_lda2$x[,2], g = ipk_train$Status)

Diperoleh dari histogram fungsi diskriminan pertama, bahwa terdapat irisan di pinggirnya pada kelompok Drop Out dan Pindah, yang artinya fungsi diskriminan pertama cukup baik dalam mengklasifikasikan kelompok Drop Out dan Pindah. Sementara, pada kelompok Lanjut dan Drop Out, tidak terdapat irisan sama sekali pada histogramnya yang artinya fungsi diskriminan pertama sangat baik dalam mengklasifikasikan kelompok mahasiswa yang Drop Out dan Lanjut. Terdapat irisan yang cukup banyak antara histogram kelompok Lanjut dan Pindah, yang artinya fungsi diskriminan pertama **tidak cukup baik* dalam mengklasifikasikan kelompok mahasiswa yang Lanjut atau Pindah.

Selanjutnya pada fungsi diskriminan kedua, diperoleh bahwa fungsi diskriminan kedua belum cukup baik untuk mengklasifikasikan ketiga status mahasiswa terlihat dari irisannya yang besar.

Evaluasi model LDA & QDA dengan data latih menggunakan histogram
```
# LDA
table(ipk_train$Status, predict_lda2$class)
```
```
##           
##            Drop Out Lanjut Pindah
##   Drop Out       22      0      1
##   Lanjut          0     23      2
##   Pindah          0      0     21
```
```
# tingkat kesalahan klasifikasi
sum(ipk_train$Status != predict_lda2$class)/length(predict_lda2$class)
```
```
## [1] 0.04347826
```
Berdasarkan data latih, diperoleh bahwa terdapat satu mahasiswa yang Drop Out namun diklasifikasikan Pindah berdasarkan model LDA, serta dua mahasiswa yang Lanjut namun diklasifikasikan Pindah. Selain itu, tidak ada mahasiswa yang Drop Out namun salah diklasifikasikan Lanjut pada model diskriminan ini, karena terlihat dari fungsi diskriminan pertamanya yang sangat baik dalam mengklasifikasikan dua kelas tersebut. Selanjutnya, dari tiga mahasiswa yang salah diklasifikasikan, diperoleh bahwa tingkat kesalahan klasifikasi oleh model LDA pada data latih ini sebesar 4.35%.
```
# QDA
table(ipk_train$Status, predict_qda2$class)
```
```
##           
##            Drop Out Lanjut Pindah
##   Drop Out       22      0      1
##   Lanjut          0     24      1
##   Pindah          0      1     20
```
```
# tingkat kesalahan klasifikasi
sum(ipk_train$Status != predict_qda2$class)/length(predict_qda2$class)
```
```
## [1] 0.04347826
```
Berdasarkan data latih pula, diperoleh bahwa terdapat tiga mahasiswa yang salah diklasifikasikan sehingga besaran tingkat kesalahan klasifikasinya juga sama besar. Di mana, masing-masing satu mahasiswa diklasifikasikan salah sebagai berikut: mahasiswa Pindah diklasifikasikan Lanjut, dan sebaliknya, serta mahasiswa Drop Out diklasifikasikan Pindah.

Evaluasi model dengan data uji

predict_lda_test2 <- predict(ipk_lda, newdata = ipk_test)
predict_qda_test2 <- predict(ipk_qda, newdata = ipk_test)

predict_lda_test2$posterior

##        Drop Out       Lanjut       Pindah
## 4  3.062659e-05 8.721838e-01 0.1277855491
## 11 4.709785e-06 9.697198e-01 0.0302755153
## 23 1.911667e-06 9.810195e-01 0.0189785600
## 24 6.698376e-05 4.062827e-01 0.5936503558
## 28 8.570749e-07 9.858431e-01 0.0141560577
## 31 5.879970e-04 2.494716e-01 0.7499404458
## 34 9.993220e-01 2.807315e-10 0.0006780251
## 39 9.569982e-01 5.936705e-07 0.0430012269
## 44 9.483809e-01 9.060534e-06 0.0516100201
## 55 9.143467e-01 3.187597e-07 0.0856529382
## 58 2.664163e-01 4.599766e-05 0.7335377183
## 63 9.661680e-04 1.293035e-02 0.9861034827
## 64 1.082454e-01 1.268812e-03 0.8904858165
## 68 3.040189e-01 2.653068e-04 0.6957157459
## 80 1.810953e-02 6.318435e-03 0.9755720328
## 83 2.107129e-02 8.669884e-03 0.9702588239

predict_qda_test2$posterior

##        Drop Out       Lanjut       Pindah
## 4  1.897492e-05 9.984358e-01 1.545201e-03
## 11 5.047265e-06 9.999743e-01 2.069881e-05
## 23 1.977875e-06 9.999924e-01 5.649122e-06
## 24 6.606717e-06 7.345443e-01 2.654491e-01
## 28 7.149427e-07 9.999965e-01 2.825119e-06
## 31 2.294431e-04 5.344726e-01 4.652979e-01
## 34 9.999986e-01 3.074280e-07 1.118025e-06
## 39 9.962552e-01 3.913152e-05 3.705664e-03
## 44 9.513719e-01 2.413077e-04 4.838680e-02
## 55 9.991773e-01 3.451918e-05 7.881662e-04
## 58 5.253172e-01 3.615889e-03 4.710669e-01
## 63 3.377471e-05 2.130551e-02 9.786607e-01
## 64 5.013306e-02 5.875057e-03 9.439919e-01
## 68 2.698201e-01 3.381547e-03 7.267983e-01
## 80 4.144070e-03 1.316969e-02 9.826862e-01
## 83 5.947884e-03 1.705120e-02 9.770009e-01

Berdasarkan data uji, diperoleh bahwa terdapat satu mahasiswa yang Drop Out namun diklasifikasikan Pindah berdasarkan model LDA, serta dua mahasiswa yang Lanjut namun diklasifikasikan Pindah. Selain itu, tidak ada mahasiswa yang Drop Out namun salah diklasifikasikan Lanjut pada model diskriminan ini, karena terlihat dari fungsi diskriminan pertamanya yang sangat baik dalam mengklasifikasikan dua kelas tersebut. Selanjutnya, dari tiga mahasiswa yang salah diklasifikasikan, diperoleh bahwa tingkat kesalahan klasifikasi oleh model LDA pada data uji ini sebesar 18.75%.

Sedangkan berdasarkan data uji pula, diperoleh tidak ada yang salah diklasifikasikan dengan model QDA. Terlihat bahwa model QDA lebih baik dalam memprediksi kelas/status akademik mahasiswa.

Untuk melihat amatan yang salah diprediksi, dilakukan dengan code sebagai berikut:

# LDA
table(ipk_test$Status, predict_lda_test2$class)

##           
##            Drop Out Lanjut Pindah
##   Drop Out        4      0      1
##   Lanjut          0      4      2
##   Pindah          0      0      5

# tingkat kesalahan klasifikasi
sum(ipk_test$Status != predict_lda_test2$class)/length(predict_lda_test2$class)

## [1] 0.1875

# melihat amatan yang salah diklasifikasikan
cbind(ipk_test, Status_pred = predict_lda_test2$class)[ipk_test$Status != predict_lda_test2$class,]

##     IPK Skor.tes   Status Status_pred
## 24 3.40      431   Lanjut      Pindah
## 31 3.24      467   Lanjut      Pindah
## 58 2.85      381 Drop Out      Pindah

# QDA
table(ipk_test$Status, predict_qda_test2$class)

##           
##            Drop Out Lanjut Pindah
##   Drop Out        5      0      0
##   Lanjut          0      6      0
##   Pindah          0      0      5

# tingkat kesalahan klasifikasi
sum(ipk_test$Status != predict_qda_test2$class)/length(predict_qda_test2$class)

## [1] 0