Exercises Week 01
Prashant Pandey
2024-10-24
Exercise 2
set.seed(123)
morange = as.data.frame(matrix(rnorm(20), ncol=2) + matrix(c(1,0), nrow=1)[rep(1, 10),])
set.seed(999)
mblue = as.data.frame(matrix(rnorm(20), ncol=2) + matrix(c(0,1), nrow=1)[rep(1, 10),])
colnames(morange) = colnames(mblue) = c('x1', 'x2')
rownames(morange) = paste0('m', 1:10)
rownames(mblue) = paste0('m', 11:20)G1_id = sample(1:10, 100, replace=TRUE)
G2_id = sample(1:10, 100, replace=TRUE)
X1 = matrix(rnorm(200), ncol=2) %*% diag(1/sqrt(5),2) + morange[G1_id,]
X2 = matrix(rnorm(200), ncol=2) %*% diag(1/sqrt(5),2) + mblue[G1_id,]
X = rbind(X1, X2)
X$color = factor(c(rep('blue', 100), rep('orange', 100)))## Plot you generated data
plot(X[X$color == 'blue', 1:2], col = 'blue', pch = 19, xlab = "x1", ylab = "x2", xlim = c(-3, 3), ylim = c(-3, 3))
points(X[X$color == 'orange', 1:2], col = 'orange', pch = 19)
title("Scatterplot of Generated Data")
Auxiliary function for Bayes Boundary:
## Hilfestellung
## m1 = means for class orange
## m2 = means for class blue
BayesBoundary <- function(x, m1, m2){
sumM <- 0; sumN <- 0;
for(i in 1:10){ sumM <- sumM + exp(-5/2*(x-as.matrix(m1[i,]))%*%t(x-as.matrix(m1[i,])))}
for(i in 1:10){ sumN <- sumN + exp(-5/2*(x-as.matrix(m2[i,]))%*%t(x-as.matrix(m2[i,])))}
return(sumM-sumN)
}xgrid = seq(-3, 3, length.out = 100)
levels <-outer(xgrid, xgrid,function(x,y)apply(cbind(x,y),1,BayesBoundary, m1=morange,
m2=mblue))Use the function countour to add a countour plot to your
existing scatterplot.
## Your plot from above again here:
plot(X[X$color == 'blue', 1:2], col = 'blue', pch = 19, xlab = "x1", ylab = "x2", xlim = c(-3, 3), ylim = c(-3, 3))
points(X[X$color == 'orange', 1:2], col = 'orange', pch = 19)
title("Scatterplot with Bayes Decision Boundary")
contour(xgrid,xgrid,levels,levels=0,add=TRUE,drawlabels=FALSE, col='black')
Exercise 3
library(class)
train_data <- X[, c("x1", "x2")]
train_labels <- X$color
calculate_empirical_risk <- function(predicted, actual) {
return(mean(predicted != actual))
}
#the test and train data are considered as to just compute the empirical loss the training on train data and testing it on test data will help us improve model on unknown data
for (k in c(1, 5, 10)) {
knn_pred <- knn(train = train_data, test = train_data, cl = train_labels, k = k)
empirical_risk <- calculate_empirical_risk(knn_pred, train_labels)
cat("Empirical Risk for k =", k, "is:", empirical_risk, "\n")
}## Empirical Risk for k = 1 is: 0
## Empirical Risk for k = 5 is: 0.07
## Empirical Risk for k = 10 is: 0.085Exercise 4
library(ISLR2)
data("Auto")
head(Auto,5)## 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
## name
## 1 chevrolet chevelle malibu
## 2 buick skylark 320
## 3 plymouth satellite
## 4 amc rebel sst
## 5 ford torinocat("Missing values in the data : ", any(is.na(Auto)), "\n")## Missing values in the data : FALSEsapply(Auto, class)## mpg cylinders displacement horsepower weight acceleration
## "numeric" "integer" "numeric" "integer" "integer" "numeric"
## year origin name
## "integer" "integer" "factor"quantitative_predictors <- sapply(Auto, is.numeric)
qualitative_predictors <- sapply(Auto, is.factor)
cat("Quantitative predictors:\n")## Quantitative predictors:print(names(Auto)[quantitative_predictors])## [1] "mpg" "cylinders" "displacement" "horsepower" "weight"
## [6] "acceleration" "year" "origin"cat("Qualitative predictors:\n")## Qualitative predictors:print(names(Auto)[qualitative_predictors])## [1] "name"cat("Range of each quantitative predictor:\n")## Range of each quantitative predictor:range_values <- sapply(Auto[, quantitative_predictors], range)
print(range_values)## mpg cylinders displacement horsepower weight acceleration year origin
## [1,] 9.0 3 68 46 1613 8.0 70 1
## [2,] 46.6 8 455 230 5140 24.8 82 3mean_values <- sapply(Auto[, quantitative_predictors], mean)
sd_values <- sapply(Auto[, quantitative_predictors], sd)
cat("Mean and standard deviation of each quantitative predictor:\n")## Mean and standard deviation of each quantitative predictor:print(mean_values)## mpg cylinders displacement horsepower weight acceleration
## 23.445918 5.471939 194.411990 104.469388 2977.584184 15.541327
## year origin
## 75.979592 1.576531print(sd_values)## mpg cylinders displacement horsepower weight acceleration
## 7.8050075 1.7057832 104.6440039 38.4911599 849.4025600 2.7588641
## year origin
## 3.6837365 0.8055182Auto_subset <- Auto[-c(10:84), ]
range_subset <- sapply(Auto_subset[, quantitative_predictors], range)
mean_subset <- sapply(Auto_subset[, quantitative_predictors], mean)
sd_subset <- sapply(Auto_subset[, quantitative_predictors], sd)
head(Auto_subset, 10) ## 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
## 7 14 8 454 220 4354 9.0 70 1
## 8 14 8 440 215 4312 8.5 70 1
## 9 14 8 455 225 4425 10.0 70 1
## 86 13 8 350 175 4100 13.0 73 1
## name
## 1 chevrolet chevelle malibu
## 2 buick skylark 320
## 3 plymouth satellite
## 4 amc rebel sst
## 5 ford torino
## 6 ford galaxie 500
## 7 chevrolet impala
## 8 plymouth fury iii
## 9 pontiac catalina
## 86 buick century 350cat("After removing the range 10th through 85th observation:\n")## After removing the range 10th through 85th observation:print(range_subset)## mpg cylinders displacement horsepower weight acceleration year origin
## [1,] 11.0 3 68 46 1649 8.5 70 1
## [2,] 46.6 8 455 230 4997 24.8 82 3print(mean_subset)## mpg cylinders displacement horsepower weight acceleration
## 24.368454 5.381703 187.753943 100.955836 2939.643533 15.718297
## year origin
## 77.132492 1.599369print(sd_subset)## mpg cylinders displacement horsepower weight acceleration
## 7.8808983 1.6581348 99.9394881 35.8955668 812.6496293 2.6938126
## year origin
## 3.1100263 0.8193079pairs(Auto[, quantitative_predictors])
#As we can see more the horse power we have less MPG Thus has a negative correlation
plot(Auto$horsepower, Auto$mpg, main = "Horsepower vs MPG", xlab = "Horsepower", ylab = "MPG", col = "blue", pch = 19)
#As we can see from graph the cars with less weight travel more thus too having negative correlation
plot(Auto$weight, Auto$mpg, main = "Weight vs MPG", xlab = "Weight", ylab = "MPG", col = "red", pch = 19)
plot(Auto$horsepower, Auto$acceleration, main = "Horsepower vs Acceleration", xlab = "Horsepower", ylab = "Acceleration", col = "orange", pch = 19)
print("As we can see from the trend that higher horsepower leads to lower MPG and we can say that more engery intensive engine requires more fuel. weight refers to as the weight for the car and more the weight more engery it requires thus leading to less MPG.")## [1] "As we can see from the trend that higher horsepower leads to lower MPG and we can say that more engery intensive engine requires more fuel. weight refers to as the weight for the car and more the weight more engery it requires thus leading to less MPG."