Karar Ağaçları

#install.packages("ISLR")
library(ISLR)
#install.packages("tree")
library(tree)
## Warning: package 'tree' was built under R version 3.6.3
# 400 farklı mağazada satılan araba çocuk koltuğu veriseti
?Carseats 
## starting httpd help server ... done
names(Carseats) # nitelikleri görmek için
##  [1] "Sales"       "CompPrice"   "Income"      "Advertising" "Population" 
##  [6] "Price"       "ShelveLoc"   "Age"         "Education"   "Urban"      
## [11] "US"
View(Carseats) # verisetini görüntülemek için
str(Carseats) # veri yapısını görmek için
## 'data.frame':    400 obs. of  11 variables:
##  $ Sales      : num  9.5 11.22 10.06 7.4 4.15 ...
##  $ CompPrice  : num  138 111 113 117 141 124 115 136 132 132 ...
##  $ Income     : num  73 48 35 100 64 113 105 81 110 113 ...
##  $ Advertising: num  11 16 10 4 3 13 0 15 0 0 ...
##  $ Population : num  276 260 269 466 340 501 45 425 108 131 ...
##  $ Price      : num  120 83 80 97 128 72 108 120 124 124 ...
##  $ ShelveLoc  : Factor w/ 3 levels "Bad","Good","Medium": 1 2 3 3 1 1 3 2 3 3 ...
##  $ Age        : num  42 65 59 55 38 78 71 67 76 76 ...
##  $ Education  : num  17 10 12 14 13 16 15 10 10 17 ...
##  $ Urban      : Factor w/ 2 levels "No","Yes": 2 2 2 2 2 1 2 2 1 1 ...
##  $ US         : Factor w/ 2 levels "No","Yes": 2 2 2 2 1 2 1 2 1 2 ...
summary(Carseats) # özet istatistikleri görmek için
##      Sales          CompPrice       Income        Advertising    
##  Min.   : 0.000   Min.   : 77   Min.   : 21.00   Min.   : 0.000  
##  1st Qu.: 5.390   1st Qu.:115   1st Qu.: 42.75   1st Qu.: 0.000  
##  Median : 7.490   Median :125   Median : 69.00   Median : 5.000  
##  Mean   : 7.496   Mean   :125   Mean   : 68.66   Mean   : 6.635  
##  3rd Qu.: 9.320   3rd Qu.:135   3rd Qu.: 91.00   3rd Qu.:12.000  
##  Max.   :16.270   Max.   :175   Max.   :120.00   Max.   :29.000  
##    Population        Price        ShelveLoc        Age          Education   
##  Min.   : 10.0   Min.   : 24.0   Bad   : 96   Min.   :25.00   Min.   :10.0  
##  1st Qu.:139.0   1st Qu.:100.0   Good  : 85   1st Qu.:39.75   1st Qu.:12.0  
##  Median :272.0   Median :117.0   Medium:219   Median :54.50   Median :14.0  
##  Mean   :264.8   Mean   :115.8                Mean   :53.32   Mean   :13.9  
##  3rd Qu.:398.5   3rd Qu.:131.0                3rd Qu.:66.00   3rd Qu.:16.0  
##  Max.   :509.0   Max.   :191.0                Max.   :80.00   Max.   :18.0  
##  Urban       US     
##  No :118   No :142  
##  Yes:282   Yes:258  
##                     
##                     
##                     
## 
sum(is.na(Carseats)) # verisetinde kayıp veri var mı?
## [1] 0
# fiyat (price) ile satış (sales) arasında ilişki var mı? 
library(ggplot2)
ggplot(data=Carseats, aes(x=Price, y=Sales, col=Urban))+geom_point()

# Satışı etkileyen nitelikleri görmek istiyoruz. Hedef niteliğimiz "Sales"

# Sales niteliğinin özet istatistiği:
summary(Carseats$Sales)
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.000   5.390   7.490   7.496   9.320  16.270
# Histogram grafiği:
hist(Carseats$Sales)

