Number 13

Getting data & loading packages

part a

summary(weekly)
##       Year           Lag1               Lag2               Lag3         
##  Min.   :1990   Min.   :-18.1950   Min.   :-18.1950   Min.   :-18.1950  
##  1st Qu.:1995   1st Qu.: -1.1540   1st Qu.: -1.1540   1st Qu.: -1.1580  
##  Median :2000   Median :  0.2410   Median :  0.2410   Median :  0.2410  
##  Mean   :2000   Mean   :  0.1506   Mean   :  0.1511   Mean   :  0.1472  
##  3rd Qu.:2005   3rd Qu.:  1.4050   3rd Qu.:  1.4090   3rd Qu.:  1.4090  
##  Max.   :2010   Max.   : 12.0260   Max.   : 12.0260   Max.   : 12.0260  
##       Lag4               Lag5              Volume            Today         
##  Min.   :-18.1950   Min.   :-18.1950   Min.   :0.08747   Min.   :-18.1950  
##  1st Qu.: -1.1580   1st Qu.: -1.1660   1st Qu.:0.33202   1st Qu.: -1.1540  
##  Median :  0.2380   Median :  0.2340   Median :1.00268   Median :  0.2410  
##  Mean   :  0.1458   Mean   :  0.1399   Mean   :1.57462   Mean   :  0.1499  
##  3rd Qu.:  1.4090   3rd Qu.:  1.4050   3rd Qu.:2.05373   3rd Qu.:  1.4050  
##  Max.   : 12.0260   Max.   : 12.0260   Max.   :9.32821   Max.   : 12.0260  
##  Direction 
##  Down:484  
##  Up  :605  
##            
##            
##            
## 
# in the data, there appears to be an similar 'min' and 'max' value between all lag variables, as well as the 'today' variable. There is also a similar median between the variables. There are 484 'down' directions and 605 'up' directions, indicating the overall shift of the market. This is shown in the summary below.

part b

glmfit <- glm(Direction ~ Lag1 + Lag2 + Lag3 + Lag4 + Lag5 + Volume, data = weekly, family = binomial)
summary (glmfit)
## 
## Call:
## glm(formula = Direction ~ Lag1 + Lag2 + Lag3 + Lag4 + Lag5 + 
##     Volume, family = binomial, data = weekly)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.6949  -1.2565   0.9913   1.0849   1.4579  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)   
## (Intercept)  0.26686    0.08593   3.106   0.0019 **
## Lag1        -0.04127    0.02641  -1.563   0.1181   
## Lag2         0.05844    0.02686   2.175   0.0296 * 
## Lag3        -0.01606    0.02666  -0.602   0.5469   
## Lag4        -0.02779    0.02646  -1.050   0.2937   
## Lag5        -0.01447    0.02638  -0.549   0.5833   
## Volume      -0.02274    0.03690  -0.616   0.5377   
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1496.2  on 1088  degrees of freedom
## Residual deviance: 1486.4  on 1082  degrees of freedom
## AIC: 1500.4
## 
## Number of Fisher Scoring iterations: 4
# Lag2 appears to be significant.

part c

