Assignment 3 Chapter 4
Jesus Gonzalez
February 18, 2022
Problem 10
This question should be answered using the Weekly data set, which is part of the ISLR 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.
library(ISLR)
library(MASS)
library(dplyr)
library(caret)
library(ggplot2)
library(rmarkdown)
library(class)
attach(Weekly)(a) Produce some numerical and graphical summaries of the Weekly data. Do there appear to be any patterns?
pairs(Weekly[ ,-9])
abs(cor(Weekly[ ,-9]))## Year Lag1 Lag2 Lag3 Lag4 Lag5
## Year 1.00000000 0.032289274 0.03339001 0.03000649 0.031127923 0.030519101
## Lag1 0.03228927 1.000000000 0.07485305 0.05863568 0.071273876 0.008183096
## Lag2 0.03339001 0.074853051 1.00000000 0.07572091 0.058381535 0.072499482
## Lag3 0.03000649 0.058635682 0.07572091 1.00000000 0.075395865 0.060657175
## Lag4 0.03112792 0.071273876 0.05838153 0.07539587 1.000000000 0.075675027
## Lag5 0.03051910 0.008183096 0.07249948 0.06065717 0.075675027 1.000000000
## Volume 0.84194162 0.064951313 0.08551314 0.06928771 0.061074617 0.058517414
## Today 0.03245989 0.075031842 0.05916672 0.07124364 0.007825873 0.011012698
## Volume Today
## Year 0.84194162 0.032459894
## Lag1 0.06495131 0.075031842
## Lag2 0.08551314 0.059166717
## Lag3 0.06928771 0.071243639
## Lag4 0.06107462 0.007825873
## Lag5 0.05851741 0.011012698
## Volume 1.00000000 0.033077783
## Today 0.03307778 1.000000000There seems to be no correlation between the Lag Variables,however overtime Volumn is increasing which shows that the average number of shares traded has also increased.
(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?
glm_dir <- glm(Direction ~ Lag1 + Lag2 + Lag3 + Lag4 + Lag5 + Volume,
data = Weekly,
family = "binomial")
summary(glm_dir)##
## 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: 4Lag2 is the only one that shows any significance.
(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.
predicted <- factor(ifelse(predict(glm_dir, type = "response") < 0.5, "Down", "Up"))
confusionMatrix(predicted, Weekly$Direction, positive = "Up")## Confusion Matrix and Statistics
##
## Reference
## Prediction Down Up
## Down 54 48
## Up 430 557
##
## Accuracy : 0.5611
## 95% CI : (0.531, 0.5908)
## No Information Rate : 0.5556
## P-Value [Acc > NIR] : 0.369
##
## Kappa : 0.035
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.9207
## Specificity : 0.1116
## Pos Pred Value : 0.5643
## Neg Pred Value : 0.5294
## Prevalence : 0.5556
## Detection Rate : 0.5115
## Detection Prevalence : 0.9063
## Balanced Accuracy : 0.5161
##
## 'Positive' Class : Up
## We can see that with confusionMatrix, initial accuracy was 56.11%
(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 <- Weekly[Weekly$Year <= 2008, ]
test <- Weekly[Weekly$Year > 2008, ]
glm_dir <- glm(Direction ~ Lag2, data = train, family = "binomial")
predicted <- factor(ifelse(predict(glm_dir, newdata = test, type = "response") < 0.5, "Down", "Up"))
confusionMatrix(predicted, test$Direction, positive = "Up")## Confusion Matrix and Statistics
##
## Reference
## Prediction Down Up
## Down 9 5
## Up 34 56
##
## Accuracy : 0.625
## 95% CI : (0.5247, 0.718)
## No Information Rate : 0.5865
## P-Value [Acc > NIR] : 0.2439
##
## Kappa : 0.1414
##
## Mcnemar's Test P-Value : 7.34e-06
##
## Sensitivity : 0.9180
## Specificity : 0.2093
## Pos Pred Value : 0.6222
## Neg Pred Value : 0.6429
## Prevalence : 0.5865
## Detection Rate : 0.5385
## Detection Prevalence : 0.8654
## Balanced Accuracy : 0.5637
##
## 'Positive' Class : Up
## We have a higher accuracy at 62.5%. But with our p-value being .2439 there is no significance.
(e) Repeat (d) using LDA.
lda_dir <- lda(Direction ~ Lag2, data = train)
predicted_lda <- predict(lda_dir, newdata = test)
confusionMatrix(data = predicted_lda$class,
reference = test$Direction,
positive = "Up")## Confusion Matrix and Statistics
##
## Reference
## Prediction Down Up
## Down 9 5
## Up 34 56
##
## Accuracy : 0.625
## 95% CI : (0.5247, 0.718)
## No Information Rate : 0.5865
## P-Value [Acc > NIR] : 0.2439
##
## Kappa : 0.1414
##
## Mcnemar's Test P-Value : 7.34e-06
##
## Sensitivity : 0.9180
## Specificity : 0.2093
## Pos Pred Value : 0.6222
## Neg Pred Value : 0.6429
## Prevalence : 0.5865
## Detection Rate : 0.5385
## Detection Prevalence : 0.8654
## Balanced Accuracy : 0.5637
##
## 'Positive' Class : Up
## The accuracy is larger. .625 vs .5865. However, the sample size is too small for the accurancy to be meaningful.
(f) Repeat (d) using QDA.
qda_d <- qda(Direction ~ Lag2, data = train)
qda_p <- predict(qda_d, newdata = test)
confusionMatrix(data = qda_p$class, reference = test$Direction, positive = "Up")## Confusion Matrix and Statistics
##
## Reference
## Prediction Down Up
## Down 0 0
## Up 43 61
##
## Accuracy : 0.5865
## 95% CI : (0.4858, 0.6823)
## No Information Rate : 0.5865
## P-Value [Acc > NIR] : 0.5419
##
## Kappa : 0
##
## Mcnemar's Test P-Value : 1.504e-10
##
## Sensitivity : 1.0000
## Specificity : 0.0000
## Pos Pred Value : 0.5865
## Neg Pred Value : NaN
## Prevalence : 0.5865
## Detection Rate : 0.5865
## Detection Prevalence : 1.0000
## Balanced Accuracy : 0.5000
##
## 'Positive' Class : Up
## With qda, we get an accuracy of .5865.
(g) Repeat (d) using KNN with K = 1.
test[100, "Lag2"]## [1] 0.043test[75, "Lag2"]## [1] 0.158train[c(10, 808), c("Lag2", "Direction")]## Lag2 Direction
## 10 0.041 Down
## 808 0.041 Upset.seed(1)
predicted_knn <- knn(train = data.frame(Lag2 = train$Lag2),
test = data.frame(Lag2 = test$Lag2),
cl = train$Direction,
k = 1,
prob = T)
attr(predicted_knn, "prob")[100]## [1] 0.5predicted_knn[100]## [1] Down
## Levels: Down UpconfusionMatrix(data = predicted_knn, reference = test$Direction, positive = "Up")## Confusion Matrix and Statistics
##
## Reference
## Prediction Down Up
## Down 21 30
## Up 22 31
##
## Accuracy : 0.5
## 95% CI : (0.4003, 0.5997)
## No Information Rate : 0.5865
## P-Value [Acc > NIR] : 0.9700
##
## Kappa : -0.0033
##
## Mcnemar's Test P-Value : 0.3317
##
## Sensitivity : 0.5082
## Specificity : 0.4884
## Pos Pred Value : 0.5849
## Neg Pred Value : 0.4118
## Prevalence : 0.5865
## Detection Rate : 0.2981
## Detection Prevalence : 0.5096
## Balanced Accuracy : 0.4983
##
## 'Positive' Class : Up
## With knn where k=1 we get and accuracy of .5.
(h) Which of these methods appears to provide the best results on this data?
The best classifier would be LDA and the Logistic Regression where we recieved an accuracy of .625 for both of them.
Problem 11
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.
library(ISLR)
library(MASS)
library(dplyr)
library(caret)
library(ggplot2)
attach(Auto)
?Auto(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.
Auto$mpg01 <- factor(as.numeric(Auto$mpg > median(Auto$mpg)))
table(Auto$mpg01)##
## 0 1
## 196 196(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.
par(mfrow = c(2,2))
boxplot(acceleration~mpg01,data = Auto,main="Accel~mpg1")
boxplot(weight~mpg01,data = Auto,main="Weight~mpg1")
boxplot(horsepower~mpg01,data = Auto,main="Horsep~mpg1")
boxplot(displacement~mpg01,data = Auto,main="Disp~mpg1")
Some useful predictors are Horsepower, weight, and displacement.
**(c) Split the data into a training set and a test set.
train = data = Auto[1:196,]
test = data = Auto[196:392,](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?
lda.fit = lda(mpg01~weight+displacement,data = Auto)
lda.fit## Call:
## lda(mpg01 ~ weight + displacement, data = Auto)
##
## Prior probabilities of groups:
## 0 1
## 0.5 0.5
##
## Group means:
## weight displacement
## 0 3620.403 273.1582
## 1 2334.765 115.6658
##
## Coefficients of linear discriminants:
## LD1
## weight -0.001011194
## displacement -0.006968032lda.pred = predict(lda.fit, test[,c('horsepower','weight','displacement')] )
table(lda.pred$class,test[,'mpg01'])##
## 0 1
## 0 56 5
## 1 11 125mean(lda.pred$class != test[,'mpg01'])## [1] 0.08121827Using the predictors from 11.b we get an error of 8.1122%.
(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~horsepower+displacement,data = Auto)
qda.fit## Call:
## qda(mpg01 ~ horsepower + displacement, data = Auto)
##
## Prior probabilities of groups:
## 0 1
## 0.5 0.5
##
## Group means:
## horsepower displacement
## 0 130.11224 273.1582
## 1 78.82653 115.6658qda.pred = predict(qda.fit,test[,c('horsepower','weight','displacement')] )
table(qda.pred$class,test[,'mpg01'])##
## 0 1
## 0 57 11
## 1 10 119mean(qda.pred$class != test[,'mpg01'])## [1] 0.106599Using the qda we get an error of 10.6599%, which is slightly higher than LDA.
(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?
logit.fit = glm(mpg01~horsepower+displacement,family = binomial,train)
summary(logit.fit)##
## Call:
## glm(formula = mpg01 ~ horsepower + displacement, family = binomial,
## data = train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.30936 -0.17525 -0.00666 0.34107 2.11244
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 9.19005 2.03526 4.515 6.32e-06 ***
## horsepower -0.04605 0.02242 -2.054 0.04 *
## displacement -0.03501 0.00745 -4.700 2.60e-06 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 251.761 on 195 degrees of freedom
## Residual deviance: 84.575 on 193 degrees of freedom
## AIC: 90.575
##
## Number of Fisher Scoring iterations: 8logit.pred = predict(logit.fit,test[,c('horsepower','weight','displacement')])
logit.class = ifelse(logit.pred>0.5,1,0)
table(logit.class,test[,'mpg01'])##
## logit.class 0 1
## 0 65 35
## 1 2 95mean(logit.class != test[,'mpg01'])## [1] 0.1878173logit.class = ifelse(logit.pred>0.25,1,0)
table(logit.class,test[,'mpg01'])##
## logit.class 0 1
## 0 65 31
## 1 2 99mean(logit.class != test[,'mpg01'])## [1] 0.1675127This model gives us an error of 16.7513% which has the highest error of all the models used.
##13 Using the Boston data set, fit classification models in order to predict whether a given suburb has a crime rate above or below the median. Explore logistic regression, LDA, and KNN models using various subsets of the predictors. Describe your findings.