4.6.1 The Stock Market Data¶
This data set consists of percentage returns for the S&P 500 stock index(美國股票市場指標之一) over 1250 days, from the beginning of 2001 until the end of 2005.¶
For each date,¶
- Lag1 through Lag5: the percentage returns for each of the five previous trading days 賺或賠的回報(比例)
- Volume: the number of shares traded on the previous day, in billions 前一天的交易數量(百萬)
- Today: the percentage return on the date in question
- Direction: whether the market was Up or Down on thisdate) 當日漲或跌Y
In [108]:
#install.packages("ISLR")
rm(list = ls())
library(ISLR)
data(Smarket)
names(Smarket)
dim(Smarket)
In [109]:
str(Smarket)
In [110]:
summary(Smarket)
pairwise correlations among the predictors¶
In [111]:
cor(Smarket[,names(Smarket) != "Direction"])
apply(cor(Smarket[,names(Smarket) != "Direction"]),
2, FUN = function(x) abs(x) > 0.5)
cor(Volume,Year) > 0.5¶
Volum和Year有比較高的相關係數值，從圖也發現
In [126]:
# By plotting the data we see that Volume is increasing over time. In other words, the average number
# of shares traded daily increased from 2001 to 2005.
par(mfrow = c(1,2))
plot(Smarket[,"Volume"])
plot(Smarket[,"Year"],Smarket[,"Volume"])
logistic Regression¶
$ P(Y=1|X)= \frac{exp(\beta_0+\beta_1 X_1+...+\beta_p X_p)}{1+exp(\beta_0+\beta_1 X_1+...+\beta_p X_p)} $
We know that these values correspond to the probability of the market going up, rather than down, because the contrasts() function indicates that R has created a dummy variable with a 1 for Up.
In [162]:
str(Smarket[,"Direction"]) # first level = failure(0), others = success(1)
contrasts(Smarket[,"Direction"])
In [114]:
glm.log <- glm(Direction ~ Lag1 + Lag2 + Lag3 + Lag4 + Lag5 + Volume ,
data = Smarket ,family = binomial)
summary(glm.log)
Lag1的p-value最小，係數為-0.073
代表: 若有一個$X_{Lag1} > 0$，則會降低看漲機率$P(Y=1|X)$
In [115]:
glm.probs <- predict(glm.log, type = "response")
# type="response" option tells to output probabilities of the form $P(Y =1 | X)$
head(glm.probs)
plot(glm.probs)
In [116]:
res_fit = rep("Down", dim(Smarket)[1])
res_fit[glm.probs > 0.5] = "Up"
table(Fitted = res_fit, True = Smarket$Direction)
mean(res_fit == Smarket[,"Direction"])
In this case, logistic regression correctly predicted the movement of the market 52.16% of the time¶
似乎只比亂猜(50%)好一點。另外，training error = 47.84%
上面的model是全部都拿去fitting，接著，分train & test data去做:
In [132]:
train = Smarket$Year < 2005
Smarket.2005 = Smarket[!train,]
glm.log_2005 = glm(Direction ~ Lag1 + Lag2 + Lag3 + Lag4 + Lag5 + Volume ,
data = Smarket ,family = binomial, subset = train)
glm.probs_2005 = predict(glm.log_2005, Smarket.2005, type = "response")
In [136]:
summary(glm.log_2005)
In [135]:
res_fit_2005 = rep("Down", dim(Smarket.2005)[1])
res_fit_2005[glm.probs_2005 > 0.5] = "Up"
table(Fitted = res_fit_2005, True = Smarket.2005$Direction)
mean(res_fit_2005 == Smarket.2005$Direction)
The results are rather disappointing: the test error rate is 52 %, which is worse than random guessing!¶
結果在testing data的正確率只有48% QQ
注意: model裡各個解釋變數的p-value都很大. 我們試著只用Lag1,Lag2去fit model: (之後的LDA, QDA, KNN都是)
In [163]:
glm.log_2005_x1x2 = glm(Direction ~ Lag1 + Lag2 ,
data = Smarket ,family = binomial, subset = train)
glm.probs_2005_x1x2 = predict(glm.log_2005_x1x2, Smarket.2005, type = "response")
res_fit_2005_x1x2 = rep("Down", dim(Smarket.2005)[1])
res_fit_2005_x1x2[ glm.probs_2005_x1x2 > 0.5] = "Up"
table(Fitted = res_fit_2005_x1x2, True = Smarket.2005$Direction)
mean(res_fit_2005_x1x2 == Smarket.2005$Direction)
結果在testing data的正確率提升到56%~
In [164]:
ls()
Linear Discriminant Analysis(LDA)¶
In [167]:
library(MASS)
lda_mod = lda(Direction ~ Lag1 + Lag2 ,
data = Smarket , subset = train)
lda_mod
In [168]:
# Prior probabilities of groups:
table(Smarket[train,"Direction"])
# Group means:
apply(Smarket[ train & (Smarket[,"Direction"] == "Down") ,c("Lag1","Lag2") ] ,
2, mean)
apply(Smarket[ train & (Smarket[,"Direction"] == "Up") ,c("Lag1","Lag2") ] ,
2, mean)
In [170]:
lda.pred = predict(lda_mod, Smarket.2005)
str(lda.pred)
- class: LDA’s predictions about the movement of the market.
- posterior a matrix whose kth column contains the posterior probability that the corresponding observation belongs to the kth class, computed from $P(Y=k | X= x) = \frac{\pi_k f_k(x)}{ \sum_{l=1}^K \pi_l f_l(x) }$, $f_k \sim N(\mu_k,\sigma^2)$
- x contains the linear discriminants, $-0.642*Lag_1 - 0.514*Lag_2$ is large.
In [171]:
res_lda = lda.pred$class
table(fitted = res_lda, Smarket.2005$Direction)
mean(res_lda == Smarket.2005$Direction)
note: LDA and logistic regression predictions are almost identical.
If applying a 50% threshold to the posterior probabilities¶
In [173]:
summary(lda.pred$posterior)
In [178]:
#lda.pred$posterior
sum(lda.pred$posterior[,2] >= 0.5) # =76+106
sum(lda.pred$posterior[,1] >= 0.5) # =35+35
Quadratic Discriminant Analysis(QDA)¶
In [183]:
qda_mod = qda(Direction ~ Lag1 + Lag2 ,
data = Smarket , subset = train)
qda_mod
In [184]:
qda.pred = predict(qda_mod, Smarket.2005)
str(qda.pred)
In [185]:
res_qda = qda.pred$class
table(fitted = res_qda, Smarket.2005$Direction)
mean(res_qda == Smarket.2005$Direction)
QDA在testing data的正確率高達60%; LDA=logistic= 56%.¶
K-Nearest Neighbors¶
In [190]:
library(class)
train_X = Smarket[ train, c("Lag1", "Lag2")]
test_X = Smarket[ !train, c("Lag1", "Lag2")]
train_Y = Smarket[ train, c("Direction")]
In [199]:
set.seed(1)
KNN_1 = knn(train = train_X, test = test_X, cl = train_Y, k = 1)
str(KNN_1)
table(Fitted = KNN_1, True = Smarket.2005$Direction)
mean(KNN_1 == Smarket.2005$Direction)
In [200]:
KNN_3 = knn(train = train_X, test = test_X, cl = train_Y, k = 3)
str(KNN_3)
table(Fitted = KNN_3, True = Smarket.2005$Direction)
mean(KNN_3 == Smarket.2005$Direction)
| logistic | LDA | QDA | KNN |
|---|---|---|---|
| 56% | 56% | 60% | 54% |
代表這筆資料上，QDA model的assumption可能比較適合!¶
In [ ]: