-
Notifications
You must be signed in to change notification settings - Fork 0
/
[TR]sınıflandırma_rapor.Rmd
2169 lines (1525 loc) · 68.2 KB
/
[TR]sınıflandırma_rapor.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
---
title: "Classification"
author: "Fatih Emre Ozturk"
date: "2023-01-14"
output:
html_document:
df_print: paged
editor_options:
markdown:
wrap: sentence
---
```{r message=FALSE, warning=FALSE, include=FALSE}
library(caret)
library(tidyverse)
library(magrittr)
library(olsrr)
library(car)
library(corrplot)
library(ISLR)
library(Hmisc)
library(caret)
library(dplyr)
library(ModelMetrics)
library(lmtest)
library(moments)
library(bestNormalize) # normalization
library(MASS)
library(psych)
library(mvnTest) # perform multivariate normality test
library(tree) # perform regression and decision tree
library(randomForest) # perform random forest
library(rpart) # performing regression trees
library(rpart.plot) # plotting regression trees
library(ipred) # bagging
library(kmed)
library(klaR)
library(e1071)
library(gridExtra)
library(ggalt)
library(ROCR)
library(MVN)
library(tinytex)
```
## Veri Setinin Çağrılması ve Gerekli Dönüşümlerin Yapılması
```{r include=FALSE}
df <- get(data("heart", package = "kmed"))
# Soruda istenilen dönüşümü uyguluyoruz.
df %<>% mutate(class = ifelse(df$class == 0, 0,1))
df2 <- df # veri setinin yedeği alınmıştır
# gerekli dönüşümler:
df$sex <- as.numeric(df$sex)
df$sex <- as.factor(df$sex)
df$fbs <- as.numeric(df$fbs)
df$fbs <- as.factor(df$fbs)
df$exang <- as.numeric(df$exang)
df$exang <- as.factor(df$exang)
df$ca <- as.factor(df$ca)
df$class <- as.factor(df$class)
# gerekli dönüşümler sonrası veri setindeki değişkenlerin türleri
str(df)
sum(is.na(df))
# veri setinde hiç eksik değer bulunmamakta.
```
## Tanımlayıcı İstatistikler
```{r echo=FALSE}
summary(df)
```
Veri setinde yer alan sayısal değerlerin tanımlayıcı istatistiklerini incelediğimizde:
- Age değişkeninin ortalamasının medyandan daha düşük olduğu saptanmıştır.
Bu da değişkenin sola çarpık olduğunu göstermektedir.
Birinci kartil ile minimum değer arasındaki farka bakıldığında uç değerlerin olabileceği düşünülmüştür.
- Trestbps değişkeninin ortalamasının medyanından az da olsa büyük olduğu saptanmıştır.
Bu da değişkenin sağa çarpık olduğunu göstermektedir.
Kartiller ile min max değişkenleri incelendiğinde ise aykırı gözlemlerin olabileceği düşünülmüştür.
- chol değişkeninin ortalamasının medyandan daha büyük olduğu saptanmıştır.
Bu da değişkenin sağa çarpık olduğunu göstermektedir.
Kartiller ile min-max değerleri incelendiğinde ise aykırı gözlemler olabileceği düşünülmektedir.
- thalach değişkeninin medyanının ortalamadan daha büyük olduğu görülmüştür.
Bu da değişkenin sola çarpık olduğunu göstermektedir.
Kartiller ile min-max değerleri arasındaki fark incelendiğinde ise aykırı gözlem olabileceği düşünülmektedir.
- Aykırı gözlemler için boxplot, dağılımlar ile ilgili genel bir bilgi sahibi olabilmek için ise histogram grafiklerine başvurulacaktır.
Veri setinde yer alan kategorik değerlerin tanımlayıcı istatistikleri incelendiğinde:
- Sex değişkeni incelendiğinde ise veride yer alan gözlemlerin büyük bir çoğunluğunun erkek olduğu saptanmıştır.
- cp değişkeni incelendiğinde çoğunluğun asymptomatic türündeki göğüs ağrısı olduğu saptanmıştır.
- fbs değişkeni incelendiğinde gözlemlerin büyük bir çoğunluğunun 120mg/dl'den daha az kan şekeri olduğu saptanmıştır.
- restecg değişkeni incelendiğinde gözlemlerin normal ile olası elektrokardiografik sonuçları olduğu, çok az kişinin anormal olduğu saptanmıştır.
- exang değişkeni incelendiğinde gözlemlerin büyük bir çoğunluğunda anjin görülmediği saptanmıştır.
- slope değişkeni incelendiğinde gözlemlerin büyük bir çoğunluğunda egzersiz ST segmentinin eğiminin düz olduğu saptanmıştır.
ca değişkeni incelendiğinde gözlemlerin büyük bir çoğunluğunun 0 değerini aldığı saptanmıştır.
- thal değişkeni incelendiğinde gözlemlerin büyük bir çoğunluğunun normal ve reversable defect seviyelerini aldığı gözlemlenmiştir.
- bağımlı değişken class incelendiğinde ise 160 kişinin kalp hastası olduğu, 137 kişinin ise kalp hastası olmadığı saptanmıştır.
### Görsel Analizler
```{r echo=FALSE}
par(mfrow = c(1,5), bty = "n")
boxplot(df$age, col = "goldenrod1", main = "Age", border = "firebrick3")
boxplot(df$trestbps, col = "goldenrod1" ,main = "Trestbps", border = "firebrick3")
boxplot(df$chol, col = "goldenrod1", main = "Chol", border = "firebrick3")
boxplot(df$thalach, col = "goldenrod1", main = "Thalach", border = "firebrick3")
boxplot(df$oldpeak, col = "goldenrod1", main = "Oldpeak", border = "firebrick3")
```
Sayısal değişkenlerin kutu grafikleri incelendiğinde:
- Age değişkeninde herhangi bir aykırı gözlem görülmemektedir.
Sola çarpıklık yine dikkat çekmektedir.
Range'i ise oldukça yüksek görülmektedir.
- Trestbps değişkeni incelendiğinde birçok aykırı gözlem olduğu saptanmıştır.
- Chol değişkeni incelendiğinde 5 adet aykırı gözlem saptanmıştır.
- Thalach değişkeni incelendiğinde 1 adet aykırı gözlem saptanmıştır.
- Oldpeak değişkeninde 4 adet aykırı gözlem dikkat çekmektedir.
```{r echo=FALSE}
indexes = sapply(df, is.numeric)
indexes["class"] = TRUE
df[,indexes]%>%
gather(-class, key = "var", value = "value") %>%
ggplot(aes(x = value, y = class, color = class)) +
geom_boxplot() +
facet_wrap(~ var, scales = "free")+
theme(axis.text.x = element_text(angle = 30, hjust = 0.85),legend.position="none",
panel.background = element_rect(fill = "white"))+
theme(strip.background =element_rect(fill="goldenrod1"))+
theme(strip.text = element_text(colour = "firebrick3"))
```
Sayısal değişkenlerin bağımlı değişkenin seviyelerine göre kutu grafikleri incelendiğinde:
- Kalp hastası olmayan gözlemlerin daha geniş bir rangede olduğu saptanmıştır.
- Kalp hastası olmayan gözlemlerin yaş ortalamasının hasta olanlara göre daha fazla olduğu saptanmıştır.
- İlginç bir şekilde kolesterol bilgisi içeren değişken için class değişkeninin seviyelerine göre fark edilir bir değişim bulunmamaktadır.
- Maximum kolesterole sahip bireyin kalp hastası olmaması da ilginç olarak ifade edilebilir.
- Dinlenmeye göre egzersizin neden olduğu ST depresyonu bilgisini içeren oldpeak değişkeni incelendiğinde kalp hastası olan gözlemlerin daha yüksek değerlerde olduğu saptanmıştır.
- Ulaşılan maksimum kalp atış hızı bilgisini içeren thalach değişkeni incelendiğinde kalp hastası olmayan bireylerin daha yüksek kalp atışı hızına ulaştığı saptanmıştır.
Kalp hastası olan gözlemlerin daha geniş bir aralıkta olduğu saptanırken daha düşük değerleri aldıkları da saptanmıştır.
- İstirahat halindeki kan basıncı bilgisini içeren trestbps değişkeni incelendiğinde ise kalp hastası olanlar ile olmayanların ortalamaları arasında bir fark görülmemektedir.
Ancak kalp hastası olanların biraz daha yüksek değerler aldığı söylenebilir.
### Eğitim - Test Ayrımı
```{r}
set.seed(2021900444)
train_indices <- sample(2, size=nrow(df), replace = TRUE, prob=c(0.7,0.3))
train <- df[train_indices==1, ]
test <- df[train_indices==2, ]
```
## Sınıflandırma Ağacı
### Tree Paketi ile Sınıflandırma
```{r echo=FALSE}
treeclass <- tree(class~. , train )
summary(treeclass ) # error rate önemli
```
İlk sınıflandırma ağacı modelinin çıktısı incelendiğinde:
- Toplam 10 değişken kullanılarak ağaç oluşturulmuş.
- Toplam 18 terminal node ile ağaç oluşturulmuş.
- Residual mean deviance 0.448 olarak dikkat çekiyor.
- Error rate 0.1005 gibi yüksek sayılabilecek bir değer almış.
```{r echo=FALSE, fig.width=10}
plot(treeclass )
text(treeclass ,pretty =0)
```
Sınıflandırma Ağacı incelendiğinde:
- Kök düğüm(root node) cp'nin 1,2 ve 3 olması olarak saptanmış.
- Thalach'ın 133.5'tan küçük olması son düğümlerden(terminal node) biri olarak saptanmış.
Ancak her iki node için de sınıf değişikliği olmaması dikkat çekiyor.
Diğer terminal node'larda da benzer bir durum var.
Ağacın budanması gerektiği açıkça belli oluyor.
- ca'nın 0 değerini alması iç düğümlerden(internal node) biri olarak saptanmış.
- Terminal nodeların büyük bir çoğunluğunda aynı değerler dikkat çekiyor.
Bu da prune etmenin gerekliliğini vurguluyor.
#### Cross Validation
```{r echo=FALSE}
set.seed(2021900444)
cv.treeclass <- cv.tree(treeclass ,FUN=prune.misclass )
plot(cv.treeclass$size ,cv.treeclass$dev ,type="b", col = "firebrick3", bty = "l")
```
Terminal düğüm sayısı ile Residual Mean Deviance arasındaki ilişkiyi içeren grafik incelendiğinde en az residual mean deviance değerinin 10 terminal node sayısı için fark edilmiştir.
Bu sebeple 10 terminal node sayısı için bir budama yapılacaktır.
```{r}
prune.treeclass1 <- prune.misclass (treeclass,best=10)
summary(prune.treeclass1)
```
Budama sonrası sınıflandırma ağacı modelinin çıktısı incelendiğinde:
- Toplam 7 değişken kullanılarak ağaç oluşturulmuş.
- Toplam 10 terminal node ile ağaç oluşturulmuş.
- Residual mean deviance 0.6314 olarak dikkat çekiyor, bu budama öncesinden daha yüksek bir değer.
- Error rate 0.1053 gibi budama öncesinden daha yüksek bir değer almış.
```{r echo=FALSE}
plot(prune.treeclass1)
text(prune.treeclass1 ,pretty =0)
```
Budama sonrası sınıflandırma Ağacı incelendiğinde:
- Kök düğüm(root node) cp'nin 1,2 ve 3 olması olarak saptanmış.
- Thal'ın 3 olması son düğümlerden(terminal node) biri olarak saptanmış.
- ca'nın 0 değerini alması yine iç düğümlerden(internal node) biri olarak saptanmış.
- Budama öncesi terminal nodeların büyük bir çoğunluğunda aynı değerler dikkat çekiyordu.
Budama sonrası bu problemin ortadan kalktığı fark edilmektedir.
#### Tree Paketi ile Oluşturulan Ağaçların Tahmini
##### İlk Ağacın Train Verisi ile Metrikleri
```{r echo=FALSE}
classtree.pred <- predict(treeclass ,train ,type="class")
caret::confusionMatrix(classtree.pred, train$class)
```
Accuracy Rate : 0.8995
Sensitivity : 0.9459
Specificity : 0.8469
```{r message=FALSE, warning=FALSE, include=FALSE}
ctpredictions <- data.frame()
ctpredictions[1,1] <- "Budama Öncesi CT"
ctpredictions[1,2] <- "Train"
ctpredictions[1,3] <- 0.8995
ctpredictions[1,4] <- 0.9459
ctpredictions[1,5] <- 0.8469
```
##### İlk Ağacın Train Verisi ile Metrikleri
```{r echo=FALSE}
classtree.predtest <- predict(treeclass, test, type = "class")
caret::confusionMatrix(classtree.predtest, test$class)
```
Accuracy Rate : 0.75
Sensitivity : 0.8776
Specificity : 0.5897
```{r include=FALSE}
ctpredictions[2,1] <- "Budama Öncesi CT"
ctpredictions[2,2] <- "Test"
ctpredictions[2,3] <- 0.75
ctpredictions[2,4] <- 0.8776
ctpredictions[2,5] <- 0.5897
```
##### Budanmış Ağacın Train Verisi ile Metrikleri
```{r echo=FALSE}
prunedtree.pred1 <- predict(prune.treeclass1 ,train ,type="class")
caret::confusionMatrix(prunedtree.pred1, train$class)
```
Accuracy Rate : 0.8947
Sensitivity : 0.9550
Specificity : 0.8265
```{r include=FALSE}
ctpredictions[3,1] <- "Budanmış CT"
ctpredictions[3,2] <- "Train"
ctpredictions[3,3] <- 0.8947
ctpredictions[3,4] <- 0.9550
ctpredictions[3,5] <- 0.8265
```
##### Budanmış Ağacın Test Verisi ile Metrikleri
```{r echo=FALSE}
prunedtree.predtest1 <- predict(prune.treeclass1, test, type = "class")
caret::confusionMatrix(prunedtree.predtest1, test$class)
```
Accuracy Rate : 0.7614
Sensitivity : 0.8980
Specificity : 0.5897
```{r include=FALSE}
ctpredictions[4,1] <- "Budanmış CT"
ctpredictions[4,2] <- "Test"
ctpredictions[4,3] <- 0.7614
ctpredictions[4,4] <- 0.8980
ctpredictions[4,5] <- 0.5897
```
### Rpart Paketi ile Sınıflandırma
Bu paketin özelliği cross validationını da kendisinin yapıp en az hatanın olduğu budanmış ağacı otomatik olarak oluşturmasıdır.
```{r}
treeclass2 <- rpart(class~., data = train, method = 'class')
treeclass2$variable.importance
```
Değişkenlerin önemi sıralandığında en önemli değişken cp olarak dikkat çekiyor.
Ardından ca, thal, exang değişkenleri geliyor.
```{r}
treeclass2$numresp
```
Dört bağımsız değişken ile ağaç oluşturulmuş.
```{r}
rpart.plot(treeclass2)
```
Ağacı incelediğimizde kök düğüm olarak yine cp'nin 1,2,3 olması dikkat çekiyor.
Internal node'lar ca'nın sıfıra eşit olması, slope'un 1 veya 3 olması durumları olarak dikkat çekiyor.
Toplam 6 adet terminal node bulunuyor.
Her bir atamayı farklı renklere ayırararak göstermiş.
Renklerin tonu ise içerdiği gözlem miktarını işaret ediyor.
##### Ağacın Train Verisi ile Metrikleri
```{r echo=FALSE}
prunedtree.pred3 <- predict(treeclass2 ,train ,type="class")
caret::confusionMatrix(prunedtree.pred3, train$class)
```
Accuracy Rate : 0.866
Sensitivity : 0.9099
Specificity : 0.8163
##### Ağacın Test Verisi ile Metrikleri
```{r echo=FALSE}
prunedtree.predtest3 <- predict(treeclass2, test, type = "class")
caret::confusionMatrix(prunedtree.predtest3, test$class)
```
Accuracy Rate : 0.8295
Sensitivity : 0.9184
Specificity : 0.7179
```{r include=FALSE}
ctpredictions[5,1] <- "rpart CT"
ctpredictions[5,2] <- "Train"
ctpredictions[5,3] <- 0.866
ctpredictions[5,4] <- 0.9099
ctpredictions[5,5] <- 0.8163
ctpredictions[6,1] <- "rpart CT"
ctpredictions[6,2] <- "Test"
ctpredictions[6,3] <- 0.8295
ctpredictions[6,4] <- 0.9184
ctpredictions[6,5] <- 0.7170
names(ctpredictions) <- c("Algoritma", "TT", "Accuracy_Rate", "Sensivity", "Specificity" )
```
### En İyi Sınıflandırma Ağacı Modelinin Seçildiği
#### Accuracy Rate Karşılaştırması
```{r}
ctpredictions %>%
ggplot(aes(x= Accuracy_Rate, y= reorder(Algoritma, -Accuracy_Rate))) +
geom_line(stat="identity") +
geom_point(aes(color=TT), size=3) +
theme(legend.position="top") +
theme(panel.background = element_rect(fill="white"))+
xlab("Accuracy Rate") +
ylab("Algoritma")
```
Tree paketi ile oluşturulan ilk model ile budanmış ağaç modellerinin train ve test verileri için accuracy rateleri incelendiğinde arada büyük farklılıkların olduğu fark edilmiştir.
Bu da bir overfit problemi olabileceğini işaret etmektedir.
Train veri setinde accuracy rate'i en düşük olan model olmasına rağmen test veri setinde en yüksek accuracy rate'e ulaşan rpart paketi dikkat çekmektedir.
#### Sensitivity Karşılaştırması
```{r}
ctpredictions %>%
ggplot(aes(x= Sensivity, y= reorder(Algoritma, -Sensivity))) +
geom_line(stat="identity") +
geom_point(aes(color=TT), size=3) +
theme(legend.position="top") +
theme(panel.background = element_rect(fill="white"))+
xlab("Sensitivity") +
ylab("Algoritma")
```
Tree paketi ile oluşturulan ilk model ile budanmış ağaç modellerinin train ve test verileri için sensitivityleri incelendiğinde arada büyük farklılıkların olduğu fark edilmiştir.
Bu da bir overfit problemi olabileceğini işaret etmektedir.
Train veri setinde sensivitiysi en düşük olan model olmasına rağmen test veri setinde en yüksek sensitivitye ulaşan rpart paketi dikkat çekmektedir.
Buna ek olarak test veri setinin sensitivity değeri train veri setinden daha çok çıkmıştır.
Bu da tam olarak istediğimiz şeydir.
#### Specificity Karşılaştırması
```{r}
ctpredictions %>%
ggplot(aes(x= Specificity, y= reorder(Algoritma, -Specificity))) +
geom_line(stat="identity") +
geom_point(aes(color=TT), size=3) +
theme(legend.position="top") +
theme(panel.background = element_rect(fill="white"))+
xlab("Specificity") +
ylab("Algoritma")
```
Tree paketi ile oluşturulan ilk model ile budanmış ağaç modellerinin train ve test verileri için accuracy rateleri incelendiğinde arada büyük farklılıkların olduğu fark edilmiştir.
Bu da bir overfit problemi olabileceğini işaret etmektedir.
Train veri setinde accuracy rate'i en düşük olan model olmasına rağmen test veri setinde en yüksek accuracy rate'e ulaşan rpart paketi dikkat çekmektedir.
Bu sebeple **rpart paketi ile oluşturulmuş model Sınıflandırma Ağacı modelleri arasında en iyi model** olarak seçilmiştir.
Diğer modellerle kıyaslama yaparken bu model kullanılacaktır.
## Bagging
### Random Forest Paketi İle Model Oluşturma
```{r}
set.seed(2021900444)
bag <- randomForest(class~. , data=train, mtry=13,importance=TRUE)
bag
```
- Toplam 500 ağaç kullanılarak model kurulmuş.
- Her bir ayrımda 13 adet değişken kullanılmış.
- OOB hata oranı ise %18.18 olarak saptanmıştır.
- Sıfırıncı sınıfın hatası 0.11 olarak saptanırken birinci sınıfta hata oranı artmış 0.255 olarak daha fazla hata saptanmıştır.
```{r}
varImpPlot(bag)
```
Değişkenlerin önemlerini işaret eden grafik incelendiğinde proline değişkeninin meandecreaseaccuracy değerine göre önemli değişkenler cp, ca, oldpeak, thal olarak saptanmıştır.
Düğüm saflığını işaret eden gini değerine göre önemli değişkenler cp, ca, oldpeak, age olarak saptanmıştır.
### ipred Paketi İle Model Oluşturma
ipred paketinde yer alan bagging fonksiyonu ile model kurulurken:
- Modele kaç iterasyonun dahil edileceğini kontrol etmek için nbagg kullanılır.
- coob = TRUE OOB hata oranını kullanmayı göstermektedir.
- tr control argümani ile 10-fold cross validation fonksiyonun içinde uygulanır.
```{r}
bag2 <- bagging(
formula = class ~ .,
data = train,
nbagg = 500,
coob = TRUE,
method = "treebag",
trControl = trainControl(method = "cv", number = 10))
bag2$err
```
OOB Missclassification error rate 0.1818 olarak saptanmıştır.
randomForest paketi ile oluşturulan model ile aynı sonuç olarak denk gelmiştir.
```{r}
VI <- data.frame(var=names(train[,-14]), imp=varImp(bag2))
VI_plot <- VI[order(VI$Overall, decreasing=F),]
barplot(VI_plot$Overall,
names.arg=rownames(VI_plot),
horiz=T,
col="goldenrod1",
xlab="Variable Importance",
las = 2)
```
Değişkenlerin önemini ifade eden grafiği incelediğimizde bir önceki paketten daha farklı bir grafikle karşılaşılmıştır.
ca ve cp değişkenleri diğer pakette en önemli değişkenler olarak görünürken bu sefer oldpeak değişkeninin daha önemli olduğu fark edilmiştir.
oldpeak değişkenini ise cp, ca, thal ve age değişkenlerinin takip ettiği söylenebilir.
### Modellerin Tahminleri
#### Tree Paketi ile Oluşturulan Modelin Train Verisi ile Metrikleri
```{r echo=FALSE}
baggintrain <- predict(bag ,train ,type="class")
caret::confusionMatrix(baggintrain, train$class)
```
Accuracy Rate : 1
Sensitivity : 1
Specificity : 1
#### Tree Paketi ile Oluşturulan Modelin Test Verisi ile Metrikleri
```{r echo=FALSE}
baggintest <- predict(bag, test, type = "class")
caret::confusionMatrix(baggintest, test$class)
```
Accuracy Rate : 0.7727
Sensitivity : 0.8571
Specificity : 0.6667
```{r include=FALSE}
bagpred <- data.frame()
bagpred[1,1] <- "bagmodel1"
bagpred[1,2] <- "train"
bagpred[2,2] <- "test"
bagpred[2,1] <- "bagmodel1"
bagpred[1,3] <- 1
bagpred[2,3] <- 0.7727
bagpred[1,4] <- 1
bagpred[2,4] <- 0.8571
bagpred[1,5] <- 1
bagpred[2,5] <- 0.6667
```
#### ipred Paketi ile Oluşturulan Modelin Train Verisi ile Metrikleri
```{r echo=FALSE}
baggintrain1 <- predict(bag2 ,train ,type="class")
caret::confusionMatrix(baggintrain1, train$class)
```
Accuracy Rate : 1
Sensitivity : 1
Specificity : 1
```{r echo=FALSE}
baggintest1 <- predict(bag2, test, type = "class")
caret::confusionMatrix(baggintest1, test$class)
```
Accuracy Rate : 0.7955
Sensitivity : 0.8776
Specificity : 0.6923
```{r include=FALSE}
bagpred[3,1] <- "ipredmodel"
bagpred[3,2] <- "train"
bagpred[4,2] <- "test"
bagpred[4,1] <- "ipredmodel"
bagpred[3,3] <- 1
bagpred[4,3] <- 0.7955
bagpred[3,4] <- 1
bagpred[4,4] <- 0.8776
bagpred[3,5] <- 1
bagpred[4,5] <- 0.6923
names(bagpred) <- c("Algoritma", "TT", "Accuracy_Rate", "Sensivity", "Specificity" )
```
### En İyi Bagging Modelinin Seçilmesi
#### Accuracy Rate Karşılaştırması
```{r}
bagpred %>%
ggplot(aes(x= Accuracy_Rate, y= reorder(Algoritma, -Accuracy_Rate))) +
geom_line(stat="identity") +
geom_point(aes(color=TT), size=3) +
theme(legend.position="top") +
theme(panel.background = element_rect(fill="white"))+
xlab("Accuracy Rate") +
ylab("Algoritma")
```
Her iki model için de train verisi ile test verisinin accuracy rateleri arasındaki fark oldukça fazla çıkmıştır.
Bir overfit problemi olduğu rahatlıkla söylenebilir.
ipred paketi ile oluşturulmuş modelin biraz daha iyi bir sonuç verdiği görülmektedir.
#### Sensitivity Karşılaştırması
```{r}
bagpred %>%
ggplot(aes(x= Sensivity, y= reorder(Algoritma, -Sensivity))) +
geom_line(stat="identity") +
geom_point(aes(color=TT), size=3) +
theme(legend.position="top") +
theme(panel.background = element_rect(fill="white"))+
xlab("Sensitivity") +
ylab("Algoritma")
```
Her iki model için de train verisi ile test verisinin sensitivityleri arasındaki fark oldukça fazla çıkmıştır.
Bir overfit problemi olduğu rahatlıkla söylenebilir.
ipred paketi ile oluşturulmuş modelin biraz daha iyi bir sonuç verdiği görülmektedir.
#### Specificity Karşılaştırması
```{r}
bagpred %>%
ggplot(aes(x= Specificity, y= reorder(Algoritma, -Specificity))) +
geom_line(stat="identity") +
geom_point(aes(color=TT), size=3) +
theme(legend.position="top") +
theme(panel.background = element_rect(fill="white"))+
xlab("Specificity") +
ylab("Algoritma")
```
Her iki model için de train verisi ile test verisinin specificityleri arasındaki fark oldukça fazla çıkmıştır.
Bir overfit problemi olduğu rahatlıkla söylenebilir.
ipred paketi ile oluşturulmuş modelin biraz daha iyi bir sonuç verdiği görülmektedir.
Tüm metrikler için benzer sonuçlarla karşılaşılmıştı.
Algoritmaların karşılaştırılmasında biraz daha iyi sonuçlar verdiği ve test veri setinin sonuçları daha yüksek olduğu için, **ipred paketi ile oluşturulmuş bagging modeli ile devam edilecektir**.
## Random Forest
```{r}
rf <- randomForest(class~. ,data=train, mtry=4,importance=TRUE)
rf
```
Modelin çıktısı incelendiğinde:
- Her bir ayrışmada 4 değişken denenmiş.
- Toplam 500 ağaç kurulmuş.
- OOB hata orası 0.177 olarak saptanmış.
- Sıfırıncı sınıf için hata 0.13, birinci sınıf için ise 0.22 olarak saptanmış.
- Toplam 36 gözlem yanlış olarak sınıflandırılmış.
```{r}
varImpPlot(rf)
```
Değişkenlerin önemlerine bakıldığında:
Mean decrease accuracy incelendiğinde en çok ca, ardından cp, oldpeakthalach,thal, sıralaması dikkat çekmekte.
Düğüm saflığını ifade eden gini değerlerine bakıldığında ise cp, ca, oldpeak sıralaması dikkat çekmektedir.
### Grid Search
Grid search'te ağaç sayısı aralığına karar vermek için grafik çizdirilmiştir.
```{r}
plot(rf)
```
```{r}
hyper_grid <- expand.grid(
mtry = c(3, 4, 5, 6),
nodesize = c(1, 3, 5, 10),
numtrees = c(200, 220,300,330),
rmse = NA
)
for (i in 1:nrow(hyper_grid)) {
fit <- randomForest(class~. ,
data=train,
mtry=hyper_grid$mtry[i],
nodesize = hyper_grid$nodesize[i],
ntree = hyper_grid$numtrees[i],
importance=TRUE)
hyper_grid$rmse[i] <- mean(fit$confusion[,3])
}
# assess top 10 models
hyper_grid %>%
arrange(rmse) %>%
head(10)
```
Grid Search sonucu en iyi parametrelere ait model aşağıdaki gibi oluşturulacaktır:
```{r}
rf2 <- randomForest(class~. ,data=train, mtry=4,importance=TRUE, nodesize = 10, ntree= 220)
rf2
```
- Her bir ayrışmada 4 değişken denenmiş.
- Toplam 220 ağaç kurulmuş.
Bu iki parametreyi zaten biz girmiştik.
- OOB estimate error rate ise 0.1531 çıkmış.
Bu grid search önceki modelden daha iyi bir sonuç olarak söylenebilir.
- Sıfırıncı sınıf için hata 0.10, birinci sınıf için ise 0.18 olarak saptanmış.
- Toplam 32 gözlem yanlış olarak sınıflandırılmış.
- Grid Search öncesine göre daha iyi sonuçlar verdiği söylenebilir.
```{r}
varImpPlot(rf2)
```
Değişkenlerin önemlerine bakıldığında;
Mean decrease accuracy incelendiğinde en çok cp, ardından ca, oldpeak ve thal sıralaması dikkat çekmekte.
İlk random forest modeline göre en dönemli değişken sıralaması değişmiştir.
Gini değerlerine bakıldığında ise cp, ca, thalach, sıralaması dikkat çekmektedir.
### Modellerin Tahminleri
#### İlk Random Forest Modelinin Train Verisi ile Metrikleri
```{r echo=FALSE}
ranfortrain <- predict(rf ,train ,type="class")
caret::confusionMatrix(ranfortrain, train$class)
```
Accuracy Rate : 1
Sensitivity : 1
Specificity : 1
#### İlk Random Forest Modelinin Test Verisi ile Metrikleri
```{r echo=FALSE}
ranfortest <- predict(rf, test, type = "class")
caret::confusionMatrix(ranfortest, test$class)
```
Accuracy Rate : 0.8182
Sensitivity : 0.8776
Specificity : 0.7436
```{r include=FALSE}
rfpred <- data.frame()
rfpred[1,1] <- "rfmodel1"
rfpred[2,1] <- "rfmodel1"
rfpred[1,2] <- "train"
rfpred[2,2] <- "test"
rfpred[1,3] <- 1
rfpred[2,3] <- 0.8182
rfpred[1,4] <- 1
rfpred[2,4] <- 0.8776
rfpred[1,5] <- 1
rfpred[2,5] <- 0.7436
```
#### Grid Search Sonrası Random Forest Modelinin Train Verisi ile Metrikleri
```{r echo=FALSE}
ranfortrain1 <- predict(rf2 ,train ,type="class")
caret::confusionMatrix(ranfortrain1, train$class)
```
Accuracy Rate : 0.9378
Sensitivity : 0.9459
Specificity : 0.9256
#### Grid Search Sonrası Random Forest Modelinin Test Verisi ile Metrikleri
```{r echo=FALSE}
ranfortest1 <- predict(rf2, test, type = "class")
caret::confusionMatrix(ranfortest1, test$class)
```
Accuracy Rate : 0.8182
Sensitivity : 0.8776
Specificity : 0.7436
```{r include=FALSE}
rfpred[3,1] <- "rfmodel2"
rfpred[4,1] <- "rfmodel2"
rfpred[3,2] <- "train"
rfpred[4,2] <- "test"
rfpred[3,3] <- 0.9378
rfpred[4,3] <- 0.8182
rfpred[3,4] <- 0.9459
rfpred[4,4] <- 0.8776
rfpred[3,5] <- 0.9256
rfpred[4,5] <- 0.7436
names(rfpred) <- c("Algoritma", "TT", "Accuracy_Rate", "Sensivity", "Specificity" )
```
### En İyi Random Forest Modelinin Seçilmesi
#### Accuracy Rate Karşılaştırması
```{r}
rfpred %>%
ggplot(aes(x= Accuracy_Rate, y= reorder(Algoritma, -Accuracy_Rate))) +
geom_line(stat="identity") +
geom_point(aes(color=TT), size=3) +
theme(legend.position="top") +
theme(panel.background = element_rect(fill="white"))+
xlab("Accuracy Rate") +
ylab("Algoritma")
```
Her iki model için de train verisi ile test verisinin accuracy rateleri arasındaki fark oldukça fazla çıkmıştır.
Bir overfit problemi olduğu rahatlıkla söylenebilir.
Grid Search ile oluşturulmuş modelin biraz daha iyi bir sonuç verdiği görülmektedir.
#### Sensitivity Karşılaştırması
```{r}
rfpred %>%
ggplot(aes(x= Sensivity, y= reorder(Algoritma, -Sensivity))) +
geom_line(stat="identity") +
geom_point(aes(color=TT), size=3) +
theme(legend.position="top") +
theme(panel.background = element_rect(fill="white"))+
xlab("Sensitivity") +
ylab("Algoritma")
```
Her iki model için de train verisi ile test verisinin accuracy rateleri arasındaki fark oldukça fazla çıkmıştır.
Bir overfit problemi olduğu rahatlıkla söylenebilir.
Grid Search ile oluşturulmuş modelin biraz daha iyi bir sonuç verdiği görülmektedir.
#### Specificity Karşılaştırması
```{r}
rfpred %>%
ggplot(aes(x= Specificity, y= reorder(Algoritma, -Specificity))) +
geom_line(stat="identity") +
geom_point(aes(color=TT), size=3) +
theme(legend.position="top") +
theme(panel.background = element_rect(fill="white"))+
xlab("Specificity") +
ylab("Algoritma")
```
Her iki model için de train verisi ile test verisinin accuracy rateleri arasındaki fark oldukça fazla çıkmıştır.
Bir overfit problemi olduğu rahatlıkla söylenebilir.
Grid Search ile oluşturulmuş modelin biraz daha iyi bir sonuç verdiği görülmektedir.
Algoritmaların karşılaştırılmasında biraz daha iyi sonuçlar verdiği ve test veri setinin sonuçları daha yüksek olduğu için, **grid search sonrası oluşturulan random forest modeli ile devam edilecektir**.
## Logistic Regression
```{r}
logmodel1 <- glm(class ~ age + sex + cp + trestbps + chol +
fbs + restecg + thalach + exang + oldpeak + slope + ca + thal, data = train, family = binomial)
summary(logmodel1)
```
### Modelin anlamlılığı
- $H_{0}$ : $\beta_{1}$ = $\beta_{2}$ = ⋯ = $\beta_{k}$ = 0
- $H_{a}$ : En azından bir $\beta_{j}$ $\ne$ 0
```{r}
# G= Null deviance-Residual Deviance
1-pchisq(288.93 - 112.58,208-188)
```
P-değeri anlamlılık seviyesi 0.05'ten küçük olduğu için sıfır hipotezini reddebiliriz.
Başka bir deyişle, bağımsız değişkenlerin bağımlı değişkeni açıklamada etkili olduğunu söyleyebilecek yeterli istatistiksel kanıtımız bulunmaktadır.
### Katsayı Değerlendirmesi
Bağımsız değişkenin değerini bir birim arttırdığımızda tahmin değerindeki değişikliği belirlemek için önce log(odds) formulünde her iki tarafa exp fonksiyonu uygulanır.
Anlamlı değişkenlerin katsayı yorumu:
```{r}
exp(1.689872)
exp(2.824694)
exp(3.703384)
exp(1.331317)
exp(0.988486)
exp(1.434285)
exp(2.770626)
exp( 2.553011)
exp(1.265260)
```
- Sex1 değişkenindeki bir birimlik artış odds oranını 5.418787 kat değiştirir
- Cp2 değişkenindeki bir birimlik artış odds oranını 16.85579 kat değiştirir
- Cp4 değişkenindeki 1 birimlik artış odds oranını 40.58441 kat değiştirir.
- Restecg2 değişkenindeki 1 birimlik artış odds oranını 3.786026 kat değiştirir.
- Oldpeak değişkenindeki 1 birimlik artış odds oranını 2.687163 kat değiştirir.
- Slope2 değişkenindeki 1 birimlik artış odds oranını 4.196643 kat değiştirir.
- Ca1 değişkenindeki 1 birimlik artış odds oranını 15.96863 kat değiştirir.
- Ca2 değişkenindeki bir birimlik artış odds oranını 12.84572 kat değiştirir
- Thal7 değişkenindeki 1 birimlik artış odds oranını 3.544014 kat değiştirir.
### Katsayılar için Güven Aralığı Tahmini
- $H_{0}$ : $\beta_{i}$ = 0