Section 18 random forest

setwd()

df <-  read.csv("G:\\RStudio\\udemy\\ml\\Machine Learning AZ\\Part 3 - Classification\\Section 20 - Random Forest Classification\\Random_Forest_Classification\\Social_Network_Ads.csv")
head(df)

Select the fields that we will be working with

df <- df[,3:5]
head(df)
# econding the target feature as factor
df$Purchased <-  factor(df$Purchased, levels = c(0,1))

Split dataset into training and test set (300 training, 100 test)

library(caTools)
set.seed(1234)
split <- sample.split(df$Purchased, SplitRatio = 0.75)
training_set <- subset(df, split == TRUE)
test_set <- subset(df, split == FALSE)

For Classification,it is better to do feature scaling (normalization)

# Feature Scaling 1 age, 2 is salary
training_set[,1:2] <-  scale(training_set[,1:2])
test_set[,1:2] <-  scale(test_set[,1:2])

Fitting Classifier to the Training Set

# Create the classifier here
# install.packages("randomForest")
library(randomForest)
classifier <- randomForest(x = training_set[-3], 
                           y = training_set$Purchased,
                           ntree = 500)
summary(classifier)
                Length Class  Mode     
call               4   -none- call     
type               1   -none- character
predicted        300   factor numeric  
err.rate        1500   -none- numeric  
confusion          6   -none- numeric  
votes            600   matrix numeric  
oob.times        300   -none- numeric  
classes            2   -none- character
importance         2   -none- numeric  
importanceSD       0   -none- NULL     
localImportance    0   -none- NULL     
proximity          0   -none- NULL     
ntree              1   -none- numeric  
mtry               1   -none- numeric  
forest            14   -none- list     
y                300   factor numeric  
test               0   -none- NULL     
inbag              0   -none- NULL     

Predicting the test set results

y_pred <- predict(classifier, newdata = test_set[-3])
y_pred
  5  15  19  25  29  40  42  43  49  51  54  55  66  74  76  77  78  90  92 100 
  0   0   1   1   0   0   0   1   1   0   0   0   0   1   1   0   0   0   1   0 
104 106 110 112 120 133 136 137 141 142 143 144 145 153 157 159 164 166 172 174 
  1   0   0   0   0   0   0   0   0   0   0   0   0   0   1   0   0   0   1   0 
179 181 183 184 195 197 202 203 216 218 221 223 228 229 235 238 239 240 242 244 
  0   0   1   0   0   0   0   1   1   0   0   1   1   0   1   0   1   1   0   1 
245 249 250 254 256 258 271 273 275 286 287 290 291 294 301 303 305 309 318 319 
  0   0   0   1   1   0   1   1   1   0   0   0   1   0   1   1   0   1   0   1 
327 330 332 333 338 341 343 351 353 354 357 360 361 363 368 369 373 386 387 394 
  0   1   1   0   0   1   0   1   0   0   1   0   1   1   1   0   0   1   1   1 
Levels: 0 1

Evaluate the prediction using confusion Matrix.

# Making the confusion matrix
# [3] refers to the outcome
cm <- table(test_set[,3], y_pred)
cm
   y_pred
     0  1
  0 56  8
  1  4 32

Plot

# install.packages("ElemStatLearn")
library(ElemStatLearn)
set <- training_set
X1 <- seq(min(set[,1]) - 1, max(set[,1]) + 1, by = 0.01)
X2 <- seq(min(set[,2]) - 1, max(set[,2]) + 1, by = 0.01)
grid_set <- expand.grid(X1, X2)
colnames(grid_set) = c('Age','EstimatedSalary')
y_grid = predict(classifier,  newdata = grid_set)
plot(set[,-3],
     main = 'Classifier Model (Training Set)',
     xlab =  'Age', ylab = 'Estimated Salary',
     xlim = range(X1), ylim = range(X2))
contour(X1, X2, matrix(as.numeric(y_grid), length(X1), length(X2)), add = TRUE)
points(grid_set, pch = '.', col = ifelse(y_grid == 1, 'springgreen3', 'tomato'))
points(set, pch = 21, bg= ifelse(set[,3] == 1,'green4', 'red3'))