#creating a confusion matrix
coef(glmfit)
## (Intercept)        Lag1        Lag2        Lag3        Lag4        Lag5 
##  0.26686414 -0.04126894  0.05844168 -0.01606114 -0.02779021 -0.01447206 
##      Volume 
## -0.02274153
summary(glmfit)$coef
##                Estimate Std. Error    z value    Pr(>|z|)
## (Intercept)  0.26686414 0.08592961  3.1056134 0.001898848
## Lag1        -0.04126894 0.02641026 -1.5626099 0.118144368
## Lag2         0.05844168 0.02686499  2.1753839 0.029601361
## Lag3        -0.01606114 0.02666299 -0.6023760 0.546923890
## Lag4        -0.02779021 0.02646332 -1.0501409 0.293653342
## Lag5        -0.01447206 0.02638478 -0.5485006 0.583348244
## Volume      -0.02274153 0.03689812 -0.6163330 0.537674762
glmprob <- predict(glmfit , type = "response")
glmprob[1:10]
##         1         2         3         4         5         6         7         8 
## 0.6086249 0.6010314 0.5875699 0.4816416 0.6169013 0.5684190 0.5786097 0.5151972 
##         9        10 
## 0.5715200 0.5554287
contrasts(weekly$Direction)
##      Up
## Down  0
## Up    1
glmpred <- rep (" Down ", 1089)
glmpred[glmprob > .5] = "Up"
table(glmpred,weekly$Direction)
##         
## glmpred  Down  Up
##    Down    54  48
##   Up      430 557
(557 + 54) / 1089
## [1] 0.5610652
# the number .561 below indicated that the model correctly predicted 51.1% of the time. To further interpret the confusion matrix, the model correctly predicted that there would be an "Up" trend 557 times and a 'Down' trend 54 times. The model is better at predicting 'Up' trends and very often mistakes "Down" trends for "Up" trends.

part d

train <- (Year <= 2008)
weekly2008tr <- weekly[!train , ]
dim(weekly2008tr)
## [1] 104   9
direction2008tr <- Direction[!train]
glmfit<- glm(Direction ~ Lag2, family = binomial , subset = train)
glmprob <- predict(glmfit, weekly2008tr, type = "response")
glmpred <- rep("Down", 104)
glmpred[glmprob > .5] <- "Up"
table(glmpred, direction2008tr)
##        direction2008tr
## glmpred Down Up
##    Down    9  5
##    Up     34 56
mean(glmpred==direction2008tr)
## [1] 0.625
mean(glmpred!= direction2008tr)
## [1] 0.375
# As shown below, the model correctly performs 62.5% of the time. Better than the first model, but still not entirely great. The model correctly predicted 56 "up" trends and 9 "down" trends. Similar to the last model, this one also frequently wrongly predicts "down" trends. There is also shown to be a 37.5% test error rate.

part e

ldafit <- lda(Direction ~ Lag2, data = weekly, subset = train)
ldafit
## Call:
## lda(Direction ~ Lag2, data = weekly, subset = train)
## 
## Prior probabilities of groups:
##      Down        Up 
## 0.4477157 0.5522843 
## 
## Group means:
##             Lag2
## Down -0.03568254
## Up    0.26036581
## 
## Coefficients of linear discriminants:
##            LD1
## Lag2 0.4414162
plot(ldafit)

ldapred <- predict(ldafit, weekly2008tr)
names(ldapred)
## [1] "class"     "posterior" "x"
ldaclass <- ldapred$class
table(ldaclass, direction2008tr)
##         direction2008tr
## ldaclass Down Up
##     Down    9  5
##     Up     34 56
mean(ldaclass == direction2008tr)
## [1] 0.625
# We can see that the lda model has almost identical results as the logistic regression model. There are 56 correctly predicted "Up" trends and only 9 predicted "down" trends.

part f

qdafit <- qda(Direction ~ Lag2, data = weekly, subset = train)
qdafit
## Call:
## qda(Direction ~ Lag2, data = weekly, subset = train)
## 
## Prior probabilities of groups:
##      Down        Up 
## 0.4477157 0.5522843 
## 
## Group means:
##             Lag2
## Down -0.03568254
## Up    0.26036581
qdapred <- predict(qdafit, weekly2008tr)
names(qdapred)
## [1] "class"     "posterior"
qdaclass <- qdapred$class
table(qdaclass, direction2008tr)
##         direction2008tr
## qdaclass Down Up
##     Down    0  0
##     Up     43 61
mean(qdaclass == direction2008tr)
## [1] 0.5865385
## This model gave interesting results. As shown in the confusion matrix, the model correctly predicted all of the "Up" trends. On the contrary, it did not correctly predict any "Down" trends. The model, overall, had 58.7% accuracy.

