Bayes Sınıflayıcı İskeleti
Bayes Sınıflayıcı İskeleti
1 Bayes Sınıflayıcısı
1.1 Teorik Zemin
Bayes sınıflayıcısı, adından da belli olduğu gibi Bayes teoreminden faydalanan bir sınıflayıcıdır. Aslında oldukça basit bir yaklaşımdır. Bağımlı değişkenimiz \(Y\), bağımsız değişkenlerimiz ise \(\textbf{X} = \{X_{1}, X_{2},…,X_{p}\}\) olsun. \(Y\) değişkeni, \(S_{1}\) ve \(S_{2}\) şeklinde iki kategori (sınıf) arasından değer alabilen, binary bir değişken olsun. \(\textbf{X}\) değişkenleri ise kategorik veya nümerik değerler alan değişkenler olsun. Bu değişkenleri kullanarak \(Y\) üzerinde yapacağımız tahmin \(\hat{Y}\) olsun. \(Y\) değişkenini açıklayan dağılım da \(P(Y|\textbf{X})\) ile gösterilsin. Öyle ise \[\begin{equation} \hat{Y} = \begin{cases} S_{1}, & P(Y=S_{1}|\textbf{X})\geq0.5\\ S_{2}, & P(Y=S_{1}|\textbf{X})<0.5\\ \end{cases} \end{equation}\] denklemi yazılabilir. Burada \(P(Y|X)\), \(Y\)’nin \(X\)’e bağlı olasılık fonksiyonudur. Bayes teoremi burada devreye girer ve \[\begin{equation} P(Y|\textbf{X})=\frac{P(Y)P(\textbf{X}|Y)}{P(\textbf{X})} \end{equation}\] denklemi elde edilir. Sınıflarımıza, \(S_{1}\) ve \(S_{2}\)’ye göre bu denklemi dağıtırsak \(i\)-nci örnek için sınıflara ait olasılıklar \[\begin{equation} \begin{alignedat}{2} P(Y_{i}=S_{1}|\textbf{X}_{i})=\frac{P(Y_{i}=S_{1})P(\textbf{X}_{i}|Y_{i}=S_{1})}{P(\textbf{X}_{i})}\\ P(Y_{i}=S_{2}|\textbf{X}_{i})=\frac{P(Y_{i}=S_{2})P(\textbf{X}_{i}|Y_{i}=S_{2})}{P(\textbf{X}_{i})} \end{alignedat} \end{equation}\] şeklindedir. Sadece \(S_{1}\) ve \(S_{2}\) sınıfları mevcut iken \(i\)-nci örnek için \(P(Y_{i}=S_{1}|\textbf{X}_{i})+P(Y_{i}=S_{2}|\textbf{X}_{i})=1\)’dir. Burada \(P(Y_{i}=S_{1}|\textbf{X}_{i})\) ve \(P(Y_{i}=S_{2}|\textbf{X}_{i})\) değerleri karşılaştırılacak ve büyük olana göre sınıf tahmini yapılacaktır. Paydaların ortak olduğuna dikkat edelim. Bu paydalar, karşılaştırma sonucunu değiştirmeyecektir. Bu nedenle \[\begin{equation} \begin{alignedat}{2} p(Y_{i}=S_{1}|\textbf{X}_{i})\sim P(Y_{i}=S_{1})P(\textbf{X}_{i}|Y_{i}=S_{1})\\ p(Y_{i}=S_{2}|\textbf{X}_{i})\sim P(Y_{i}=S_{2})P(\textbf{X}_{i}|Y_{i}=S_{2}) \end{alignedat} \end{equation}\] kullanılabilir. Genelleyecek olursak \[\begin{equation} p(Y|\textbf{X})\sim P(Y)P(\textbf{X}|Y) \end{equation}\] elde edilir. Burada \(P(Y)\) önsel, \(P(\textbf{X}|Y)\) olabilirlik ve \(p(Y|\textbf{X})\) sonsal olarak adlandırılmaktadır. Sadece önsel ve olabilirlik kısımları hesaplanırsa, sonsalın dağılımı elde edilmiş olacaktır. Buradan da karşılaştırma yapılarak sınıf tahmini yapılabilecektir. Eğer sınıflara ait olasılıklar hesaplanmak isteniyorsa, \(p(Y|\textbf{X})\) toplamlarını \(1\)’e eşitleyecek şekilde standartlaştırma uygulanarak olasılıklar hesaplanabilir. Sınıf sayısı \(k\) tane olursa \[ p(Y_{i}=S_{1}|\textbf{X}_{i})\sim P(Y_{i}=S_{1})P(\textbf{X}_{i}|Y_{i}=S_{1}) \] \[ p(Y_{i}=S_{2}|\textbf{X}_{i})\sim P(Y_{i}=S_{2})P(\textbf{X}_{i}|Y_{i}=S_{2}) \] \[ \vdots\\ \] \[ p(Y_{i}=S_{k}|\textbf{X}_{i})\sim P(Y_{i}=S_{k})P(\textbf{X}_{i}|Y_{i}=S_{k}) \] şeklinde sonsallarımız olacaktır. Tahmin yine en büyük sonsal değerine sahip sınıfa yönelik olacaktır. Sınıf olasılıkları hesaplanmak isteniyorsa sonsalların toplamı \(1\) yapacak şekilde standartlaştırılabilir. Bu konu ile daha ayrıntılı bilgi edinebilmek için Friedman, Hastie, Tibshirani, & others (2001) kitabına başvurulabilir.
1.2 Hesaplama
\(P(Y)\) önsel dağılımı ile kastedilen henüz hiçbir bilgiden faydalanılmamışken, elimizde önceden olan bilgidir. Yani ne demek istedim? Elimizde 100 tane insan olsun. Bu insanların 20 tanesi hasta 80 tanesi sağlıklı olsun. Bu insanların farklı özellikleri hakkında henüz birşey bilmiyor olalım. Bu durumda ben herhangi bir kişiyi seçtiğimde, bu seçtiğim kişinin sağlıklı olması olasılığına nasıl cevap veririm? Elbette 0.8 derim. Hasta olma olasılığına da bir o şekidle 0.2 derim. Bu şekilde aslında bağımsız değişkenler olmadan tahminde bulunmuş oldum ve tüm insanlara “sağlıklı” dedim. Bunu ön bilgime dayalı olarak söyledim. Veri setindeki örnek sayısı \(n\) olsun. Buradan yola çıkarak önseller \[ P(Y_{i}=S_{1})=\frac{n_1}{n} \] \[ P(Y_{i}=S_{2})=\frac{n_2}{n} \] \[ \vdots\\ \] \[\begin{equation} P(Y_{i}=S_{k})=\frac{n_k}{n} \end{equation}\] şeklinde hesaplanabilir. Literatürde sıklıkla kullanılan “iris” veri setini ele alalım.
data <- iris
str(iris)## 'data.frame': 150 obs. of 5 variables:
## $ Sepal.Length: num 5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
## $ Sepal.Width : num 3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
## $ Petal.Length: num 1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
## $ Petal.Width : num 0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
## $ Species : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...Bağımlı değişken olan Species 3 kategoriden oluşmaktadır. \(\textbf{X}\) ve \(Y\) değişkenlerimizi tanımlayalım. Hem görselleştirmede kolaylık olsun diye hem de iris veri seti sınıflama konusunda çok kolay bir veri olması nedeniyle, zorluğu artırmak amacıyla \(\textbf{X}\)’yi oluşturmak için sadece 1. ve 3. değişkenleri seçelim. Okunulabilirlik açısından değişken isimlerini “X1” ve “X2” olarak değiştirelim.
library(ggplot2)## Registered S3 methods overwritten by 'tibble':
## method from
## format.tbl pillar
## print.tbl pillarY <- data[,5]
X <- data[,c(1,3)]
colnames(X) <- c("X1","X2")
S <- levels(Y)
k <- length(S)
n <- nrow(X)
p <- ncol(X)
print(paste0("n = ", n, ", p = ", p, ", k = ", k))## [1] "n = 150, p = 2, k = 3"ggplot() +
geom_point(data = X,
mapping = aes_string(x = colnames(X)[1],
y = colnames(X)[2],
fill = Y),
size = 2.5, shape = 21) +
scale_fill_manual(values = c("orange", "red", "green"), name = "Y") +
theme_bw()
1.2.1 Önsel hesaplama
Eğitim ve test setini %70-%30 olacak şekilde ayarlayıp, ardından eğitim setine ait önsellerimizi belirleyelim.
set.seed(1)
n_egitim <- round(n*0.7)
n_test <- n - n_egitim
egitim_i <- sample(1:n, n_egitim)
X_egitim <- X[egitim_i,]
Y_egitim <- Y[egitim_i]
X_test <- X[-egitim_i,]
Y_test <- Y[-egitim_i]
onseller <- c(table(Y_egitim)/n_egitim)
print(onseller)## setosa versicolor virginica
## 0.3333333 0.3142857 0.35238101.2.2 Olabilirlik hesaplama
Önselleri belirlediğimize göre, olabilirliği belirlemeye geçebiliriz. \(P(\textbf{X}|Y=S_{k})\) fonksiyonu, varsayımlarımıza bağlı olarak farklı şekillerde hesaplanabilir. Bağımsız değişkenlerin birbirlerinden bağımsız olduklarını varsayarsak olabilirliği \[ P(\textbf{X}|Y=S_{k})=P(X_{1}|Y=S_{k})\times P(X_{2}|Y=S_{k}) \times \cdots \times P(X_{p}|Y=S_{k}) \] \[ P(\textbf{X}|Y=S_{k})= \prod_{j=1}^{p} P(X_{j}|Y=S_{k}) \]
şeklinde elde edebiliriz. Bu şekilde, çok değişkenli dağılım hesaplamak yerine tek değişkenli \(p\) adet dağılım hesaplamamız yeterli olmaktadır. Buradaki bağımsızlık varsayımı gerçek verilerde karşılaşması çok düşük bir durumdur. Bir nevi “naif” bir varsayımdır. Bu nedenle bu şekilde olabilirlik hesaplayarak elde edilen bayes sınıflayıcısı “naif bayes” olarak adlandırılmaktadır.
1.2.3 Naif Normal yaklaşımı
Varsayımlar burada bitmiyor. Tek değişkenli dağılımları hesaplayabilmek için hangi dağılım kullanılacağına karar vermek gerekir. Değişkenlerin normal dağılıma sahip olduğunu varsayalım. Bu durumda \(P(X_{j}|Y=S_{k}) = P(X_{j}|Y=S_{k};\mu_{S_{k}},\sigma_{S_{k}})\) olacaktır. Burada \(S_k\) sınıfı için olabilirlik \[ P(X_{j}|Y=S_{k};\mu_{S_{k}},\sigma_{S_{k}})=\frac{1}{\sqrt{2\pi \sigma_{S_{k}}^2}}e^{-0.5(\frac{X_j-\mu_{S_{k}}}{\sigma_{S_{k}}})^2 } \] Tüm sınıflara ait tüm tek değişkenli durumlarda ortalama ve standart sapmaları hesaplayalım.
ortalamalar <- sapply(S, function(m) sapply(X_egitim, function(m2) mean(m2[Y_egitim == m])))
print(ortalamalar)## setosa versicolor virginica
## X1 5.017143 5.960606 6.691892
## X2 1.468571 4.318182 5.621622standart_sapmalar <- sapply(S, function(m) sapply(X_egitim, function(m2) sd(m2[Y_egitim == m])))
print(standart_sapmalar)## setosa versicolor virginica
## X1 0.3674120 0.5612149 0.6348133
## X2 0.1936817 0.4805300 0.5759703Bu değerleri kullanarak tahminde bulunacağımız test verisi için olabilirliği hesaplayalım. Burada normal dağılım için yoğunluğu hesaplamada dnorm fonksiyonunu kullanacağız. P_X_Y ifadesi ile olabilirlik değişkenini ifade edecek olursak:
P_X_Y_normal <- lapply(S, function(m) sapply(1:p, function(m2) {
P_X_Y_temp <- dnorm(x = X_test[,m2],
mean = ortalamalar[m2,m],
sd = standart_sapmalar[m2,m])
P_X_Y_temp[is.infinite(P_X_Y_temp)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
P_X_Y_temp[P_X_Y_temp == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(P_X_Y_temp)
}))
P_X_Y_normal <- lapply(P_X_Y_normal, function(m) apply(m, 1, prod))
print(P_X_Y_normal)## [[1]]
## [1] 1.055101e+00 1.158647e+00 2.098394e+00 2.204894e+00 5.125078e-01
## [6] 1.282545e+00 3.924469e-01 1.774661e+00 1.224041e+00 8.542141e-01
## [11] 1.529725e+00 1.764057e+00 1.731987e+00 1.641192e+00 2.098394e+00
## [16] 1.197701e-56 7.587937e-38 1.121785e-60 2.537356e-54 1.804931e-63
## [21] 8.098502e-45 5.026330e-39 1.123532e-54 4.054936e-54 8.012889e-56
## [26] 2.338625e-39 5.146073e-25 1.416687e-29 7.587937e-38 2.583008e-44
## [31] 2.583008e-44 5.788601e-14 4.967088e-121 1.356398e-53 1.554602e-113
## [36] 1.981621e-88 5.407307e-98 4.400517e-69 1.407198e-108 2.012664e-70
## [41] 2.942857e-102 7.899062e-102 1.563001e-97 3.555013e-66 9.757048e-104
##
## [[2]]
## [1] 1.284844e-10 1.061301e-09 1.338210e-09 4.634177e-09 1.212246e-10
## [6] 1.217548e-08 1.800274e-08 1.536785e-08 5.335755e-09 9.799483e-11
## [11] 3.700562e-10 6.823934e-10 2.051987e-08 1.002977e-08 1.338210e-09
## [16] 4.043662e-01 3.384500e-01 3.131071e-01 4.932410e-01 3.584748e-01
## [21] 5.692507e-01 4.728186e-01 2.442061e-01 4.469206e-01 5.016160e-01
## [26] 4.595876e-01 1.243432e-01 1.842159e-01 3.384500e-01 5.140582e-01
## [31] 5.140582e-01 4.229584e-03 3.333522e-04 9.211764e-02 2.133694e-03
## [36] 5.386995e-02 1.806873e-02 2.306644e-01 3.966697e-03 2.749392e-01
## [41] 1.238022e-02 1.400945e-02 2.110616e-02 3.561127e-01 7.061838e-03
##
## [[3]]
## [1] 1.887454e-15 1.449300e-14 2.695152e-14 9.477734e-14 1.388682e-15
## [6] 4.166975e-13 9.749922e-13 3.233959e-13 8.208053e-14 1.990979e-15
## [11] 7.436535e-15 1.107551e-14 4.860476e-13 2.986806e-13 2.695152e-14
## [16] 5.880249e-02 1.419069e-03 8.624893e-02 1.928258e-02 1.000089e-01
## [21] 9.505699e-03 4.565994e-03 4.590809e-02 1.488956e-02 4.840926e-02
## [26] 5.354403e-03 1.452930e-04 2.859014e-04 1.419069e-03 6.105879e-03
## [31] 6.105879e-03 5.949863e-07 3.149946e-01 1.216599e-03 4.148690e-01
## [36] 3.350853e-01 4.066776e-01 4.523687e-02 4.312385e-01 1.285701e-01
## [41] 3.913435e-01 3.595116e-01 3.829851e-01 8.688578e-02 4.349432e-01Burada edilen olabilirlikler, sınıflara göre ait oldukları önsellerle çarpılarak sonsal elde edilecektir.
p_Y_X_normal <- sapply(1:length(S), function(m) P_X_Y_normal[[m]]*onseller[m])
colnames(p_Y_X_normal) <- S
head(p_Y_X_normal)## setosa versicolor virginica
## [1,] 0.3517002 4.038082e-11 6.651028e-16
## [2,] 0.3862157 3.335519e-10 5.107059e-15
## [3,] 0.6994646 4.205802e-10 9.497202e-15
## [4,] 0.7349646 1.456456e-09 3.339773e-14
## [5,] 0.1708359 3.809915e-11 4.893452e-16
## [6,] 0.4275151 3.826578e-09 1.468363e-13### her satır, o örneğe ait sonsalları göstermektedir. Toplamlarını 1 olacak şekilde standartlaştıralım. Böylece olasılıkları hesaplamış olacağız.
p_Y_X_normal <- t(apply(p_Y_X_normal, 1, function(m) m/sum(m)))
head(p_Y_X_normal)## setosa versicolor virginica
## [1,] 1 1.148160e-10 1.891107e-15
## [2,] 1 8.636415e-10 1.322333e-14
## [3,] 1 6.012888e-10 1.357782e-14
## [4,] 1 1.981668e-09 4.544128e-14
## [5,] 1 2.230160e-10 2.864416e-15
## [6,] 1 8.950744e-09 3.434645e-13### olasılıkların toplamlarının 1 olup olmadığını kontrol edelim
print(apply(p_Y_X_normal, 1, sum))## [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [39] 1 1 1 1 1 1 1Her örnek için sınıf olasılıklarının toplamı 1’dir. Böylece bu olasılıkların “olasılık” olarak kabul edilebileceğini gösterdik. Elde edilen olasılıklara bakarsak hangi sınıfa ait olasılık daha yüksek ise model, o sınıfı tahmin olarak seçecektir. Tahminleri belirleyelim.
Y_sapka_normal <- apply(p_Y_X_normal, 1, function(m) S[which.max(m)]) ### tahminler
Y_sapka_normal <- factor(Y_sapka_normal, levels = S, labels = S)
print(Y_sapka_normal)## [1] setosa setosa setosa setosa setosa setosa
## [7] setosa setosa setosa setosa setosa setosa
## [13] setosa setosa setosa versicolor versicolor versicolor
## [19] versicolor versicolor versicolor versicolor versicolor versicolor
## [25] versicolor versicolor versicolor versicolor versicolor versicolor
## [31] versicolor versicolor virginica versicolor virginica virginica
## [37] virginica versicolor virginica versicolor virginica virginica
## [43] virginica versicolor virginica
## Levels: setosa versicolor virginicaprint(table(Y_test, Y_sapka_normal))## Y_sapka_normal
## Y_test setosa versicolor virginica
## setosa 15 0 0
## versicolor 0 17 0
## virginica 0 4 9dogruluk_orani_normal <- sum(Y_test == Y_sapka_normal)/n_test
print(paste0("Test doğruluk oranı = ", round(dogruluk_orani_normal,3)))## [1] "Test dogruluk orani = 0.911"Yaptığımız işlemleri teyit etmek için şöyle bir yol deneyebiliriz. e1071 paketinde naiveBayes fonksiyonu, naif normal bayes sınıflayıcısını kullanmaktaadır. Sonuçlaramızı karşılaştıralım.
library(e1071)
model_e1071 <- naiveBayes(x = X_egitim, y = Y_egitim)
print(model_e1071)##
## Naive Bayes Classifier for Discrete Predictors
##
## Call:
## naiveBayes.default(x = X_egitim, y = Y_egitim)
##
## A-priori probabilities:
## Y_egitim
## setosa versicolor virginica
## 0.3333333 0.3142857 0.3523810
##
## Conditional probabilities:
## X1
## Y_egitim [,1] [,2]
## setosa 5.017143 0.3674120
## versicolor 5.960606 0.5612149
## virginica 6.691892 0.6348133
##
## X2
## Y_egitim [,1] [,2]
## setosa 1.468571 0.1936817
## versicolor 4.318182 0.4805300
## virginica 5.621622 0.5759703p_Y_X_e1071 <- predict(object = model_e1071, newdata = X_test, type = "raw")
Y_sapka_e1071 <- predict(object = model_e1071, newdata = X_test, type = "class")
print(table(Y_sapka_normal, Y_sapka_e1071)) ### naiveBayes fonksiyonu ve bizim tahminlerimizin karşılaştırması## Y_sapka_e1071
## Y_sapka_normal setosa versicolor virginica
## setosa 15 0 0
## versicolor 0 21 0
## virginica 0 0 9head(p_Y_X_e1071) ### naiveBayes fonksiyonuna ait olasılıklar## setosa versicolor virginica
## [1,] 1 1.148160e-10 1.891107e-15
## [2,] 1 8.636415e-10 1.322333e-14
## [3,] 1 6.012888e-10 1.357782e-14
## [4,] 1 1.981668e-09 4.544128e-14
## [5,] 1 2.230160e-10 2.864416e-15
## [6,] 1 8.950744e-09 3.434645e-13head(p_Y_X_normal) ### bizim bulduğumuz olasılıklar## setosa versicolor virginica
## [1,] 1 1.148160e-10 1.891107e-15
## [2,] 1 8.636415e-10 1.322333e-14
## [3,] 1 6.012888e-10 1.357782e-14
## [4,] 1 1.981668e-09 4.544128e-14
## [5,] 1 2.230160e-10 2.864416e-15
## [6,] 1 8.950744e-09 3.434645e-13Tahminlerimizin tamamen aynı, elde ettiğimiz olasılıkların da gözle görülemeyecek kadar ufak seviyede farklı olduğunu görüyoruz.
1.2.4 Naif Kernel yaklaşımı
Normal dağılım dışında farklı bir dağılım varsayılmış olsa idi, o dağılıma ait olan parametreler her bir değişken ve her bir sınıf için tahmin edilecekti. Bu parametreler kullanılarak olabilirlik fonksiyonu her bir sınıf için hesaplanabilir. Peki burada daha farklı ne yapılabilir? Çekirdek diğer adıyla kernel fonksiyonları ile yoğunluklar hesaplanabilir. Böylece daha karmaşık dağılımları ortaya çıkarmak mümkün olur. Fakat aşırı uyum problemiyle karşılaşılması daha olasıdır. Kernel fonksiyonlarından normal kernel yani Gaussian kerneli ele alalım. O zaman \(P(X_{j}|Y=S_{k}) = P(X_{j}|Y=S_{k};h_{S_{k}})\) değeri \[ P(X_{j}|Y=S_{k};h_{S_{k}})=\frac{1}{n_k} \sum_i^{n_k} \frac{1}{\sqrt{2\pi h_{S_{k}}^2}}e^{-0.5(\frac{X_j-x_i}{h_{S_{k}}})^2 } \]
şeklinde hesaplanır. Burada \(h\) bant genişliğidir. Bant genişliği hesaplamada bir çok yöntem mevcuttur. Aslında burada \(h\) dışında \(x_i\)’de parametre sayılabilir. Çünkü eğitim setine ait örnekleri ifade etmektedir. Test setinde tahminde bulunurken, eğitim seti örnekleri kullanılarak dağılım tahmin edilecektir. \(h\) tahmini için şimdilik stats paketinde bw.ucv fonksiyonunu kullanalım. Bu fonksiyon yansız çapraz-geçerlilik yöntemini kullanmaktadır.
hler <- sapply(S, function(m) sapply(X_egitim, function(m2) stats::bw.ucv(m2[Y_egitim == m])))## Warning in stats::bw.ucv(m2[Y_egitim == m]): minimum occurred at one end of the
## range
## Warning in stats::bw.ucv(m2[Y_egitim == m]): minimum occurred at one end of the
## range
## Warning in stats::bw.ucv(m2[Y_egitim == m]): minimum occurred at one end of the
## range
## Warning in stats::bw.ucv(m2[Y_egitim == m]): minimum occurred at one end of the
## range
## Warning in stats::bw.ucv(m2[Y_egitim == m]): minimum occurred at one end of the
## rangeprint(hler)## setosa versicolor virginica
## X1 0.2056042 0.3176646 0.3513160
## X2 0.1084255 0.2716036 0.1501705Elde edilen bant genişliklerini kullanarak test verisi üzerinden \(P(X_{j}|Y=S_{k};h_{S_{k}})\) değerlerini hesaplayalım. Ardından test verisi için tahminlerimizi elde edelim.
P_X_Y_normalkernel <- lapply(S, function(m) sapply(1:p, function(m2) {
P_X_Y_temp <- sapply(1:n_test, function(m3) {
mean(dnorm(x = X_test[m3,m2],
mean = X_egitim[Y_egitim == m,m2],
sd = hler[m2,m]))
})
P_X_Y_temp[is.infinite(P_X_Y_temp)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
P_X_Y_temp[P_X_Y_temp == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(P_X_Y_temp)
}))
P_X_Y_normalkernel <- lapply(P_X_Y_normalkernel, function(m) apply(m, 1, prod))
head(P_X_Y_normalkernel)## [[1]]
## [1] 9.363965e-01 1.065052e+00 1.875773e+00 1.839813e+00 7.023805e-01
## [6] 1.177506e+00 5.057409e-01 1.381445e+00 9.608683e-01 7.013966e-01
## [11] 1.346262e+00 1.542974e+00 1.366252e+00 1.433273e+00 1.875773e+00
## [16] 2.765643e-129 3.572308e-83 9.241366e-140 7.611900e-127 1.209077e-148
## [21] 4.602710e-100 4.597645e-84 3.205302e-122 1.057786e-126 3.359366e-128
## [26] 2.181062e-84 2.883247e-49 1.459054e-61 3.572308e-83 1.081258e-99
## [31] 1.081258e-99 8.950249e-24 7.348153e-307 2.591771e-126 1.012293e-287
## [36] 6.036433e-218 1.717558e-244 4.459203e-168 1.690483e-273 3.602233e-169
## [41] 2.738134e-257 1.063753e-256 8.342909e-244 6.002825e-158 1.205854e-259
##
## [[2]]
## [1] 1.512097e-14 1.799540e-12 4.604593e-13 5.657941e-12 5.483842e-14
## [6] 1.118454e-11 1.510283e-11 6.072374e-11 2.805482e-11 2.031690e-15
## [11] 3.272885e-14 2.890321e-13 7.337884e-11 9.617071e-12 4.604593e-13
## [16] 3.298279e-01 2.565643e-01 2.995032e-01 4.235650e-01 3.351710e-01
## [21] 3.828961e-01 3.111528e-01 2.436899e-01 3.950723e-01 3.874006e-01
## [26] 2.971411e-01 1.437645e-01 1.677669e-01 2.565643e-01 3.665201e-01
## [31] 3.665201e-01 1.626768e-02 1.414002e-04 1.281925e-01 9.328055e-04
## [36] 5.706571e-02 1.545319e-02 2.789146e-01 2.493782e-03 2.919006e-01
## [41] 7.859118e-03 8.542330e-03 1.683308e-02 3.625798e-01 5.952938e-03
##
## [[3]]
## [1] 1.082985e-122 5.420902e-110 4.685981e-115 1.325231e-108 2.456133e-117
## [6] 1.030633e-107 2.549295e-107 2.405474e-102 2.449601e-103 1.549078e-128
## [11] 1.063476e-121 1.101079e-115 4.449227e-102 6.814107e-108 4.685981e-115
## [16] 6.943338e-03 7.507997e-09 2.535428e-02 3.310438e-03 7.016614e-02
## [21] 9.797229e-06 2.176157e-08 1.186637e-03 2.574878e-03 6.580552e-03
## [26] 2.411452e-08 9.888977e-19 2.394773e-14 7.507997e-09 6.714639e-06
## [31] 6.714639e-06 1.127300e-34 1.817464e-01 8.655681e-05 2.478068e-01
## [36] 3.265291e-01 2.693416e-01 1.064515e-01 2.627203e-01 2.532839e-01
## [41] 2.902130e-01 2.866282e-01 2.730675e-01 1.251708e-01 2.619942e-01p_Y_X_normalkernel <- sapply(1:length(S), function(m) P_X_Y_normalkernel[[m]]*onseller[m])
colnames(p_Y_X_normalkernel) <- S
head(p_Y_X_normalkernel)## setosa versicolor virginica
## [1,] 0.3121322 4.752306e-15 3.816233e-123
## [2,] 0.3550173 5.655698e-13 1.910223e-110
## [3,] 0.6252575 1.447158e-13 1.651251e-115
## [4,] 0.6132709 1.778210e-12 4.669861e-109
## [5,] 0.2341268 1.723493e-14 8.654946e-118
## [6,] 0.3925021 3.515142e-12 3.631756e-108### her satır, o örneğe ait sonsalları göstermektedir. Toplamlarını 1 olacak şekilde standartlaştıralım. Böylece olasılıkları hesaplamış olacağız.
p_Y_X_normalkernel <- t(apply(p_Y_X_normalkernel, 1, function(m) m/sum(m)))
head(p_Y_X_normalkernel)## setosa versicolor virginica
## [1,] 1 1.522530e-14 1.222634e-122
## [2,] 1 1.593076e-12 5.380646e-110
## [3,] 1 2.314499e-13 2.640913e-115
## [4,] 1 2.899550e-12 7.614678e-109
## [5,] 1 7.361366e-14 3.696691e-117
## [6,] 1 8.955727e-12 9.252832e-108### olasılıkların toplamlarının 1 olup olmadığını kontrol edelim
print(apply(p_Y_X_normalkernel, 1, sum))## [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [39] 1 1 1 1 1 1 1Y_sapka_normalkernel <- apply(p_Y_X_normalkernel, 1, function(m) S[which.max(m)]) ### tahminler
Y_sapka_normalkernel <- factor(Y_sapka_normalkernel, levels = S, labels = S)
print(Y_sapka_normalkernel)## [1] setosa setosa setosa setosa setosa setosa
## [7] setosa setosa setosa setosa setosa setosa
## [13] setosa setosa setosa versicolor versicolor versicolor
## [19] versicolor versicolor versicolor versicolor versicolor versicolor
## [25] versicolor versicolor versicolor versicolor versicolor versicolor
## [31] versicolor versicolor virginica versicolor virginica virginica
## [37] virginica versicolor virginica versicolor virginica virginica
## [43] virginica versicolor virginica
## Levels: setosa versicolor virginicaprint(table(Y_test, Y_sapka_normalkernel))## Y_sapka_normalkernel
## Y_test setosa versicolor virginica
## setosa 15 0 0
## versicolor 0 17 0
## virginica 0 4 9dogruluk_orani_normalkernel <- sum(Y_test == Y_sapka_normalkernel)/n_test
print(paste0("Test doğruluk oranı = ", round(dogruluk_orani_normalkernel,3)))## [1] "Test dogruluk orani = 0.911"%91.1 doğruluk oranına sahip bir bayes sınıflayıcısı eldetmiş olduk.
1.2.5 Çok değişkenli normal yaklaşımı
Değişkenlerin birbirlerinden bağımsız olduklarını varsaymadan olabilirliği hesaplamanın yolu var mıdır? Çok değişkenli dağılımlar yoluyla olabilirlik elde etmek elbette mümkündür. Bu durumda yine dağılım hakkında varsayımda bulunmak gerekecektir. \(\textbf{X}\)’in çoklu normal dağılımna uygun olduğunu varsayalım. Öyle ise olabilirliğimiz \[ P(\textbf{X}|Y=S_{k};\boldsymbol{\mu}_{S_{k}},\boldsymbol\Sigma_{S_{k}})=\frac{1}{\sqrt{(2\pi)^p |\boldsymbol\Sigma_{S_{k}}|}}e^{-0.5({\textbf{X}}-{\boldsymbol{\mu}_{S_{k}}})^\mathrm{T}{\boldsymbol\Sigma_{S_{k}}}^{-1}({\textbf{X}}-{\boldsymbol{\mu}_{S_{k}}})} \] şeklindedir. Burada \(\boldsymbol{\mu}\) ortalamalar vektörü, \(\boldsymbol\Sigma\) varyans kovaryans matrisidir. Her sınıf örneklemine ait \(\boldsymbol{\mu}\) ve \(\boldsymbol\Sigma\) parametrelerini tahmin edelim.
print(ortalamalar) ## her bir sütun, o sınıfa ait ortalama vektörüdür## setosa versicolor virginica
## X1 5.017143 5.960606 6.691892
## X2 1.468571 4.318182 5.621622Sigmalar_kuadratik <- lapply(S, function(m) cov(X_egitim[Y_egitim == m,]))
names(Sigmalar_kuadratik) <- S
print(Sigmalar_kuadratik)## $setosa
## X1 X2
## X1 0.1349916 0.02026050
## X2 0.0202605 0.03751261
##
## $versicolor
## X1 X2
## X1 0.3149621 0.2107386
## X2 0.2107386 0.2309091
##
## $virginica
## X1 X2
## X1 0.4029880 0.3096246
## X2 0.3096246 0.3317417Sigmalar_lineer <- cov(X_egitim)
print(Sigmalar_lineer)## X1 X2
## X1 0.7671007 1.394413
## X2 1.3944130 3.292403Sigmalar_kuadratik ve Sigmalar_lineer isminde iki farklı \(\boldsymbol{\Sigma}\) değişkeni hesapladığımız görülüyor. Burada başka bir varsayım devreye girmektedir. Sınıflara ait varyans-kovaryans matrislerinin aynı olduğu varsayılırsa, tüm \(X^{eğitim}\) veri setini kullanarak \(\boldsymbol{\Sigma}_{S_{k}}^{lineer}\), sınıflara ait varyans-kovaryans matrislerinin farklı olduğu kabul edilirse \(\boldsymbol{\Sigma}_{S_{k}}^{kuadratik}\) olacak şekilde varyans-kovaryans matrisleri elde edilir. Bu iki yaklaşım, literatürde “diskriminant analizi” olarak geçen yöntemin iki türüne karşılık gelir: Lineer diskriminant analizi, Kuadratik diskriminant analizi. Çoklu normal dağılım için yoğunlukları mvtnorm paketinde dmvnorm fonksiyonuyla elde edeceğiz.
Önsellerimizi kullanarak lineer diskriminant için olabilirlik değerlerini test verisi için hesaplayalım. Ardından tahminlerimizi gerçekleştirelim
library(mvtnorm)
P_X_Y_coklunormal_lineer <- lapply(S, function(m) {
P_X_Y_temp <- mvtnorm::dmvnorm(x = X_test,
mean = ortalamalar[,m],
sigma = Sigmalar_lineer)
P_X_Y_temp[is.infinite(P_X_Y_temp)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
P_X_Y_temp[P_X_Y_temp == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(P_X_Y_temp)
})
print(P_X_Y_coklunormal_lineer)## [[1]]
## 3 4 5 8 9 11
## 0.1751822085 0.1234997863 0.2085291032 0.2081828788 0.0783260104 0.1417758389
## 16 27 30 36 41 46
## 0.0586348705 0.2051121785 0.1404596406 0.2011010405 0.2061372343 0.1887202555
## 47 49 50 52 54 55
## 0.2077791891 0.1699084373 0.2085291032 0.0502936478 0.0295045582 0.0439280931
## 56 57 62 63 66 67
## 0.0185875090 0.0418706253 0.0543575132 0.0771271914 0.0326070729 0.0128546366
## 69 72 80 82 90 96
## 0.0502351726 0.0788618842 0.1020287206 0.0535132819 0.0295045582 0.0355841405
## 97 99 103 107 109 116
## 0.0355841405 0.0590571985 0.0093811458 0.0001991096 0.0113239009 0.0190851163
## 117 122 125 128 133 137
## 0.0153360875 0.0040840318 0.0133064331 0.0236738016 0.0106736178 0.0084284499
## 138 139 141
## 0.0131271747 0.0230275828 0.0154310456
##
## [[2]]
## 3 4 5 8 9 11
## 0.052295454 0.057744891 0.046212920 0.053589100 0.042493900 0.020091750
## 16 27 30 36 41 46
## 0.005310796 0.061327834 0.065709727 0.033032512 0.039329502 0.056366777
## 47 49 50 52 54 55
## 0.053513610 0.027953389 0.046212920 0.143195914 0.152183923 0.125138397
## 56 57 62 63 66 67
## 0.150406470 0.186724093 0.208253726 0.188654555 0.051083736 0.120756107
## 69 72 80 82 90 96
## 0.192767290 0.166158648 0.184680283 0.176131517 0.152183923 0.183737429
## 97 99 103 107 109 116
## 0.183737429 0.123771648 0.076477146 0.005315810 0.144362045 0.180048741
## 117 122 125 128 133 137
## 0.168141658 0.069835671 0.146044060 0.191971305 0.157801488 0.144660891
## 138 139 141
## 0.167084433 0.186631918 0.145808511
##
## [[3]]
## 3 4 5 8 9 11
## 0.011369769 0.011265186 0.013578757 0.015692431 0.006789530 0.008831216
## 16 27 30 36 41 46
## 0.003165586 0.017897343 0.014140633 0.009772459 0.011595725 0.013518401
## 47 49 50 52 54 55
## 0.017285917 0.011100434 0.013578757 0.156826942 0.067982607 0.151180244
## 56 57 62 63 66 67
## 0.080923723 0.183496375 0.138689992 0.140017576 0.076128500 0.058697716
## 69 72 80 82 90 96
## 0.172317308 0.136500882 0.102815419 0.079490390 0.067982607 0.099874700
## 97 99 103 107 109 116
## 0.099874700 0.038114446 0.162533430 0.001269407 0.205096343 0.191874577
## 117 122 125 128 133 137
## 0.196985492 0.033485597 0.208195639 0.152933730 0.166452349 0.137858239
## 138 139 141
## 0.176846985 0.134784043 0.208570768p_Y_X_coklunormal_lineer <- sapply(1:length(S), function(m) P_X_Y_coklunormal_lineer[[m]]*onseller[m])
colnames(p_Y_X_coklunormal_lineer) <- S
head(p_Y_X_coklunormal_lineer)## setosa versicolor virginica
## 3 0.05839407 0.01643571 0.004006490
## 4 0.04116660 0.01814839 0.003969637
## 5 0.06950970 0.01452406 0.004784895
## 8 0.06939429 0.01684229 0.005529714
## 9 0.02610867 0.01335523 0.002392501
## 11 0.04725861 0.00631455 0.003111952### her satır, o örneğe ait sonsalları göstermektedir. Toplamlarını 1 olacak şekilde standartlaştıralım. Böylece olasılıkları hesaplamış olacağız.
p_Y_X_coklunormal_lineer <- t(apply(p_Y_X_coklunormal_lineer, 1, function(m) m/sum(m)))
head(p_Y_X_coklunormal_lineer)## setosa versicolor virginica
## 3 0.7407005 0.2084791 0.05082039
## 4 0.6504991 0.2867741 0.06272672
## 5 0.7826025 0.1635249 0.05387264
## 8 0.7562068 0.1835346 0.06025866
## 9 0.6237677 0.3190725 0.05715975
## 11 0.8337041 0.1113970 0.05489893### olasılıkların toplamlarının 1 olup olmadığını kontrol edelim
print(apply(p_Y_X_coklunormal_lineer, 1, sum))## 3 4 5 8 9 11 16 27 30 36 41 46 47 49 50 52 54 55 56 57
## 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## 62 63 66 67 69 72 80 82 90 96 97 99 103 107 109 116 117 122 125 128
## 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## 133 137 138 139 141
## 1 1 1 1 1Y_sapka_coklunormal_lineer <- apply(p_Y_X_coklunormal_lineer, 1, function(m) S[which.max(m)]) ### tahminler
Y_sapka_coklunormal_lineer <- factor(Y_sapka_coklunormal_lineer, levels = S, labels = S)
print(Y_sapka_coklunormal_lineer)## 3 4 5 8 9 11 16
## setosa setosa setosa setosa setosa setosa setosa
## 27 30 36 41 46 47 49
## setosa setosa setosa setosa setosa setosa setosa
## 50 52 54 55 56 57 62
## setosa virginica versicolor virginica versicolor virginica versicolor
## 63 66 67 69 72 80 82
## versicolor virginica versicolor virginica versicolor versicolor versicolor
## 90 96 97 99 103 107 109
## versicolor versicolor versicolor versicolor virginica versicolor virginica
## 116 117 122 125 128 133 137
## virginica virginica versicolor virginica versicolor virginica virginica
## 138 139 141
## virginica versicolor virginica
## Levels: setosa versicolor virginicaprint(table(Y_test, Y_sapka_coklunormal_lineer))## Y_sapka_coklunormal_lineer
## Y_test setosa versicolor virginica
## setosa 15 0 0
## versicolor 0 12 5
## virginica 0 4 9dogruluk_orani_coklunormal_lineer <- sum(Y_test == Y_sapka_coklunormal_lineer)/n_test
print(paste0("Test doğruluk oranı = ", round(dogruluk_orani_coklunormal_lineer,3)))## [1] "Test dogruluk orani = 0.8"Lineer diskriminant için çoklu normal bayes sınıflayıcısının doğruluk oranını %80 olarak tespit ettik. Aynı işlemleri kuadratik diskriminant için de uygulayalım.
P_X_Y_coklunormal_kuadratik <- lapply(S, function(m) {
P_X_Y_temp <- mvtnorm::dmvnorm(x = X_test,
mean = ortalamalar[,m],
sigma = Sigmalar_kuadratik[[m]])
P_X_Y_temp[is.infinite(P_X_Y_temp)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
P_X_Y_temp[P_X_Y_temp == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(P_X_Y_temp)
})
print(P_X_Y_coklunormal_kuadratik)## [[1]]
## 3 4 5 8 9
## 1.300042e+00 1.077264e+00 2.187882e+00 2.291816e+00 5.644573e-01
## 11 16 27 30 36
## 1.342388e+00 3.855206e-01 1.796180e+00 1.009823e+00 8.351328e-01
## 41 46 47 49 50
## 1.562725e+00 1.922794e+00 1.852244e+00 1.731683e+00 2.187882e+00
## 52 54 55 56 57
## 1.146872e-53 8.025361e-39 3.383104e-57 3.786891e-55 3.530126e-61
## 62 63 66 67 69
## 3.683671e-44 1.034943e-37 4.047077e-50 1.685149e-55 6.476726e-54
## 72 80 82 90 96
## 1.355117e-37 1.511569e-24 4.278839e-30 8.025361e-39 1.206354e-44
## 97 99 103 107 109
## 1.206354e-44 6.642324e-15 3.343560e-114 6.093260e-59 1.025638e-109
## 116 117 122 125 128
## 3.685797e-86 2.780243e-95 2.415177e-71 1.221147e-104 1.476549e-69
## 133 137 138 139 141
## 2.008633e-100 9.734840e-101 1.525562e-95 9.042184e-66 1.087818e-99
##
## [[2]]
## 3 4 5 8 9 11
## 2.866397e-13 8.099687e-11 6.824833e-14 8.111642e-13 6.524842e-11 2.203526e-15
## 16 27 30 36 41 46
## 1.113713e-17 8.626208e-12 2.463193e-10 3.460522e-16 5.137711e-15 9.316279e-13
## 47 49 50 52 54 55
## 2.397534e-12 1.090781e-14 6.824833e-14 6.490777e-01 6.749731e-01 5.755746e-01
## 56 57 62 63 66 67
## 4.193226e-01 6.895336e-01 9.093049e-01 4.875453e-01 1.538500e-01 2.843043e-01
## 69 72 80 82 90 96
## 8.613013e-01 3.576987e-01 8.469414e-02 3.957566e-01 6.749731e-01 8.343513e-01
## 97 99 103 107 109 116
## 8.343513e-01 1.361827e-02 2.876487e-03 1.909088e-03 1.760072e-03 5.012081e-02
## 117 122 125 128 133 137
## 1.404593e-02 1.777543e-02 4.991148e-03 2.431742e-01 3.061052e-03 1.619858e-03
## 138 139 141
## 8.687446e-03 2.976408e-01 1.266382e-02
##
## [[3]]
## 3 4 5 8 9 11
## 5.608932e-21 8.456313e-18 4.163207e-22 8.878019e-21 1.181645e-17 2.290587e-24
## 16 27 30 36 41 46
## 1.856447e-27 1.701880e-19 2.603489e-17 6.650067e-25 1.754949e-23 1.803670e-20
## 47 49 50 52 54 55
## 2.670127e-20 2.061485e-23 4.163207e-22 1.009020e-02 9.877620e-03 1.333311e-02
## 56 57 62 63 66 67
## 1.212652e-01 8.695438e-02 1.109171e-02 8.051806e-04 2.658575e-04 1.217931e-01
## 69 72 80 82 90 96
## 3.183426e-02 3.748516e-04 1.277156e-05 6.404596e-04 9.877620e-03 2.378914e-02
## 97 99 103 107 109 116
## 2.378914e-02 1.051890e-06 6.612219e-01 1.076946e-02 6.987987e-01 7.000302e-01
## 117 122 125 128 133 137
## 7.790639e-01 1.732588e-01 7.959334e-01 3.625851e-01 5.916044e-01 4.461475e-01
## 138 139 141
## 6.960949e-01 2.886573e-01 8.149409e-01p_Y_X_coklunormal_kuadratik <- sapply(1:length(S), function(m) P_X_Y_coklunormal_kuadratik[[m]]*onseller[m])
colnames(p_Y_X_coklunormal_kuadratik) <- S
head(p_Y_X_coklunormal_kuadratik)## setosa versicolor virginica
## 3 0.4333472 9.008677e-14 1.976481e-21
## 4 0.3590881 2.545616e-11 2.979843e-18
## 5 0.7292940 2.144948e-14 1.467035e-22
## 8 0.7639385 2.549373e-13 3.128445e-21
## 9 0.1881524 2.050665e-11 4.163893e-18
## 11 0.4474627 6.925367e-16 8.071591e-25### her satır, o örneğe ait sonsalları göstermektedir. Toplamlarını 1 olacak şekilde standartlaştıralım. Böylece olasılıkları hesaplamış olacağız.
p_Y_X_coklunormal_kuadratik <- t(apply(p_Y_X_coklunormal_kuadratik, 1, function(m) m/sum(m)))
head(p_Y_X_coklunormal_kuadratik)## setosa versicolor virginica
## 3 1 2.078859e-13 4.560964e-21
## 4 1 7.089112e-11 8.298363e-18
## 5 1 2.941129e-14 2.011582e-22
## 8 1 3.337144e-13 4.095152e-21
## 9 1 1.089895e-10 2.213042e-17
## 11 1 1.547697e-15 1.803858e-24### olasılıkların toplamlarının 1 olup olmadığını kontrol edelim
print(apply(p_Y_X_coklunormal_kuadratik, 1, sum))## 3 4 5 8 9 11 16 27 30 36 41 46 47 49 50 52 54 55 56 57
## 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## 62 63 66 67 69 72 80 82 90 96 97 99 103 107 109 116 117 122 125 128
## 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## 133 137 138 139 141
## 1 1 1 1 1Y_sapka_coklunormal_kuadratik <- apply(p_Y_X_coklunormal_kuadratik, 1, function(m) S[which.max(m)]) ### tahminler
Y_sapka_coklunormal_kuadratik <- factor(Y_sapka_coklunormal_kuadratik, levels = S, labels = S)
print(Y_sapka_coklunormal_kuadratik)## 3 4 5 8 9 11 16
## setosa setosa setosa setosa setosa setosa setosa
## 27 30 36 41 46 47 49
## setosa setosa setosa setosa setosa setosa setosa
## 50 52 54 55 56 57 62
## setosa versicolor versicolor versicolor versicolor versicolor versicolor
## 63 66 67 69 72 80 82
## versicolor versicolor versicolor versicolor versicolor versicolor versicolor
## 90 96 97 99 103 107 109
## versicolor versicolor versicolor versicolor virginica virginica virginica
## 116 117 122 125 128 133 137
## virginica virginica virginica virginica virginica virginica virginica
## 138 139 141
## virginica virginica virginica
## Levels: setosa versicolor virginicaprint(table(Y_test, Y_sapka_coklunormal_kuadratik))## Y_sapka_coklunormal_kuadratik
## Y_test setosa versicolor virginica
## setosa 15 0 0
## versicolor 0 17 0
## virginica 0 0 13dogruluk_orani_coklunormal_kuadratik <- sum(Y_test == Y_sapka_coklunormal_kuadratik)/n_test
print(paste0("Test doğruluk oranı = ", round(dogruluk_orani_coklunormal_kuadratik,3)))## [1] "Test dogruluk orani = 1"Kuadratik diskriminant test verisindeki tüm örnekleri doğru tahmin eden bir bayes sınıflayıcısı elde etti! Demek ki varyans kovaryans matrisleri gerçekten de sınıflar arasında farklılık gösteriyormuş.
1.2.6 Çok değişkenli kernel yaklaşımı
Çoklu değişkenli yaklaşım için çok değişkenli kernel fonksiyonları da mevcuttur. Yine çok değişkenli normal kernel fonksiyonunu ele alalım. Tek değişkenli normal kernel ile normal dağılım arasındaki benzerlik gibi, burada da çok değişkenli normal kernel ile çok değişkenli normal dağılım arasında benzerlik mevcuttur. Çok değişkenli normal kernel için \(P(\textbf{X}|Y=S_{k};\textbf H_{S_{k}})\) şu şekildedir: \[ P(\textbf{X}|Y=S_{k};\textbf{H}_{S_{k}})=\frac{1}{n} \sum_i^n\frac{1}{\sqrt{(2\pi)^p |\textbf{H}_{S_{k}}|}}e^{-0.5({\textbf{X}}-{\textbf{X}_{i}})^\mathrm{T}{\textbf{H}_{S_{k}}}^{-1}({\textbf{X}}-{\textbf{X}_{i}})} \]
Burada \(\textbf H\) bant genişliği matrisidir. Bu matrisin hesaplanması için ks paketinde yöntemler mevcuttur. Ben burada Hucv fonksiyonunu kullanacağım. Bu fonksiyon, tek değişkenli bant genişliğini hesaplarken yaptığımz gibi yansız çapraz-geçerlilik yaklaşımını kullanmaktadır.
library(ks)
Hler <- lapply(S, function(m) Hucv(X_egitim[Y_egitim == m,]))## Warning in Hlscv(...): Data contain duplicated values: LSCV is not well-behaved
## in this case
## Warning in Hlscv(...): Data contain duplicated values: LSCV is not well-behaved
## in this case
## Warning in Hlscv(...): Data contain duplicated values: LSCV is not well-behaved
## in this casenames(Hler) <- S
print(Hler)## $setosa
## [,1] [,2]
## [1,] 9.456476e-02 -4.769569e-10
## [2,] -4.769569e-10 4.599747e-13
##
## $versicolor
## [,1] [,2]
## [1,] 0.09617942 0.1372960
## [2,] 0.13729596 0.2028689
##
## $virginica
## [,1] [,2]
## [1,] 0.1583509 0.1549495
## [2,] 0.1549495 0.1690589\(\textbf H\) bant genişliği matrislerimizi elde ettik. Olabilirliği hesaplamaya geçebiliriz. Ardından test verisi için tahminde bulunarak doğruluk oranını hesaplayacağız. Tek değişkenli kernelde olduğu gibi test olabilirliği için eğitim setinden faydalanılacak.
P_X_Y_coklunormal_kernel <- lapply(S, function(m) {
P_X_Y_temp <- sapply(1:n_test, function(m2) {
mean(mvtnorm::dmvnorm(x = as.matrix(X_egitim[Y_egitim == m,]),
mean = as.matrix(X_test[m2,,drop = FALSE]), ### Eğitim setine ait x değerleri ortalama olarak alınacağı için, x ve mean değerleri yer değiştirebilir. Sonuç değişmez.
sigma = Hler[[m]]))
})
P_X_Y_temp[is.infinite(P_X_Y_temp)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
P_X_Y_temp[P_X_Y_temp == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(P_X_Y_temp)
})
print(P_X_Y_coklunormal_kernel)## [[1]]
## [1] 4.711546e+04 5.177470e+04 1.425422e+05 1.480524e+05 6.032211e+04
## [6] 1.093666e+05 3.640290e+04 7.890045e+04 6.845553e+04 7.394251e+02
## [11] 2.748341e+04 1.365436e+05 6.845553e+04 1.336951e+05 1.425422e+05
## [16] 1.000000e-20 1.000000e-20 1.000000e-20 1.000000e-20 1.000000e-20
## [21] 1.000000e-20 1.000000e-20 1.000000e-20 1.000000e-20 1.000000e-20
## [26] 1.000000e-20 1.000000e-20 1.000000e-20 1.000000e-20 1.000000e-20
## [31] 1.000000e-20 1.000000e-20 1.000000e-20 1.000000e-20 1.000000e-20
## [36] 1.000000e-20 1.000000e-20 1.000000e-20 1.000000e-20 1.000000e-20
## [41] 1.000000e-20 1.000000e-20 1.000000e-20 1.000000e-20 1.000000e-20
##
## [[2]]
## [1] 1.031077e-13 3.453221e-10 9.796949e-17 3.053825e-14 1.631537e-10
## [6] 1.016870e-33 2.611658e-62 2.225891e-12 1.010757e-09 1.287131e-23
## [11] 7.345451e-20 3.615486e-13 2.379785e-14 7.483621e-27 9.796949e-17
## [16] 3.523279e-01 3.941063e-01 2.693666e-01 2.478921e-01 1.393028e-01
## [21] 5.500844e-01 2.987838e-01 8.318167e-02 3.528664e-01 1.878802e-01
## [26] 1.560868e-01 6.062242e-02 5.454863e-01 3.941063e-01 5.839315e-01
## [31] 5.839315e-01 5.546228e-02 2.093905e-03 4.241894e-18 2.863000e-03
## [36] 4.711834e-02 1.278181e-02 5.874870e-02 1.748133e-02 1.195205e-01
## [41] 8.815624e-02 8.818929e-02 6.160707e-02 1.495170e-01 9.639359e-02
##
## [[3]]
## [1] 3.061437e-42 9.631827e-32 5.825057e-49 1.680423e-44 5.882843e-30
## [6] 1.632196e-61 4.585280e-77 2.732006e-40 4.708982e-31 1.252841e-58
## [11] 1.137957e-53 1.457645e-41 6.696870e-44 7.324530e-57 5.825057e-49
## [16] 2.720335e-02 2.698552e-02 3.653945e-02 1.186305e-01 1.532916e-01
## [21] 1.625531e-02 1.612856e-03 4.912618e-05 8.544697e-02 4.715670e-02
## [26] 6.070801e-04 4.797872e-06 4.392656e-04 2.698552e-02 6.831973e-02
## [31] 6.831973e-02 1.111934e-07 4.706171e-01 4.017864e-03 3.704217e-01
## [36] 3.996200e-01 3.810234e-01 4.127975e-01 3.930876e-01 3.472494e-01
## [41] 4.794833e-01 4.939263e-01 4.153080e-01 2.857086e-01 4.416979e-01p_Y_X_coklunormal_kernel <- sapply(1:length(S), function(m) P_X_Y_coklunormal_kernel[[m]]*onseller[m])
colnames(p_Y_X_coklunormal_kernel) <- S
head(p_Y_X_coklunormal_kernel)## setosa versicolor virginica
## [1,] 15705.15 3.240527e-14 1.078792e-42
## [2,] 17258.23 1.085298e-10 3.394072e-32
## [3,] 47514.05 3.079041e-17 2.052639e-49
## [4,] 49350.79 9.597736e-15 5.921492e-45
## [5,] 20107.37 5.127688e-11 2.073002e-30
## [6,] 36455.53 3.195878e-34 5.751547e-62### her satır, o örneğe ait sonsalları göstermektedir. Toplamlarını 1 olacak şekilde standartlaştıralım. Böylece olasılıkları hesaplamış olacağız.
p_Y_X_coklunormal_kernel <- t(apply(p_Y_X_coklunormal_kernel, 1, function(m) m/sum(m)))
head(p_Y_X_coklunormal_kernel)## setosa versicolor virginica
## [1,] 1 2.063353e-18 6.869031e-47
## [2,] 1 6.288581e-15 1.966639e-36
## [3,] 1 6.480274e-22 4.320068e-54
## [4,] 1 1.944799e-19 1.199878e-49
## [5,] 1 2.550153e-15 1.030966e-34
## [6,] 1 8.766511e-39 1.577688e-66### olasılıkların toplamlarının 1 olup olmadığını kontrol edelim
print(apply(p_Y_X_coklunormal_kernel, 1, sum))## [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [39] 1 1 1 1 1 1 1Y_sapka_coklunormal_kernel <- apply(p_Y_X_coklunormal_kernel, 1, function(m) S[which.max(m)]) ### tahminler
Y_sapka_coklunormal_kernel <- factor(Y_sapka_coklunormal_kernel, levels = S, labels = S)
print(Y_sapka_coklunormal_kernel)## [1] setosa setosa setosa setosa setosa setosa
## [7] setosa setosa setosa setosa setosa setosa
## [13] setosa setosa setosa versicolor versicolor versicolor
## [19] versicolor virginica versicolor versicolor versicolor versicolor
## [25] versicolor versicolor versicolor versicolor versicolor versicolor
## [31] versicolor versicolor virginica virginica virginica virginica
## [37] virginica virginica virginica virginica virginica virginica
## [43] virginica virginica virginica
## Levels: setosa versicolor virginicaprint(table(Y_test, Y_sapka_coklunormal_kernel))## Y_sapka_coklunormal_kernel
## Y_test setosa versicolor virginica
## setosa 15 0 0
## versicolor 0 16 1
## virginica 0 0 13dogruluk_orani_coklunormal_kernel <- sum(Y_test == Y_sapka_coklunormal_kernel)/n_test
print(paste0("Test doğruluk oranı = ", round(dogruluk_orani_coklunormal_kernel,3)))## [1] "Test dogruluk orani = 0.978"Çok değişkenli normal kernel bayes sınıflayıcısı ise %97.8’lik bir doğruluk oranını yakaladı.
1.2.7 Copula yaklaşımı
Tek değişkenli dağılımlar için normal dağılımı ve kernel yaklaşımını denedik. Buradan yola çıkarak tüm tek değişkenli dağılımları uygulamak mümkündür. Çok değişkenli dağılımlardan ise çok değişkenli normal ve çok değişkenli normal kernel yaklaşımlarını denedik. Çok değişkenli dağılım için lineer ve kuadratik yaklaşımları denedik. Peki buradan sonra nereye gidilebilir? Bu sorunun cevabına Copula verilebilir. Copula nedir? Copulalar, değişkenler arasındaki bağımlılık yapısını modelleyebilen esnek çok değişkenli yapılara sahip fonksiyonlardır. Copula hem simetrik hem de asimetrik bağımlılık yapılarını modelleyebilir. Farklı dağılım ailelerinden tek değişkenli marjinallerle bilinmeyen çok değişkenli dağılım fonksiyonlarının elde edilmesini sağlar. Bu şekilde, bağımlılık Copula ile daha esnek bir şekilde modellenebilir. [0,1] aralığında değerler alan ve değişkenler arasındaki bağımlılık yapısını açıklamak için kullanılan çoklu değişkenler için çok değişkenli bir dağılım fonksiyonudur. Copula’nın kullanılabilmesi için, gerektiğinde değerler dönüştürülerek [0,1] aralığına düşürülmelidir.
Özetle Copuladan bahsedelim. \(F\), \(p\) boyutlu dağılım fonksiyonu ve \(F_1, ..., F_p\) değişkenlere ait tek değişkenli dağılım fonksiyonları olsun. \(X \in R^p\) için \(p\) boyutlu Copula mevcuttur ve şu şekildedir: \[ F(X_1,...,X_p)=C(F_1(X_1),...,F_p(X_p)) \]
\(X_1,...,X_p\) değişkenleri sürekli ise C, özgün tanımlıdır. Bu durumda \(p\) boyutlu bir \(F\) dağılım fonksiyonu vardır. \(p\) boyutlu yoğunluk fonksiyonunu elde etmek için \[ f(X_1,...,X_p)=\frac{\partial F(X_1,...,X_p)}{\partial X_1,...,X_p}=\frac{C(u_1,...,u_p)}{\partial u_1,...,u_p}\times\prod_{j=1}^p \frac{\partial F(X_j)}{\partial X_j} \]
\[ f(X_1,...,X_p)=c(u_1,...,u_p)\times\prod_{j=1}^p f(X_i) \]
kullanılır. Burada \(c\) Copula yoğunluk fonksiyonudur. Burada marjinal dağılımlar ile Copulanın bağımsız olduğunu görüyoruz. Bu nedenle yoğunlukları farklı dağılımlarla elde etmek mümkündür. Bu da çok değişkenli dağılımın esnek bir şekilde elde edilebilmesine olanak sağlar. Ayrıntılı bilgi için Joe & Kurowicka (2011)’ye başvurulabilir. Buradan Bayes sınıflayıcısına geçiş yaparsak \[ f(X_1,...,X_p|Y=S_{k};\Theta_{S_{k}})=P(\textbf{X}|Y=S_{k};\Theta_{S_{k}})=c(u_1,...,u_p)\times\prod_{j=1}^p P(X_j|Y=S_{k}) \]
yazabiliriz. Burada \(\Theta\) Copula yoğunluk fonksiyonu ve marjinal yoğunluk fonksiyonlarına ait parametreleri ifade etmektedir. Copula yoğunluk fonksiyonu için bir çok dağılım aile mevcuttur. Bunlar eliptik ve arşimedyan Copula aileleri olarak iki gruba ayrılmaktadır. Eliptik kapula ailelerine normal ve t Copula örnek verilebilir. Arşimedyan Copulaların her biri farklı yapılardaki farklı bağımlılık yapılarını ortaya koymayı amaçlar ve yapıları birbirilerine benzemeyebilir. Farklı doğrusal olmayan yapıları modelleyebiliyor olması, bizim için Copulanın asıl avantajıdır. Bayes sınıflayıcısı için yoğunlukların elde edilmesi yeterli olacaktır.
Copula yoğunluk değerlerini elde etmek için farklı programlardaki hazır fonksiyonlardan faydalanılabilir. Burada R programını kullanarak hesaplama yapmaya devam edeceğiz. Copula yoğunluğu elde ederken biraz dolambaçlı yollar izleyeceğiz. Copula aileleri arasında uygun olan aileyi seçebilmek için VineCopula paketinde BiCopSelect fonksiyonu kullanılacaktır. Bu fonksiyon, farklı Copula aileleri için en çok olabilirlik yaklaşımı ile parametre tahmini yapar. Ardından Akaike Bilgi Kriteri’ne (AIC) göre en uygun aileyi tespit eder. Uygun aile ve o aileye ait parametre(ler)i kullanarak BicopPDF fonksiyonunu kullanarak Copula yoğunlukları, yani \(c\), hesaplanır. Bu fonksiyonlar iki değişkenli durumlar için geçerlidir. 2’den fazla değişken olursa, CVine ve DVine Copula modellerine başvurulabilir. Bunun için öncelikle CDVine paketinde CDVineCopSelect fonksiyonu ile C ve D-Vine modellerinden uygun olan aile, parametreleriyle tespit edilir. Ardından VineCopula paketinde C2RVine veya D2RVine fonksiyonları ile bu model RVine modeline dönüştürülür. Son olarak RVinePDF fonksiyonu kullanılarak elde edilen modele ait yoğunluklar hesaplanır.
\(c\) yoğunluğunu elde edebildiğimize göre, marjinal yoğunluklara geçebiliriz. Marjinal yoğunluklar için yapılacaklar, naif bayes sınıflayıcısı için yapılacaklarla tamamen aynıdır. Biz önce değişkenlerin normal dağılımlı olduğunu varsayarak, ardından normal dağılım kernel fonksiyonunu kullanarak marjinalleri hesaplayalım. Öncelikle eğitim setini \([0,1]\) aralığına dönüştürelim.
library(VineCopula)
X_egitim_std <- 1/(1 + exp(-X_egitim))
X_test_std <- 1/(1 + exp(-X_test))
modeller_cop <- lapply(S, function(m) BiCopSelect(u1 = X_egitim_std[Y_egitim == m,1], u2 = X_egitim_std[Y_egitim == m,2]))
#### secilen Copula modelleri:
modeller_cop[[1]]## Bivariate copula: Rotated Tawn type 1 180 degrees (par = 20, par2 = 0.32, tau = 0.32)modeller_cop[[2]]## Bivariate copula: Rotated Tawn type 1 180 degrees (par = 20, par2 = 0.72, tau = 0.69)modeller_cop[[3]]## Bivariate copula: Rotated Tawn type 1 180 degrees (par = 20, par2 = 0.85, tau = 0.81)c_X <- lapply(1:length(S), function(m) {
c_X_temp <- BiCopPDF(u1 = X_test_std[,1], u2 = X_test_std[,2], obj = modeller_cop[[m]])
c_X_temp[is.infinite(c_X_temp)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
c_X_temp[c_X_temp == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(c_X_temp)
})
names(c_X) <- S
c_X## $setosa
## [1] 6.568064 4.036773 6.780022 6.549048 3.923095 6.327227 3.640311 5.270942
## [9] 3.760840 2.391935 4.840776 6.465474 5.945611 6.925086 6.780022 5.364856
## [17] 4.013029 5.540936 4.280190 5.194397 4.565337 4.715028 5.910719 4.144432
## [25] 5.029387 4.869662 4.280236 4.013035 4.013029 4.280191 4.280191 3.528376
## [33] 6.726223 3.308703 5.910703 5.364853 5.540933 4.144432 5.910703 4.869647
## [41] 5.364853 5.194396 5.364853 4.715018 5.910703
##
## $versicolor
## [1] 7.022500e-06 8.242870e-05 5.869871e-06 1.607977e-05 7.172757e-05
## [6] 3.542865e-06 1.222293e-06 4.292989e-05 1.444521e-04 7.222872e-07
## [11] 2.087017e-06 1.307485e-05 2.909796e-05 5.117135e-06 5.869871e-06
## [16] 8.385755e+01 5.783292e+01 9.284101e+01 4.356470e+01 8.955493e+01
## [21] 6.844452e+01 3.658370e+01 4.058860e+01 3.531354e+01 8.631323e+01
## [26] 2.945707e+01 7.276652e+00 3.282023e+01 5.783292e+01 6.443356e+01
## [31] 6.443356e+01 2.599281e+00 7.411093e+01 1.080057e+01 4.540796e+01
## [36] 4.735720e+01 4.427952e+01 2.032795e+01 4.928725e+01 4.888292e+01
## [41] 3.533706e+01 3.124746e+01 3.815455e+01 4.736049e+01 5.453497e+01
##
## $virginica
## [1] 3.134437e-07 3.679149e-06 2.619970e-07 7.177080e-07 3.201510e-06
## [6] 1.581329e-07 5.455605e-08 1.916144e-06 6.447537e-06 3.223870e-08
## [11] 9.315233e-08 5.835858e-07 1.298765e-06 2.283992e-07 2.619970e-07
## [16] 9.767209e+00 1.247485e+01 1.191672e+01 6.371724e+01 3.294610e+01
## [21] 9.786982e+00 2.440134e+00 2.444245e+00 7.646751e+01 1.748323e+01
## [26] 1.770780e+00 3.556227e-01 2.375966e+00 1.247485e+01 1.814061e+01
## [31] 1.814061e+01 1.212877e-01 2.978386e+02 5.065663e+01 2.586472e+02
## [36] 1.777458e+02 2.164499e+02 1.156187e+02 2.539283e+02 1.050586e+02
## [41] 2.044375e+02 1.782157e+02 2.085779e+02 9.321607e+01 2.340856e+02c_X, her bir sınıf için \(c\) yoğunluk değerleridir. Şimdi normal dağılım varsayımı ile marjinal yoğunlukları hesaplayalım. Ardından olabilirliği hesaplayalım.
ortalamalar_std <- sapply(S, function(m) sapply(X_egitim_std, function(m2) mean(m2[Y_egitim == m])))
print(ortalamalar_std)## setosa versicolor virginica
## X1 0.9929873 0.9970168 0.9985195
## X2 0.8111218 0.9852709 0.9958508standart_sapmalar_std <- sapply(S, function(m) sapply(X_egitim_std, function(m2) sd(m2[Y_egitim == m])))
print(standart_sapmalar_std)## setosa versicolor virginica
## X1 0.002579462 0.001685668 0.0008408009
## X2 0.029490472 0.007797739 0.0020102339P_X_Y_normal_marj <- lapply(S, function(m) sapply(1:p, function(m2) {
P_X_Y_marj <- dnorm(x = X_test_std[,m2],
mean = ortalamalar_std[m2,m],
sd = standart_sapmalar_std[m2,m])
P_X_Y_marj[is.infinite(P_X_Y_marj)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
P_X_Y_marj[P_X_Y_marj == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(P_X_Y_marj)
}))
P_X_Y_normal_cop <- lapply(1:length(S), function(m) apply(cbind(P_X_Y_normal_marj[[m]],c_X[[m]]), 1, prod))
p_Y_X_normal_cop <- sapply(1:length(S), function(m) P_X_Y_normal_cop[[m]]*onseller[m])
colnames(p_Y_X_normal_cop) <- S
head(p_Y_X_normal_cop)## setosa versicolor virginica
## [1,] 2347.7328 4.016325e-147 1.950114e-42
## [2,] 1436.1708 2.265444e-105 5.573149e-46
## [3,] 4481.6087 3.863022e-123 1.978585e-33
## [4,] 4425.1864 2.017276e-103 5.420085e-33
## [5,] 365.6473 2.158830e-127 7.997879e-59
## [6,] 2676.9614 3.346066e-103 4.252505e-28### her satır, o örneğe ait sonsalları göstermektedir. Toplamlarını 1 olacak şekilde standartlaştıralım. Böylece olasılıkları hesaplamış olacağız.
p_Y_X_normal_cop <- t(apply(p_Y_X_normal_cop, 1, function(m) m/sum(m)))
head(p_Y_X_normal_cop)## setosa versicolor virginica
## [1,] 1 1.710725e-150 8.306372e-46
## [2,] 1 1.577420e-108 3.880561e-49
## [3,] 1 8.619721e-127 4.414898e-37
## [4,] 1 4.558623e-107 1.224826e-36
## [5,] 1 5.904131e-130 2.187320e-61
## [6,] 1 1.249949e-106 1.588557e-31### olasılıkların toplamlarının 1 olup olmadığını kontrol edelim
print(apply(p_Y_X_normal_cop, 1, sum))## [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [39] 1 1 1 1 1 1 1Y_sapka_normal_cop <- apply(p_Y_X_normal_cop, 1, function(m) S[which.max(m)]) ### tahminler
Y_sapka_normal_cop <- factor(Y_sapka_normal_cop, levels = S, labels = S)
print(Y_sapka_normal_cop)## [1] setosa setosa setosa setosa setosa setosa
## [7] setosa setosa setosa setosa setosa setosa
## [13] setosa setosa setosa versicolor versicolor versicolor
## [19] versicolor versicolor versicolor versicolor versicolor versicolor
## [25] versicolor versicolor versicolor versicolor versicolor versicolor
## [31] versicolor versicolor virginica versicolor virginica virginica
## [37] virginica versicolor virginica virginica virginica virginica
## [43] virginica virginica virginica
## Levels: setosa versicolor virginicaprint(table(Y_test, Y_sapka_normal_cop))## Y_sapka_normal_cop
## Y_test setosa versicolor virginica
## setosa 15 0 0
## versicolor 0 17 0
## virginica 0 2 11dogruluk_orani_normal_cop <- sum(Y_test == Y_sapka_normal_cop)/n_test
print(paste0("Test doğruluk oranı = ", round(dogruluk_orani_normal_cop,3)))## [1] "Test dogruluk orani = 0.956"Normal dağılım varsayımı ile Copula Bayes sınıflayıcısı %95.6’lık bir performans elde etti. Normal dağılım kernel fonksiyonu ile bu işlemlerigerçekleştirelim.
hler_std <- sapply(S, function(m) sapply(X_egitim_std, function(m2) stats::bw.ucv(m2[Y_egitim == m])))## Warning in stats::bw.ucv(m2[Y_egitim == m]): minimum occurred at one end of the
## range
## Warning in stats::bw.ucv(m2[Y_egitim == m]): minimum occurred at one end of the
## rangeprint(hler_std)## setosa versicolor virginica
## X1 0.00144347 0.000874499 0.0003422197
## X2 0.01650290 0.002574766 0.0008371572P_X_Y_normalkernel_marj <- lapply(S, function(m) sapply(1:p, function(m2) {
P_X_Y_temp <- sapply(1:n_test, function(m3) {
mean(dnorm(x = X_test_std[m3,m2],
mean = X_egitim_std[Y_egitim == m,m2],
sd = hler_std[m2,m]))
})
P_X_Y_temp[is.infinite(P_X_Y_temp)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
P_X_Y_temp[P_X_Y_temp == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(P_X_Y_temp)
}))
P_X_Y_normal_cop <- lapply(1:length(S), function(m) apply(cbind(P_X_Y_normal_marj[[m]],c_X[[m]]), 1, prod))
p_Y_X_normalkernel_cop <- sapply(1:length(S), function(m) P_X_Y_normal_cop[[m]]*onseller[m])
colnames(p_Y_X_normalkernel_cop) <- S
head(p_Y_X_normalkernel_cop)## setosa versicolor virginica
## [1,] 2347.7328 4.016325e-147 1.950114e-42
## [2,] 1436.1708 2.265444e-105 5.573149e-46
## [3,] 4481.6087 3.863022e-123 1.978585e-33
## [4,] 4425.1864 2.017276e-103 5.420085e-33
## [5,] 365.6473 2.158830e-127 7.997879e-59
## [6,] 2676.9614 3.346066e-103 4.252505e-28### her satır, o örneğe ait sonsalları göstermektedir. Toplamlarını 1 olacak şekilde standartlaştıralım. Böylece olasılıkları hesaplamış olacağız.
p_Y_X_normalkernel_cop <- t(apply(p_Y_X_normalkernel_cop, 1, function(m) m/sum(m)))
head(p_Y_X_normalkernel_cop)## setosa versicolor virginica
## [1,] 1 1.710725e-150 8.306372e-46
## [2,] 1 1.577420e-108 3.880561e-49
## [3,] 1 8.619721e-127 4.414898e-37
## [4,] 1 4.558623e-107 1.224826e-36
## [5,] 1 5.904131e-130 2.187320e-61
## [6,] 1 1.249949e-106 1.588557e-31### olasılıkların toplamlarının 1 olup olmadığını kontrol edelim
print(apply(p_Y_X_normalkernel_cop, 1, sum))## [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [39] 1 1 1 1 1 1 1Y_sapka_normalkernel_cop <- apply(p_Y_X_normalkernel_cop, 1, function(m) S[which.max(m)]) ### tahminler
Y_sapka_normalkernel_cop <- factor(Y_sapka_normalkernel_cop, levels = S, labels = S)
print(Y_sapka_normalkernel_cop)## [1] setosa setosa setosa setosa setosa setosa
## [7] setosa setosa setosa setosa setosa setosa
## [13] setosa setosa setosa versicolor versicolor versicolor
## [19] versicolor versicolor versicolor versicolor versicolor versicolor
## [25] versicolor versicolor versicolor versicolor versicolor versicolor
## [31] versicolor versicolor virginica versicolor virginica virginica
## [37] virginica versicolor virginica virginica virginica virginica
## [43] virginica virginica virginica
## Levels: setosa versicolor virginicaprint(table(Y_test, Y_sapka_normalkernel_cop))## Y_sapka_normalkernel_cop
## Y_test setosa versicolor virginica
## setosa 15 0 0
## versicolor 0 17 0
## virginica 0 2 11dogruluk_orani_normalkernel <- sum(Y_test == Y_sapka_normalkernel_cop)/n_test
print(paste0("Test doğruluk oranı = ", round(dogruluk_orani_normalkernel,3)))## [1] "Test dogruluk orani = 0.956"Normal dağılım kernel fonksiyonu ile Copula Bayes sınıflayıcısı %91.1’lik doğruluk oranına ulaşmıştır.
1.3 Yöntemleri tek bir fonksiyonda toplama
Bu kadar yeni yaklaşım kullanma yeter. Şimdi bu yöntemleri tek bir fonksiyon altında kullanabileceğimiz bir format haline getirelim. Fonksiyonumuzun adı bayes_siniflayicisi olsun. Şimdi yapacağımız kodlama pahada hafif ama yükte biraz ağır olacak. Bu fonksiyonu oluştururken önceki verilen kodları kullanabiliriz. İşte başlıyoruz.
bayes_siniflayicisi <- function(X_egitim, Y_egitim, method = "N-NB"){
p <- ncol(X_egitim)
n_egitim <- nrow(X_egitim)
onseller <- c(table(Y_egitim)/n_egitim) ### Önseller tüm yöntemler için aynı olacaktır.
if (method == "N-NB") { ## Normal Naif Bayes
ortalamalar <- sapply(S, function(m) sapply(X_egitim, function(m2) mean(m2[Y_egitim == m])))
standart_sapmalar <- sapply(S, function(m) sapply(X_egitim, function(m2) sd(m2[Y_egitim == m])))
return(list(par = list(onseller = onseller,
ortalamalar = ortalamalar,
standart_sapmalar = standart_sapmalar),
method = "N-NB"))
}
if (method == "NK-NB") { ## Normal Kernel Naif Bayes
hler <- sapply(S, function(m) sapply(X_egitim, function(m2) stats::bw.ucv(m2[Y_egitim == m])))
return(list(par = list(onseller = onseller,
X_egitim = X_egitim,
Y_egitim = Y_egitim,
hler = hler),
method = "NK-NB"))
}
if (method == "CDN-L-B") { ## Çok Değişkenli Lineer Bayes
ortalamalar <- sapply(S, function(m) sapply(X_egitim, function(m2) mean(m2[Y_egitim == m])))
Sigmalar_lineer <- cov(X_egitim)
return(list(par = list(onseller = onseller,
ortalamalar = ortalamalar,
Sigmalar_lineer = Sigmalar_lineer),
method = "CDN-L-B"))
}
if (method == "CDN-K-B") { ## Çok Değişkenli Kuadratik Bayes
ortalamalar <- sapply(S, function(m) sapply(X_egitim, function(m2) mean(m2[Y_egitim == m])))
Sigmalar_kuadratik <- lapply(S, function(m) cov(X_egitim[Y_egitim == m,]))
names(Sigmalar_kuadratik) <- S
return(list(par = list(onseller = onseller,
ortalamalar = ortalamalar,
Sigmalar_kuadratik = Sigmalar_kuadratik),
method = "CDN-K-B"))
}
if (method == "CDNK-B") { ## Çok Değişkenli Normal Kernel Bayes
Hler <- lapply(S, function(m) ks::Hucv(X_egitim[Y_egitim == m,]))
names(Hler) <- S
return(list(par = list(onseller = onseller,
X_egitim = X_egitim,
Y_egitim = Y_egitim,
Hler = Hler),
method = "CDNK-B"))
}
if (method == "CDC-N-B" | method == "CDC-NK-B") { ## Çok Değişkenli Normal Copula Bayes - Çok Değişkenli Copula Normal Kernel Bayes.
X_egitim_std <- 1/(1 + exp(-X_egitim))
X_test_std <- 1/(1 + exp(-X_test))
if (p == 2) {
modeller_cop <- lapply(S, function(m) VineCopula::BiCopSelect(u1 = X_egitim_std[Y_egitim == m,1], u2 = X_egitim_std[Y_egitim == m,2]))
}
if (p > 2) { ### NOT: X_egitim veri seti, 2'den fazla değişken içerdiğinde Vine yapılarından faydalanıyoruz. Burada çok fazla hazır fonksiyonlara güveniyoruz. Bu durumda kullanılan fonksiyonların farklı sebeplerden hatalar vermesi muttemeldir. Aslında en doğru olan, Copula yoğunluklarını manuel hesaplamak, gerkeli bilgi kriterlerini elde etmek ve uygun Vine yapılarını oluşturmaktır. Her ne kadar manuel işlemlerle uygun Copula yapısı hesaplamak mümkün olsa da, işin bu kısmını Copula konusunda uzmanlaşmış araştırmacılara bırakıyorum.Hazır fonksiyonlara güvenerek işimize devam edelim.
### Her sınıf için uygun CVine ve DVine yapılarını tespit edelim
modeller_cop_cvine <- lapply(S, function(m) CDVine::CDVineCopSelect(data = X_egitim_std[Y_egitim == m,], type = 1)) ## en uygun CVine modelleri
names(modeller_cop_cvine) <- S
modeller_cop_dvine <- lapply(S, function(m) CDVine::CDVineCopSelect(data = X_egitim_std[Y_egitim == m,], type = 2)) ## en uygun DVine modelleri
names(modeller_cop_dvine) <- S
### Her sınıf için vine modellerinin rvine modellerine dönüşümü
modeller_cop_c2rvine <- lapply(S, function(m) VineCopula::C2RVine(order = 1:p, family = modeller_cop_cvine[[m]]$family, par = modeller_cop_cvine[[m]]$par, par2 = modeller_cop_cvine[[m]]$par2)) ### CVine modellerinin RVine modellerine dönüşümü
names(modeller_cop_c2rvine) <- S
modeller_cop_d2rvine <- lapply(S, function(m) VineCopula::D2RVine(order = 1:p, family = modeller_cop_dvine[[m]]$family, par = modeller_cop_dvine[[m]]$par, par2 = modeller_cop_dvine[[m]]$par2)) ### DVine modellerinin RVine modellerine dönüşümü
names(modeller_cop_d2rvine) <- S
### Tüm modeller için AIC ölçütlerinin hesaplanması
AIClar_c2rvine <- lapply(S, function(m) VineCopula::RVineAIC(data = X_egitim_std[Y_egitim == m,], RVM = modeller_cop_c2rvine[[m]])$AIC)
names(AIClar_c2rvine) <- S
AIClar_d2rvine <- lapply(S, function(m) VineCopula::RVineAIC(data = X_egitim_std[Y_egitim == m,], RVM = modeller_cop_d2rvine[[m]])$AIC)
names(AIClar_d2rvine) <- S
### Her bir sınıf için küçük AIC değerine sahip Vine modelinin seçilmesi
modeller_cop <- lapply(S, function(m) {
if (AIClar_c2rvine[[m]] < AIClar_d2rvine[[m]]) {
return(AIClar_c2rvine[[m]])
} else {
return(AIClar_d2rvine[[m]])
}
})
}
### Marjinallerin hesaplanması
if (method == "CDC-N-B") { ## Çok değişkenli Copula Normal marjinal Bayes
ortalamalar_std <- sapply(S, function(m) sapply(X_egitim_std, function(m2) mean(m2[Y_egitim == m])))
standart_sapmalar_std <- sapply(S, function(m) sapply(X_egitim_std, function(m2) sd(m2[Y_egitim == m])))
return(list(par = list(onseller = onseller,
ortalamalar_std = ortalamalar_std,
standart_sapmalar_std = standart_sapmalar_std,
modeller_cop = modeller_cop),
method = "CDC-N-B"))
}
if (method == "CDC-NK-B") { ## Çok değişkenli Copula Normal kernel marjinal Bayes
hler_std <- sapply(S, function(m) sapply(X_egitim_std, function(m2) stats::bw.ucv(m2[Y_egitim == m])))
return(list(par = list(onseller = onseller,
X_egitim_std = X_egitim_std,
Y_egitim = Y_egitim,
hler_std = hler_std,
modeller_cop = modeller_cop),
method = "CDC-NK-B"))
}
}
}Böylece seçtiğimiz methoda göre Bayes sınıflayıcısını hesaplayan bir fonksiyonumuz oldu. Bu fonksiyon, method kısmına yazacağımız yönteme göre uygun parametreleri hesaplayacaktır. Şimdi ne yapacağız? Her bir yöntem için uygun tahmin fonksiyonunu oluşturacağız. bayes_siniflayicisi tüm yöntemler için çıktıda yöntem ismini belirtmektedir. Buradan fayadalanarak tahmin fonksiyonunu predict_bayes_siniflayicisi adı altında oluşturalım. Yine yukarıda daha önce yazdığımız kodlardan faydalanabiliriz.
predict_bayes_siniflayicisi <- function(model, X_test, tahmin_turu = "sinif"){
method <- model$method
p <- ncol(X_test)
n_test <- nrow(X_test)
onseller <- model$par$onseller
if (method == "N-NB") { ## Normal Naif Bayes
ortalamalar <- model$par$ortalamalar
standart_sapmalar <- model$par$standart_sapmalar
P_X_Y_normal <- lapply(S, function(m) sapply(1:p, function(m2) {
P_X_Y_temp <- dnorm(x = X_test[,m2],
mean = ortalamalar[m2,m],
sd = standart_sapmalar[m2,m])
P_X_Y_temp[is.infinite(P_X_Y_temp)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
P_X_Y_temp[P_X_Y_temp == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(P_X_Y_temp)
}))
P_X_Y_normal <- lapply(P_X_Y_normal, function(m) apply(m, 1, prod))
p_Y_X_normal <- sapply(1:length(S), function(m) P_X_Y_normal[[m]]*onseller[m])
colnames(p_Y_X_normal) <- S
### her satır, o örneğe ait sonsalları göstermektedir. Toplamlarını 1 olacak şekilde standartlaştıralım. Böylece olasılıkları hesaplamış olacağız.
p_Y_X_normal <- t(apply(p_Y_X_normal, 1, function(m) m/sum(m)))
if (tahmin_turu == "olasilik") {
return(p_Y_X_normal)
} else {
Y_sapka_normal <- apply(p_Y_X_normal, 1, function(m) S[which.max(m)]) ### tahminler
Y_sapka_normal <- factor(Y_sapka_normal, levels = S, labels = S)
return(Y_sapka_normal)
}
}
if (method == "NK-NB") { ## Normal Kernel Naif Bayes
hler <- model$par$hler
X_egitim <- model$par$X_egitim
Y_egitim <- model$par$Y_egitim
P_X_Y_normalkernel <- lapply(S, function(m) sapply(1:p, function(m2) {
P_X_Y_temp <- sapply(1:n_test, function(m3) {
mean(dnorm(x = X_test[m3,m2],
mean = X_egitim[Y_egitim == m,m2],
sd = hler[m2,m]))
})
P_X_Y_temp[is.infinite(P_X_Y_temp)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
P_X_Y_temp[P_X_Y_temp == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(P_X_Y_temp)
}))
P_X_Y_normalkernel <- lapply(P_X_Y_normalkernel, function(m) apply(m, 1, prod))
p_Y_X_normalkernel <- sapply(1:length(S), function(m) P_X_Y_normalkernel[[m]]*onseller[m])
colnames(p_Y_X_normalkernel) <- S
### her satır, o örneğe ait sonsalları göstermektedir. Toplamlarını 1 olacak şekilde standartlaştıralım. Böylece olasılıkları hesaplamış olacağız.
p_Y_X_normalkernel <- t(apply(p_Y_X_normalkernel, 1, function(m) m/sum(m)))
if (tahmin_turu == "olasilik") {
return(p_Y_X_normalkernel)
} else {
Y_sapka_normalkernel <- apply(p_Y_X_normalkernel, 1, function(m) S[which.max(m)]) ### tahminler
Y_sapka_normalkernel <- factor(Y_sapka_normalkernel, levels = S, labels = S)
return(Y_sapka_normalkernel)
}
}
if (method == "CDN-L-B") { ## Çok Değişkenli Lineer Bayes
ortalamalar <- model$par$ortalamalar
Sigmalar_lineer <- model$par$Sigmalar_lineer
P_X_Y_coklunormal_lineer <- lapply(S, function(m) {
P_X_Y_temp <- mvtnorm::dmvnorm(x = X_test,
mean = ortalamalar[,m],
sigma = Sigmalar_lineer)
P_X_Y_temp[is.infinite(P_X_Y_temp)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
P_X_Y_temp[P_X_Y_temp == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(P_X_Y_temp)
})
p_Y_X_coklunormal_lineer <- sapply(1:length(S), function(m) P_X_Y_coklunormal_lineer[[m]]*onseller[m])
colnames(p_Y_X_coklunormal_lineer) <- S
### her satır, o örneğe ait sonsalları göstermektedir. Toplamlarını 1 olacak şekilde standartlaştıralım. Böylece olasılıkları hesaplamış olacağız.
p_Y_X_coklunormal_lineer <- t(apply(p_Y_X_coklunormal_lineer, 1, function(m) m/sum(m)))
if (tahmin_turu == "olasilik") {
return(p_Y_X_coklunormal_lineer)
} else {
Y_sapka_coklunormal_lineer <- apply(p_Y_X_coklunormal_lineer, 1, function(m) S[which.max(m)]) ### tahminler
Y_sapka_coklunormal_lineer <- factor(Y_sapka_coklunormal_lineer, levels = S, labels = S)
return(Y_sapka_coklunormal_lineer)
}
}
if (method == "CDN-K-B") { ## Çok Değişkenli Kuadratik Bayes
ortalamalar <- model$par$ortalamalar
Sigmalar_kuadratik <- model$par$Sigmalar_kuadratik
P_X_Y_coklunormal_kuadratik <- lapply(S, function(m) {
P_X_Y_temp <- mvtnorm::dmvnorm(x = X_test,
mean = ortalamalar[,m],
sigma = Sigmalar_kuadratik[[m]])
P_X_Y_temp[is.infinite(P_X_Y_temp)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
P_X_Y_temp[P_X_Y_temp == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(P_X_Y_temp)
})
p_Y_X_coklunormal_kuadratik <- sapply(1:length(S), function(m) P_X_Y_coklunormal_kuadratik[[m]]*onseller[m])
colnames(p_Y_X_coklunormal_kuadratik) <- S
### her satır, o örneğe ait sonsalları göstermektedir. Toplamlarını 1 olacak şekilde standartlaştıralım. Böylece olasılıkları hesaplamış olacağız.
p_Y_X_coklunormal_kuadratik <- t(apply(p_Y_X_coklunormal_kuadratik, 1, function(m) m/sum(m)))
if (tahmin_turu == "olasilik") {
return(p_Y_X_coklunormal_kuadratik)
} else {
Y_sapka_coklunormal_kuadratik <- apply(p_Y_X_coklunormal_kuadratik, 1, function(m) S[which.max(m)]) ### tahminler
Y_sapka_coklunormal_kuadratik <- factor(Y_sapka_coklunormal_kuadratik, levels = S, labels = S)
return(Y_sapka_coklunormal_kuadratik)
}
}
if (method == "CDNK-B") { ## Çok Değişkenli Normal Kernel Bayes
Hler <- model$par$Hler
X_egitim <- model$par$X_egitim
Y_egitim <- model$par$Y_egitim
P_X_Y_coklunormal_kernel <- lapply(S, function(m) {
P_X_Y_temp <- sapply(1:n_test, function(m2) {
mean(mvtnorm::dmvnorm(x = as.matrix(X_egitim[Y_egitim == m,]),
mean = as.matrix(X_test[m2,,drop = FALSE]), ### Eğitim setine ait x değerleri ortalama olarak alınacağı için, x ve mean değerleri yer değiştirebilir. Sonuç değişmez.
sigma = Hler[[m]]))
})
P_X_Y_temp[is.infinite(P_X_Y_temp)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
P_X_Y_temp[P_X_Y_temp == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(P_X_Y_temp)
})
p_Y_X_coklunormal_kernel <- sapply(1:length(S), function(m) P_X_Y_coklunormal_kernel[[m]]*onseller[m])
colnames(p_Y_X_coklunormal_kernel) <- S
### her satır, o örneğe ait sonsalları göstermektedir. Toplamlarını 1 olacak şekilde standartlaştıralım. Böylece olasılıkları hesaplamış olacağız.
p_Y_X_coklunormal_kernel <- t(apply(p_Y_X_coklunormal_kernel, 1, function(m) m/sum(m)))
if (tahmin_turu == "olasilik") {
return(p_Y_X_coklunormal_kernel)
} else {
Y_sapka_coklunormal_kernel <- apply(p_Y_X_coklunormal_kernel, 1, function(m) S[which.max(m)]) ### tahminler
Y_sapka_coklunormal_kernel <- factor(Y_sapka_coklunormal_kernel, levels = S, labels = S)
return(Y_sapka_coklunormal_kernel)
}
}
if (method == "CDC-N-B" | method == "CDC-NK-B") { ## Çok Değişkenli Normal Copula Bayes - Çok Değişkenli Copula Normal Kernel Bayes.
X_test_std <- 1/(1 + exp(-X_test))
modeller_cop <- model$par$modeller_cop
if (p == 2) {
c_X <- lapply(1:length(S), function(m) {
c_X_temp <- VineCopula::BiCopPDF(u1 = X_test_std[,1], u2 = X_test_std[,2], obj = modeller_cop[[m]])
c_X_temp[is.infinite(c_X_temp)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
c_X_temp[c_X_temp == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(c_X_temp)
})
names(c_X) <- S
if (method == "CDC-N-B") {
ortalamalar_std <- model$par$ortalamalar_std
standart_sapmalar_std <- model$par$ortalamalar_std
P_X_Y_normal_marj <- lapply(S, function(m) sapply(1:p, function(m2) {
P_X_Y_marj <- dnorm(x = X_test_std[,m2],
mean = ortalamalar_std[m2,m],
sd = standart_sapmalar_std[m2,m])
P_X_Y_marj[is.infinite(P_X_Y_marj)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
P_X_Y_marj[P_X_Y_marj == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(P_X_Y_marj)
}))
P_X_Y_normal_cop <- lapply(1:length(S), function(m) apply(cbind(P_X_Y_normal_marj[[m]],c_X[[m]]), 1, prod))
p_Y_X_normal_cop <- sapply(1:length(S), function(m) P_X_Y_normal_cop[[m]]*onseller[m])
colnames(p_Y_X_normal_cop) <- S
### her satır, o örneğe ait sonsalları göstermektedir. Toplamlarını 1 olacak şekilde standartlaştıralım. Böylece olasılıkları hesaplamış olacağız.
p_Y_X_normal_cop <- t(apply(p_Y_X_normal_cop, 1, function(m) m/sum(m)))
if (tahmin_turu == "olasilik") {
return(p_Y_X_normal_cop)
} else {
Y_sapka_normal_cop <- apply(p_Y_X_normal_cop, 1, function(m) S[which.max(m)]) ### tahminler
Y_sapka_normal_cop <- factor(Y_sapka_normal_cop, levels = S, labels = S)
return(Y_sapka_normal_cop)
}
}
if (method == "CDC-NK-B") {
hler_std <- model$par$hler_std
X_egitim_std <- model$par$X_egitim_std
Y_egitim <- model$par$Y_egitim
P_X_Y_normalkernel_marj <- lapply(S, function(m) sapply(1:p, function(m2) {
P_X_Y_temp <- sapply(1:n_test, function(m3) {
mean(dnorm(x = X_test_std[m3,m2],
mean = X_egitim_std[Y_egitim == m,m2],
sd = hler_std[m2,m]))
})
P_X_Y_temp[is.infinite(P_X_Y_temp)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
P_X_Y_temp[P_X_Y_temp == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(P_X_Y_temp)
}))
p_X_Y_normalkernel_cop <- lapply(1:length(S), function(m) apply(cbind(P_X_Y_normalkernel_marj[[m]], c_X[[m]]), 1, prod))
p_Y_X_normalkernel_cop <- sapply(1:length(S), function(m) p_X_Y_normalkernel_cop[[m]]*onseller[m])
colnames(p_Y_X_normalkernel_cop) <- S
### her satır, o örneğe ait sonsalları göstermektedir. Toplamlarını 1 olacak şekilde standartlaştıralım. Böylece olasılıkları hesaplamış olacağız.
p_Y_X_normalkernel_cop <- t(apply(p_Y_X_normalkernel_cop, 1, function(m) m/sum(m)))
if (tahmin_turu == "olasilik") {
return(p_Y_X_normalkernel_cop)
} else {
Y_sapka_normalkernel_cop <- apply(p_Y_X_normalkernel_cop, 1, function(m) S[which.max(m)]) ### tahminler
Y_sapka_normalkernel_cop <- factor(Y_sapka_normalkernel_cop, levels = S, labels = S)
return(Y_sapka_normalkernel_cop)
}
}
}
if (p > 2) {
c_X <- lapply(1:length(S), function(m) {
c_X_temp <- VineCopula::RVinePDF(newdata = X_test_std, RVM = modeller_cop[[m]])
c_X_temp[is.infinite(c_X_temp)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
c_X_temp[c_X_temp == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(c_X_temp)
})
names(c_X) <- S
if (method == "CDC-N-B") {
ortalamalar_std <- model$par$ortalamalar_std
standart_sapmalar_std <- model$par$ortalamalar_std
P_X_Y_normal_marj <- lapply(S, function(m) sapply(1:p, function(m2) {
P_X_Y_marj <- dnorm(x = X_test_std[,m2],
mean = ortalamalar_std[m2,m],
sd = standart_sapmalar_std[m2,m])
P_X_Y_marj[is.infinite(P_X_Y_marj)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
P_X_Y_marj[P_X_Y_marj == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(P_X_Y_marj)
}))
P_X_Y_normal_cop <- lapply(1:length(S), function(m) apply(cbind(P_X_Y_normal_marj[[m]],c_X[[m]]), 1, prod))
p_Y_X_normal_cop <- sapply(1:length(S), function(m) P_X_Y_normal_cop[[m]]*onseller[m])
colnames(p_Y_X_normal_cop) <- S
### her satır, o örneğe ait sonsalları göstermektedir. Toplamlarını 1 olacak şekilde standartlaştıralım. Böylece olasılıkları hesaplamış olacağız.
p_Y_X_normal_cop <- t(apply(p_Y_X_normal_cop, 1, function(m) m/sum(m)))
if (tahmin_turu == "olasilik") {
return(p_Y_X_normal_cop)
} else {
Y_sapka_normal_cop <- apply(p_Y_X_normal_cop, 1, function(m) S[which.max(m)]) ### tahminler
Y_sapka_normal_cop <- factor(Y_sapka_normal_cop, levels = S, labels = S)
return(Y_sapka_normal_cop)
}
}
if (method == "CDC-NK-B") {
hler_std <- model$par$hler_std
X_egitim_std <- model$par$X_egitim_std
Y_egitim <- model$par$Y_egitim
P_X_Y_normalkernel_marj <- lapply(S, function(m) sapply(1:p, function(m2) {
P_X_Y_temp <- sapply(1:n_test, function(m3) {
mean(dnorm(x = X_test_std[m3,m2],
mean = X_egitim_std[Y_egitim == m,m2],
sd = hler_std[m2,m]))
})
P_X_Y_temp[is.infinite(P_X_Y_temp)] <- 1e100 ### Inf sonucu veren yoğunluklar için kaba bir düzeltme
P_X_Y_temp[P_X_Y_temp == 0] <- 1e-20 ### 0 değeri veren yoğunluklar için kaba bir düzeltme
return(P_X_Y_temp)
}))
P_X_Y_normalkernel_cop <- lapply(1:length(S), function(m) apply(cbind(P_X_Y_normalkernel_marj[[m]], c_X[[m]]), 1, prod))
p_Y_X_normalkernel_cop <- sapply(1:length(S), function(m) P_X_Y_normalkernel_cop[[m]]*onseller[m])
colnames(p_Y_X_normalkernel_cop) <- S
### her satır, o örneğe ait sonsalları göstermektedir. Toplamlarını 1 olacak şekilde standartlaştıralım. Böylece olasılıkları hesaplamış olacağız.
p_Y_X_normalkernel_cop <- t(apply(p_Y_X_normalkernel_cop, 1, function(m) m/sum(m)))
if (tahmin_turu == "olasilik") {
return(p_Y_X_normalkernel_cop)
} else {
Y_sapka_normalkernel_cop <- apply(p_Y_X_normalkernel_cop, 1, function(m) S[which.max(m)]) ### tahminler
Y_sapka_normalkernel_cop <- factor(Y_sapka_normalkernel_cop, levels = S, labels = S)
return(Y_sapka_normalkernel_cop)
}
}
}
}
}Bu da bittiğine göre şimdi fonksiyonları kullanma aşamasına geçebiliriz. Aynı modellerimizi yeni oluşturduğumuz fonksiyonlar ile elde edip, tahminleri hesaplamaya başlamadan önce, yöntem kodlamalarımızı belirtelim.
N-NB: Normal Dağılım Naif Bayes sınıflayıcısıNK-NB: Normal Dağılım Kernel Naif Bayes sınıflayıcısıCDN-L-B: Çok Değişkenli Normal Lineer Diskriminant Bayes sınıflayıcısıCDN-K-B: Çok Değişkenli Normal Kuadratik Diskriminant Bayes sınıflayıcısıCDNK-B: Çok Değişkenli Normal Kernel Bayes sınıflayıcısıCDC-N-B: Çok Değişkenli Kapula Normal Dağılım Marjinalleri ile Bayes sınıflayıcısıCDC-NK-B: Çok Değişkenli Kapula Normal Dağılım Kernel Marjinelleri ile Bayes sınıflayıcısı
Tahmin türü için de (1) sinif: Sınıf değerleri (2) olasilik: Her bir sınıfa ait olasılık değerleri şeklinde çıktı verecektir. Şimdi işimize koyulalım. Önce her bir yöntem için modelleri kuralım.
model_N_NB <- bayes_siniflayicisi(X_egitim = X_egitim, Y_egitim = Y_egitim, method = "N-NB")
model_NK_NB <- bayes_siniflayicisi(X_egitim = X_egitim, Y_egitim = Y_egitim, method = "NK-NB")## Warning in stats::bw.ucv(m2[Y_egitim == m]): minimum occurred at one end of the
## range
## Warning in stats::bw.ucv(m2[Y_egitim == m]): minimum occurred at one end of the
## range
## Warning in stats::bw.ucv(m2[Y_egitim == m]): minimum occurred at one end of the
## range
## Warning in stats::bw.ucv(m2[Y_egitim == m]): minimum occurred at one end of the
## range
## Warning in stats::bw.ucv(m2[Y_egitim == m]): minimum occurred at one end of the
## rangemodel_CDN_L_B <- bayes_siniflayicisi(X_egitim = X_egitim, Y_egitim = Y_egitim, method = "CDN-L-B")
model_CDN_K_B <- bayes_siniflayicisi(X_egitim = X_egitim, Y_egitim = Y_egitim, method = "CDN-K-B")
model_CDNK_B <- bayes_siniflayicisi(X_egitim = X_egitim, Y_egitim = Y_egitim, method = "CDNK-B")## Warning in Hlscv(...): Data contain duplicated values: LSCV is not well-behaved
## in this case## Warning in Hlscv(...): Data contain duplicated values: LSCV is not well-behaved
## in this case
## Warning in Hlscv(...): Data contain duplicated values: LSCV is not well-behaved
## in this casemodel_CDC_N_B <- bayes_siniflayicisi(X_egitim = X_egitim, Y_egitim = Y_egitim, method = "CDC-N-B")
model_CDC_NK_B <- bayes_siniflayicisi(X_egitim = X_egitim, Y_egitim = Y_egitim, method = "CDC-NK-B")## Warning in stats::bw.ucv(m2[Y_egitim == m]): minimum occurred at one end of the
## range## Warning in stats::bw.ucv(m2[Y_egitim == m]): minimum occurred at one end of the
## rangeSıkıntısız bir şekilde sınıf tahminlerimizi elde ederek devam edelim.
tahminler_N_NB <- predict_bayes_siniflayicisi(model = model_N_NB, X_test = X_test, tahmin_turu = "sinif")
tahminler_NK_NB <- predict_bayes_siniflayicisi(model = model_NK_NB, X_test = X_test, tahmin_turu = "sinif")
tahminler_CDN_L_B <- predict_bayes_siniflayicisi(model = model_CDN_L_B, X_test = X_test, tahmin_turu = "sinif")
tahminler_CDN_K_B <- predict_bayes_siniflayicisi(model = model_CDN_K_B, X_test = X_test, tahmin_turu = "sinif")
tahminler_CDNK_B <- predict_bayes_siniflayicisi(model = model_CDNK_B, X_test = X_test, tahmin_turu = "sinif")
tahminler_CDC_N_B <- predict_bayes_siniflayicisi(model = model_CDC_N_B, X_test = X_test, tahmin_turu = "sinif")
tahminler_CDC_NK_B <- predict_bayes_siniflayicisi(model = model_CDC_NK_B, X_test = X_test, tahmin_turu = "sinif")Şimdi doğruluk oranlarımıza bakalım.
dogruluk_orani_N_NB <- sum(Y_test == tahminler_N_NB)/n_test
dogruluk_orani_NK_NB <- sum(Y_test == tahminler_NK_NB)/n_test
dogruluk_orani_CDN_L_B <- sum(Y_test == tahminler_CDN_L_B)/n_test
dogruluk_orani_CDN_K_B <- sum(Y_test == tahminler_CDN_K_B)/n_test
dogruluk_orani_CDNK_B <- sum(Y_test == tahminler_CDNK_B)/n_test
dogruluk_orani_CDC_N_B <- sum(Y_test == tahminler_CDC_N_B)/n_test
dogruluk_orani_CDC_NK_B <- sum(Y_test == tahminler_CDC_NK_B)/n_test
perf_tbl <- data.frame(N_NB = dogruluk_orani_N_NB,
NK_NB = dogruluk_orani_NK_NB,
CDN_L_B = dogruluk_orani_CDN_L_B,
CDN_K_B = dogruluk_orani_CDN_K_B,
CDNK_B = dogruluk_orani_CDNK_B,
CDC_N_B = dogruluk_orani_CDC_N_B,
CDC_NK_B = dogruluk_orani_CDC_NK_B,
row.names = c("Doğruluk Oranı")
)
print(perf_tbl)## N_NB NK_NB CDN_L_B CDN_K_B CDNK_B CDC_N_B
## Dogruluk Orani 0.9111111 0.9111111 0.8 1 0.9777778 0.9333333
## CDC_NK_B
## Dogruluk Orani 0.9555556Şimdi gelelim işin eylenceli kısmına, grafiklere! Modellerin veri setinin bulunduğu bölgedeki karar sınırlarını tespit etmek için kontor grafiklerinden faydalanacağız. Bu grafikler, çözünürlüğe bağlı olacak şekilde olası tüm noktalar için tahmin yaparak tahmin değişikliği yaşanan sınırları tespit eder. Ardından karar sınırlarını oluşturur. Başlıyoruz!
library(ggplot2)
library(ggnewscale)
cozunurluk <- 150 ## bu değer ne kadar artarsa, o kadar yavaş ve ayrıntılı grafikler elde ederiz.
araliklar <- apply(X, 2, range) ### her iki değişkenin minimum ve maksimum değerlerini hesaplarız
print(araliklar)## X1 X2
## [1,] 4.3 1.0
## [2,] 7.9 6.9#### hesaplanan minimumlardan maksimumlara kadar cozunurluk kadar, yani 150 tane nokta belirlenir
grid_x_ekseni <- seq(from = araliklar[1,1], to = araliklar[2,1], length.out = cozunurluk)
grid_y_ekseni <- seq(from = araliklar[1,2], to = araliklar[2,2], length.out = cozunurluk)
#### tum nokta kombinasyonları
grid <- expand.grid(grid_x_ekseni,
grid_y_ekseni)
colnames(grid) <- colnames(X)
#### tum nokta kombinasyonları üzerinde sınıf tahmini
tahminler_grid <- predict_bayes_siniflayicisi(model = model_N_NB, X_test = grid)
#### ggplot içerisinde kullanmak üzere bir veri seti
tbl <- data.frame(grid, tahminler_grid)
### tbl'yi data olarak kullanmadım. Fakat kullanmak isteyen için tbl ggplot için uygun haldedir.
ggplot() +
geom_contour_filled(mapping = aes(x = tbl[,1], y = tbl[,2], z = as.integer(tbl$tahminler_grid)), breaks = 0:(length(S)+1), color = "black", alpha = 0.5) +
scale_fill_viridis_d(labels = c(S), name = "Sınıf") +
new_scale_fill() +
geom_point(mapping = aes(x = X_egitim[,1], y = X_egitim[,2], color = Y_egitim), shape = 3, size = 2) +
geom_point(mapping = aes(x = X_test[,1], y = X_test[,2], fill = Y_test), shape = 21, size = 2) +
scale_x_continuous(expand = c(0,0), name = colnames(X)[1]) +
scale_y_continuous(expand = c(0,0), name = colnames(X)[2]) +
scale_color_manual(values = c("orange", "red", "green"), name = "Eğitim") +
scale_fill_manual(values = c("orange", "red", "green"), name = "Test") +
annotate(geom = "label",
x = min(tbl[,1]) + diff(range(tbl[,1]))*0.2,
y = max(tbl[,2]) - diff(range(tbl[,1]))*0.1,
label = paste("Doğruluk Oranı =",
formatC(dogruluk_orani_N_NB, digits = 3, format = "f"))) +
theme_bw()
Herşey yolunda gözüküyor. Öyle ise bu grafik oluşturma işlemini fonksiyon haline getirelim hemen. Böylece tüm modeller için her seferinde tekrar kodlamamıza gerek kalmaz ve otomatik elde ederiz.
NOT: Bu grafik sadece iki değişkenli durumlar için geçerlidir.
kontor_grafigi <- function(model,
X, ### veri bölgesini belirlemek için
X_egitim,
Y_egitim,
X_test,
Y_test,
baslik = "", ### grafik başlığı
cozunurluk = 150, ### grafiğin ayrıntısını belirlemek için
sinif_sayisi = 2, ### 2 sınıf varsa, olasılıklara göre daha ayrıntılı grafik çizilebilir. 3 sınıf var iken sadece sınırlarını çizer
olcut, ### hangi performans elde edilmişse o performansın değeri
olcut_name, ### performans ölçütünün ismi
point_alpha = 1) { ### veri seti büyük olduğunda noktaların saydamlaşması, daha rahat görebilmemizi sağlayacaktır.
library(ggplot2)
library(ggnewscale)
araliklar <- apply(X, 2, range)
grid_x_ekseni <- seq(from = araliklar[1,1], to = araliklar[2,1], length.out = cozunurluk)
grid_y_ekseni <- seq(from = araliklar[1,2], to = araliklar[2,2], length.out = cozunurluk)
grid <- expand.grid(grid_x_ekseni,
grid_y_ekseni)
colnames(grid) <- colnames(X)
tahminler_grid <- predict_bayes_siniflayicisi(model = model, X_test = grid, tahmin_turu = ifelse(sinif_sayisi == 2, "olasilik", "sinif"))
if (sinif_sayisi == 2) {
tbl <- data.frame(grid, tahmin = tahminler_grid[,1])
colnames(tbl)[3] <- "tahmin"
} else {
tbl <- data.frame(grid, tahmin = tahminler_grid)
colnames(tbl)[3] <- "tahmin"
}
plt <- ggplot()
if (sinif_sayisi == 2) {
tbl[1,3] <- 0
tbl[2,3] <- 1
plt <- plt + geom_contour_filled(mapping = aes(x = tbl[,1], y = tbl[,2], z = tbl$tahmin), color = "black", alpha = 0.5, breaks = seq(0, 1, 0.1)) +
scale_fill_viridis_d(name = "Olasılık")
} else {
plt <- plt + geom_contour_filled(mapping = aes(x = tbl[,1], y = tbl[,2], z = as.integer(tbl$tahmin)), breaks = 0:(length(S)+1), color = "black", alpha = 0.5) +
scale_fill_viridis_d(labels = c(S), name = "Sınıf")
}
plt <- plt +
new_scale_fill() +
geom_point(mapping = aes(x = X_egitim[,1], y = X_egitim[,2], color = Y_egitim), shape = 3, size = 1.5, alpha = point_alpha) +
geom_point(mapping = aes(x = X_test[,1], y = X_test[,2], fill = Y_test), shape = 21, size = 1.5, alpha = point_alpha) +
scale_x_continuous(expand = c(0,0), name = colnames(X)[1]) +
scale_y_continuous(expand = c(0,0), name = colnames(X)[2]) +
scale_colour_manual(values = c("black", "red", "green")[1:sinif_sayisi], name = "Eğitim") +
scale_fill_manual(values = c("black", "red", "green")[1:sinif_sayisi], name = "Test") +
labs(title = baslik) +
annotate(geom = "label",
x = min(tbl[,1]) + diff(range(tbl[,1]))*0.2,
y = max(tbl[,2]) - diff(range(tbl[,1]))*0.1,
label = paste0(olcut_name,
" = ",
formatC(olcut, digits = 3, format = "f")),
size = 3) +
theme_bw() +
theme(plot.title = element_text(size = 10, hjust = 0.5))
plt
return(plt)
}Kontor grafiği için fonksiyonu da yazdığımıza göre grafiklerimizi elde edebiliriz.
library(ggpubr)
plt_N_NB <- kontor_grafigi(model = model_N_NB, X = X, X_egitim = X_egitim, Y_egitim = Y_egitim, X_test = X_test, Y_test = Y_test, baslik = "N_NB", cozunurluk = 150, sinif_sayisi = 3, olcut = dogruluk_orani_N_NB, olcut_name = "Doğruluk oranı", point_alpha = 1)
plt_NK_NB <- kontor_grafigi(model = model_NK_NB, X = X, X_egitim = X_egitim, Y_egitim = Y_egitim, X_test = X_test, Y_test = Y_test, baslik = "NK_NB", cozunurluk = 150, sinif_sayisi = 3, olcut = dogruluk_orani_NK_NB, olcut_name = "Doğruluk oranı", point_alpha = 1)
plt_CDN_L_B <- kontor_grafigi(model = model_CDN_L_B, X = X, X_egitim = X_egitim, Y_egitim = Y_egitim, X_test = X_test, Y_test = Y_test, baslik = "CDN_L_B", cozunurluk = 150, sinif_sayisi = 3, olcut = dogruluk_orani_CDN_L_B, olcut_name = "Doğruluk oranı", point_alpha = 1)
plt_CDN_K_B <- kontor_grafigi(model = model_CDN_K_B, X = X, X_egitim = X_egitim, Y_egitim = Y_egitim, X_test = X_test, Y_test = Y_test, baslik = "CDN_K_B", cozunurluk = 150, sinif_sayisi = 3, olcut = dogruluk_orani_CDN_K_B, olcut_name = "Doğruluk oranı", point_alpha = 1)
plt_CDNK_B <- kontor_grafigi(model = model_CDNK_B, X = X, X_egitim = X_egitim, Y_egitim = Y_egitim, X_test = X_test, Y_test = Y_test, baslik = "CDNK_B", cozunurluk = 150, sinif_sayisi = 3, olcut = dogruluk_orani_CDNK_B, olcut_name = "Doğruluk oranı", point_alpha = 1)
plt_CDC_N_B <- kontor_grafigi(model = model_CDC_N_B, X = X, X_egitim = X_egitim, Y_egitim = Y_egitim, X_test = X_test, Y_test = Y_test, baslik = "CDC_N_B", cozunurluk = 150, sinif_sayisi = 3, olcut = dogruluk_orani_CDC_N_B, olcut_name = "Doğruluk oranı", point_alpha = 1)
plt_CDC_NK_B <- kontor_grafigi(model = model_CDC_NK_B, X = X, X_egitim = X_egitim, Y_egitim = Y_egitim, X_test = X_test, Y_test = Y_test, baslik = "CDC_NK_B", cozunurluk = 150, sinif_sayisi = 3, olcut = dogruluk_orani_CDC_NK_B, olcut_name = "Doğruluk oranı", point_alpha = 1)
ggarrange(plt_N_NB,
plt_NK_NB,
plt_CDN_L_B,
plt_CDN_K_B,
plt_CDNK_B,
plt_CDC_N_B,
plt_CDC_NK_B, ncol = 2, common.legend = TRUE, legend = "right")## $`1`
##
## $`2`
##
## $`3`
##
## $`4`
##
## attr(,"class")
## [1] "list" "ggarrange"2 Örnek Çalışma
Iris verisi, doğrusal olarak ayırıştırılabilen bir veri seti. Bu nedenle yöntemlerin hepsinin de başarılı olması şaşılacak durum değildir. Daha zorlayıcı bir veri seti üzerinde yöntemleri gözlemlemek daha faydalı olacaktır. imbalance paketinde bulunan banana veri seti, sınıf dengesizliği de bulunan, doğrusal olmayan bir şekilde ayrıştırılabilen bir veri seti. Veri setini görelim.
set.seed(123)
library(imbalance)
data <- banana
X <- data[,1:2]
Y <- data[,3]
n <- nrow(X)
print(n)## [1] 2640p <- ncol(X)
S <- levels(Y)
n_egitim <- round(n*0.7)
n_test <- n - n_egitim
egitim_i <- sample(1:n, n_egitim)
X_egitim <- X[egitim_i,]
Y_egitim <- Y[egitim_i]
X_test <- X[-egitim_i,]
Y_test <- Y[-egitim_i]
ggplot() +
geom_point(mapping = aes(x = X_egitim[,1], y = X_egitim[,2], color = Y_egitim), shape = 3, alpha = 0.6) +
geom_point(mapping = aes(x = X_test[,1], y = X_test[,2], fill = Y_test), shape = 21, alpha = 0.6) +
scale_color_manual(values = c("black", "red"), name = "Eğitim") +
scale_fill_manual(values = c("black", "red"), name = "Test") +
xlab("X1") +
ylab("X2") +
theme_bw()
Sonuçları incelemeden önce, veri setindeki sınıflara ait gözlemlerin miktarları arasında epeyce bir farklılık olduğu görülüyor. İnceleyecek olursak:
nrow(X[Y == S[1],])## [1] 2376nrow(X[Y == S[2],])## [1] 264nrow(X[Y == S[1],])/nrow(X[Y == S[2],]) ### dengesizlik oranı## [1] 9Gözlem miktarları arasında 9 kat fark olduğu görülüyor. Burada model performanslarını ölçmek için doğruluk oranına bakmak doğru olmayacaktır. Sınıflama modellerinde sıklıkla karşılaşılan problemlerden birisi dengesiz sınıf problemidir. Doğruluk oranı, çoğunluk sınıftan yana yanlı davranan bir ölçüttür. Bu modeller için Matthew Korelasyon Katsayısı (MKK) kullanılacaktır. mlr paketinde measureMCC fonksiyonu ile MKK ölçütü hesaplanabilir. Tüm yöntemler için sonuçları ve grafiklerimizi elde edelim.
methodlar <- c("N-NB",
"NK-NB",
"CDN-L-B",
"CDN-K-B",
"CDNK-B",
"CDC-N-B",
"CDC-NK-B"
)
modeller <- vector(mode = "list", length = length(methodlar))
tahminler <- vector(mode = "list", length = length(methodlar))
MKKlar <- numeric(length(methodlar))
grafikler <- vector(mode = "list", length = length(methodlar))
for (i in 1:length(methodlar)) {
modeller[[i]] <- bayes_siniflayicisi(X_egitim = X_egitim, Y_egitim = Y_egitim, method = methodlar[i])
tahminler[[i]] <- predict_bayes_siniflayicisi(model = modeller[[i]], X_test = X_test, tahmin_turu = "sinif")
MKKlar[i] <- mlr::measureMCC(truth = Y_test, response = tahminler[[i]], negative = S[1], positive = S[2])
grafikler[[i]] <- kontor_grafigi(model = modeller[[i]], X = X, X_egitim = X_egitim, Y_egitim = Y_egitim, X_test = X_test, Y_test = Y_test, baslik = methodlar[i], cozunurluk = 150, sinif_sayisi = 2, olcut = MKKlar[i], olcut_name = "MKK", point_alpha = 0.8)
}## Warning in Hlscv(...): Data contain duplicated values: LSCV is not well-behaved
## in this caseggarrange(plotlist = grafikler, common.legend = TRUE, ncol = 2)## $`1`
##
## $`2`
##
## $`3`
##
## $`4`