Section 12 Logistic regression

setwd()

df <-  read.csv("G:\\RStudio\\udemy\\ml\\Machine Learning AZ\\Part 3 - Classification\\Section 14 - Logistic Regression\\Logistic_Regression\\Social_Network_Ads.csv")
head(df)

Select the fields that we will be working with

df <- df[,3:5]
head(df)

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

library(caTools)
package <U+393C><U+3E31>caTools<U+393C><U+3E32> was built under R version 3.3.3
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 logistic Regeression to the Training Set

classifier <- glm(formula = Purchased ~ Age + EstimatedSalary,
                  family = binomial, data = training_set)
summary(classifier)

Call:
glm(formula = Purchased ~ Age + EstimatedSalary, family = binomial, 
    data = training_set)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-2.9098  -0.5571  -0.1744   0.3933   2.2917  

Coefficients:
                Estimate Std. Error z value Pr(>|z|)    
(Intercept)      -1.0890     0.1911  -5.700 1.20e-08 ***
Age               2.3769     0.2983   7.969 1.60e-15 ***
EstimatedSalary   1.1488     0.2161   5.316 1.06e-07 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 390.89  on 299  degrees of freedom
Residual deviance: 209.32  on 297  degrees of freedom
AIC: 215.32

Number of Fisher Scoring iterations: 6

Predicting the test set results

prob_pred <-  predict(classifier, type = 'response', newdata = test_set[-3]
                      )
y_pred <-  ifelse(prob_pred > 0.5, 1, 0)
y_pred
  5  15  19  25  29  40  42  43  49  51  54  55  66  74  76  77  78  90  92 100 
  0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   0   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   0   0 
179 181 183 184 195 197 202 203 216 218 221 223 228 229 235 238 239 240 242 244 
  0   0   0   0   0   0   1   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   0 
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   1   0   1   0   1   1   1   0   0   1   1   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 59  5
  1  9 27

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')
prob_set = predict(classifier, type = 'response', newdata = grid_set)
y_grid = ifelse(prob_set > 0.5, 1, 0)
plot(set[,-3],
     main = 'Logistic Regression(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')
prob_set = predict(classifier, type = 'response', newdata = grid_set)
y_grid = ifelse(prob_set > 0.5, 1, 0)
plot(set[,-3],
     main = 'Logistic Regression(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'))