part g

library(class)
train.x=as.matrix(Lag2[train])
test.x=as.matrix(Lag2[!train])
train.Direction =Direction[train]
set.seed (1)
knnpred <- knn (train.x, test.x, train.Direction , k = 1)
table(knnpred, direction2008tr)
##        direction2008tr
## knnpred Down Up
##    Down   21 30
##    Up     22 31
direction2008tr
##   [1] Down Down Down Down Up   Down Down Down Down Up   Up   Up   Up   Up   Up  
##  [16] Down Up   Up   Down Up   Up   Up   Up   Down Down Down Down Up   Up   Up  
##  [31] Up   Down Up   Up   Down Up   Up   Down Down Up   Up   Down Down Up   Up  
##  [46] Down Up   Up   Up   Down Up   Down Up   Down Down Down Down Up   Up   Down
##  [61] Up   Up   Up   Up   Up   Up   Down Up   Down Down Up   Down Up   Down Up  
##  [76] Up   Down Down Up   Down Up   Down Up   Down Down Down Up   Up   Up   Up  
##  [91] Down Up   Up   Up   Up   Up   Down Up   Down Up   Up   Up   Up   Up  
## Levels: Down Up
mean(knnpred == direction2008tr)
## [1] 0.5
# The KNN model only predicted correctly 50% of the time. The model predicted 31 "Up" trends correctly and 21 "Down" trends correctly.

part h

library(e1071)
## Warning: package 'e1071' was built under R version 4.2.2
nbfit <-naiveBayes(Direction ~ Lag2, data = weekly, subset = train)
nbfit
## 
## Naive Bayes Classifier for Discrete Predictors
## 
## Call:
## naiveBayes.default(x = X, y = Y, laplace = laplace)
## 
## A-priori probabilities:
## Y
##      Down        Up 
## 0.4477157 0.5522843 
## 
## Conditional probabilities:
##       Lag2
## Y             [,1]     [,2]
##   Down -0.03568254 2.199504
##   Up    0.26036581 2.317485
nbclass <- predict(nbfit , weekly2008tr)
table(nbclass , direction2008tr)
##        direction2008tr
## nbclass Down Up
##    Down    0  0
##    Up     43 61
mean(nbclass == direction2008tr)
## [1] 0.5865385
## The Naive Bayes correctly predicted 58.7% of the time. The model correctly predicted 61 "up" trends and 0 "down" trends.

part i

The LDA and GLM performed the best out of all the models, both with 62.5% accuracy.

part j

# KNN with different K values
train.x=as.matrix(Lag2[train])
test.x=as.matrix(Lag2[!train])
train.Direction =Direction[train]
set.seed (1)
knnpred <- knn (train.x, test.x, train.Direction , k = 3)
table(knnpred, direction2008tr)
##        direction2008tr
## knnpred Down Up
##    Down   16 20
##    Up     27 41
mean(knnpred == direction2008tr)
## [1] 0.5480769
train.x=as.matrix(Lag2[train])
test.x=as.matrix(Lag2[!train])
train.Direction =Direction[train]
set.seed (1)
knnpred <- knn (train.x, test.x, train.Direction , k = 9)
table(knnpred, direction2008tr)
##        direction2008tr
## knnpred Down Up
##    Down   17 20
##    Up     26 41
mean(knnpred == direction2008tr)
## [1] 0.5576923
# LDA with different predictors
ldafit <- lda(Direction ~ Lag2 + Lag5, data = weekly, subset = train)
ldafit
## Call:
## lda(Direction ~ Lag2 + Lag5, data = weekly, subset = train)
## 
## Prior probabilities of groups:
##      Down        Up 
## 0.4477157 0.5522843 
## 
## Group means:
##             Lag2       Lag5
## Down -0.03568254 0.21409297
## Up    0.26036581 0.04548897
## 
## Coefficients of linear discriminants:
##             LD1
## Lag2  0.3813248
## Lag5 -0.1980466
ldapred <- predict(ldafit, weekly2008tr)
names(ldapred)
## [1] "class"     "posterior" "x"
ldaclass <- ldapred$class
table(ldaclass, direction2008tr)
##         direction2008tr
## ldaclass Down Up
##     Down    6  5
##     Up     37 56
mean(ldaclass == direction2008tr)
## [1] 0.5961538