# Sales kantitatif bir nitelik, İkili (binary) cevaplı ağaç oluşturmak istiyoruz.
# Bu yüzden yükskew satışlar için "HighSales" niteliğini oluşturuyoruz. 
# Sales niteliğinin Histogram dağılımı ve özet istatisitiğine göre 8 değeri seriyi hemen hemen 
# eşit oalrak dağıtacak gibi gözükmekte. Sales 8'den büyük ise "Yes" değil ise "No" olarak kodluyoruz.


HighSales <- as.factor(ifelse(Carseats$Sales<=8, "No","Yes"))

# ve bunu da dataframe'e dahil ediyoruz:
Carseats <- data.frame(Carseats, HighSales)
str(Carseats)
## 'data.frame':    400 obs. of  12 variables:
##  $ Sales      : num  9.5 11.22 10.06 7.4 4.15 ...
##  $ CompPrice  : num  138 111 113 117 141 124 115 136 132 132 ...
##  $ Income     : num  73 48 35 100 64 113 105 81 110 113 ...
##  $ Advertising: num  11 16 10 4 3 13 0 15 0 0 ...
##  $ Population : num  276 260 269 466 340 501 45 425 108 131 ...
##  $ Price      : num  120 83 80 97 128 72 108 120 124 124 ...
##  $ ShelveLoc  : Factor w/ 3 levels "Bad","Good","Medium": 1 2 3 3 1 1 3 2 3 3 ...
##  $ Age        : num  42 65 59 55 38 78 71 67 76 76 ...
##  $ Education  : num  17 10 12 14 13 16 15 10 10 17 ...
##  $ Urban      : Factor w/ 2 levels "No","Yes": 2 2 2 2 2 1 2 2 1 1 ...
##  $ US         : Factor w/ 2 levels "No","Yes": 2 2 2 2 1 2 1 2 1 2 ...
##  $ HighSales  : Factor w/ 2 levels "No","Yes": 2 2 2 1 1 2 1 2 1 1 ...
# Sales niteliğine artık ihtiyacımız kalmadığı için dataframe'den çıkarıyoruz:
Carseats$Sales <- NULL
str(Carseats)
## 'data.frame':    400 obs. of  11 variables:
##  $ CompPrice  : num  138 111 113 117 141 124 115 136 132 132 ...
##  $ Income     : num  73 48 35 100 64 113 105 81 110 113 ...
##  $ Advertising: num  11 16 10 4 3 13 0 15 0 0 ...
##  $ Population : num  276 260 269 466 340 501 45 425 108 131 ...
##  $ Price      : num  120 83 80 97 128 72 108 120 124 124 ...
##  $ ShelveLoc  : Factor w/ 3 levels "Bad","Good","Medium": 1 2 3 3 1 1 3 2 3 3 ...
##  $ Age        : num  42 65 59 55 38 78 71 67 76 76 ...
##  $ Education  : num  17 10 12 14 13 16 15 10 10 17 ...
##  $ Urban      : Factor w/ 2 levels "No","Yes": 2 2 2 2 2 1 2 2 1 1 ...
##  $ US         : Factor w/ 2 levels "No","Yes": 2 2 2 2 1 2 1 2 1 2 ...
##  $ HighSales  : Factor w/ 2 levels "No","Yes": 2 2 2 1 1 2 1 2 1 1 ...
# ilk önce train ya da test olarak ayırmadan bir ağaç oluşturuyoruz:

tree.Carseats <- tree(HighSales~., data = Carseats)

# modelin özet verilerin görmek için:
summary(tree.Carseats)
## 
## Classification tree:
## tree(formula = HighSales ~ ., data = Carseats)
## Variables actually used in tree construction:
## [1] "ShelveLoc"   "Price"       "Income"      "CompPrice"   "Population" 
## [6] "Advertising" "Age"         "US"         
## Number of terminal nodes:  27 
## Residual mean deviance:  0.4575 = 170.7 / 373 
## Misclassification error rate: 0.09 = 36 / 400
# ağacı çizdirmek için:
plot(tree.Carseats)
text(tree.Carseats)

