R Markdown: Dania Soto

  1. 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 market 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.
  1. Produce some numerical and graphical summaries of the Weekly data. Do there appear to be any patterns?
library(ISLR)
## Warning: package 'ISLR' was built under R version 4.0.5
library(MASS)
library(dplyr)
## Warning: package 'dplyr' was built under R version 4.0.5
## 
## Attaching package: 'dplyr'
## The following object is masked from 'package:MASS':
## 
##     select
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
library(caret)
## Warning: package 'caret' was built under R version 4.0.5
## Loading required package: lattice
## Loading required package: ggplot2
library(tidyr)
## Warning: package 'tidyr' was built under R version 4.0.5
library(class)
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  
##            
##            
##            
## 
names(Weekly)
## [1] "Year"      "Lag1"      "Lag2"      "Lag3"      "Lag4"      "Lag5"     
## [7] "Volume"    "Today"     "Direction"
pairs(Weekly)

Weekly %>% pivot_longer(-c(Direction,Volume,Today,Year),names_to="Lag",values_to="Value") %>% ggplot(aes(x=Today,y=Value,fill=Lag)) +
  geom_boxplot()

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

Based on our summary statistics, scatter plot matrix, and box plots there is no patterns as of now. The variables that appear to have some significant relationship are Year and Volume as show on correlations.

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.fit=glm(Direction~Lag1+Lag2+Lag3+Lag4+Lag5+Volume, data=Weekly, family="binomial")

summary(glm.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

Our summary statistic shows Lag2 is statisical significant to predict Direction. It has a p-value of 0.296 which is smaller than our significant level of 0.05. Therefore, we can reject the null hypothesis and accept the alternative. We can also conclude that with 1 increase of Lag2, it increases 0.05844 to be exact of Direction.

  1. 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
glm.full.probs = predict(glm.fit, type = "response")
glm.full.pred = rep("Down", 1089)
glm.full.pred[glm.full.probs > 0.5] = "Up"
table(glm.full.pred, Weekly$Direction)
##              
## glm.full.pred Down  Up
##          Down   54  48
##          Up    430 557
mean(glm.full.pred == Weekly$Direction)
## [1] 0.5610652

In conclusion, we can agree that the percentage of correct predictions is 56.10652%. Indicating that 43.89348% is our error rate. We can also state that our model is 92.066% right by dividing 557/605. Additionally, Down weekly trends have been predicted to decrease with a 11.15% accuracy prediction by dividing 54/484.

  1. 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$Year <2009)
test = (Weekly$Year > 2008)
glm.fit2 = glm(Direction ~ Lag2, data = Weekly, subset = train, family = "binomial")
summary(glm.fit2)
## 
## Call:
## glm(formula = Direction ~ Lag2, family = "binomial", data = Weekly, 
##     subset = train)
## 
## Deviance Residuals: 
##    Min      1Q  Median      3Q     Max  
## -1.536  -1.264   1.021   1.091   1.368  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)   
## (Intercept)  0.20326    0.06428   3.162  0.00157 **
## Lag2         0.05810    0.02870   2.024  0.04298 * 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 1354.7  on 984  degrees of freedom
## Residual deviance: 1350.5  on 983  degrees of freedom
## AIC: 1354.5
## 
## Number of Fisher Scoring iterations: 4
glm.probs1 = predict(glm.fit2, Weekly[!train, ], type = "response")
glm.pred1 = rep("Down", dim(Weekly[!train, ])[1])
glm.pred1[glm.probs1 > 0.5] = "Up"
table(glm.pred1, Weekly[!train, ]$Direction)
##          
## glm.pred1 Down Up
##      Down    9  5
##      Up     34 56
mean(glm.pred1 == Weekly[!train, ]$Direction)
## [1] 0.625

Using the training dataset, the percentage of correct predictions is 62.5%, which is an improvement of 6.39348% compared to model that was using all dataset. We can also state that our model is 91.803% right by dividing 56/61. Additionally, Down weekly trends have been predicted to decrease with a 20.93% accuracy prediction by dividing 9/43.

  1. Repeat (d) using LDA.