Question 14

part a

library(ISLR2)
auto <- ISLR2::Auto
auto$mpg01 <- ifelse(auto$mpg >= median(auto$mpg), 1, 0)

part b

pairs(Auto[, -9])

par(mfrow=c(2,4))
boxplot(auto$cylinders ~ auto$mpg01)
boxplot(auto$displacement ~ auto$mpg01)
boxplot(auto$horsepower ~ auto$mpg01)
boxplot(auto$weight ~ auto$mpg01)
boxplot(auto$acceleration ~ auto$mpg01)
boxplot(auto$year ~ auto$mpg01)
boxplot(auto$origin ~ auto$mpg01)
# There is the strongest of relationships between mpg and displacement, horsepower, and weight.

part c

train <- (auto$year <= 77)
auto77tr <- auto[!train , ]
dim(auto77tr)
## [1] 150  10
mpg77tr <- auto$mpg01[!train]

part d

ldafit <- lda(mpg01 ~ displacement + horsepower + weight, data = auto, subset = train)
ldafit
## Call:
## lda(mpg01 ~ displacement + horsepower + weight, data = auto, 
##     subset = train)
## 
## Prior probabilities of groups:
##         0         1 
## 0.6487603 0.3512397 
## 
## Group means:
##   displacement horsepower   weight
## 0     280.5350  133.63694 3675.758
## 1     105.5118   78.14118 2219.953
## 
## Coefficients of linear discriminants:
##                       LD1
## displacement -0.008602118
## horsepower    0.013384743
## weight       -0.001206420
plot(ldafit)

ldapred <- predict(ldafit, auto77tr)
names(ldapred)
## [1] "class"     "posterior" "x"
ldaclass <- ldapred$class
table(ldaclass, mpg77tr)
##         mpg77tr
## ldaclass  0  1
##        0 34 14
##        1  5 97
mean(ldaclass == mpg77tr)
## [1] 0.8733333
1-mean(ldaclass == mpg77tr)
## [1] 0.1266667
# the LDA model has a test error of 12.7%.

part e

qdafit <- qda(mpg01 ~ displacement + horsepower + weight, data = auto, subset = train)
qdafit
## Call:
## qda(mpg01 ~ displacement + horsepower + weight, data = auto, 
##     subset = train)
## 
## Prior probabilities of groups:
##         0         1 
## 0.6487603 0.3512397 
## 
## Group means:
##   displacement horsepower   weight
## 0     280.5350  133.63694 3675.758
## 1     105.5118   78.14118 2219.953
qdapred <- predict(qdafit, auto77tr)
names(qdapred)
## [1] "class"     "posterior"
qdaclass <- qdapred$class
table(qdaclass, mpg77tr)
##         mpg77tr
## qdaclass  0  1
##        0 36 20
##        1  3 91
mean(qdaclass == mpg77tr)
## [1] 0.8466667
1-mean(ldaclass == mpg77tr)
## [1] 0.1266667
# the test error of the LDA model is 12.7%.

part f

glmfit <-  glm(auto$mpg01 ~ displacement + weight + horsepower + horsepower, data = Auto, family = binomial, subset = train)
glmprob <-  predict(glmfit, auto77tr, type = "response")
glmpred <-  rep(0, length(glmprob))
glmpred[glmprob > 0.5] <- 1
table(glmpred, mpg77tr)
##        mpg77tr
## glmpred  0  1
##       0 38 33
##       1  1 78
mean(glmpred==mpg77tr)
## [1] 0.7733333
1-mean(glmpred== mpg77tr)
## [1] 0.2266667
# the logistic regression had a test error of 22.7%.