LS0tDQp0aXRsZTogIk1MIFVzaW5nIFIgU2VjdGlvbiAxMiBMb2dpc3RpYyBSZWdyZXNzaW9uIg0Kb3V0cHV0OiBodG1sX25vdGVib29rDQotLS0NCg0KIyBTZWN0aW9uIDEyIExvZ2lzdGljIHJlZ3Jlc3Npb24NCiMgc2V0d2QoKQ0KDQpgYGB7cn0NCmRmIDwtICByZWFkLmNzdigiRzpcXFJTdHVkaW9cXHVkZW15XFxtbFxcTWFjaGluZSBMZWFybmluZyBBWlxcUGFydCAzIC0gQ2xhc3NpZmljYXRpb25cXFNlY3Rpb24gMTQgLSBMb2dpc3RpYyBSZWdyZXNzaW9uXFxMb2dpc3RpY19SZWdyZXNzaW9uXFxTb2NpYWxfTmV0d29ya19BZHMuY3N2IikNCmhlYWQoZGYpDQpgYGANCg0KIyBTZWxlY3QgdGhlIGZpZWxkcyB0aGF0IHdlIHdpbGwgYmUgd29ya2luZyB3aXRoDQoNCmBgYHtyfQ0KZGYgPC0gZGZbLDM6NV0NCmhlYWQoZGYpDQpgYGANCg0KIyBTcGxpdCBkYXRhc2V0IGludG8gdHJhaW5pbmcgYW5kIHRlc3Qgc2V0ICgzMDAgdHJhaW5pbmcsIDEwMCB0ZXN0KQ0KYGBge3J9DQpsaWJyYXJ5KGNhVG9vbHMpDQpzZXQuc2VlZCgxMjM0KQ0Kc3BsaXQgPC0gc2FtcGxlLnNwbGl0KGRmJFB1cmNoYXNlZCwgU3BsaXRSYXRpbyA9IDAuNzUpDQp0cmFpbmluZ19zZXQgPC0gc3Vic2V0KGRmLCBzcGxpdCA9PSBUUlVFKQ0KdGVzdF9zZXQgPC0gc3Vic2V0KGRmLCBzcGxpdCA9PSBGQUxTRSkNCg0KYGBgDQoNCiMgRm9yIENsYXNzaWZpY2F0aW9uLGl0IGlzIGJldHRlciB0byBkbyBmZWF0dXJlIHNjYWxpbmcgKG5vcm1hbGl6YXRpb24pDQoNCmBgYHtyfQ0KIyBGZWF0dXJlIFNjYWxpbmcgMSBhZ2UsIDIgaXMgc2FsYXJ5DQp0cmFpbmluZ19zZXRbLDE6Ml0gPC0gIHNjYWxlKHRyYWluaW5nX3NldFssMToyXSkNCnRlc3Rfc2V0WywxOjJdIDwtICBzY2FsZSh0ZXN0X3NldFssMToyXSkNCmBgYA0KDQojIEZpdHRpbmcgbG9naXN0aWMgUmVnZXJlc3Npb24gdG8gdGhlIFRyYWluaW5nIFNldA0KDQpgYGB7cn0NCmNsYXNzaWZpZXIgPC0gZ2xtKGZvcm11bGEgPSBQdXJjaGFzZWQgfiBBZ2UgKyBFc3RpbWF0ZWRTYWxhcnksDQogICAgICAgICAgICAgICAgICBmYW1pbHkgPSBiaW5vbWlhbCwgZGF0YSA9IHRyYWluaW5nX3NldCkNCnN1bW1hcnkoY2xhc3NpZmllcikNCg0KYGBgDQoNCiMgUHJlZGljdGluZyB0aGUgdGVzdCBzZXQgcmVzdWx0cw0KDQpgYGB7cn0NCnByb2JfcHJlZCA8LSAgcHJlZGljdChjbGFzc2lmaWVyLCB0eXBlID0gJ3Jlc3BvbnNlJywgbmV3ZGF0YSA9IHRlc3Rfc2V0Wy0zXQ0KICAgICAgICAgICAgICAgICAgICAgICkNCnlfcHJlZCA8LSAgaWZlbHNlKHByb2JfcHJlZCA+IDAuNSwgMSwgMCkNCnlfcHJlZA0KDQpgYGANCg0KIyBFdmFsdWF0ZSB0aGUgcHJlZGljdGlvbiB1c2luZyBjb25mdXNpb24gTWF0cml4Lg0KDQpgYGB7cn0NCiMgTWFraW5nIHRoZSBjb25mdXNpb24gbWF0cml4DQojIFszXSByZWZlcnMgdG8gdGhlIG91dGNvbWUNCg0KY20gPC0gdGFibGUodGVzdF9zZXRbLDNdLCB5X3ByZWQpDQpjbQ0KYGBgDQoNCiMgUGxvdA0KDQpgYGB7cn0NCiMgaW5zdGFsbC5wYWNrYWdlcygiRWxlbVN0YXRMZWFybiIpDQpsaWJyYXJ5KEVsZW1TdGF0TGVhcm4pDQpzZXQgPC0gdHJhaW5pbmdfc2V0DQpYMSA8LSBzZXEobWluKHNldFssMV0pIC0gMSwgbWF4KHNldFssMV0pICsgMSwgYnkgPSAwLjAxKQ0KWDIgPC0gc2VxKG1pbihzZXRbLDJdKSAtIDEsIG1heChzZXRbLDJdKSArIDEsIGJ5ID0gMC4wMSkNCmdyaWRfc2V0IDwtIGV4cGFuZC5ncmlkKFgxLCBYMikNCmNvbG5hbWVzKGdyaWRfc2V0KSA9IGMoJ0FnZScsJ0VzdGltYXRlZFNhbGFyeScpDQpwcm9iX3NldCA9IHByZWRpY3QoY2xhc3NpZmllciwgdHlwZSA9ICdyZXNwb25zZScsIG5ld2RhdGEgPSBncmlkX3NldCkNCnlfZ3JpZCA9IGlmZWxzZShwcm9iX3NldCA+IDAuNSwgMSwgMCkNCnBsb3Qoc2V0WywtM10sDQogICAgIG1haW4gPSAnTG9naXN0aWMgUmVncmVzc2lvbihUcmFpbmluZyBTZXQpJywNCiAgICAgeGxhYiA9ICAnQWdlJywgeWxhYiA9ICdFc3RpbWF0ZWQgU2FsYXJ5JywNCiAgICAgeGxpbSA9IHJhbmdlKFgxKSwgeWxpbSA9IHJhbmdlKFgyKSkNCmNvbnRvdXIoWDEsIFgyLCBtYXRyaXgoYXMubnVtZXJpYyh5X2dyaWQpLCBsZW5ndGgoWDEpLCBsZW5ndGgoWDIpKSwgYWRkID0gVFJVRSkNCnBvaW50cyhncmlkX3NldCwgcGNoID0gJy4nLCBjb2wgPSBpZmVsc2UoeV9ncmlkID09IDEsICdzcHJpbmdncmVlbjMnLCAndG9tYXRvJykpDQpwb2ludHMoc2V0LCBwY2ggPSAyMSwgYmc9IGlmZWxzZShzZXRbLDNdID09IDEsJ2dyZWVuNCcsICdyZWQzJykpDQpgYGANCg0KIyBQbG90IGRlc2NyaXB0aW9uDQpUaGUgcmVkIHJlZ2lvbiBpcyBwcmVkaWN0ZWQgYnkgdGhlIGNsYXNzaWZpZXIgYXMgIkRvbnQgYnV5IiA8L2JyPg0KVGhlIGdyZWVuIHJlZ2lvbiBpcyBwcmVkaWN0ZWQgYnkgdGhlIGNsYXNzaWZpZXIgYXMgIkJ1eSIgPC9icj4NClRoZSByZWQgZG90cyBhcmUgdGhvc2UgcGVvcGxlIHRoYXQgYWN0dWFsbHkgZGlkIG5vdCBidXkgPC9icj4NClRoZSBncmVlbiBkb3RzIGFyZSB0aG9zZSBwZW9wbGUgdGhhdCBhY3R1YWxseSBib3VnaHQuIDwvYnI+DQpUaGUgbGluZSBpcyB0aGUgcHJlZGljdGlvbiBib3VuZGFyeS4gDQoNCiMgTm93IHdlIHNlZSB0aGUgcmVzdWx0IG9mIHRoZSB0ZXN0IHNldA0KDQpgYGB7cn0NCnNldCA8LSB0ZXN0X3NldA0KWDEgPC0gc2VxKG1pbihzZXRbLDFdKSAtIDEsIG1heChzZXRbLDFdKSArIDEsIGJ5ID0gMC4wMSkNClgyIDwtIHNlcShtaW4oc2V0WywyXSkgLSAxLCBtYXgoc2V0WywyXSkgKyAxLCBieSA9IDAuMDEpDQpncmlkX3NldCA8LSBleHBhbmQuZ3JpZChYMSwgWDIpDQpjb2xuYW1lcyhncmlkX3NldCkgPSBjKCdBZ2UnLCdFc3RpbWF0ZWRTYWxhcnknKQ0KcHJvYl9zZXQgPSBwcmVkaWN0KGNsYXNzaWZpZXIsIHR5cGUgPSAncmVzcG9uc2UnLCBuZXdkYXRhID0gZ3JpZF9zZXQpDQp5X2dyaWQgPSBpZmVsc2UocHJvYl9zZXQgPiAwLjUsIDEsIDApDQpwbG90KHNldFssLTNdLA0KICAgICBtYWluID0gJ0xvZ2lzdGljIFJlZ3Jlc3Npb24oVGVzdCBTZXQpJywNCiAgICAgeGxhYiA9ICAnQWdlJywgeWxhYiA9ICdFc3RpbWF0ZWQgU2FsYXJ5JywNCiAgICAgeGxpbSA9IHJhbmdlKFgxKSwgeWxpbSA9IHJhbmdlKFgyKSkNCmNvbnRvdXIoWDEsIFgyLCBtYXRyaXgoYXMubnVtZXJpYyh5X2dyaWQpLCBsZW5ndGgoWDEpLCBsZW5ndGgoWDIpKSwgYWRkID0gVFJVRSkNCnBvaW50cyhncmlkX3NldCwgcGNoID0gJy4nLCBjb2wgPSBpZmVsc2UoeV9ncmlkID09IDEsICdzcHJpbmdncmVlbjMnLCAndG9tYXRvJykpDQpwb2ludHMoc2V0LCBwY2ggPSAyMSwgYmc9IGlmZWxzZShzZXRbLDNdID09IDEsJ2dyZWVuNCcsICdyZWQzJykpDQpgYGANCg0K