fit.ldaa <- lda(Direction ~ Lag2, data = Weekly, subset = train)
fit.ldaa
## Call:
## lda(Direction ~ Lag2, data = Weekly, subset = train)
## 
## Prior probabilities of groups:
##      Down        Up 
## 0.4477157 0.5522843 
## 
## Group means:
##             Lag2
## Down -0.03568254
## Up    0.26036581
## 
## Coefficients of linear discriminants:
##            LD1
## Lag2 0.4414162
pred.lda = predict(fit.ldaa, Weekly[!train, ])
table(pred.lda$class, Weekly[!train, ]$Direction)
##       
##        Down Up
##   Down    9  5
##   Up     34 56
mean(pred.lda$class == Weekly[!train, ]$Direction)
## [1] 0.625

After using LDA we can see that our model percentage of correct predictions is 62.5% similarly to exercise d. 

  1. Repeat (d) using QDA.
qda.fit = qda(Direction ~ Lag2, data = Weekly, subset = train)
qda.pred = predict(qda.fit, Weekly[!train, ])
table(qda.pred$class, Weekly[!train, ]$Direction)
##       
##        Down Up
##   Down    0  0
##   Up     43 61
mean(qda.pred$class == Weekly[!train, ]$Direction)
## [1] 0.5865385

After using QDA we can see that our model percentage of corrections is 58.65% which is lower than our LDA run.

  1. Repeat (d) using KNN with K = 1.
set.seed(1)
train.X = data.frame(Weekly[train, ]$Lag2)
test.X = data.frame(Weekly[!train, ]$Lag2)
train.Direction = Weekly[train, ]$Direction
pred.knn <- knn(train.X, test.X, train.Direction, k = 1)
table(pred.knn, Weekly[!train, ]$Direction)
##         
## pred.knn Down Up
##     Down   21 30
##     Up     22 31
  1. Which of these methods appears to provide the best results on this data?

Based on the test error rates, LDA and logistic regression give the best results of this data because they have smaller error rates.

  1. 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.
qda.fit1 = qda(Direction ~ Lag1 
               + Lag2 + Lag3, data = Weekly, subset = train)
qda.fit1
## Call:
## qda(Direction ~ Lag1 + Lag2 + Lag3, data = Weekly, subset = train)
## 
## Prior probabilities of groups:
##      Down        Up 
## 0.4477157 0.5522843 
## 
## Group means:
##              Lag1        Lag2       Lag3
## Down  0.289444444 -0.03568254 0.17080045
## Up   -0.009213235  0.26036581 0.08404044
qda.pred1 = predict(qda.fit1, data = test, type = "response")
qda.class1 = qda.pred1$class
table(qda.class1, Weekly[!test, ]$Direction)
##           
## qda.class1 Down  Up
##       Down   77  85
##       Up    364 459
mean(qda.class1 == Weekly[!train, ]$Direction)
## Warning in `==.default`(qda.class1, Weekly[!train, ]$Direction): longer object
## length is not a multiple of shorter object length
## Warning in is.na(e1) | is.na(e2): longer object length is not a multiple of
## shorter object length
## [1] 0.551269
fit.lda1 = lda(Direction~Lag1 + Lag2 + Lag3, data = Weekly, subset = train)
fit.lda1
## Call:
## lda(Direction ~ Lag1 + Lag2 + Lag3, data = Weekly, subset = train)
## 
## Prior probabilities of groups:
##      Down        Up 
## 0.4477157 0.5522843 
## 
## Group means:
##              Lag1        Lag2       Lag3
## Down  0.289444444 -0.03568254 0.17080045
## Up   -0.009213235  0.26036581 0.08404044
## 
## Coefficients of linear discriminants:
##              LD1
## Lag1 -0.29658609
## Lag2  0.29258490
## Lag3 -0.04766747
pred.lda2 = predict(fit.lda1, data = test, type = "response")
lda.class2 = pred.lda2$class
table(lda.class2, Weekly[!test, ]$Direction)
##           
## lda.class2 Down  Up
##       Down   39  45
##       Up    402 499
mean(lda.class2 == Weekly[!train, ]$Direction)
## Warning in `==.default`(lda.class2, Weekly[!train, ]$Direction): longer object
## length is not a multiple of shorter object length
## Warning in is.na(e1) | is.na(e2): longer object length is not a multiple of
## shorter object length
## [1] 0.5756345
pred.knn2 = knn(train.X, test.X, train.Direction, k = 10)
table(pred.knn2, Weekly[!train, ]$Direction)
##          
## pred.knn2 Down Up
##      Down   17 18
##      Up     26 43
mean(pred.knn2 == Weekly[!train, ]$Direction)
## [1] 0.5769231