part g

library(e1071)
nbfit <-naiveBayes(mpg01 ~ displacement + horsepower + weight, data = auto, subset = train)
nbfit
## 
## Naive Bayes Classifier for Discrete Predictors
## 
## Call:
## naiveBayes.default(x = X, y = Y, laplace = laplace)
## 
## A-priori probabilities:
## Y
##         0         1 
## 0.6487603 0.3512397 
## 
## Conditional probabilities:
##    displacement
## Y       [,1]     [,2]
##   0 280.5350 93.39326
##   1 105.5118 23.60160
## 
##    horsepower
## Y        [,1]     [,2]
##   0 133.63694 39.44132
##   1  78.14118 14.85898
## 
##    weight
## Y       [,1]     [,2]
##   0 3675.758 720.1427
##   1 2219.953 301.3293
nbclass <- predict(nbfit , auto77tr)
table(nbclass , mpg77tr)
##        mpg77tr
## nbclass  0  1
##       0 36 20
##       1  3 91
mean(nbclass == mpg77tr)
## [1] 0.8466667
1-mean(nbclass == mpg77tr)
## [1] 0.1533333
# the model has a test error 15.3%.

part h

train.x = cbind(auto$displacement, auto$horsepower, auto$weight)[train,]
test.x=cbind(auto$displacement,auto$horsepower, auto$weight)[!train,]
train.mpg01=auto$mpg01[train]
set.seed (1)
knnpred <- knn(train.x, test.x, train.mpg01 , k = 1)
table(knnpred, mpg77tr)
##        mpg77tr
## knnpred  0  1
##       0 37 27
##       1  2 84
mean(knnpred == mpg77tr)
## [1] 0.8066667
1-mean(knnpred == mpg77tr)
## [1] 0.1933333
knnpred <- knn(train.x, test.x, train.mpg01 , k = 4)
table(knnpred, mpg77tr)
##        mpg77tr
## knnpred  0  1
##       0 38 25
##       1  1 86
mean(knnpred == mpg77tr)
## [1] 0.8266667
1-mean(knnpred == mpg77tr)
## [1] 0.1733333
knnpred <- knn(train.x, test.x, train.mpg01 , k = 2)
table(knnpred, mpg77tr)
##        mpg77tr
## knnpred  0  1
##       0 39 26
##       1  0 85
mean(knnpred == mpg77tr)
## [1] 0.8266667
1-mean(knnpred == mpg77tr)
## [1] 0.1733333
# the KNN with k=4 and k=2 have the lowest error rate: 17.3.

Question 16

Loading data and doing a correlation test

boston <- ISLR2::Boston
boston$crim01 <- ifelse(boston$crim >= median(boston$crim), 1, 0)
pairs(boston[, -4])