# her bir uç (terminal) düğümün ayrıntısı için:
tree.Carseats
## node), split, n, deviance, yval, (yprob)
##       * denotes terminal node
## 
##   1) root 400 541.500 No ( 0.59000 0.41000 )  
##     2) ShelveLoc: Bad,Medium 315 390.600 No ( 0.68889 0.31111 )  
##       4) Price < 92.5 46  56.530 Yes ( 0.30435 0.69565 )  
##         8) Income < 57 10  12.220 No ( 0.70000 0.30000 )  
##          16) CompPrice < 110.5 5   0.000 No ( 1.00000 0.00000 ) *
##          17) CompPrice > 110.5 5   6.730 Yes ( 0.40000 0.60000 ) *
##         9) Income > 57 36  35.470 Yes ( 0.19444 0.80556 )  
##          18) Population < 207.5 16  21.170 Yes ( 0.37500 0.62500 ) *
##          19) Population > 207.5 20   7.941 Yes ( 0.05000 0.95000 ) *
##       5) Price > 92.5 269 299.800 No ( 0.75465 0.24535 )  
##        10) Advertising < 13.5 224 213.200 No ( 0.81696 0.18304 )  
##          20) CompPrice < 124.5 96  44.890 No ( 0.93750 0.06250 )  
##            40) Price < 106.5 38  33.150 No ( 0.84211 0.15789 )  
##              80) Population < 177 12  16.300 No ( 0.58333 0.41667 )  
##               160) Income < 60.5 6   0.000 No ( 1.00000 0.00000 ) *
##               161) Income > 60.5 6   5.407 Yes ( 0.16667 0.83333 ) *
##              81) Population > 177 26   8.477 No ( 0.96154 0.03846 ) *
##            41) Price > 106.5 58   0.000 No ( 1.00000 0.00000 ) *
##          21) CompPrice > 124.5 128 150.200 No ( 0.72656 0.27344 )  
##            42) Price < 122.5 51  70.680 Yes ( 0.49020 0.50980 )  
##              84) ShelveLoc: Bad 11   6.702 No ( 0.90909 0.09091 ) *
##              85) ShelveLoc: Medium 40  52.930 Yes ( 0.37500 0.62500 )  
##               170) Price < 109.5 16   7.481 Yes ( 0.06250 0.93750 ) *
##               171) Price > 109.5 24  32.600 No ( 0.58333 0.41667 )  
##                 342) Age < 49.5 13  16.050 Yes ( 0.30769 0.69231 ) *
##                 343) Age > 49.5 11   6.702 No ( 0.90909 0.09091 ) *
##            43) Price > 122.5 77  55.540 No ( 0.88312 0.11688 )  
##              86) CompPrice < 147.5 58  17.400 No ( 0.96552 0.03448 ) *
##              87) CompPrice > 147.5 19  25.010 No ( 0.63158 0.36842 )  
##               174) Price < 147 12  16.300 Yes ( 0.41667 0.58333 )  
##                 348) CompPrice < 152.5 7   5.742 Yes ( 0.14286 0.85714 ) *
##                 349) CompPrice > 152.5 5   5.004 No ( 0.80000 0.20000 ) *
##               175) Price > 147 7   0.000 No ( 1.00000 0.00000 ) *
##        11) Advertising > 13.5 45  61.830 Yes ( 0.44444 0.55556 )  
##          22) Age < 54.5 25  25.020 Yes ( 0.20000 0.80000 )  
##            44) CompPrice < 130.5 14  18.250 Yes ( 0.35714 0.64286 )  
##              88) Income < 100 9  12.370 No ( 0.55556 0.44444 ) *
##              89) Income > 100 5   0.000 Yes ( 0.00000 1.00000 ) *
##            45) CompPrice > 130.5 11   0.000 Yes ( 0.00000 1.00000 ) *
##          23) Age > 54.5 20  22.490 No ( 0.75000 0.25000 )  
##            46) CompPrice < 122.5 10   0.000 No ( 1.00000 0.00000 ) *
##            47) CompPrice > 122.5 10  13.860 No ( 0.50000 0.50000 )  
##              94) Price < 125 5   0.000 Yes ( 0.00000 1.00000 ) *
##              95) Price > 125 5   0.000 No ( 1.00000 0.00000 ) *
##     3) ShelveLoc: Good 85  90.330 Yes ( 0.22353 0.77647 )  
##       6) Price < 135 68  49.260 Yes ( 0.11765 0.88235 )  
##        12) US: No 17  22.070 Yes ( 0.35294 0.64706 )  
##          24) Price < 109 8   0.000 Yes ( 0.00000 1.00000 ) *
##          25) Price > 109 9  11.460 No ( 0.66667 0.33333 ) *
##        13) US: Yes 51  16.880 Yes ( 0.03922 0.96078 ) *
##       7) Price > 135 17  22.070 No ( 0.64706 0.35294 )  
##        14) Income < 46 6   0.000 No ( 1.00000 0.00000 ) *
##        15) Income > 46 11  15.160 Yes ( 0.45455 0.54545 ) *