QDA: 0.551269 LDA: 0.5756345 KNN: 0.5769231

Based on further examination of Lag1, Lag2, and Lag3 using QDA, LDA and KNN the best one is KNN.

  1. 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.
  1. 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.
AutoData<-ISLR::Auto
summary(AutoData)
##       mpg          cylinders      displacement     horsepower        weight    
##  Min.   : 9.00   Min.   :3.000   Min.   : 68.0   Min.   : 46.0   Min.   :1613  
##  1st Qu.:17.00   1st Qu.:4.000   1st Qu.:105.0   1st Qu.: 75.0   1st Qu.:2225  
##  Median :22.75   Median :4.000   Median :151.0   Median : 93.5   Median :2804  
##  Mean   :23.45   Mean   :5.472   Mean   :194.4   Mean   :104.5   Mean   :2978  
##  3rd Qu.:29.00   3rd Qu.:8.000   3rd Qu.:275.8   3rd Qu.:126.0   3rd Qu.:3615  
##  Max.   :46.60   Max.   :8.000   Max.   :455.0   Max.   :230.0   Max.   :5140  
##                                                                                
##   acceleration        year           origin                      name    
##  Min.   : 8.00   Min.   :70.00   Min.   :1.000   amc matador       :  5  
##  1st Qu.:13.78   1st Qu.:73.00   1st Qu.:1.000   ford pinto        :  5  
##  Median :15.50   Median :76.00   Median :1.000   toyota corolla    :  5  
##  Mean   :15.54   Mean   :75.98   Mean   :1.577   amc gremlin       :  4  
##  3rd Qu.:17.02   3rd Qu.:79.00   3rd Qu.:2.000   amc hornet        :  4  
##  Max.   :24.80   Max.   :82.00   Max.   :3.000   chevrolet chevette:  4  
##                                                  (Other)           :365
head(AutoData)
##   mpg cylinders displacement horsepower weight acceleration year origin
## 1  18         8          307        130   3504         12.0   70      1
## 2  15         8          350        165   3693         11.5   70      1
## 3  18         8          318        150   3436         11.0   70      1
## 4  16         8          304        150   3433         12.0   70      1
## 5  17         8          302        140   3449         10.5   70      1
## 6  15         8          429        198   4341         10.0   70      1
##                        name
## 1 chevrolet chevelle malibu
## 2         buick skylark 320
## 3        plymouth satellite
## 4             amc rebel sst
## 5               ford torino
## 6          ford galaxie 500
cor(AutoData[, -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
##              acceleration       year     origin
## mpg             0.4233285  0.5805410  0.5652088
## cylinders      -0.5046834 -0.3456474 -0.5689316
## displacement   -0.5438005 -0.3698552 -0.6145351
## horsepower     -0.6891955 -0.4163615 -0.4551715
## weight         -0.4168392 -0.3091199 -0.5850054
## acceleration    1.0000000  0.2903161  0.2127458
## year            0.2903161  1.0000000  0.1815277
## origin          0.2127458  0.1815277  1.0000000
mpg01 <- rep(0, length(mpg))
mpg01[mpg > median(mpg)] <- 1
## Error in median.default(mpg): need numeric data
AutoData = data.frame(AutoData, mpg01)
## Error in data.frame(AutoData, mpg01): arguments imply differing number of rows: 392, 11
head(AutoData)
##   mpg cylinders displacement horsepower weight acceleration year origin
## 1  18         8          307        130   3504         12.0   70      1
## 2  15         8          350        165   3693         11.5   70      1
## 3  18         8          318        150   3436         11.0   70      1
## 4  16         8          304        150   3433         12.0   70      1
## 5  17         8          302        140   3449         10.5   70      1
## 6  15         8          429        198   4341         10.0   70      1
##                        name
## 1 chevrolet chevelle malibu
## 2         buick skylark 320
## 3        plymouth satellite
## 4             amc rebel sst
## 5               ford torino
## 6          ford galaxie 500
  1. 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.
pairs(AutoData)

par(mfrow = c(3, 2))
plot(AutoData$cylinders, AutoData$mpg01)
plot(AutoData$displacement, AutoData$mpg01)
plot(AutoData$horsepower, AutoData$mpg01)
plot(AutoData$weight, AutoData$mpg01)
plot(AutoData$acceleration, AutoData$mpg01)
plot(AutoData$year, AutoData$mpg01)

Based on our plots we can see that there is an association between mpg1 and weight, horsepower, displacement and cylinders.

  1. Split the data into train and test
train <- (year %% 2 == 0)
## Error in eval(expr, envir, enclos): object 'year' not found
Auto.train <- AutoData[train, ]
Auto.test <- AutoData[!train, ]
mpg01.test <- mpg01[!train]
  1. 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?
fit.lda3 = lda(mpg01 ~ cylinders + weight + displacement + horsepower, data = AutoData, subset = train)
## Error in model.frame.default(formula = mpg01 ~ cylinders + weight + displacement + : variable lengths differ (found for 'cylinders')
fit.lda3
## Error in eval(expr, envir, enclos): object 'fit.lda3' not found
pred.lda3 <- predict(fit.lda3, Auto.test)
## Error in predict(fit.lda3, Auto.test): object 'fit.lda3' not found
table(pred.lda3$class, mpg01.test)
## Error in table(pred.lda3$class, mpg01.test): object 'pred.lda3' not found
mean(pred.lda3$class != mpg01.test)
## Error in mean(pred.lda3$class != mpg01.test): object 'pred.lda3' not found

Our test error rate is 12.63%.

  1. 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.fit3 <- qda(mpg1 ~ cylinders + weight + displacement + horsepower, data = AutoData, subset = train)
## Error in eval(predvars, data, env): object 'mpg1' not found
qda.fit3
## Error in eval(expr, envir, enclos): object 'qda.fit3' not found
pred.qda.auto <- predict(qda.fit3, Auto.test)
## Error in predict(qda.fit3, Auto.test): object 'qda.fit3' not found
table(pred.qda.auto$class, mpg01.test)
## Error in table(pred.qda.auto$class, mpg01.test): object 'pred.qda.auto' not found
mean(pred.qda.auto$class != mpg01.test)
## Error in mean(pred.qda.auto$class != mpg01.test): object 'pred.qda.auto' not found

Our QDA method gave us a test error rate of 13.19%.

  1. erform 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?
fit.auto.glm <- glm(mpg01~ cylinders + weight + displacement + horsepower, data = AutoData, family = binomial, subset = train)
## Error in model.frame.default(formula = mpg01 ~ cylinders + weight + displacement + : variable lengths differ (found for 'cylinders')
summary(fit.auto.glm)
## Error in summary(fit.auto.glm): object 'fit.auto.glm' not found
probs.auto <- predict(fit.auto.glm, Auto.test, type = "response")
## Error in predict(fit.auto.glm, Auto.test, type = "response"): object 'fit.auto.glm' not found
pred.glm <- rep(0, length(probs.auto))
## Error in eval(expr, envir, enclos): object 'probs.auto' not found
pred.glm[probs.auto > 0.5] <- 1
## Error in pred.glm[probs.auto > 0.5] <- 1: object 'pred.glm' not found
table(pred.glm, mpg01.test)
## Error in table(pred.glm, mpg01.test): object 'pred.glm' not found
mean(pred.glm != mpg01.test)
## Error in mean(pred.glm != mpg01.test): object 'pred.glm' not found

Our logistic regression method gave us a test error rate of 12.09%.

  1. 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?
train.autoX <- cbind(cylinders, weight, displacement, horsepower)[train, ]
## Error in cbind(cylinders, weight, displacement, horsepower): object 'cylinders' not found
test.autoX <- cbind(cylinders, weight, displacement, horsepower)[!train, ]
## Error in cbind(cylinders, weight, displacement, horsepower): object 'cylinders' not found
train.mpg01 <- mpg01[train]
set.seed(1)
pred.knn.auto <- knn(train.autoX, test.autoX, train.mpg01, k = 1)
## Error in as.matrix(train): object 'train.autoX' not found
table(pred.knn.auto, mpg01.test)
## Error in table(pred.knn.auto, mpg01.test): object 'pred.knn.auto' not found
mean(pred.knn.auto != mpg01.test)
## Error in mean(pred.knn.auto != mpg01.test): object 'pred.knn.auto' not found

Our test error rate for K = 1 is 15.38%.

pred.knn.auto2 <- knn(train.autoX, test.autoX, train.mpg01, k = 300)
## Error in as.matrix(train): object 'train.autoX' not found
table(pred.knn.auto2, mpg01.test)
## Error in table(pred.knn.auto2, mpg01.test): object 'pred.knn.auto2' not found
mean(pred.knn.auto2 != mpg01.test)
## Error in mean(pred.knn.auto2 != mpg01.test): object 'pred.knn.auto2' not found

Our test error rate if 54.94% when K = 300. Comparing both we can state that 15.38% error is better than 54.94%.

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

BostonData <-MASS::Boston
summary(BostonData)
##       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.00
attach(BostonData)
crime1 <- rep(0, length(crim))
crime1[crim > median(crim)] <- 1
Boston <- data.frame(BostonData, crime1)
train <- 1:(length(crim) / 2)
test <- (length(crim) / 2 + 1):length(crim)
Boston.train <- BostonData[train, ]
Boston.test <- BostonData[test, ]
crime1.test <- crime1[test]
fit.glm.boston <- glm(crime1 ~ . - crime1 - crim, data = BostonData, family = binomial, subset = train)
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
pred.boston <- predict(fit.glm.boston, Boston.test, type = "response")
pred.glm.boston <- rep(0, length(pred.boston))
pred.glm.boston[pred.boston > 0.5] <- 1
table(pred.glm.boston, crime1.test)
##                crime1.test
## pred.glm.boston   0   1
##               0  68  24
##               1  22 139
mean(pred.glm.boston != crime1.test)
## [1] 0.1818182

Our test error rate is 18.18% for logistic regression.

fit.glm.boston <- glm(crime1 ~ . - crime1 - crim - chas - nox, data = BostonData, family = binomial, subset = train)
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
pred.boston1 <- predict(fit.glm.boston, Boston.test, type = "response")
pred.glm.boston1 <- rep(0, length(pred.boston1))
pred.glm.boston1[pred.boston1 > 0.5] <- 1
table(pred.glm.boston1, crime1.test)
##                 crime1.test
## pred.glm.boston1   0   1
##                0  78  28
##                1  12 135
mean(pred.glm.boston1 != crime1.test)
## [1] 0.1581028

Our test error rate is 15.81% for logistic regression which is better than our previous 18.18%

fit.lda.boston <- lda(crime1 ~ . - crime1 - crim - chas - nox, data = BostonData, subset = train)
pred.lda.boston <- predict(fit.lda.boston, Boston.test)
table(pred.lda.boston$class, crime1.test)
##    crime1.test
##       0   1
##   0  82  30
##   1   8 133
mean(pred.lda.boston$class != crime1.test)
## [1] 0.1501976

Our test error rate is 15.02% for our LDA model.

train.bostonX <- cbind(zn, indus, chas, nox, rm, age, dis, rad, tax, ptratio, black, lstat, medv)[train, ]
test.bostonX <- cbind(zn, indus, chas, nox, rm, age, dis, rad, tax, ptratio, black, lstat, medv)[test, ]
train.crime1 <- crime1[train]
set.seed(1)
pred.knn.boston <- knn(train.bostonX, test.bostonX, train.crime1, k = 1)
table(pred.knn.boston, crime1.test)
##                crime1.test
## pred.knn.boston   0   1
##               0  85 111
##               1   5  52
mean(pred.knn.boston != crime1.test)
## [1] 0.458498

Our test error rate is 45.85% when using K =1 for our KNN model.

pred.knn.boston1 <- knn(train.bostonX, test.bostonX, train.crime1, k = 15)
table(pred.knn.boston1, crime1.test)
##                 crime1.test
## pred.knn.boston1   0   1
##                0  83  23
##                1   7 140
mean(pred.knn.boston1 != crime1.test)
## [1] 0.1185771

Our test error rate is 11.86% when using K = 15 for our KNN model.

pred.knn.boston2 <- knn(train.bostonX, test.bostonX, train.crime1, k = 300)
## Warning in knn(train.bostonX, test.bostonX, train.crime1, k = 300): k = 300
## exceeds number 253 of patterns
table(pred.knn.boston2, crime1.test)
##                 crime1.test
## pred.knn.boston2   0   1
##                0  90 163
##                1   0   0
mean(pred.knn.boston2 != crime1.test)
## [1] 0.6442688

Our test error rate is 64.42% when using K = 300 for our KNN model.

Overall our smallest test error rate for Boston is 11.86%, model KNN, using K = 15