round(cor(boston[, -4]), digits = 2)
##          crim    zn indus   nox    rm   age   dis   rad   tax ptratio lstat
## crim     1.00 -0.20  0.41  0.42 -0.22  0.35 -0.38  0.63  0.58    0.29  0.46
## zn      -0.20  1.00 -0.53 -0.52  0.31 -0.57  0.66 -0.31 -0.31   -0.39 -0.41
## indus    0.41 -0.53  1.00  0.76 -0.39  0.64 -0.71  0.60  0.72    0.38  0.60
## nox      0.42 -0.52  0.76  1.00 -0.30  0.73 -0.77  0.61  0.67    0.19  0.59
## rm      -0.22  0.31 -0.39 -0.30  1.00 -0.24  0.21 -0.21 -0.29   -0.36 -0.61
## age      0.35 -0.57  0.64  0.73 -0.24  1.00 -0.75  0.46  0.51    0.26  0.60
## dis     -0.38  0.66 -0.71 -0.77  0.21 -0.75  1.00 -0.49 -0.53   -0.23 -0.50
## rad      0.63 -0.31  0.60  0.61 -0.21  0.46 -0.49  1.00  0.91    0.46  0.49
## tax      0.58 -0.31  0.72  0.67 -0.29  0.51 -0.53  0.91  1.00    0.46  0.54
## ptratio  0.29 -0.39  0.38  0.19 -0.36  0.26 -0.23  0.46  0.46    1.00  0.37
## lstat    0.46 -0.41  0.60  0.59 -0.61  0.60 -0.50  0.49  0.54    0.37  1.00
## medv    -0.39  0.36 -0.48 -0.43  0.70 -0.38  0.25 -0.38 -0.47   -0.51 -0.74
## crim01   0.41 -0.44  0.60  0.72 -0.16  0.61 -0.62  0.62  0.61    0.25  0.45
##          medv crim01
## crim    -0.39   0.41
## zn       0.36  -0.44
## indus   -0.48   0.60
## nox     -0.43   0.72
## rm       0.70  -0.16
## age     -0.38   0.61
## dis      0.25  -0.62
## rad     -0.38   0.62
## tax     -0.47   0.61
## ptratio -0.51   0.25
## lstat   -0.74   0.45
## medv     1.00  -0.26
## crim01  -0.26   1.00
# We can see that indus, nox, rad, tax, age, and lstat have the highest correlation with crime rate per capita.

splitting the data

set.seed(1)
sample <- sample.int(n = nrow(boston), size = floor(.7*nrow(boston)), replace = F)
train <- boston[sample, ]
test  <- boston[-sample, ]

runnig a logistic regression model

glmfit <- glm(crim01 ~ indus + nox + rad + tax + age + lstat, data = train, family = binomial)
summary(glmfit)
## 
## Call:
## glm(formula = crim01 ~ indus + nox + rad + tax + age + lstat, 
##     family = binomial, data = train)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -2.09915  -0.28081  -0.03413   0.00474   2.56795  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -21.569492   3.454173  -6.244 4.25e-10 ***
## indus        -0.066141   0.051218  -1.291  0.19658    
## nox          38.906387   7.370033   5.279 1.30e-07 ***
## rad           0.625093   0.139993   4.465 8.00e-06 ***
## tax          -0.007698   0.002765  -2.784  0.00537 ** 
## age           0.005389   0.010695   0.504  0.61435    
## lstat         0.025567   0.039065   0.654  0.51280    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 490.65  on 353  degrees of freedom
## Residual deviance: 171.76  on 347  degrees of freedom
## AIC: 185.76
## 
## Number of Fisher Scoring iterations: 8
## indus, age, and lstat are not significant predictors

running a glm with significant predicotrs

glmfit <- glm(crim01 ~ nox + rad + tax, data = train, family = binomial)
summary(glmfit)
## 
## Call:
## glm(formula = crim01 ~ nox + rad + tax, family = binomial, data = train)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.94970  -0.30307  -0.03747   0.00553   2.51044  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -19.613946   2.596569  -7.554 4.23e-14 ***
## nox          35.312548   4.917585   7.181 6.93e-13 ***
## rad           0.651184   0.132400   4.918 8.73e-07 ***
## tax          -0.008215   0.002558  -3.212  0.00132 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 490.65  on 353  degrees of freedom
## Residual deviance: 174.14  on 350  degrees of freedom
## AIC: 182.14
## 
## Number of Fisher Scoring iterations: 8
glmprob <- predict(glmfit, test, type = "response")
glmpred <- rep(0, 152)
glmpred[glmprob > .5] <- 1
matrix(data=table(glmpred, test$crim01), nrow=2, ncol=2, dimnames=list(c("low", "high"), c("low", "high")))
##      low high
## low   66   14
## high   7   65
(66 + 65) / 152
## [1] 0.8618421
1-(66 + 65) / 152
## [1] 0.1381579
# the model has a 13.8% error rate. It correctly predicted 65 "high" crime rates and 66 "low" crime rates.