Veri Bölme

# birçok farklı veri ayırma yöntemi bulunmaktadır. İlk önce sample() fonksiyonunu kullanarak ayıralım.
# 400 gözlemin 250'si eğitim 150'sini test olarak ayıralım. 
# eğitim seti üzerinde ağacı büyütüp, test seti üzerine performansını değerlendireceğiz.

# set.seed() ile sonuçlarımızın aynı şekilde tekrar üretilebilir olmasını sağlıyoruz. 
set.seed(101)
# aynı değerleri yerine koymaksızın default ayar ile:
train <- sample(1:nrow(Carseats),250)

# Veriyi ayırdıktan sonra modeli oluşturuyoruz.
# tree packeti ayrım için gini kullanmakta.

tree.Carseats <- tree(HighSales~., Carseats, subset = train)
summary(tree.Carseats)
## 
## Classification tree:
## tree(formula = HighSales ~ ., data = Carseats, subset = train)
## Variables actually used in tree construction:
## [1] "ShelveLoc"   "Price"       "Age"         "CompPrice"   "Income"     
## [6] "Advertising" "Population" 
## Number of terminal nodes:  21 
## Residual mean deviance:  0.4442 = 101.7 / 229 
## Misclassification error rate: 0.112 = 28 / 250
plot(tree.Carseats)
text(tree.Carseats, pretty = 0)

# test seti üzerine tahmin ağacı oluşturalım
# type = "class" gerçek sınıf tahminini döndürür.

tree.prediction <- predict(tree.Carseats, Carseats[-train,], type = "class")
# test seti üzerine sınıflandırma
tree.prediction 
##   [1] Yes Yes Yes Yes Yes No  No  Yes Yes No  No  No  No  No  Yes No  No  No 
##  [19] No  No  No  No  No  Yes Yes Yes Yes No  No  No  Yes No  No  Yes Yes Yes
##  [37] No  No  No  No  No  Yes No  No  Yes No  No  No  Yes No  No  No  No  No 
##  [55] Yes No  Yes Yes Yes Yes Yes No  Yes No  No  Yes Yes Yes Yes No  No  Yes
##  [73] No  Yes No  Yes No  No  No  No  No  No  Yes No  No  Yes No  No  Yes Yes
##  [91] No  Yes No  Yes No  Yes No  Yes No  No  No  No  No  No  Yes No  Yes No 
## [109] No  No  Yes Yes No  No  No  Yes No  Yes No  Yes No  No  Yes No  No  Yes
## [127] No  No  No  No  Yes Yes No  No  Yes Yes No  Yes Yes No  No  Yes No  No 
## [145] No  No  Yes No  No  No 
## Levels: No Yes
# yanlış sınıflandırma tablosu:
with(Carseats[-train,], table(tree.prediction, HighSales))
##                HighSales
## tree.prediction No Yes
##             No  74  18
##             Yes 19  39
head(tree.prediction)
## [1] Yes Yes Yes Yes Yes No 
## Levels: No Yes
# hata oranı (error rate)

(74+39)/150 
## [1] 0.7533333
# 0.7 gibi bir hata oranı görülmekte ki bu da oldukça çalı gibi bir ağacımız var demek.
# bu da çok fazla varyans olabilir demek.  
# ağacı optimum olarak budamak için cross-validation (cv) kullanalım.
# yanlış sınıflandırmayı minimize etmek istediğimiz için misclassifications'ı fonksiyon olarak seçiyoruz.

