Assignment2
library(tinytex)
library(latexpdf)
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
[Link]
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:
summary(cars)
## speed dist
## Min. : 4.0 Min. : 2.00
## 1st Qu.:12.0 1st Qu.: 26.00
## Median :15.0 Median : 36.00
## Mean :15.4 Mean : 42.98
## 3rd Qu.:19.0 3rd Qu.: 56.00
## Max. :25.0 Max. :120.00
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.
# a)
require(ISLR); require(tidyverse); require(ggthemes); require(GGally)
## Loading required package: ISLR
## Loading required package: tidyverse
## -- Attaching packages ---------------------------------------
tidyverse 1.3.0 --
## v ggplot2 3.3.2 v purrr 0.3.4
## v tibble 3.0.3 v dplyr 1.0.2
## v tidyr 1.1.2 v stringr 1.4.0
## v readr 1.4.0 v forcats 0.5.0
## -- Conflicts ------------------------------------------
tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
## Loading required package: ggthemes
## Loading required package: GGally
## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2
##
## Attaching package: 'GGally'
## The following object is masked from 'package:latexpdf':
##
## wrap
require(knitr); require(kableExtra); require(broom)
## Loading required package: knitr
## Loading required package: kableExtra
##
## Attaching package: 'kableExtra'
## The following object is masked from 'package:dplyr':
##
## group_rows
## Loading required package: broom
theme_set(theme_tufte(base_size = 14))
[Link](1)
data('Auto')
Auto <- Auto %>%
filter(!cylinders %in% c(3,5)) %>%
mutate(mpg01 = factor(ifelse(mpg > median(mpg), 1, 0)),
cylinders = factor(cylinders,
levels = c(4,6,8),
ordered = TRUE),
origin = factor(origin,
levels = c(1,2,3),
labels = c('African', 'European',
'American')))
median(Auto$mpg)
## [1] 23
Auto %>%
dplyr::select(mpg, mpg01) %>%
sample_n(6)
## mpg mpg01
## 1 29.8 1
## 2 23.0 0
## 3 25.0 1
## 4 28.4 1
## 5 17.0 0
## 6 14.5 0
# Binary variables
# b)
Auto %>%
dplyr::select(-name, -mpg) %>%
ggpairs(aes(col = mpg01, fill = mpg01, alpha = 0.6),
upper = list(combo = 'box'),
diag = list(discrete = wrap('barDiag', position = 'fill')),
lower = list(combo = 'dot_no_facet')) +
theme([Link].x = element_text(angle = 90, hjust = 1))
Auto %>%
dplyr::select(-name, -mpg, - origin, -cylinders) %>%
gather(Variable, value, -mpg01) %>%
mutate(Variable = str_to_title(Variable)) %>%
ggplot(aes(mpg01, value, fill = mpg01)) +
geom_boxplot(alpha = 0.6) +
facet_wrap(~ Variable, scales = 'free', ncol = 1, switch = 'x') +
coord_flip() +
theme([Link] = 'top') +
labs(x = '', y = '', title = 'Variable Boxplots by mpg01')
## Warning: 'switch' is deprecated.
## Use '[Link]' instead.
## See help("Deprecated")
# From the faceted ggpairs plot it looks like most of the variables
separate our target well. The best separators seem to
be:cylinders,displacement,horsepower,weight,year
# c)
[Link](1)
num_train <- nrow(Auto) * 0.75
inTrain <- sample(nrow(Auto), size = num_train)
training <- Auto[inTrain,]
testing <- Auto[-inTrain,]
# d)
require(MASS)
## Loading required package: MASS
##
## Attaching package: 'MASS'
## The following object is masked from 'package:dplyr':
##
## select
fmla <- [Link]('mpg01 ~ displacement + horsepower + weight + year
+ cylinders')
lda_model <- lda(fmla, data = training)
pred <- predict(lda_model, testing)
table(pred$class, testing$mpg01)
##
## 0 1
## 0 48 5
## 1 5 39
mean(pred$class == testing$mpg01)
## [1] 0.8969072
# e)
qda_model <- qda(fmla, data = training)
pred <- predict(qda_model, testing)
table(pred$class, testing$mpg01)
##
## 0 1
## 0 48 5
## 1 5 39
mean(pred$class == testing$mpg01)
## [1] 0.8969072
#ASSIGNMENT 2
log_reg <- glm(fmla, data = training, family = binomial)
pred <- predict(log_reg, testing, type = 'response')
pred_values <- round(pred)
table(pred_values, testing$mpg01)
##
## pred_values 0 1
## 0 49 3
## 1 4 41
mean(pred_values == testing$mpg01)
## [1] 0.9278351
require(class)
## Loading required package: class
[Link](1)
acc <- list()
x_train <- training[,c('cylinders', 'displacement', 'horsepower',
'weight', 'year')]
y_train <- training$mpg0
x_test <- testing[,c('cylinders', 'displacement', 'horsepower',
'weight', 'year')]
for (i in 1:20) {
knn_pred <- knn(train = x_train, test = x_test, cl = y_train, k =
i)
acc[[Link](i)] = mean(knn_pred == testing$mpg01)
}
acc <- unlist(acc)
data_frame(acc = acc) %>%
mutate(k = row_number()) %>%
ggplot(aes(k, acc)) +
geom_col(aes(fill = k == [Link](acc))) +
labs(x = 'K', y = 'Accuracy', title = 'KNN Accuracy for different
values of K') +
scale_x_continuous(breaks = 1:20) +
scale_y_continuous(breaks = round(c(seq(0.90, 0.94, 0.01),
max(acc)),
digits = 3)) +
geom_hline(yintercept = max(acc), lty = 2) +
coord_cartesian(ylim = c(min(acc), max(acc))) +
guides(fill = FALSE)
## Warning: `data_frame()` is deprecated as of tibble 1.1.0.
## Please use `tibble()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was
generated.