LDA

library(MASS)
ldafit <- lda(crim01 ~ nox + rad + tax, data = train)
ldafit
## Call:
## lda(crim01 ~ nox + rad + tax, data = train)
## 
## Prior probabilities of groups:
##         0         1 
## 0.5084746 0.4915254 
## 
## Group means:
##         nox       rad      tax
## 0 0.4695150  4.127778 306.9444
## 1 0.6377989 14.873563 510.2989
## 
## Coefficients of linear discriminants:
##              LD1
## nox  9.776108458
## rad  0.095225895
## tax -0.001700844
plot(ldafit)

ldapred <- predict(ldafit, test)
names(ldapred)
## [1] "class"     "posterior" "x"
ldaclass <- ldapred$class
summary(ldaclass)
##  0  1 
## 93 59
matrix(data=table(ldaclass, test$crim01), nrow=2, ncol=2, dimnames=list(c("low", "high"), c("low", "high")))
##      low high
## low   73   20
## high   0   59
(59+73)/152*100
## [1] 86.84211
(1-(59+73)/152)*100
## [1] 13.15789
# The lda model had an error rate of 13%. It correctly predicted 59 'high' crime rates and 73 'low' crime rates. This model performed very well.

NB Model

library(e1071)
nbfit <-naiveBayes(crim01 ~ tax + rad + nox, data = train)
nbfit
## 
## Naive Bayes Classifier for Discrete Predictors
## 
## Call:
## naiveBayes.default(x = X, y = Y, laplace = laplace)
## 
## A-priori probabilities:
## Y
##         0         1 
## 0.5084746 0.4915254 
## 
## Conditional probabilities:
##    tax
## Y       [,1]     [,2]
##   0 306.9444  89.9149
##   1 510.2989 167.2258
## 
##    rad
## Y        [,1]     [,2]
##   0  4.127778 1.704514
##   1 14.873563 9.526118
## 
##    nox
## Y        [,1]       [,2]
##   0 0.4695150 0.05545892
##   1 0.6377989 0.10196576
nbclass <- predict(nbfit , test)
matrix(data=table(nbclass, test$crim01), nrow=2, ncol=2, dimnames=list(c("low", "high"), c("low", "high")))
##      low high
## low   72   24
## high   1   55
(55+72)/152*100
## [1] 83.55263
(1-(55+72)/152)*100
## [1] 16.44737
# The Naive Bayes model has a 16.5% error rate. It correctly predicted 55 "high" crime rates and 72 "low".

KNN Model

library(class)
train.x<- cbind(train$tax, train$rad, train$nox)
test.x <- cbind(test$tax, test$rad, test$nox)
set.seed(1)
knnpred <- knn(train.x, test.x, train$crim01, k=1)
matrix(data=table(knnpred, test$crim01), nrow=2, ncol=2, dimnames=list(c("low", "high"), c("low", "high")))
##      low high
## low   69    2
## high   4   77
(77+69)/152*100
## [1] 96.05263
(1-(77+69)/152)*100
## [1] 3.947368
knnpred <- knn(train.x, test.x, train$crim01, k=10)
matrix(data=table(knnpred, test$crim01), nrow=2, ncol=2, dimnames=list(c("low", "high"), c("low", "high")))
##      low high
## low   54    3
## high  19   76
knnpred <- knn(train.x, test.x, train$crim01, k=100)
matrix(data=table(knnpred, test$crim01), nrow=2, ncol=2, dimnames=list(c("low", "high"), c("low", "high")))
##      low high
## low   65   36
## high   8   43
# The KNN model preformed the best with k=1, with only a 3.9% error rate. It correctly predicted 77 "high" crime rates and 69 "low".

Overall, the KNN model preformed the best with predicted crime rate per capita with only a 3.9% error rate!