Blog

HW5
Fengrui Liu
2020/10/1
##3. (e)
library(ISLR)
attach(Weekly)
library(MASS)
## Warning: package ‘MASS’ was built under R version 3.6.2
weekly_training <- Weekly[Year <= 2008,] weekly_test <- Weekly[Year > 2008,]
LAD_data = lda(Direction ~ Lag2, data= weekly_training)
Predicted_LDA <- predict(LAD_data, data.frame(weekly_test))$class table( weekly_test$Direction, Predicted_LDA ) ## Predicted_LDA ## Down Up ## Down 9 34 ## Up 5 56 mean(weekly_test$Direction == Predicted_LDA) ## [1] 0.625 (f) QDA_data <- qda(Direction ~ Lag2, data=weekly_training) Predicted_QDA <- predict(QDA_data, data.frame(weekly_test))$class table( weekly_test$Direction, Predicted_QDA ) ## Predicted_QDA ## Down Up ## Down 0 43 ## Up 0 61 mean(weekly_test$Direction == Predicted_QDA) ## [1] 0.5865385 (g) X.train <- matrix( Lag2[ Year <= 2008 ], sum(Year <= 2008), 1 ) X.test <- matrix( Lag2[ Year > 2008 ], sum(Year >= 2009), 1 )
Y.train <- Direction[ Year <= 2008 ] Y.test <- Direction[ Year > 2008 ]
knn.fit <- class::knn( X.train, X.test, Y.train, 1 ) table( Y.test, knn.fit ) ## knn.fit ## Y.test Down Up ## Down 21 22 1 ## Up 30 31 mean( Y.test == knn.fit ) ## [1] 0.5 (h) LDA: classification rate is 63%. QDA: classification rate is 53%. KNN: classification rate is 51%. LDA is better than QDA. LDA,QDA are better than KNN. 4 attach(Boston) names(Boston) ## [1] "crim" "zn" "indus" "chas" "nox" "rm" "age" ## [8] "dis" "rad" "tax" "ptratio" "black" "lstat" "medv" Crime <- rep(0, length(crim)) Crime[crim > median(crim)] <- 1 Boston<- data.frame(Boston,Crime) train <- 1:(dim(Boston)[1]/2) test <- (dim(Boston)[1]/2 + 1):dim(Boston)[1] Boston_train <- Boston[train, ] Boston_test <- Boston[test, ] crim_test <- Crime[test] ## Logistic regression. reg_model1 <- glm(Crime ~ zn + indus + chas + nox + rm + age + dis + rad + tax + ptratio + black + lstat + medv, family="binomial") summary(reg_model1) ## ## Call: ## glm(formula = Crime ~ zn + indus + chas + nox + rm + age + dis + ## rad + tax + ptratio + black + lstat + medv, family = "binomial") ## ## Deviance Residuals: ## Min 1Q Median 3Q Max ## -2.3946 -0.1585 -0.0004 0.0023 3.4239 ## ## Coefficients: ## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -34.103704 6.530014 -5.223 1.76e-07 ***
## zn -0.079918 0.033731 -2.369 0.01782 *
## indus -0.059389 0.043722 -1.358 0.17436
## chas 0.785327 0.728930 1.077 0.28132
## nox 48.523782 7.396497 6.560 5.37e-11 ***
## rm -0.425596 0.701104 -0.607 0.54383
## age 0.022172 0.012221 1.814 0.06963 .
## dis 0.691400 0.218308 3.167 0.00154 **
## rad 0.656465 0.152452 4.306 1.66e-05 ***
## tax -0.006412 0.002689 -2.385 0.01709 *
## ptratio 0.368716 0.122136 3.019 0.00254 **
## black -0.013524 0.006536 -2.069 0.03853 *
## lstat 0.043862 0.048981 0.895 0.37052
## medv 0.167130 0.066940 2.497 0.01254 *
## —
2
## Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ‘ 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 701.46 on 505 degrees of freedom
## Residual deviance: 211.93 on 492 degrees of freedom
## AIC: 239.93
##
## Number of Fisher Scoring iterations: 9
Because of the P-value, significant variables are: zn, nox, age, dis, rad, tax, ptratio, black, medv.
reg_model2<- glm(Crime ~ zn + nox + age + dis + rad + tax + ptratio + black + medv, data = Boston_train, family="binomial") ## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred summary(reg_model2) ## ## Call: ## glm(formula = Crime ~ zn + nox + age + dis + rad + tax + ptratio + ## black + medv, family = "binomial", data = Boston_train) ## ## Deviance Residuals: ## Min 1Q Median 3Q Max ## -2.1131 -0.1780 -0.0009 0.2415 3.0885 ## ## Coefficients: ## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -66.233571 11.236568 -5.894 3.76e-09 ***
## zn -0.428786 0.098572 -4.350 1.36e-05 ***
## nox 81.501997 14.107158 5.777 7.59e-09 ***
## age 0.020096 0.017923 1.121 0.2622
## dis 2.199728 0.463544 4.745 2.08e-06 ***
## rad 1.523621 0.312386 4.877 1.08e-06 ***
## tax -0.012168 0.005396 -2.255 0.0241 *
## ptratio 0.639813 0.164406 3.892 9.96e-05 ***
## black -0.009557 0.005961 -1.603 0.1089
## medv 0.094511 0.048743 1.939 0.0525 .
## —
## Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ‘ 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 329.37 on 252 degrees of freedom
## Residual deviance: 91.88 on 243 degrees of freedom
## AIC: 111.88
##
## Number of Fisher Scoring iterations: 9
p <- predict(reg_model2, type = "response", data.frame(Boston_test)) p_crime <- 1*(p > 0.5)
table(Boston_test$Crime, p_crime)
## p_crime
## 0 1
## 0 71 19
3
## 1 21 142
mean(Boston_test$Crime != p_crime)
## [1] 0.1581028
## LDA
lda.crime<- lda(Crime ~ zn + nox + age + dis + rad + tax + ptratio + black + medv, data=Boston_train) predict_lda <- predict(lda.crime, data.frame(Boston_test))$class table(Boston_test$Crime, predict_lda) ## predict_lda ## 0 1 ## 0 80 10 ## 1 22 141 mean(Boston_test$Crime != predict_lda) ## [1] 0.1264822 ## QDA qda.crime<- qda(Crime ~ zn + nox + age + dis + rad + tax + ptratio + black + medv, data=Boston_train) predict_qda <- predict(qda.crime, data.frame(Boston_test))$class table(Boston_test$Crime, predict_qda) ## predict_qda ## 0 1 ## 0 81 9 ## 1 155 8 81+9+8+155 ## [1] 253 155+9 ## [1] 164 164/253 ## [1] 0.6482213 ## KNN x_test <- Boston_test[ , c(2,5,7,8,9,10,11,12,14)] x_train <- Boston_train[ , c(2,5,7,8,9,10,11,12,14)] crime_test <- Crime[test] knn <- class::knn(x_test, x_train,crime_test,1) table(crim_test,knn) ## knn ## crim_test 0 1 ## 0 57 33 ## 1 125 38 57+33+125+38 ## [1] 253 125+33 ## [1] 158 4 158/253 ## [1] 0.6245059 According to the error rate, LDA will be best model in this case, because it havs the lowest error rate 12.65%. 5