cv.Carseats <- cv.tree(tree.Carseats, FUN = prune.misclass) # 10 fold cross-validation
cv.Carseats
## $size
## [1] 21 15 13 11  8  5  4  2  1
## 
## $dev
## [1]  56  54  53  53  56  55  64  85 113
## 
## $k
## [1]      -Inf  0.000000  0.500000  1.000000  1.666667  3.000000  6.000000
## [8] 12.000000 32.000000
## 
## $method
## [1] "misclass"
## 
## attr(,"class")
## [1] "prune"         "tree.sequence"
# cv.tree(), hata oranı ve cost-complexity parametresine karşılık gelen her ağacın uç düğüm sayısını raporlar.

plot(cv.Carseats)

# grafikten en iyi düğüm sayısının 12 ya da 13 olabileceği gözükmekte.
# ağacı tanımlayan 13 büyüklüğnde budama yapalım.


# prune.misclass(Cost-Complexity Pruning Of Tree Object):
# en az önemli olanları yinelemeli olarak keserek bir alt ağaç dizisini belirler.

# 13 büyüklüğünde ağacımızı buduyoruz: 

prune.Carseat <- prune.misclass(tree.Carseats, best = 13)
prune.Carseat
## node), split, n, deviance, yval, (yprob)
##       * denotes terminal node
## 
##  1) root 250 341.400 No ( 0.57200 0.42800 )  
##    2) ShelveLoc: Bad,Medium 194 244.600 No ( 0.67526 0.32474 )  
##      4) Price < 106 72  98.420 Yes ( 0.43056 0.56944 )  
##        8) Age < 63.5 46  50.610 Yes ( 0.23913 0.76087 )  
##         16) CompPrice < 112.5 18  24.730 Yes ( 0.44444 0.55556 )  
##           32) Income < 100.5 13  17.320 No ( 0.61538 0.38462 )  
##             64) Price < 94.5 8  10.590 Yes ( 0.37500 0.62500 ) *
##             65) Price > 94.5 5   0.000 No ( 1.00000 0.00000 ) *
##           33) Income > 100.5 5   0.000 Yes ( 0.00000 1.00000 ) *
##         17) CompPrice > 112.5 28  19.070 Yes ( 0.10714 0.89286 ) *
##        9) Age > 63.5 26  28.090 No ( 0.76923 0.23077 )  
##         18) Income < 96.5 21  13.210 No ( 0.90476 0.09524 ) *
##         19) Income > 96.5 5   5.004 Yes ( 0.20000 0.80000 ) *
##      5) Price > 106 122 115.100 No ( 0.81967 0.18033 )  
##       10) CompPrice < 124.5 39   0.000 No ( 1.00000 0.00000 ) *
##       11) CompPrice > 124.5 83  96.000 No ( 0.73494 0.26506 )  
##         22) Advertising < 13.5 73  71.360 No ( 0.80822 0.19178 )  
##           44) Price < 126.5 32  41.180 No ( 0.65625 0.34375 )  
##             88) Age < 49 14  19.120 Yes ( 0.42857 0.57143 ) *
##             89) Age > 49 18  16.220 No ( 0.83333 0.16667 ) *
##           45) Price > 126.5 41  21.460 No ( 0.92683 0.07317 ) *
##         23) Advertising > 13.5 10  10.010 Yes ( 0.20000 0.80000 ) *
##    3) ShelveLoc: Good 56  58.190 Yes ( 0.21429 0.78571 )  
##      6) Price < 135 48  32.080 Yes ( 0.10417 0.89583 ) *
##      7) Price > 135 8   6.028 No ( 0.87500 0.12500 ) *
# yorumlaması güzel olan sığ ağaçlar elde edelim:

plot(prune.Carseat) 
text(prune.Carseat)

# budanmış ağacı test verisinde değerlendirelim:

tree.prediction2 <- predict(prune.Carseat, Carseats[-train,], type = "class")

# yanlış sınıflandırma tablosu:

with(Carseats[-train,], table(tree.prediction2, HighSales))
##                 HighSales
## tree.prediction2 No Yes
##              No  72  19
##              Yes 21  38
# error rate

(72+38)/150
## [1] 0.7333333
# budama islemi ya da cv süreci tahmin gücünü artırmadı!
# farklı yaklaşımlar denenbilir == boosting, random forest, bagging...)

Veri ayrımı için R caret paketini de kullabiliriz

library(caret)
## Warning: package 'caret' was built under R version 3.6.3
## Loading required package: lattice
# örneklerin yüzde 80'inini eğitim, kalanını test seti olarak ayıralım.


set.seed(101)
train.indices <- createDataPartition(Carseats$HighSales, # sınıfı tanımlayan nitelik
                                     p = .80, # eğitim setinin gözlem oranı
                                     list = FALSE) # sonucun liste olarak dönmemesi için 

# eğitim seti için:

train.data <- Carseats[train.indices,]

# test seti için:

test.data <- Carseats[-train.indices,]

# createDataPartition fonksiyonu ile HighSales'in dağılımı iki veri setinde de aynı olur:

prop.table(table(train.data$HighSales))
## 
##       No      Yes 
## 0.588785 0.411215
prop.table(table(test.data$HighSales))
## 
##        No       Yes 
## 0.5949367 0.4050633
# modeli kuralım:

tree.Carseats2 <- tree(HighSales~., train.data)
summary(tree.Carseats2)
## 
## Classification tree:
## tree(formula = HighSales ~ ., data = train.data)
## Variables actually used in tree construction:
## [1] "ShelveLoc"   "Price"       "CompPrice"   "Education"   "Advertising"
## [6] "Age"         "Income"      "US"         
## Number of terminal nodes:  23 
## Residual mean deviance:  0.4344 = 129.4 / 298 
## Misclassification error rate: 0.08723 = 28 / 321
# ağacı çizelim:

plot(tree.Carseats2)
text(tree.Carseats2, pretty = 0)

# modeli olusturduktan sonra test icin test verisine uygulayalım:

tree.prediction2 <- predict(tree.Carseats2, test.data, type = "class")
tree.prediction2 
##  [1] No  No  Yes No  Yes No  No  No  No  No  No  No  Yes No  No  No  No  No  No 
## [20] Yes No  No  No  No  No  No  No  No  No  Yes No  Yes Yes Yes No  No  No  No 
## [39] No  No  No  Yes Yes Yes Yes No  Yes Yes No  Yes Yes No  No  No  No  Yes No 
## [58] Yes No  No  No  No  No  Yes Yes No  No  No  No  No  No  No  No  No  No  No 
## [77] No  Yes No 
## Levels: No Yes
# agaci budamak icin yine cv hata ölçüsünden yararlanalım:

with(test.data, table(tree.prediction2, HighSales))
##                 HighSales
## tree.prediction2 No Yes
##              No  41  17
##              Yes  6  15
head(tree.prediction2)
## [1] No  No  Yes No  Yes No 
## Levels: No Yes
# error rate

(41+16)/79 
## [1] 0.721519

Değerlendirme Kriterleri

tree.cm <- table(true=test.data$HighSales, predicted=tree.prediction2)
tree.cm
##      predicted
## true  No Yes
##   No  41   6
##   Yes 17  15
# Model değerlendirme ölçülerini görmek için:

compute.eval.metrics <- function(cmatrix) {
  TP <- cmatrix[1,1] # true positive
  TN <- cmatrix[2,2] # true negative
  FP <- cmatrix[2,1] # false positive
  FN <- cmatrix[1,2] # false negative
  acc <- sum(diag(cmatrix)) / sum(cmatrix)
  precision <- TP / (TP + FP)
  recall <- TP / (TP + FN)
  F1 <- 2*precision*recall / (precision + recall)
  c(accuracy = acc, precision = precision, recall = recall, F1 = F1)
}

tree.eval <- compute.eval.metrics(tree.cm)
tree.eval
##  accuracy precision    recall        F1 
## 0.7088608 0.7068966 0.8723404 0.7809524