Assignment 3
ikq392
2022-09-18
Problem 13.
This question should be answered using the Weekly data set, which is part of the ISLR2 package. This data is similar in nature to the Smarket data from this chapter’s lab, except that it contains 1, 089 weekly returns for 21 years, from the beginning of 1990 to the end of 2010.
(a) Produce some numerical and graphical summaries of the Weekly data. Do there appear to be any patterns?
library(ISLR2)
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
##
##
##
## library(ISLR2)
pairs(Weekly)
cor(Weekly[,-9])## Year Lag1 Lag2 Lag3 Lag4
## Year 1.00000000 -0.032289274 -0.03339001 -0.03000649 -0.031127923
## Lag1 -0.03228927 1.000000000 -0.07485305 0.05863568 -0.071273876
## Lag2 -0.03339001 -0.074853051 1.00000000 -0.07572091 0.058381535
## Lag3 -0.03000649 0.058635682 -0.07572091 1.00000000 -0.075395865
## Lag4 -0.03112792 -0.071273876 0.05838153 -0.07539587 1.000000000
## Lag5 -0.03051910 -0.008183096 -0.07249948 0.06065717 -0.075675027
## Volume 0.84194162 -0.064951313 -0.08551314 -0.06928771 -0.061074617
## Today -0.03245989 -0.075031842 0.05916672 -0.07124364 -0.007825873
## Lag5 Volume Today
## Year -0.030519101 0.84194162 -0.032459894
## Lag1 -0.008183096 -0.06495131 -0.075031842
## Lag2 -0.072499482 -0.08551314 0.059166717
## Lag3 0.060657175 -0.06928771 -0.071243639
## Lag4 -0.075675027 -0.06107462 -0.007825873
## Lag5 1.000000000 -0.05851741 0.011012698
## Volume -0.058517414 1.00000000 -0.033077783
## Today 0.011012698 -0.03307778 1.000000000There are no substantial correlations except for a very high volume growth of trading from 1990 (0.087) and 2010 (9.328).
(b) Use the full data set to perform a logistic regression with Direction as the response and the five lag variables plus Volume as predictors. Use the summary function to print the results. Do any of the predictors appear to be statistically significant? If so, which ones?
attach(Weekly)
Weekly.fit<-glm(Direction~Lag1+Lag2+Lag3+Lag4+Lag5+Volume, data=Weekly,family=binomial)
summary(Weekly.fit)##
## 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: 4The only statistically significant variable is Lag2. All
others fail to reject the null hypothesis.
(c) Compute the confusion matrix and overall fraction of correct predictions. Explain what the confusion matrix is telling you about the types of mistakes made by logistic regression.
logWeekly.prob= predict(Weekly.fit, type='response')
logWeekly.pred =rep("Down", length(logWeekly.prob))
logWeekly.pred[logWeekly.prob > 0.5] = "Up"
table(logWeekly.pred, Direction)## Direction
## logWeekly.pred Down Up
## Down 54 48
## Up 430 557The model predicted the up or down trend a total of 1,089 times (54+48+430+557). Of these predictions, a down trend was correctly predicted 54 times and an up trend was correctly predicted 557 times (54+557 = 611, 611 / 1089 = 56% accuracy). Up trends were correctly predicted 92% of the time (557/(48+557)), and Down trends were correctly predicted 11% of the time (54/(430+54)).
(d) Now fit the logistic regression model using a training data period from 1990 to 2008, with Lag2 as the only predictor. Compute the confusion matrix and the overall fraction of correct predictions for the held out data (that is, the data from 2009 and 2010).
train = (Year<2009)
Weekly.0910 <-Weekly[!train,]
Weekly.fit<-glm(Direction~Lag2, data=Weekly,family=binomial, subset=train)
logWeekly.prob= predict(Weekly.fit, Weekly.0910, type = "response")
logWeekly.pred = rep("Down", length(logWeekly.prob))
logWeekly.pred[logWeekly.prob > 0.5] = "Up"
Direction.0910 = Direction[!train]
table(logWeekly.pred, Direction.0910)## Direction.0910
## logWeekly.pred Down Up
## Down 9 5
## Up 34 56mean(logWeekly.pred == Direction.0910)## [1] 0.625The training model correctly predicted trends 63% of the time, an improvement of 7 percentage points.
(e) Repeat (d) using LDA.
library(MASS)
Weeklylda.fit<-lda(Direction~Lag2, data=Weekly,family=binomial, subset=train)
Weeklylda.pred<-predict(Weeklylda.fit, Weekly.0910)
table(Weeklylda.pred$class, Direction.0910)## Direction.0910
## Down Up
## Down 9 5
## Up 34 56mean(Weeklylda.pred$class==Direction.0910)## [1] 0.625Using LDA gives the same result as the logistic regression model.
(f) Repeat (d) using QDA.
Weeklyqda.fit = qda(Direction ~ Lag2, data = Weekly, subset = train)
Weeklyqda.pred = predict(Weeklyqda.fit, Weekly.0910)$class
table(Weeklyqda.pred, Direction.0910)## Direction.0910
## Weeklyqda.pred Down Up
## Down 0 0
## Up 43 61mean(Weeklyqda.pred==Direction.0910)## [1] 0.5865385Using QDA gives a model with 59% accuracy, lower than LDA by 4 percentage points.
(g) Repeat (d) using KNN with K = 1.
library(class)
Week.train=as.matrix(Lag2[train])
Week.test=as.matrix(Lag2[!train])
train.Direction =Direction[train]
set.seed(1)
Weekknn.pred=knn(Week.train,Week.test,train.Direction,k=1)
table(Weekknn.pred,Direction.0910)## Direction.0910
## Weekknn.pred Down Up
## Down 21 30
## Up 22 31mean(Weekknn.pred == Direction.0910)## [1] 0.5Using KNN gives a model with 50% accuracy, or random chance for up or down trend.
(h) Repeat (d) using naive Bayes.
library(e1071)
weeklynb.fit<-naiveBayes(Direction~Lag2,data=Weekly,subset=train)
weeklynb.class<-predict(weeklynb.fit,Weekly.0910)
table(weeklynb.class,Direction.0910)## Direction.0910
## weeklynb.class Down Up
## Down 0 0
## Up 43 61mean(weeklynb.class == Direction.0910)## [1] 0.5865385Using Naive Bayes gives a model with 62% accuracy.
(i) Which of these methods appears to provide the best
results on this data?
The methods with highest accuracy rates provide the best results - this
would be the logistic regression and LDA with rates of 63%.
(j) Experiment with different combinations of predictors,
including possible transformations and interactions, for each of the
methods. Report the variables, method, and associated confusion matrix
that appears to provide the best results on the held out data. Note that
you should also experiment with values for K in the KNN
classifier.
Logistic regression with interaction Lag2 & Lag4
Weekly.fit<-glm(Direction~Lag2:Lag4+Lag2, data=Weekly,family=binomial, subset=train)
logWeekly.prob= predict(Weekly.fit, Weekly.0910, type = "response")
logWeekly.pred = rep("Down", length(logWeekly.prob))
logWeekly.pred[logWeekly.prob > 0.5] = "Up"
Direction.0910 = Direction[!train]
table(logWeekly.pred, Direction.0910)## Direction.0910
## logWeekly.pred Down Up
## Down 3 4
## Up 40 57mean(logWeekly.pred == Direction.0910)## [1] 0.5769231K=10
Week.train=as.matrix(Lag2[train])
Week.test=as.matrix(Lag2[!train])
train.Direction =Direction[train]
set.seed(1)
Weekknn.pred=knn(Week.train,Week.test,train.Direction,k=10)
table(Weekknn.pred,Direction.0910)## Direction.0910
## Weekknn.pred Down Up
## Down 17 21
## Up 26 40mean(Weekknn.pred == Direction.0910)## [1] 0.5480769Both experiments produce models with lower accuracy rates.
Problem 14.
In this problem, you will develop a model to predict whether a given car gets high or low gas mileage based on the Auto data set.
(a) Create a binary variable, mpg01, that contains a 1 if mpg contains a value above its median, and a 0 if mpg contains a value below its median. You can compute the median using the median() function. Note you may find it helpful to use the data.frame() function to create a single data set containing both mpg01 and the other Auto variables.
library(ISLR2)
attach(Auto)
mpg01 <- ifelse( mpg > median(mpg), yes = 1, no = 0)
Auto <- data.frame(Auto, mpg01)(b) Explore the data graphically in order to investigate the association between mpg01 and the other features. Which of the other features seem most likely to be useful in predicting mpg01? Scatterplots and boxplots may be useful tools to answer this question. Describe your findings.
cor(Auto[,-9])## mpg cylinders displacement horsepower weight
## mpg 1.0000000 -0.7776175 -0.8051269 -0.7784268 -0.8322442
## cylinders -0.7776175 1.0000000 0.9508233 0.8429834 0.8975273
## displacement -0.8051269 0.9508233 1.0000000 0.8972570 0.9329944
## horsepower -0.7784268 0.8429834 0.8972570 1.0000000 0.8645377
## weight -0.8322442 0.8975273 0.9329944 0.8645377 1.0000000
## acceleration 0.4233285 -0.5046834 -0.5438005 -0.6891955 -0.4168392
## year 0.5805410 -0.3456474 -0.3698552 -0.4163615 -0.3091199
## origin 0.5652088 -0.5689316 -0.6145351 -0.4551715 -0.5850054
## mpg01 0.8369392 -0.7591939 -0.7534766 -0.6670526 -0.7577566
## acceleration year origin mpg01
## mpg 0.4233285 0.5805410 0.5652088 0.8369392
## cylinders -0.5046834 -0.3456474 -0.5689316 -0.7591939
## displacement -0.5438005 -0.3698552 -0.6145351 -0.7534766
## horsepower -0.6891955 -0.4163615 -0.4551715 -0.6670526
## weight -0.4168392 -0.3091199 -0.5850054 -0.7577566
## acceleration 1.0000000 0.2903161 0.2127458 0.3468215
## year 0.2903161 1.0000000 0.1815277 0.4299042
## origin 0.2127458 0.1815277 1.0000000 0.5136984
## mpg01 0.3468215 0.4299042 0.5136984 1.0000000par(mfrow=c(2,3))
boxplot(cylinders ~ mpg01, data = Auto, main = "Cylinders vs mpg01")
boxplot(displacement ~ mpg01, data = Auto, main = "Displacement vs mpg01")
boxplot(horsepower ~ mpg01, data = Auto, main = "Horsepower vs mpg01")
boxplot(weight ~ mpg01, data = Auto, main = "Weight vs mpg01")
boxplot(acceleration ~ mpg01, data = Auto, main = "Acceleration vs mpg01")
boxplot(year ~ mpg01, data = Auto, main = "Year vs mpg01")
The features that seem most likely to be useful in predicting mpg01 are
Cylinders, displacement, weight,
and horsepower.
(c) Split the data into a training set and a test set.
Auto <- data.frame(mpg01, apply(cbind(cylinders, weight, displacement, horsepower, acceleration), 2, scale), year)
train <- (year %% 2 == 0) # if the year is even (%%)
test <- !train
Auto.train <- Auto[train,]
Auto.test <- Auto[test,]
mpg01.test <- mpg01[test](d) Perform LDA on the training data in order to predict mpg01 using the variables that seemed most associated with mpg01 in (b). What is the test error of the model obtained?
library(MASS)
lda.fit <- lda(mpg01 ~ cylinders + weight + displacement + horsepower, data = Auto, subset = train)
lda.pred <- predict(lda.fit, Auto.test)
mean(lda.pred$class != mpg01.test)## [1] 0.1263736The test error of the model obtained is 12.6%.
(e) Perform QDA on the training data in order to predict mpg01 using the variables that seemed most associated with mpg01 in (b). What is the test error of the model obtained?
qda.fit = qda(mpg01 ~ cylinders + weight + displacement + horsepower, data = Auto, family=binomial, subset = train)
qda.pred = predict(qda.fit, Auto.train)$class
table(qda.pred, Auto.train$mpg01)##
## qda.pred 0 1
## 0 86 6
## 1 10 108mean(qda.pred!= Auto.test$mpg01)## [1] 0.3857143The test error of the model obtained is 38.6%.
(f) Perform logistic regression on the training data in order to predict mpg01 using the variables that seemed most associated with mpg01 in (b). What is the test error of the model obtained?
library(MASS)
glm.fit <- glm(mpg01 ~ cylinders + weight + displacement + horsepower,data = Auto,family = binomial,subset = train)
glm.probs <- predict(glm.fit, Auto.test, type = "response")
glm.pred <- rep(0, length(glm.probs))
glm.pred[glm.probs > 0.5] <- 1
mean(glm.pred != mpg01.test)## [1] 0.1208791The test error of the model obtained is 12.1%.
(g) Perform naive Bayes on the training data in order to predict mpg01 using the variables that seemed most associated with mpg01 in (b). What is the test error of the model obtained?
mpg01nb.fit<-naiveBayes(mpg01 ~ cylinders + weight + displacement + horsepower, data = Auto, subset = train)
mpg01nb.class<-predict(mpg01nb.fit,Auto.test)
table(mpg01nb.class=mpg01.test)## mpg01nb.class
## 0 1
## 100 82mean(mpg01nb.class !=mpg01.test)## [1] 0.1263736The test error of the naive Bayes model is 12.6%.
(h) Perform KNN on the training data, with several values of K, in order to predict mpg01. Use only the variables that seemed most associated with mpg01 in (b). What test errors do you obtain? Which value of K seems to perform the best on this data set?
library(class)
train.X <- cbind(cylinders, weight, displacement, horsepower)[train,]
test.X <- cbind(cylinders, weight, displacement, horsepower)[test,]
train.mpg01 <- mpg01[train]
set.seed(1)k=1
knn.pred <- knn(train.X, test.X, train.mpg01, k = 1)
mean(knn.pred != mpg01.test)## [1] 0.1538462The test error of the k=1 model is 15.4%.
k=10
knn.pred <- knn(train.X, test.X, train.mpg01, k = 10)
mean(knn.pred != mpg01.test)## [1] 0.1648352The test error of the k=1 model is 14.8%.
k=100
knn.pred <- knn(train.X, test.X, train.mpg01, k = 100)
mean(knn.pred != mpg01.test)## [1] 0.1428571The test error of the k=1 model is 14.3%. K=100 seems to perform the best on this data set.
Problem 16.
Using the Boston data set, fit classification models in order to predict whether a given census tract has a crime rate above or below the median. Explore logistic regression, LDA, naive Bayes, and KNN models using various subsets of the predictors. Describe your findings. Hint: You will have to create the response variable yourself, using the variables that are contained in the Boston data set.
summary(Boston)## crim zn indus chas
## Min. : 0.00632 Min. : 0.00 Min. : 0.46 Min. :0.00000
## 1st Qu.: 0.08205 1st Qu.: 0.00 1st Qu.: 5.19 1st Qu.:0.00000
## Median : 0.25651 Median : 0.00 Median : 9.69 Median :0.00000
## Mean : 3.61352 Mean : 11.36 Mean :11.14 Mean :0.06917
## 3rd Qu.: 3.67708 3rd Qu.: 12.50 3rd Qu.:18.10 3rd Qu.:0.00000
## Max. :88.97620 Max. :100.00 Max. :27.74 Max. :1.00000
## nox rm age dis
## Min. :0.3850 Min. :3.561 Min. : 2.90 Min. : 1.130
## 1st Qu.:0.4490 1st Qu.:5.886 1st Qu.: 45.02 1st Qu.: 2.100
## Median :0.5380 Median :6.208 Median : 77.50 Median : 3.207
## Mean :0.5547 Mean :6.285 Mean : 68.57 Mean : 3.795
## 3rd Qu.:0.6240 3rd Qu.:6.623 3rd Qu.: 94.08 3rd Qu.: 5.188
## Max. :0.8710 Max. :8.780 Max. :100.00 Max. :12.127
## rad tax ptratio black
## Min. : 1.000 Min. :187.0 Min. :12.60 Min. : 0.32
## 1st Qu.: 4.000 1st Qu.:279.0 1st Qu.:17.40 1st Qu.:375.38
## Median : 5.000 Median :330.0 Median :19.05 Median :391.44
## Mean : 9.549 Mean :408.2 Mean :18.46 Mean :356.67
## 3rd Qu.:24.000 3rd Qu.:666.0 3rd Qu.:20.20 3rd Qu.:396.23
## Max. :24.000 Max. :711.0 Max. :22.00 Max. :396.90
## lstat medv
## Min. : 1.73 Min. : 5.00
## 1st Qu.: 6.95 1st Qu.:17.02
## Median :11.36 Median :21.20
## Mean :12.65 Mean :22.53
## 3rd Qu.:16.95 3rd Qu.:25.00
## Max. :37.97 Max. :50.00attach(Boston)
median_crime=median(crim)crim_lvl <- rep(0, 506)
crim_lvl[crim > median_crime] = 1
crim_lvl <- as.factor(crim_lvl)
Boston_2 <- data.frame(Boston, crim_lvl)
detach(Boston)
pairs(Boston_2)
The nox, age, dis, medv variables appear to have strong correlation with crime rate.
set.seed(1)
train_13 <- rbinom(506, 1, 0.7)
Boston_2 <- cbind(Boston_2, train_13)
Boston.train <- Boston_2[train_13 == 1,]
Boston.test <- Boston_2[train_13 == 0,]
attach(Boston.train)Logistic model:
log_13_fits <- glm(crim_lvl~nox + age + dis + medv, data = Boston.train, family = binomial)
summary(log_13_fits)##
## Call:
## glm(formula = crim_lvl ~ nox + age + dis + medv, family = binomial,
## data = Boston.train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.17404 -0.35742 0.00278 0.26418 2.53635
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -24.900404 4.019591 -6.195 5.84e-10 ***
## nox 38.426015 5.859800 6.558 5.47e-11 ***
## age 0.016253 0.009966 1.631 0.1029
## dis 0.309361 0.164026 1.886 0.0593 .
## medv 0.087237 0.028230 3.090 0.0020 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 499.02 on 359 degrees of freedom
## Residual deviance: 210.55 on 355 degrees of freedom
## AIC: 220.55
##
## Number of Fisher Scoring iterations: 7The age variable is not significant.
log_13_fits <- glm(crim_lvl~nox + dis + medv, data = Boston.train, family = binomial)
summary(log_13_fits)##
## Call:
## glm(formula = crim_lvl ~ nox + dis + medv, family = binomial,
## data = Boston.train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.19958 -0.39388 0.00252 0.26563 2.48475
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -23.94414 3.89175 -6.153 7.63e-10 ***
## nox 39.78032 5.77733 6.886 5.75e-12 ***
## dis 0.23393 0.15697 1.490 0.13615
## medv 0.07713 0.02678 2.880 0.00398 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 499.02 on 359 degrees of freedom
## Residual deviance: 213.25 on 356 degrees of freedom
## AIC: 221.25
##
## Number of Fisher Scoring iterations: 7The dis variable is not significant.
log_13_fits <- glm(crim_lvl~nox + medv, data = Boston.train, family = binomial)
summary(log_13_fits)##
## Call:
## glm(formula = crim_lvl ~ nox + medv, family = binomial, data = Boston.train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.17657 -0.38729 0.00523 0.30375 2.65695
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -19.74864 2.42833 -8.133 4.2e-16 ***
## nox 33.97633 3.88025 8.756 < 2e-16 ***
## medv 0.06605 0.02524 2.617 0.00887 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 499.02 on 359 degrees of freedom
## Residual deviance: 215.41 on 357 degrees of freedom
## AIC: 221.41
##
## Number of Fisher Scoring iterations: 6detach(Boston.train)
log_13_prob <- predict(log_13_fits, Boston.test, type = 'response')
log_13_preds <- rep(0, 146)
log_13_preds[log_13_prob > 0.5] = 1
dat <- matrix(data=table(log_13_preds, Boston.test$crim_lvl), nrow=2, ncol=2,
dimnames=list(c("Below median", "Above median"), c("Below", "Above")))
names(dimnames(dat)) <- c("predicted", "observed")
print(dat)## observed
## predicted Below Above
## Below median 63 16
## Above median 12 55The model’s error rate is (16+12)/146, or 0.1917808 = 19.2%.
The nox and medv predictors are
significant. As the nox variable increases, the probability
of an above median crime rate for the neighborhood increases. As the
median value of owner-occupied homes increases, the probability for high
crime rate also increases.
LDA Analysis:
lda_13_fits <- lda(crim_lvl~nox + age+ dis+medv, data = Boston_2, subset= (train_13==1))
lda_13_fits## Call:
## lda(crim_lvl ~ nox + age + dis + medv, data = Boston_2, subset = (train_13 ==
## 1))
##
## Prior probabilities of groups:
## 0 1
## 0.4944444 0.5055556
##
## Group means:
## nox age dis medv
## 0 0.4690051 51.33371 5.241056 24.95618
## 1 0.6401758 86.26044 2.498684 20.19670
##
## Coefficients of linear discriminants:
## LD1
## nox 9.32383649
## age 0.01342745
## dis -0.08315746
## medv 0.01499271lda_13_preds <- predict(lda_13_fits, Boston.test)
lda_13_class <- lda_13_preds$class
dat <- matrix(data=table(lda_13_class, Boston.test$crim_lvl), nrow=2, ncol=2,
dimnames=list(c("Below median", "Above median"), c("Below", "Above")))
names(dimnames(dat)) <- c("predicted", "observed")
print(dat)## observed
## predicted Below Above
## Below median 62 14
## Above median 13 57The error rate is (14+13)/146 = 0.1849315 or 18.5%.
Through LDA Analysis, the variables nox,
age, and medv have positive correlation. The
dis variable has negative correlation. The error rate is
slightly lower than the logistic model.
Naive Bayes:
bosnb.fit<-naiveBayes(crim_lvl~nox + age+ dis+medv, data = Boston_2, subset= (train_13==1))
bosnb.class<-predict(bosnb.fit,Boston.test)
dat <- matrix(data=table(bosnb.class, Boston.test$crim_lvl), nrow=2, ncol=2,
dimnames=list(c("Below median", "Above median"), c("Below", "Above")))
names(dimnames(dat)) <- c("predicted", "observed")
print(dat)## observed
## predicted Below Above
## Below median 59 8
## Above median 16 63The error rate is (8+16)/146 = 0.16438 or 16.4%.
K Nearest Neighbors, k=3:
train.x_13 <- cbind(Boston.train$nox, Boston.train$tax, Boston.train$pratio)
test.x_13 <- cbind(Boston.test$nox, Boston.test$tax, Boston.test$pratio)
set.seed(1)
knn_pred_13 <- knn(train.x_13, test.x_13, Boston.train$crim_lvl, k=3)
table(knn_pred_13, Boston.test$crim_lvl)##
## knn_pred_13 0 1
## 0 71 5
## 1 4 66The error rate is (4+5)/146 = 0.06164384, or 6.16%.
K Nearest Neighbors, k=5:
train.x_13 <- cbind(Boston.train$nox, Boston.train$tax, Boston.train$pratio)
test.x_13 <- cbind(Boston.test$nox, Boston.test$tax, Boston.test$pratio)
set.seed(1)
knn_pred_13 <- knn(train.x_13, test.x_13, Boston.train$crim_lvl, k=5)
table(knn_pred_13, Boston.test$crim_lvl)##
## knn_pred_13 0 1
## 0 69 5
## 1 6 66The error rate is (5+6)/146 = 0.07534247, or 7.53%.
The KNN models give a lower error rate than logistic regression or LDA - I was unable to run naive Bayes. While KNN does not give analysis on significant predictors, it does tell us that we can attempt to lower the crime rate of a community by looking at the three nearest neighboring communities’ air porllution, tax rates, and school funding.