library(rattle)## Warning: package 'rattle' was built under R version 4.4.3## Loading required package: tibble## Warning: package 'tibble' was built under R version 4.4.2## Loading required package: bitops## 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(MASS)
library(dplyr)## Warning: package 'dplyr' was built under R version 4.4.2##
## Attaching package: 'dplyr'## The following object is masked from 'package:MASS':
##
## select## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union# Gunakan data wine
data(wine)
wine$Type <- as.factor(wine$Type)
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 1450wine1 <- subset(wine, Type==1)[, -1]
wine2 <- subset(wine, Type==2)[, -1]
wine3 <- subset(wine, Type==3)[, -1]mean1 <- colMeans(wine1)
mean2 <- colMeans(wine2)
mean3 <- colMeans(wine3)
mean1## Alcohol Malic Ash Alcalinity Magnesium
## 13.744746 2.010678 2.455593 17.037288 106.338983
## Phenols Flavanoids Nonflavanoids Proanthocyanins Color
## 2.840169 2.982373 0.290000 1.899322 5.528305
## Hue Dilution Proline
## 1.062034 3.157797 1115.711864mean2## Alcohol Malic Ash Alcalinity Magnesium
## 12.278732 1.932676 2.244789 20.238028 94.549296
## Phenols Flavanoids Nonflavanoids Proanthocyanins Color
## 2.258873 2.080845 0.363662 1.630282 3.086620
## Hue Dilution Proline
## 1.056282 2.785352 519.507042mean3## Alcohol Malic Ash Alcalinity Magnesium
## 13.1537500 3.3337500 2.4370833 21.4166667 99.3125000
## Phenols Flavanoids Nonflavanoids Proanthocyanins Color
## 1.6787500 0.7814583 0.4475000 1.1535417 7.3962500
## Hue Dilution Proline
## 0.6827083 1.6835417 629.8958333S1 <- cov(wine1)
S2 <- cov(wine2)
S3 <- cov(wine3)Karena ada 3 kelompok : \[ S_p = \frac{ (n_1 - 1) S_1 + (n_2 - 1) S_2 + (n_3 - 1) S_3 }{ n_1 + n_2 + n_3 - 3 }. \]
n1 <- nrow(wine1)
n2 <- nrow(wine2)
n3 <- nrow(wine3)
S_pooled <- ((n1-1)*S1 + (n2-1)*S2 + (n3-1)*S3) / (n1+n2+n3 - 3)
S_pooled## Alcohol Malic Ash Alcalinity
## Alcohol 0.2620524692 0.008173006 -0.013309201 -0.097217247
## Malic 0.0081730058 0.887546797 0.021390808 0.414755904
## Ash -0.0133092007 0.021390808 0.066072101 0.484160564
## Alcalinity -0.0972172465 0.414755904 0.484160564 8.006811181
## Magnesium 0.0179329792 -0.889338146 0.689515000 3.237835078
## Phenols 0.0270981493 -0.014484958 0.016170012 0.108615254
## Flavanoids 0.0226317094 -0.009409246 0.029971050 0.246419036
## Nonflavanoids -0.0009755453 0.010175167 0.007020600 0.046914930
## Proanthocyanins 0.0167713010 0.017203063 0.002680707 0.092725129
## Color 0.2464579756 -0.258700080 0.009794193 -0.101795100
## Hue 0.0007821049 -0.042132471 0.002322241 -0.009830867
## Dilution -0.0049853649 0.046529336 0.010911447 0.225631791
## Proline 12.2371146387 -33.058491786 -0.500982245 -32.832867328
## Magnesium Phenols Flavanoids Nonflavanoids
## Alcohol 0.01793298 0.027098149 0.022631709 -0.0009755453
## Malic -0.88933815 -0.014484958 -0.009409246 0.0101751670
## Ash 0.68951500 0.016170012 0.029971050 0.0070205996
## Alcalinity 3.23783508 0.108615254 0.246419036 0.0469149296
## Magnesium 180.65777316 0.577138879 0.666844055 -0.2870589537
## Phenols 0.57713888 0.191270475 0.161307036 -0.0077357545
## Flavanoids 0.66684406 0.161307036 0.274707514 -0.0152671127
## Nonflavanoids -0.28705895 -0.007735755 -0.015267113 0.0119117022
## Proanthocyanins 1.30039685 0.091843668 0.127793315 -0.0086408471
## Color 1.77241139 0.198982410 0.286678302 -0.0015106923
## Hue 0.12615835 -0.001465230 -0.004206350 0.0013585815
## Dilution -0.28113023 0.059863215 0.067861940 -0.0100718089
## Proline 476.24886037 8.395412541 3.425698332 -0.4931676056
## Proanthocyanins Color Hue Dilution
## Alcohol 0.016771301 0.246457976 0.0007821049 -0.004985365
## Malic 0.017203063 -0.258700080 -0.0421324707 0.046529336
## Ash 0.002680707 0.009794193 0.0023222412 0.010911447
## Alcalinity 0.092725129 -0.101795100 -0.0098308675 0.225631791
## Magnesium 1.300396848 1.772411386 0.1261583492 -0.281130226
## Phenols 0.091843668 0.198982410 -0.0014652303 0.059863215
## Flavanoids 0.127793315 0.286678302 -0.0042063499 0.067861940
## Nonflavanoids -0.008640847 -0.001510692 0.0013585815 -0.010071809
## Proanthocyanins 0.246172944 0.229207073 -0.0063058554 0.042441730
## Color 0.229207073 2.284923081 -0.0409962365 -0.066305133
## Hue -0.006305855 -0.040996237 0.0244876469 -0.003347103
## Dilution 0.042441730 -0.066305133 -0.0033471032 0.160778730
## Proline 11.482320240 68.093681637 4.4910170120 -10.942642431
## Proline
## Alcohol 12.2371146
## Malic -33.0584918
## Ash -0.5009822
## Alcalinity -32.8328673
## Magnesium 476.2488604
## Phenols 8.3954125
## Flavanoids 3.4256983
## Nonflavanoids -0.4931676
## Proanthocyanins 11.4823202
## Color 68.0936816
## Hue 4.4910170
## Dilution -10.9426424
## Proline 29707.6818705S_inv <- solve(S_pooled)Untuk kelas \(k\): \[ b_k = S^-1 \miu_k c_k = - 1/2 \miu_k' S^-1 \miu_k + log(\pi_k) \]
prior <- table(wine$Type) / nrow(wine)
mu1 <- as.numeric(mean1)
mu2 <- as.numeric(mean2)
mu3 <- as.numeric(mean3)
b1 <- S_inv %*% mu1
b2 <- S_inv %*% mu2
b3 <- S_inv %*% mu3
c1 <- -0.5 * t(mu1) %*% S_inv %*% mu1 + log(prior["1"])
c2 <- -0.5 * t(mu2) %*% S_inv %*% mu2 + log(prior["2"])
c3 <- -0.5 * t(mu3) %*% S_inv %*% mu3 + log(prior["3"])\[ \[ \delta_k(x) = x^{\top} S^{-1} \mu_k - \frac{1}{2} \mu_k^{\top} S^{-1} \mu_k + \log(\pi_k) \] \]
X <- as.matrix(wine[, -1])
wine$delta1 <- X %*% b1 + as.numeric(c1)
wine$delta2 <- X %*% b2 + as.numeric(c2)
wine$delta3 <- X %*% b3 + as.numeric(c3)Pilih kelas dengan nilai fungsi diskriminan terbesar
wine$pred_manual <- apply(
wine[, c("delta1","delta2","delta3")],
1,
function(z) which.max(z)
)table(Actual = wine$Type, Pred = wine$pred_manual)## Pred
## Actual 1 2 3
## 1 59 0 0
## 2 0 71 0
## 3 0 0 48