Plot description

The red region is predicted by the classifier as “Dont buy”
The green region is predicted by the classifier as “Buy”
The red dots are those people that actually did not buy
The green dots are those people that actually bought.
The line is the prediction boundary.

Now we see the result of the test set

set <- test_set
X1 <- seq(min(set[,1]) - 1, max(set[,1]) + 1, by = 0.01)
X2 <- seq(min(set[,2]) - 1, max(set[,2]) + 1, by = 0.01)
grid_set <- expand.grid(X1, X2)
colnames(grid_set) = c('Age','EstimatedSalary')
y_grid = predict(classifier,  newdata = grid_set)
plot(set[,-3],
     main = 'Classifier Model (Test Set)',
     xlab =  'Age', ylab = 'Estimated Salary',
     xlim = range(X1), ylim = range(X2))
contour(X1, X2, matrix(as.numeric(y_grid), length(X1), length(X2)), add = TRUE)
points(grid_set, pch = '.', col = ifelse(y_grid == 1, 'springgreen3', 'tomato'))
points(set, pch = 21, bg= ifelse(set[,3] == 1,'green4', 'red3'))

LS0tDQp0aXRsZTogIk1MIFVzaW5nIFIgU2VjdGlvbiAxOCBSYW5kb20gRm9yZXN0Ig0Kb3V0cHV0OiBodG1sX25vdGVib29rDQotLS0NCg0KIyBTZWN0aW9uIDE4IHJhbmRvbSBmb3Jlc3QNCiMgc2V0d2QoKQ0KDQpgYGB7cn0NCmRmIDwtICByZWFkLmNzdigiRzpcXFJTdHVkaW9cXHVkZW15XFxtbFxcTWFjaGluZSBMZWFybmluZyBBWlxcUGFydCAzIC0gQ2xhc3NpZmljYXRpb25cXFNlY3Rpb24gMjAgLSBSYW5kb20gRm9yZXN0IENsYXNzaWZpY2F0aW9uXFxSYW5kb21fRm9yZXN0X0NsYXNzaWZpY2F0aW9uXFxTb2NpYWxfTmV0d29ya19BZHMuY3N2IikNCmhlYWQoZGYpDQpgYGANCg0KIyBTZWxlY3QgdGhlIGZpZWxkcyB0aGF0IHdlIHdpbGwgYmUgd29ya2luZyB3aXRoDQoNCmBgYHtyfQ0KZGYgPC0gZGZbLDM6NV0NCmhlYWQoZGYpDQpgYGANCg0KYGBge3J9DQojIGVjb25kaW5nIHRoZSB0YXJnZXQgZmVhdHVyZSBhcyBmYWN0b3INCmRmJFB1cmNoYXNlZCA8LSAgZmFjdG9yKGRmJFB1cmNoYXNlZCwgbGV2ZWxzID0gYygwLDEpKQ0KYGBgDQoNCiMgU3BsaXQgZGF0YXNldCBpbnRvIHRyYWluaW5nIGFuZCB0ZXN0IHNldCAoMzAwIHRyYWluaW5nLCAxMDAgdGVzdCkNCmBgYHtyfQ0KbGlicmFyeShjYVRvb2xzKQ0Kc2V0LnNlZWQoMTIzNCkNCnNwbGl0IDwtIHNhbXBsZS5zcGxpdChkZiRQdXJjaGFzZWQsIFNwbGl0UmF0aW8gPSAwLjc1KQ0KdHJhaW5pbmdfc2V0IDwtIHN1YnNldChkZiwgc3BsaXQgPT0gVFJVRSkNCnRlc3Rfc2V0IDwtIHN1YnNldChkZiwgc3BsaXQgPT0gRkFMU0UpDQoNCmBgYA0KDQojIEZvciBDbGFzc2lmaWNhdGlvbixpdCBpcyBiZXR0ZXIgdG8gZG8gZmVhdHVyZSBzY2FsaW5nIChub3JtYWxpemF0aW9uKQ0KDQpgYGB7cn0NCiMgRmVhdHVyZSBTY2FsaW5nIDEgYWdlLCAyIGlzIHNhbGFyeQ0KdHJhaW5pbmdfc2V0WywxOjJdIDwtICBzY2FsZSh0cmFpbmluZ19zZXRbLDE6Ml0pDQp0ZXN0X3NldFssMToyXSA8LSAgc2NhbGUodGVzdF9zZXRbLDE6Ml0pDQpgYGANCg0KIyBGaXR0aW5nIENsYXNzaWZpZXIgdG8gdGhlIFRyYWluaW5nIFNldA0KDQpgYGB7cn0NCiMgQ3JlYXRlIHRoZSBjbGFzc2lmaWVyIGhlcmUNCiMgaW5zdGFsbC5wYWNrYWdlcygicmFuZG9tRm9yZXN0IikNCmxpYnJhcnkocmFuZG9tRm9yZXN0KQ0KDQpjbGFzc2lmaWVyIDwtIHJhbmRvbUZvcmVzdCh4ID0gdHJhaW5pbmdfc2V0Wy0zXSwgDQogICAgICAgICAgICAgICAgICAgICAgICAgICB5ID0gdHJhaW5pbmdfc2V0JFB1cmNoYXNlZCwNCiAgICAgICAgICAgICAgICAgICAgICAgICAgIG50cmVlID0gNTAwKQ0Kc3VtbWFyeShjbGFzc2lmaWVyKQ0KYGBgDQoNCiMgUHJlZGljdGluZyB0aGUgdGVzdCBzZXQgcmVzdWx0cw0KDQpgYGB7cn0NCnlfcHJlZCA8LSBwcmVkaWN0KGNsYXNzaWZpZXIsIG5ld2RhdGEgPSB0ZXN0X3NldFstM10pDQp5X3ByZWQNCg0KYGBgDQoNCiMgRXZhbHVhdGUgdGhlIHByZWRpY3Rpb24gdXNpbmcgY29uZnVzaW9uIE1hdHJpeC4NCg0KYGBge3J9DQojIE1ha2luZyB0aGUgY29uZnVzaW9uIG1hdHJpeA0KIyBbM10gcmVmZXJzIHRvIHRoZSBvdXRjb21lDQoNCmNtIDwtIHRhYmxlKHRlc3Rfc2V0WywzXSwgeV9wcmVkKQ0KY20NCmBgYA0KDQojIFBsb3QNCg0KYGBge3J9DQojIGluc3RhbGwucGFja2FnZXMoIkVsZW1TdGF0TGVhcm4iKQ0KbGlicmFyeShFbGVtU3RhdExlYXJuKQ0Kc2V0IDwtIHRyYWluaW5nX3NldA0KWDEgPC0gc2VxKG1pbihzZXRbLDFdKSAtIDEsIG1heChzZXRbLDFdKSArIDEsIGJ5ID0gMC4wMSkNClgyIDwtIHNlcShtaW4oc2V0WywyXSkgLSAxLCBtYXgoc2V0WywyXSkgKyAxLCBieSA9IDAuMDEpDQpncmlkX3NldCA8LSBleHBhbmQuZ3JpZChYMSwgWDIpDQpjb2xuYW1lcyhncmlkX3NldCkgPSBjKCdBZ2UnLCdFc3RpbWF0ZWRTYWxhcnknKQ0KDQp5X2dyaWQgPSBwcmVkaWN0KGNsYXNzaWZpZXIsICBuZXdkYXRhID0gZ3JpZF9zZXQpDQpwbG90KHNldFssLTNdLA0KICAgICBtYWluID0gJ0NsYXNzaWZpZXIgTW9kZWwgKFRyYWluaW5nIFNldCknLA0KICAgICB4bGFiID0gICdBZ2UnLCB5bGFiID0gJ0VzdGltYXRlZCBTYWxhcnknLA0KICAgICB4bGltID0gcmFuZ2UoWDEpLCB5bGltID0gcmFuZ2UoWDIpKQ0KY29udG91cihYMSwgWDIsIG1hdHJpeChhcy5udW1lcmljKHlfZ3JpZCksIGxlbmd0aChYMSksIGxlbmd0aChYMikpLCBhZGQgPSBUUlVFKQ0KcG9pbnRzKGdyaWRfc2V0LCBwY2ggPSAnLicsIGNvbCA9IGlmZWxzZSh5X2dyaWQgPT0gMSwgJ3NwcmluZ2dyZWVuMycsICd0b21hdG8nKSkNCnBvaW50cyhzZXQsIHBjaCA9IDIxLCBiZz0gaWZlbHNlKHNldFssM10gPT0gMSwnZ3JlZW40JywgJ3JlZDMnKSkNCmBgYA0KDQojIFBsb3QgZGVzY3JpcHRpb24NClRoZSByZWQgcmVnaW9uIGlzIHByZWRpY3RlZCBieSB0aGUgY2xhc3NpZmllciBhcyAiRG9udCBidXkiIDwvYnI+DQpUaGUgZ3JlZW4gcmVnaW9uIGlzIHByZWRpY3RlZCBieSB0aGUgY2xhc3NpZmllciBhcyAiQnV5IiA8L2JyPg0KVGhlIHJlZCBkb3RzIGFyZSB0aG9zZSBwZW9wbGUgdGhhdCBhY3R1YWxseSBkaWQgbm90IGJ1eSA8L2JyPg0KVGhlIGdyZWVuIGRvdHMgYXJlIHRob3NlIHBlb3BsZSB0aGF0IGFjdHVhbGx5IGJvdWdodC4gPC9icj4NClRoZSBsaW5lIGlzIHRoZSBwcmVkaWN0aW9uIGJvdW5kYXJ5LiANCg0KIyBOb3cgd2Ugc2VlIHRoZSByZXN1bHQgb2YgdGhlIHRlc3Qgc2V0DQoNCmBgYHtyfQ0Kc2V0IDwtIHRlc3Rfc2V0DQpYMSA8LSBzZXEobWluKHNldFssMV0pIC0gMSwgbWF4KHNldFssMV0pICsgMSwgYnkgPSAwLjAxKQ0KWDIgPC0gc2VxKG1pbihzZXRbLDJdKSAtIDEsIG1heChzZXRbLDJdKSArIDEsIGJ5ID0gMC4wMSkNCmdyaWRfc2V0IDwtIGV4cGFuZC5ncmlkKFgxLCBYMikNCmNvbG5hbWVzKGdyaWRfc2V0KSA9IGMoJ0FnZScsJ0VzdGltYXRlZFNhbGFyeScpDQoNCnlfZ3JpZCA9IHByZWRpY3QoY2xhc3NpZmllciwgIG5ld2RhdGEgPSBncmlkX3NldCkNCnBsb3Qoc2V0WywtM10sDQogICAgIG1haW4gPSAnQ2xhc3NpZmllciBNb2RlbCAoVGVzdCBTZXQpJywNCiAgICAgeGxhYiA9ICAnQWdlJywgeWxhYiA9ICdFc3RpbWF0ZWQgU2FsYXJ5JywNCiAgICAgeGxpbSA9IHJhbmdlKFgxKSwgeWxpbSA9IHJhbmdlKFgyKSkNCmNvbnRvdXIoWDEsIFgyLCBtYXRyaXgoYXMubnVtZXJpYyh5X2dyaWQpLCBsZW5ndGgoWDEpLCBsZW5ndGgoWDIpKSwgYWRkID0gVFJVRSkNCnBvaW50cyhncmlkX3NldCwgcGNoID0gJy4nLCBjb2wgPSBpZmVsc2UoeV9ncmlkID09IDEsICdzcHJpbmdncmVlbjMnLCAndG9tYXRvJykpDQpwb2ludHMoc2V0LCBwY2ggPSAyMSwgYmc9IGlmZWxzZShzZXRbLDNdID09IDEsJ2dyZWVuNCcsICdyZWQzJykpDQpgYGANCg0K