R Markdown

This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.

When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:

# (A)
library(ISLR)
## Warning: package 'ISLR' was built under R version 4.2.3
library(corrplot)
## Warning: package 'corrplot' was built under R version 4.2.3
## corrplot 0.92 loaded
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  
##            
##            
##            
## 
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.000000000
corrplot(cor(Weekly[, -9]), method = "square")

pairs(Weekly[-9])

# (B)
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: 4
# (C)
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 557
# (D)
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 56
mean(logWeekly.pred == Direction.0910)
## [1] 0.625
# (E)
library(MASS)
Weeklylda.fit <- lda(Direction ~ Lag2, data = Weekly, subset = train)
Weeklylda.pred <- predict(Weeklylda.fit, Weekly.0910)
table(Weeklylda.pred$class, Direction.0910)
##       Direction.0910
##        Down Up
##   Down    9  5
##   Up     34 56
mean(Weeklylda.pred$class == Direction.0910)
## [1] 0.625
# (F)
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 61
mean(Weeklyqda.pred == Direction.0910)
## [1] 0.5865385
# (G)
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 31
mean(Weekknn.pred == Direction.0910)
## [1] 0.5
# (H)
# Confusion matrix and overall fraction of correct predictions for logistic regression with Lag2
table(logWeekly.pred, Direction.0910)
##               Direction.0910
## logWeekly.pred Down Up
##           Down    9  5
##           Up     34 56
mean(logWeekly.pred == Direction.0910)
## [1] 0.625
# (I)
# The methods that have the highest accuracy rates are the Logistic Regression and Linear Discriminant Analysis; both having rates of 62.5%.

# (J)
# 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"
table(logWeekly.pred, Direction.0910)
##               Direction.0910
## logWeekly.pred Down Up
##           Down    3  4
##           Up     40 57
mean(logWeekly.pred == Direction.0910)
## [1] 0.5769231
# LDA with Interaction Lag2:Lag4
Weeklylda.fit <- lda(Direction ~ Lag2:Lag4 + Lag2, data = Weekly, subset = train)
Weeklylda.pred <- predict(Weeklylda.fit, Weekly.0910)
table(Weeklylda.pred$class, Direction.0910)
##       Direction.0910
##        Down Up
##   Down    3  3
##   Up     40 58
mean(Weeklylda.pred$class == Direction.0910)
## [1] 0.5865385
# QDA with Polynomial Transformation of Lag2
Weeklyqda.fit <- qda(Direction ~ poly(Lag2, 2), data = Weekly, subset = train)
Weeklyqda.pred <- predict(Weeklyqda.fit, Weekly.0910)$class
table(Weeklyqda.pred, Direction.0910)
##               Direction.0910
## Weeklyqda.pred Down Up
##           Down    7  3
##           Up     36 58
mean(Weeklyqda.pred == Direction.0910)
## [1] 0.625
# KNN with K = 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 40
mean(Weekknn.pred == Direction.0910)
## [1] 0.5480769
# KNN with K = 100
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 = 100)
table(Weekknn.pred, Direction.0910)
##             Direction.0910
## Weekknn.pred Down Up
##         Down   10 11
##         Up     33 50
mean(Weekknn.pred == Direction.0910)
## [1] 0.5769231

Including Plots

You can also embed plots, for example:

Note that the echo = FALSE parameter was added to the code chunk to prevent printing of the R code that generated the plot.