#Irving Cedillo
Assignment 7
p=seq(0,1,0.0001)
#Gini
G=2*p*(1-p)
#Classification Error
E=1-pmax(p,1-p)
#Entropy
D=-(p*log(p) + (1-p)*log(1-p))
plot(p,D, col="red",ylab="")
lines(p,E,col='green')
lines(p,G,col='blue')
legend(0.3,0.15,c("Entropy", "Missclassification","Gini"),lty=c(1,1,1),lwd=c(2.5,2.5,2.5),col=c('red','green','blue'))
library(ISLR)
attach(Carseats)
str(Carseats)'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 ...#split data into train and test set
library(caret)Warning: package 'caret' was built under R version 4.5.2Loading required package: ggplot2Loading required package: latticelibrary(rsample)
Attaching package: 'rsample'The following object is masked from 'package:caret':
calibrationset.seed(420)
data_split = initial_split(Carseats, prop = 0.75)
training = training(data_split)
testing = testing(data_split)library(rattle)Warning: package 'rattle' was built under R version 4.5.3Loading required package: tibbleLoading required package: bitopsRattle: A free graphical interface for data science with R.
Version 5.6.2 Copyright (c) 2006-2023 Togaware Pty Ltd.
Type 'rattle()' to shake, rattle, and roll your data.library(rpart)
one_tree<- rpart(
Sales~.,
data=training,
method='anova',
control=rpart.control(minsplit=15, cp=0.01)
)
one_treen= 300
node), split, n, deviance, yval
* denotes terminal node
1) root 300 2164.441000 7.522600
2) ShelveLoc=Bad,Medium 237 1321.918000 6.859367
4) Price>=127 68 233.798000 5.216029
8) Price>=155.5 8 30.678890 3.018750 *
9) Price< 155.5 60 159.344900 5.509000
18) CompPrice< 145.5 52 108.234700 5.176731 *
19) CompPrice>=145.5 8 8.053088 7.668750 *
5) Price< 127 169 830.591700 7.520592
10) Age>=50.5 103 446.428800 6.858641
20) Price>=89.5 87 307.339000 6.497126
40) ShelveLoc=Bad 25 74.280820 5.184400 *
41) ShelveLoc=Medium 62 172.605400 7.026452
82) CompPrice< 121.5 35 61.272910 6.337143
164) Price>=101.5 19 13.545460 5.585789 *
165) Price< 101.5 16 24.264090 7.229375 *
83) CompPrice>=121.5 27 73.144800 7.920000
166) Advertising< 6 15 32.332890 6.902667 *
167) Advertising>=6 12 5.881767 9.191667 *
21) Price< 89.5 16 65.893790 8.824375
42) Income< 103 11 28.234620 7.877273 *
43) Income>=103 5 6.084680 10.908000 *
11) Age< 50.5 66 268.596500 8.553636
22) CompPrice< 132.5 51 193.212000 8.080784
44) Price>=103.5 27 80.891390 7.300741
88) Advertising< 11 18 41.373690 6.609444 *
89) Advertising>=11 9 13.711600 8.683333 *
45) Price< 103.5 24 77.409730 8.958333 *
23) CompPrice>=132.5 15 25.211170 10.161330 *
3) ShelveLoc=Good 63 346.089700 10.017620
6) Price>=135 13 52.860720 7.575385 *
7) Price< 135 50 195.530400 10.652600
14) Price>=109.5 30 101.087900 9.869667
28) CompPrice< 121.5 10 13.690840 8.344000 *
29) CompPrice>=121.5 20 52.482180 10.632500
58) Age>=61.5 8 14.016400 9.330000 *
59) Age< 61.5 12 15.845690 11.500830 *
15) Price< 109.5 20 48.468620 11.827000 *fancyRpartPlot(one_tree)
summary(one_tree)Call:
rpart(formula = Sales ~ ., data = training, method = "anova",
control = rpart.control(minsplit = 15, cp = 0.01))
n= 300
CP nsplit rel error xerror xstd
1 0.22935882 0 1.0000000 1.0070348 0.07647436
2 0.11898122 1 0.7706412 0.7834015 0.06044015
3 0.05339319 2 0.6516600 0.7347905 0.05729078
4 0.04513806 3 0.5982668 0.7297357 0.05688703
5 0.03381752 4 0.5531287 0.7003548 0.05397576
6 0.02792996 5 0.5193112 0.6870442 0.05181216
7 0.02318076 6 0.4913812 0.6828809 0.04949177
8 0.02124052 7 0.4682005 0.6669323 0.04785102
9 0.02022425 8 0.4469600 0.6508346 0.04590742
10 0.01989295 9 0.4267357 0.6530759 0.04558939
11 0.01764322 10 0.4068428 0.6746540 0.04709305
12 0.01613818 11 0.3891995 0.6400347 0.04573562
13 0.01613113 12 0.3730614 0.6470458 0.04643684
14 0.01612927 13 0.3569302 0.6470458 0.04643684
15 0.01458783 14 0.3408010 0.6379534 0.04577285
16 0.01192275 15 0.3262131 0.6162214 0.04575636
17 0.01084038 16 0.3142904 0.6118530 0.04495968
18 0.01045077 17 0.3034500 0.5997696 0.04359850
19 0.01000000 18 0.2929992 0.5924067 0.04284178
Variable importance
Price ShelveLoc CompPrice Age Advertising Income
33 29 15 9 4 4
US Population Education Urban
2 2 1 1
Node number 1: 300 observations, complexity param=0.2293588
mean=7.5226, MSE=7.214803
left son=2 (237 obs) right son=3 (63 obs)
Primary splits:
ShelveLoc splits as LRL, improve=0.22935880, (0 missing)
Price < 89.5 to the right, improve=0.12430060, (0 missing)
Advertising < 7.5 to the left, improve=0.06733414, (0 missing)
Age < 63.5 to the right, improve=0.05179969, (0 missing)
Income < 60.5 to the left, improve=0.04258192, (0 missing)
Surrogate splits:
Income < 23 to the right, agree=0.793, adj=0.016, (0 split)
Node number 2: 237 observations, complexity param=0.1189812
mean=6.859367, MSE=5.577711
left son=4 (68 obs) right son=5 (169 obs)
Primary splits:
Price < 127 to the right, improve=0.19481380, (0 missing)
ShelveLoc splits as L-R, improve=0.08941319, (0 missing)
Advertising < 7.5 to the left, improve=0.08149945, (0 missing)
Income < 60.5 to the left, improve=0.05543100, (0 missing)
Age < 68.5 to the right, improve=0.05284529, (0 missing)
Surrogate splits:
CompPrice < 135.5 to the right, agree=0.768, adj=0.191, (0 split)
Age < 25.5 to the left, agree=0.717, adj=0.015, (0 split)
Node number 3: 63 observations, complexity param=0.04513806
mean=10.01762, MSE=5.493488
left son=6 (13 obs) right son=7 (50 obs)
Primary splits:
Price < 135 to the right, improve=0.28229280, (0 missing)
Age < 61.5 to the right, improve=0.12915300, (0 missing)
Advertising < 14 to the left, improve=0.10056180, (0 missing)
Income < 42.5 to the left, improve=0.07675283, (0 missing)
Population < 91 to the right, improve=0.07521338, (0 missing)
Surrogate splits:
CompPrice < 150 to the right, agree=0.825, adj=0.154, (0 split)
Node number 4: 68 observations, complexity param=0.02022425
mean=5.216029, MSE=3.438206
left son=8 (8 obs) right son=9 (60 obs)
Primary splits:
Price < 155.5 to the right, improve=0.18723080, (0 missing)
CompPrice < 147.5 to the left, improve=0.17375110, (0 missing)
Age < 76.5 to the right, improve=0.11541240, (0 missing)
Income < 83.5 to the left, improve=0.10578220, (0 missing)
ShelveLoc splits as L-R, improve=0.08908628, (0 missing)
Surrogate splits:
Income < 24.5 to the left, agree=0.912, adj=0.250, (0 split)
CompPrice < 156 to the right, agree=0.897, adj=0.125, (0 split)
Node number 5: 169 observations, complexity param=0.05339319
mean=7.520592, MSE=4.914744
left son=10 (103 obs) right son=11 (66 obs)
Primary splits:
Age < 50.5 to the right, improve=0.13913740, (0 missing)
Price < 94.5 to the right, improve=0.12135310, (0 missing)
CompPrice < 124.5 to the left, improve=0.12113240, (0 missing)
Advertising < 7.5 to the left, improve=0.11214660, (0 missing)
ShelveLoc splits as L-R, improve=0.09910288, (0 missing)
Surrogate splits:
Price < 118.5 to the left, agree=0.651, adj=0.106, (0 split)
CompPrice < 124.5 to the left, agree=0.639, adj=0.076, (0 split)
Urban splits as RL, agree=0.633, adj=0.061, (0 split)
Advertising < 17.5 to the left, agree=0.627, adj=0.045, (0 split)
Population < 361.5 to the left, agree=0.615, adj=0.015, (0 split)
Node number 6: 13 observations
mean=7.575385, MSE=4.066209
Node number 7: 50 observations, complexity param=0.02124052
mean=10.6526, MSE=3.910607
left son=14 (30 obs) right son=15 (20 obs)
Primary splits:
Price < 109.5 to the right, improve=0.23512380, (0 missing)
Age < 61.5 to the right, improve=0.14808290, (0 missing)
CompPrice < 133.5 to the left, improve=0.13387200, (0 missing)
Advertising < 16.5 to the left, improve=0.07975360, (0 missing)
Population < 67 to the right, improve=0.06733118, (0 missing)
Surrogate splits:
CompPrice < 113.5 to the right, agree=0.72, adj=0.30, (0 split)
Population < 57 to the right, agree=0.68, adj=0.20, (0 split)
Age < 73.5 to the left, agree=0.66, adj=0.15, (0 split)
Education < 12.5 to the right, agree=0.66, adj=0.15, (0 split)
Income < 30.5 to the right, agree=0.62, adj=0.05, (0 split)
Node number 8: 8 observations
mean=3.01875, MSE=3.834861
Node number 9: 60 observations, complexity param=0.01989295
mean=5.509, MSE=2.655749
left son=18 (52 obs) right son=19 (8 obs)
Primary splits:
CompPrice < 145.5 to the left, improve=0.27021320, (0 missing)
ShelveLoc splits as L-R, improve=0.12228800, (0 missing)
Advertising < 4.5 to the left, improve=0.10232230, (0 missing)
Education < 17.5 to the left, improve=0.08939600, (0 missing)
Population < 492 to the right, improve=0.08491441, (0 missing)
Surrogate splits:
Age < 27.5 to the right, agree=0.883, adj=0.125, (0 split)
Node number 10: 103 observations, complexity param=0.03381752
mean=6.858641, MSE=4.33426
left son=20 (87 obs) right son=21 (16 obs)
Primary splits:
Price < 89.5 to the right, improve=0.16395900, (0 missing)
Advertising < 7.5 to the left, improve=0.13796410, (0 missing)
ShelveLoc splits as L-R, improve=0.13477040, (0 missing)
CompPrice < 123.5 to the left, improve=0.08104175, (0 missing)
Income < 96.5 to the left, improve=0.06480818, (0 missing)
Node number 11: 66 observations, complexity param=0.02318076
mean=8.553636, MSE=4.069644
left son=22 (51 obs) right son=23 (15 obs)
Primary splits:
CompPrice < 132.5 to the left, improve=0.18679830, (0 missing)
Price < 105 to the right, improve=0.16940130, (0 missing)
Income < 61.5 to the left, improve=0.14614830, (0 missing)
ShelveLoc splits as L-R, improve=0.08820555, (0 missing)
US splits as LR, improve=0.08277259, (0 missing)
Node number 14: 30 observations, complexity param=0.01613113
mean=9.869667, MSE=3.369597
left son=28 (10 obs) right son=29 (20 obs)
Primary splits:
CompPrice < 121.5 to the left, improve=0.3453913, (0 missing)
Advertising < 14 to the left, improve=0.3068468, (0 missing)
Income < 40.5 to the left, improve=0.2232514, (0 missing)
Age < 61 to the right, improve=0.2153965, (0 missing)
Population < 351 to the left, improve=0.1657123, (0 missing)
Surrogate splits:
Income < 40.5 to the left, agree=0.733, adj=0.2, (0 split)
Price < 111 to the left, agree=0.733, adj=0.2, (0 split)
Node number 15: 20 observations
mean=11.827, MSE=2.423431
Node number 18: 52 observations
mean=5.176731, MSE=2.081437
Node number 19: 8 observations
mean=7.66875, MSE=1.006636
Node number 20: 87 observations, complexity param=0.02792996
mean=6.497126, MSE=3.532632
left son=40 (25 obs) right son=41 (62 obs)
Primary splits:
ShelveLoc splits as L-R, improve=0.19669730, (0 missing)
CompPrice < 123.5 to the left, improve=0.19335060, (0 missing)
Advertising < 13.5 to the left, improve=0.08561502, (0 missing)
Age < 73.5 to the right, improve=0.05791727, (0 missing)
Price < 108.5 to the right, improve=0.04839484, (0 missing)
Surrogate splits:
CompPrice < 152.5 to the right, agree=0.736, adj=0.08, (0 split)
Node number 21: 16 observations, complexity param=0.01458783
mean=8.824375, MSE=4.118362
left son=42 (11 obs) right son=43 (5 obs)
Primary splits:
Income < 103 to the left, improve=0.47917250, (0 missing)
Advertising < 6.5 to the left, improve=0.26803820, (0 missing)
ShelveLoc splits as L-R, improve=0.14794370, (0 missing)
Price < 80.5 to the right, improve=0.08578207, (0 missing)
Education < 13 to the right, improve=0.06072663, (0 missing)
Surrogate splits:
Price < 68.5 to the right, agree=0.812, adj=0.4, (0 split)
Node number 22: 51 observations, complexity param=0.01612927
mean=8.080784, MSE=3.78847
left son=44 (27 obs) right son=45 (24 obs)
Primary splits:
Price < 103.5 to the right, improve=0.18068680, (0 missing)
Income < 66.5 to the left, improve=0.14808970, (0 missing)
US splits as LR, improve=0.13580020, (0 missing)
Advertising < 0.5 to the left, improve=0.12927790, (0 missing)
ShelveLoc splits as L-R, improve=0.08021555, (0 missing)
Surrogate splits:
CompPrice < 108 to the right, agree=0.725, adj=0.417, (0 split)
Age < 32.5 to the left, agree=0.647, adj=0.250, (0 split)
Income < 40 to the right, agree=0.588, adj=0.125, (0 split)
Population < 371.5 to the left, agree=0.588, adj=0.125, (0 split)
ShelveLoc splits as R-L, agree=0.588, adj=0.125, (0 split)
Node number 23: 15 observations
mean=10.16133, MSE=1.680745
Node number 28: 10 observations
mean=8.344, MSE=1.369084
Node number 29: 20 observations, complexity param=0.01045077
mean=10.6325, MSE=2.624109
left son=58 (8 obs) right son=59 (12 obs)
Primary splits:
Age < 61.5 to the right, improve=0.4310051, (0 missing)
Advertising < 14 to the left, improve=0.2963871, (0 missing)
Population < 185 to the left, improve=0.1764234, (0 missing)
Income < 49 to the left, improve=0.1658095, (0 missing)
CompPrice < 133.5 to the left, improve=0.1476716, (0 missing)
Surrogate splits:
Advertising < 0.5 to the left, agree=0.70, adj=0.250, (0 split)
Education < 16.5 to the right, agree=0.70, adj=0.250, (0 split)
Income < 43 to the left, agree=0.65, adj=0.125, (0 split)
Population < 168 to the left, agree=0.65, adj=0.125, (0 split)
US splits as LR, agree=0.65, adj=0.125, (0 split)
Node number 40: 25 observations
mean=5.1844, MSE=2.971233
Node number 41: 62 observations, complexity param=0.01764322
mean=7.026452, MSE=2.783958
left son=82 (35 obs) right son=83 (27 obs)
Primary splits:
CompPrice < 121.5 to the left, improve=0.22124280, (0 missing)
Advertising < 6.5 to the left, improve=0.13831550, (0 missing)
Price < 108.5 to the right, improve=0.07986785, (0 missing)
Age < 65.5 to the right, improve=0.06507368, (0 missing)
Population < 431 to the left, improve=0.06478684, (0 missing)
Surrogate splits:
Price < 111.5 to the left, agree=0.726, adj=0.370, (0 split)
Income < 25.5 to the right, agree=0.629, adj=0.148, (0 split)
Advertising < 10.5 to the left, agree=0.629, adj=0.148, (0 split)
Age < 58.5 to the right, agree=0.629, adj=0.148, (0 split)
Population < 431 to the left, agree=0.581, adj=0.037, (0 split)
Node number 42: 11 observations
mean=7.877273, MSE=2.566783
Node number 43: 5 observations
mean=10.908, MSE=1.216936
Node number 44: 27 observations, complexity param=0.01192275
mean=7.300741, MSE=2.995977
left son=88 (18 obs) right son=89 (9 obs)
Primary splits:
Advertising < 11 to the left, improve=0.3190215, (0 missing)
CompPrice < 115.5 to the left, improve=0.3106700, (0 missing)
US splits as LR, improve=0.2467620, (0 missing)
Income < 98 to the left, improve=0.2122268, (0 missing)
Population < 121 to the left, improve=0.1804956, (0 missing)
Surrogate splits:
US splits as LR, agree=0.815, adj=0.444, (0 split)
CompPrice < 104.5 to the right, agree=0.741, adj=0.222, (0 split)
Income < 75.5 to the left, agree=0.741, adj=0.222, (0 split)
Price < 109.5 to the right, agree=0.704, adj=0.111, (0 split)
Education < 10.5 to the right, agree=0.704, adj=0.111, (0 split)
Node number 45: 24 observations
mean=8.958333, MSE=3.225406
Node number 58: 8 observations
mean=9.33, MSE=1.75205
Node number 59: 12 observations
mean=11.50083, MSE=1.320474
Node number 82: 35 observations, complexity param=0.01084038
mean=6.337143, MSE=1.750655
left son=164 (19 obs) right son=165 (16 obs)
Primary splits:
Price < 101.5 to the right, improve=0.38293200, (0 missing)
Age < 60.5 to the right, improve=0.09270468, (0 missing)
Advertising < 2.5 to the right, improve=0.08935337, (0 missing)
CompPrice < 107 to the left, improve=0.07910772, (0 missing)
Income < 81 to the left, improve=0.05989671, (0 missing)
Surrogate splits:
Advertising < 2.5 to the right, agree=0.686, adj=0.313, (0 split)
Income < 77 to the left, agree=0.657, adj=0.250, (0 split)
Age < 61.5 to the right, agree=0.657, adj=0.250, (0 split)
Urban splits as RL, agree=0.657, adj=0.250, (0 split)
CompPrice < 105 to the right, agree=0.600, adj=0.125, (0 split)
Node number 83: 27 observations, complexity param=0.01613818
mean=7.92, MSE=2.709067
left son=166 (15 obs) right son=167 (12 obs)
Primary splits:
Advertising < 6 to the left, improve=0.4775478, (0 missing)
Price < 115.5 to the right, improve=0.3687783, (0 missing)
Population < 419 to the left, improve=0.2452742, (0 missing)
Age < 74.5 to the right, improve=0.1880624, (0 missing)
Education < 16.5 to the right, improve=0.1249212, (0 missing)
Surrogate splits:
US splits as LR, agree=0.815, adj=0.583, (0 split)
Price < 115.5 to the right, agree=0.741, adj=0.417, (0 split)
Population < 348 to the left, agree=0.704, adj=0.333, (0 split)
Education < 10.5 to the right, agree=0.704, adj=0.333, (0 split)
Age < 71 to the right, agree=0.667, adj=0.250, (0 split)
Node number 88: 18 observations
mean=6.609444, MSE=2.298539
Node number 89: 9 observations
mean=8.683333, MSE=1.523511
Node number 164: 19 observations
mean=5.585789, MSE=0.7129191
Node number 165: 16 observations
mean=7.229375, MSE=1.516506
Node number 166: 15 observations
mean=6.902667, MSE=2.155526
Node number 167: 12 observations
mean=9.191667, MSE=0.4901472 From the root mse , we see that the model is off by an average of 1.96, or in the units of the data, off by 1,960 carseats per store.
test_predictions<-predict(one_tree, newdata = testing)
test_mse <- mean((testing$Sales - test_predictions)^2)
cat('Test MSE:',test_mse,'\n')Test MSE: 4.833786 cat('Test RMSE:',sqrt(test_mse),'\n')Test RMSE: 2.198587 printcp(one_tree)
Regression tree:
rpart(formula = Sales ~ ., data = training, method = "anova",
control = rpart.control(minsplit = 15, cp = 0.01))
Variables actually used in tree construction:
[1] Advertising Age CompPrice Income Price ShelveLoc
Root node error: 2164.4/300 = 7.2148
n= 300
CP nsplit rel error xerror xstd
1 0.229359 0 1.00000 1.00703 0.076474
2 0.118981 1 0.77064 0.78340 0.060440
3 0.053393 2 0.65166 0.73479 0.057291
4 0.045138 3 0.59827 0.72974 0.056887
5 0.033818 4 0.55313 0.70035 0.053976
6 0.027930 5 0.51931 0.68704 0.051812
7 0.023181 6 0.49138 0.68288 0.049492
8 0.021241 7 0.46820 0.66693 0.047851
9 0.020224 8 0.44696 0.65083 0.045907
10 0.019893 9 0.42674 0.65308 0.045589
11 0.017643 10 0.40684 0.67465 0.047093
12 0.016138 11 0.38920 0.64003 0.045736
13 0.016131 12 0.37306 0.64705 0.046437
14 0.016129 13 0.35693 0.64705 0.046437
15 0.014588 14 0.34080 0.63795 0.045773
16 0.011923 15 0.32621 0.61622 0.045756
17 0.010840 16 0.31429 0.61185 0.044960
18 0.010451 17 0.30345 0.59977 0.043599
19 0.010000 18 0.29300 0.59241 0.042842plotcp(one_tree)
cat('Optimum cp value: ')Optimum cp value: one_tree$cptable[which.min(one_tree$cptable[,"xerror"]),"CP"][1] 0.01tree_prune=prune(one_tree,cp=one_tree$cptable[which.min(one_tree$cptable[,"xerror"]),"CP"])
fancyRpartPlot(tree_prune, uniform=TRUE, main="Absolute Min CP Tree")
test_mse = mean((testing$Sales - predict(tree_prune, testing))^2)
cat('\nTest MSE: ', test_mse)
Test MSE: 4.833786car_seat_bag = train(Sales~.,
data=training,
method='treebag',
trControl=trainControl('cv',number=10)
)
#view importance of variables
varImp(car_seat_bag)treebag variable importance
Overall
Price 100.000
CompPrice 79.521
Age 74.486
Income 72.272
Advertising 65.542
Population 47.761
ShelveLocMedium 37.087
Education 27.919
USYes 9.137
ShelveLocGood 4.484
UrbanYes 0.000#plot iportance level
plot(varImp(car_seat_bag))
test_mse = mean((testing$Sales - predict(car_seat_bag, testing))^2)
cat('\nTest MSE: ', test_mse)
Test MSE: 3.899382car_seat_rf = train(Sales~.,
data=training,
method='rf',
trControl=trainControl('cv',number=10),
importance=TRUE)
car_seat_rf$bestTune mtry
3 11#final best model
car_seat_rf$finalModel
Call:
randomForest(x = x, y = y, mtry = param$mtry, importance = TRUE)
Type of random forest: regression
Number of trees: 500
No. of variables tried at each split: 11
Mean of squared residuals: 2.425581
% Var explained: 66.38#view importance of variables
varImp(car_seat_rf)rf variable importance
Overall
Price 100.000
ShelveLocGood 90.205
CompPrice 44.448
Advertising 31.680
ShelveLocMedium 28.492
Age 22.572
Income 20.118
USYes 5.484
Education 5.414
Population 3.703
UrbanYes 0.000#plot iportance level
plot(varImp(car_seat_rf))
test_mse = mean((testing$Sales - predict(car_seat_rf, testing))^2)
cat('\nTest MSE: ', test_mse)
Test MSE: 3.082109library(BART)Warning: package 'BART' was built under R version 4.5.3Loading required package: nlmeLoading required package: survival
Attaching package: 'survival'The following object is masked from 'package:caret':
clusterx_train=model.matrix(Sales ~ ., data = training)[, -1]
x_test=model.matrix(Sales ~ ., data = testing)[, -1]
y_train=training$Sales
y_test=testing$Sales
car_seat_bart = gbart(x.train = x_train,
y.train = y_train,
x.test = x_test) *****Calling gbart: type=1
*****Data:
data:n,p,np: 300, 11, 100
y1,yn: 0.147400, -2.162600
x1,x[n*p]: 129.000000, 0.000000
xp1,xp[np*p]: 141.000000, 1.000000
*****Number of Trees: 200
*****Number of Cut Points: 67 ... 1
*****burn,nd,thin: 100,1000,1
*****Prior:beta,alpha,tau,nu,lambda,offset: 2,0.95,0.263397,3,0.200899,7.5226
*****sigma: 1.015556
*****w (weights): 1.000000 ... 1.000000
*****Dirichlet:sparse,theta,omega,a,b,rho,augment: 0,0,1,0.5,1,11,0
*****printevery: 100
MCMC
done 0 (out of 1100)
done 100 (out of 1100)
done 200 (out of 1100)
done 300 (out of 1100)
done 400 (out of 1100)
done 500 (out of 1100)
done 600 (out of 1100)
done 700 (out of 1100)
done 800 (out of 1100)
done 900 (out of 1100)
done 1000 (out of 1100)
time: 6s
trcnt,tecnt: 1000,1000test_mse_bart = mean((y_test - car_seat_bart$yhat.test.mean)^2)
cat('\nTest MSE: ', test_mse_bart, '\n')
Test MSE: 1.331761 bart_importance=car_seat_bart$varcount.mean
print(sort(bart_importance)) Advertising Income Age UrbanYes USYes
18.589 19.607 19.636 20.397 20.878
Population ShelveLocMedium Education CompPrice ShelveLocGood
21.257 21.288 21.590 22.141 22.885
Price
31.492 barplot(car_seat_bart$varcount.mean, las = 2, main = "BART Importance")
library(ISLR)
set.seed(420)
attach(OJ)
train_idx<-sample(1:nrow(OJ), 800)
training_oj<- OJ[train_idx, ]
testing_oj<- OJ[-train_idx, ]
str(OJ)'data.frame': 1070 obs. of 18 variables:
$ Purchase : Factor w/ 2 levels "CH","MM": 1 1 1 2 1 1 1 1 1 1 ...
$ WeekofPurchase: num 237 239 245 227 228 230 232 234 235 238 ...
$ StoreID : num 1 1 1 1 7 7 7 7 7 7 ...
$ PriceCH : num 1.75 1.75 1.86 1.69 1.69 1.69 1.69 1.75 1.75 1.75 ...
$ PriceMM : num 1.99 1.99 2.09 1.69 1.69 1.99 1.99 1.99 1.99 1.99 ...
$ DiscCH : num 0 0 0.17 0 0 0 0 0 0 0 ...
$ DiscMM : num 0 0.3 0 0 0 0 0.4 0.4 0.4 0.4 ...
$ SpecialCH : num 0 0 0 0 0 0 1 1 0 0 ...
$ SpecialMM : num 0 1 0 0 0 1 1 0 0 0 ...
$ LoyalCH : num 0.5 0.6 0.68 0.4 0.957 ...
$ SalePriceMM : num 1.99 1.69 2.09 1.69 1.69 1.99 1.59 1.59 1.59 1.59 ...
$ SalePriceCH : num 1.75 1.75 1.69 1.69 1.69 1.69 1.69 1.75 1.75 1.75 ...
$ PriceDiff : num 0.24 -0.06 0.4 0 0 0.3 -0.1 -0.16 -0.16 -0.16 ...
$ Store7 : Factor w/ 2 levels "No","Yes": 1 1 1 1 2 2 2 2 2 2 ...
$ PctDiscMM : num 0 0.151 0 0 0 ...
$ PctDiscCH : num 0 0 0.0914 0 0 ...
$ ListPriceDiff : num 0.24 0.24 0.23 0 0 0.3 0.3 0.24 0.24 0.24 ...
$ STORE : num 1 1 1 1 0 0 0 0 0 0 ...summary(OJ) Purchase WeekofPurchase StoreID PriceCH PriceMM
CH:653 Min. :227.0 Min. :1.00 Min. :1.690 Min. :1.690
MM:417 1st Qu.:240.0 1st Qu.:2.00 1st Qu.:1.790 1st Qu.:1.990
Median :257.0 Median :3.00 Median :1.860 Median :2.090
Mean :254.4 Mean :3.96 Mean :1.867 Mean :2.085
3rd Qu.:268.0 3rd Qu.:7.00 3rd Qu.:1.990 3rd Qu.:2.180
Max. :278.0 Max. :7.00 Max. :2.090 Max. :2.290
DiscCH DiscMM SpecialCH SpecialMM
Min. :0.00000 Min. :0.0000 Min. :0.0000 Min. :0.0000
1st Qu.:0.00000 1st Qu.:0.0000 1st Qu.:0.0000 1st Qu.:0.0000
Median :0.00000 Median :0.0000 Median :0.0000 Median :0.0000
Mean :0.05186 Mean :0.1234 Mean :0.1477 Mean :0.1617
3rd Qu.:0.00000 3rd Qu.:0.2300 3rd Qu.:0.0000 3rd Qu.:0.0000
Max. :0.50000 Max. :0.8000 Max. :1.0000 Max. :1.0000
LoyalCH SalePriceMM SalePriceCH PriceDiff Store7
Min. :0.000011 Min. :1.190 Min. :1.390 Min. :-0.6700 No :714
1st Qu.:0.325257 1st Qu.:1.690 1st Qu.:1.750 1st Qu.: 0.0000 Yes:356
Median :0.600000 Median :2.090 Median :1.860 Median : 0.2300
Mean :0.565782 Mean :1.962 Mean :1.816 Mean : 0.1465
3rd Qu.:0.850873 3rd Qu.:2.130 3rd Qu.:1.890 3rd Qu.: 0.3200
Max. :0.999947 Max. :2.290 Max. :2.090 Max. : 0.6400
PctDiscMM PctDiscCH ListPriceDiff STORE
Min. :0.0000 Min. :0.00000 Min. :0.000 Min. :0.000
1st Qu.:0.0000 1st Qu.:0.00000 1st Qu.:0.140 1st Qu.:0.000
Median :0.0000 Median :0.00000 Median :0.240 Median :2.000
Mean :0.0593 Mean :0.02731 Mean :0.218 Mean :1.631
3rd Qu.:0.1127 3rd Qu.:0.00000 3rd Qu.:0.300 3rd Qu.:3.000
Max. :0.4020 Max. :0.25269 Max. :0.440 Max. :4.000 oj_tree <- rpart(
Purchase~.,
data = training_oj,
method='class'
)
train_preds_class <- predict(oj_tree, type = 'class')
train_misclass_error <- mean(training_oj$Purchase != train_preds_class)
cat('Training Misclassification Rate:', train_misclass_error, '\n')Training Misclassification Rate: 0.15 summary(oj_tree)Call:
rpart(formula = Purchase ~ ., data = training_oj, method = "class")
n= 800
CP nsplit rel error xerror xstd
1 0.50825083 0 1.0000000 1.0000000 0.04528057
2 0.01430143 1 0.4917492 0.5247525 0.03725117
3 0.01320132 4 0.4488449 0.5148515 0.03698432
4 0.01155116 5 0.4356436 0.5181518 0.03707385
5 0.01000000 8 0.3960396 0.5049505 0.03671219
Variable importance
LoyalCH PriceDiff SalePriceMM PctDiscMM DiscMM
59 10 7 5 4
ListPriceDiff PriceMM WeekofPurchase PriceCH STORE
4 4 4 1 1
StoreID
1
Node number 1: 800 observations, complexity param=0.5082508
predicted class=CH expected loss=0.37875 P(node) =1
class counts: 497 303
probabilities: 0.621 0.379
left son=2 (506 obs) right son=3 (294 obs)
Primary splits:
LoyalCH < 0.48285 to the right, improve=136.47880, (0 missing)
StoreID < 3.5 to the right, improve= 34.24055, (0 missing)
PriceDiff < 0.015 to the right, improve= 23.60828, (0 missing)
SalePriceMM < 1.84 to the right, improve= 18.86534, (0 missing)
Store7 splits as RL, improve= 18.12516, (0 missing)
Surrogate splits:
DiscMM < 0.57 to the left, agree=0.641, adj=0.024, (0 split)
PctDiscMM < 0.264375 to the left, agree=0.641, adj=0.024, (0 split)
PriceMM < 1.74 to the right, agree=0.640, adj=0.020, (0 split)
SalePriceMM < 1.435 to the right, agree=0.640, adj=0.020, (0 split)
PriceDiff < -0.485 to the right, agree=0.640, adj=0.020, (0 split)
Node number 2: 506 observations, complexity param=0.01430143
predicted class=CH expected loss=0.1561265 P(node) =0.6325
class counts: 427 79
probabilities: 0.844 0.156
left son=4 (299 obs) right son=5 (207 obs)
Primary splits:
LoyalCH < 0.705699 to the right, improve=15.392220, (0 missing)
PriceDiff < 0.015 to the right, improve=11.981540, (0 missing)
SalePriceMM < 1.84 to the right, improve= 9.663327, (0 missing)
ListPriceDiff < 0.255 to the right, improve= 7.579536, (0 missing)
PctDiscMM < 0.1155095 to the left, improve= 5.497316, (0 missing)
Surrogate splits:
WeekofPurchase < 237.5 to the right, agree=0.642, adj=0.126, (0 split)
PriceCH < 1.755 to the right, agree=0.638, adj=0.116, (0 split)
PriceMM < 2.04 to the right, agree=0.630, adj=0.097, (0 split)
SalePriceMM < 1.64 to the right, agree=0.609, adj=0.043, (0 split)
PctDiscMM < 0.1961965 to the left, agree=0.597, adj=0.014, (0 split)
Node number 3: 294 observations, complexity param=0.01155116
predicted class=MM expected loss=0.2380952 P(node) =0.3675
class counts: 70 224
probabilities: 0.238 0.762
left son=6 (129 obs) right son=7 (165 obs)
Primary splits:
LoyalCH < 0.2761415 to the right, improve=10.274840, (0 missing)
PriceDiff < 0.54 to the right, improve= 5.469108, (0 missing)
DiscCH < 0.335 to the right, improve= 4.816667, (0 missing)
PctDiscCH < 0.18822 to the right, improve= 4.816667, (0 missing)
STORE < 1.5 to the left, improve= 4.736842, (0 missing)
Surrogate splits:
STORE < 1.5 to the left, agree=0.636, adj=0.171, (0 split)
StoreID < 3.5 to the right, agree=0.622, adj=0.140, (0 split)
SalePriceCH < 1.72 to the left, agree=0.602, adj=0.093, (0 split)
DiscCH < 0.335 to the right, agree=0.588, adj=0.062, (0 split)
PctDiscCH < 0.18822 to the right, agree=0.588, adj=0.062, (0 split)
Node number 4: 299 observations
predicted class=CH expected loss=0.05351171 P(node) =0.37375
class counts: 283 16
probabilities: 0.946 0.054
Node number 5: 207 observations, complexity param=0.01430143
predicted class=CH expected loss=0.3043478 P(node) =0.25875
class counts: 144 63
probabilities: 0.696 0.304
left son=10 (79 obs) right son=11 (128 obs)
Primary splits:
PriceDiff < 0.265 to the right, improve=13.32919, (0 missing)
ListPriceDiff < 0.235 to the right, improve=12.76067, (0 missing)
SalePriceMM < 2.125 to the right, improve=10.79035, (0 missing)
DiscMM < 0.15 to the left, improve= 5.64394, (0 missing)
PctDiscMM < 0.0729725 to the left, improve= 5.64394, (0 missing)
Surrogate splits:
ListPriceDiff < 0.255 to the right, agree=0.855, adj=0.620, (0 split)
SalePriceMM < 2.125 to the right, agree=0.802, adj=0.481, (0 split)
DiscMM < 0.03 to the left, agree=0.729, adj=0.291, (0 split)
PctDiscMM < 0.0137615 to the left, agree=0.729, adj=0.291, (0 split)
PriceMM < 2.155 to the right, agree=0.671, adj=0.139, (0 split)
Node number 6: 129 observations, complexity param=0.01155116
predicted class=MM expected loss=0.3875969 P(node) =0.16125
class counts: 50 79
probabilities: 0.388 0.612
left son=12 (61 obs) right son=13 (68 obs)
Primary splits:
SalePriceMM < 2.04 to the right, improve=6.671361, (0 missing)
PriceDiff < 0.05 to the right, improve=5.832664, (0 missing)
DiscMM < 0.22 to the left, improve=3.722361, (0 missing)
DiscCH < 0.27 to the right, improve=3.475353, (0 missing)
SalePriceCH < 1.54 to the left, improve=3.475353, (0 missing)
Surrogate splits:
PriceDiff < 0.15 to the right, agree=0.899, adj=0.787, (0 split)
PriceMM < 2.04 to the right, agree=0.806, adj=0.590, (0 split)
DiscMM < 0.08 to the left, agree=0.806, adj=0.590, (0 split)
PctDiscMM < 0.038887 to the left, agree=0.806, adj=0.590, (0 split)
WeekofPurchase < 243.5 to the right, agree=0.729, adj=0.426, (0 split)
Node number 7: 165 observations
predicted class=MM expected loss=0.1212121 P(node) =0.20625
class counts: 20 145
probabilities: 0.121 0.879
Node number 10: 79 observations
predicted class=CH expected loss=0.07594937 P(node) =0.09875
class counts: 73 6
probabilities: 0.924 0.076
Node number 11: 128 observations, complexity param=0.01430143
predicted class=CH expected loss=0.4453125 P(node) =0.16
class counts: 71 57
probabilities: 0.555 0.445
left son=22 (101 obs) right son=23 (27 obs)
Primary splits:
PriceDiff < -0.165 to the right, improve=5.972916, (0 missing)
ListPriceDiff < 0.155 to the right, improve=4.959375, (0 missing)
SalePriceMM < 2.155 to the right, improve=2.875979, (0 missing)
DiscCH < 0.15 to the right, improve=2.586917, (0 missing)
PctDiscCH < 0.0729725 to the right, improve=2.586917, (0 missing)
Surrogate splits:
SalePriceMM < 1.585 to the right, agree=0.867, adj=0.370, (0 split)
DiscMM < 0.57 to the left, agree=0.836, adj=0.222, (0 split)
PctDiscMM < 0.264375 to the left, agree=0.836, adj=0.222, (0 split)
WeekofPurchase < 274.5 to the left, agree=0.828, adj=0.185, (0 split)
SpecialMM < 0.5 to the left, agree=0.812, adj=0.111, (0 split)
Node number 12: 61 observations, complexity param=0.01155116
predicted class=CH expected loss=0.442623 P(node) =0.07625
class counts: 34 27
probabilities: 0.557 0.443
left son=24 (52 obs) right son=25 (9 obs)
Primary splits:
WeekofPurchase < 244.5 to the right, improve=2.371865, (0 missing)
PriceMM < 2.205 to the left, improve=2.174724, (0 missing)
SalePriceMM < 2.205 to the left, improve=2.174724, (0 missing)
STORE < 2.5 to the left, improve=1.442805, (0 missing)
SalePriceCH < 1.62 to the left, improve=1.025711, (0 missing)
Node number 13: 68 observations
predicted class=MM expected loss=0.2352941 P(node) =0.085
class counts: 16 52
probabilities: 0.235 0.765
Node number 22: 101 observations, complexity param=0.01320132
predicted class=CH expected loss=0.3663366 P(node) =0.12625
class counts: 64 37
probabilities: 0.634 0.366
left son=44 (71 obs) right son=45 (30 obs)
Primary splits:
ListPriceDiff < 0.16 to the right, improve=3.425361, (0 missing)
LoyalCH < 0.6752175 to the left, improve=1.923647, (0 missing)
PriceMM < 2.11 to the right, improve=1.760273, (0 missing)
SalePriceMM < 2.155 to the right, improve=1.623437, (0 missing)
StoreID < 5.5 to the right, improve=1.509868, (0 missing)
Surrogate splits:
PriceMM < 1.89 to the right, agree=0.842, adj=0.467, (0 split)
WeekofPurchase < 232.5 to the right, agree=0.832, adj=0.433, (0 split)
PriceCH < 1.72 to the right, agree=0.792, adj=0.300, (0 split)
STORE < 3.5 to the left, agree=0.743, adj=0.133, (0 split)
DiscCH < 0.05 to the left, agree=0.723, adj=0.067, (0 split)
Node number 23: 27 observations
predicted class=MM expected loss=0.2592593 P(node) =0.03375
class counts: 7 20
probabilities: 0.259 0.741
Node number 24: 52 observations
predicted class=CH expected loss=0.3846154 P(node) =0.065
class counts: 32 20
probabilities: 0.615 0.385
Node number 25: 9 observations
predicted class=MM expected loss=0.2222222 P(node) =0.01125
class counts: 2 7
probabilities: 0.222 0.778
Node number 44: 71 observations
predicted class=CH expected loss=0.2816901 P(node) =0.08875
class counts: 51 20
probabilities: 0.718 0.282
Node number 45: 30 observations
predicted class=MM expected loss=0.4333333 P(node) =0.0375
class counts: 13 17
probabilities: 0.433 0.567 Selecting node number 4 we see that it is terminal sice there is not other node to the left or right of it. It contains roughly 37% of the data values and has 299 observations within it. The label for this terminal node is CH-Citrus Hill; and of the 299 predicted values, 283 were correctly identified as citrus hill, so a correct classification rate of 94.6%
From the tree model it is clear to see that the variable: LoyalCH, PriceDiff, ListPriceDiff, SalePriceMM, and WeekofPurchase are the msot important factors in the tree to be able to differentiate between the two classes MM and CH. The most important nodes are if LoyalCH>=.706 then 37.4% of the data go to a terminal node of CH, and if LoyalCH<=.276 then 20.6% of the observations go to the terminal node that classifies the MM class.
library(visNetwork)Warning: package 'visNetwork' was built under R version 4.5.3library(sparkline)Warning: package 'sparkline' was built under R version 4.5.3fancyRpartPlot(oj_tree)
visTree(oj_tree,
main = "Interactive OJ Decision Tree",
width = "100%",
height = "600px")predictions = predict(oj_tree, newdata = testing_oj, type = 'class')
misclass_error <- mean(testing_oj$Purchase != predictions)
cat('Misclassification Error Rate:', misclass_error, '\n')Misclassification Error Rate: 0.1814815 cat('Accuracy:',1-misclass_error, '\n')Accuracy: 0.8185185 cat('\nConfusion Matrix:\n')
Confusion Matrix:table(Predicted=predictions, Actual=testing_oj$Purchase) Actual
Predicted CH MM
CH 134 27
MM 22 87printcp(oj_tree)
Classification tree:
rpart(formula = Purchase ~ ., data = training_oj, method = "class")
Variables actually used in tree construction:
[1] ListPriceDiff LoyalCH PriceDiff SalePriceMM WeekofPurchase
Root node error: 303/800 = 0.37875
n= 800
CP nsplit rel error xerror xstd
1 0.508251 0 1.00000 1.00000 0.045281
2 0.014301 1 0.49175 0.52475 0.037251
3 0.013201 4 0.44884 0.51485 0.036984
4 0.011551 5 0.43564 0.51815 0.037074
5 0.010000 8 0.39604 0.50495 0.036712plotcp(oj_tree)
The training data performs better for both the pruned and unpruned tree. The unpruned tree had an error training rate of .15 while the pruned tree was at .18 . Meanwhile the testing data shows the similar pattern of the unpruned tree having higher accuracy than the pruned tree, but not by much.
What stood out was the interpretation of the trees. Though the pruned performed worse since it is technically has higher bias since it is on oversimplification, it has much better interpretation potential.
cat('Smalled CP: \n')Smalled CP: oj_tree$cptable[which.min(oj_tree$cptable[,"xerror"]),"CP"][1] 0.01tree_prune=prune(oj_tree,cp=oj_tree$cptable[which.min(oj_tree$cptable[,"xerror"]),"CP"])
fancyRpartPlot(tree_prune, uniform=TRUE, main="Absolute Min CP Tree")
pruned_preds <- predict(tree_prune, newdata = testing_oj, type = "class")
pruned_test_error <- mean(testing_oj$Purchase != pruned_preds)
cat('\nPruned Tree Test Mis Rate: ', pruned_test_error, '\n')
Pruned Tree Test Mis Rate: 0.1814815 cat('\nPruned Tree Test Accuracy: ', 1-pruned_test_error, '\n\n\n')
Pruned Tree Test Accuracy: 0.8185185 pruned_preds_train <- predict(tree_prune, newdata = training_oj, type = "class")
train_misclass_error <- mean(training_oj$Purchase != pruned_preds_train)
cat('\nTraining Misclassification Rate:', train_misclass_error, '\n')
Training Misclassification Rate: 0.15 cat('\nTraining Accuracy:', 1-train_misclass_error, '\n')
Training Accuracy: 0.85