---
tags: ISLR
---

# ISLR hw11

**M094020055 陳耀融**

「課本 第六章習題：第6題、第7題、第10題；第七章習題：第3題 、第4題 」

## ch06 Q6
### a

Set y1 = -3 and lambda = 0.5

beta <- seq(-10,10,0.05)
ridge <- (-3-beta)^2 + 0.5 * beta^2
plot(beta, ridge, main = 'ridge')


It achieve minima in x = -2
$y / (1 + \lambda) = -3 / (1 + 0.5) = -2$

It get the same result as 6.14

### b

Set y1 = -3 and lambda = 0.5

beta <- seq(-10,10,0.05)
lasso <- (-3-beta)^2 + 0.5 * abs(beta)
plot(beta, lasso, main = 'lasso')


It achieve minima in x = -2.75
$y + (\lambda / 2) = -3 + (0.5 / 2) = -2.75$

It get the same result as 6.15

## Q7
### a

$$
\begin{aligned}
Likelihood&=P(\bf{y}|\beta)\\
&=\prod_{i=1}^n P(y_i|\beta,\delta^2)\\
&=\prod_{i=1}^n \frac{1}{\delta\sqrt{2\pi}}\exp(-\frac{(y_i-\beta_0+\sum_{j=1}^px_{ij}\beta_j)^2}{2\delta^2})\\
&=(\frac{1}{\delta\sqrt{2\pi}})^n\exp(-\frac{\sum_{i=1}^n(y_i-\beta_0+\sum_{j=1}^px_{ij}\beta_j)^2}{2\delta^2})
\end{aligned}
$$

## Q10
### A

set.seed(1340)
p <- 20
n <- 1000
x <- matrix(rnorm(n * p), n, p)
B <- rnorm(p)
idx <- sample(length(B), 5)
idx
# [1] 15 18  3  4 12
B[idx] <- 0
eps <- rnorm(p)
y <- x %*% B + eps

15 18 3 4 12 is set 0

### B

train_idx <- sample(1:nrow(y), 100)
test_idx <- setdiff(1:nrow(y), train_idx)
data <- as.data.frame(cbind(x, y))
train_data <- data[train_idx, ]
test_data <- data[test_idx, ]

### C

library(leaps)
subsut_model <- regsubsets(y ~ . - y, data = train_data, nvmax = p)

x_cols <- colnames(train_data)
errs <- sapply(1:p, function(i){
  coef_i <- coef(subsut_model, id = i)
  pred <- as.matrix(train_data[, x_cols %in% names(coef_i)]) %*% coef_i[names(coef_i) %in% x_cols]
  return(mean((train_data$y - pred) ^ 2))
})

plot(errs, ylab = 'train MSE', pch = 19, type = 'b')


### D

x_cols <- colnames(test_data)
errs <- sapply(1:p, function(i){
  coef_i <- coef(subsut_model, id = i)
  pred <- as.matrix(test_data[, x_cols %in% names(coef_i)]) %*% coef_i[names(coef_i) %in% x_cols]
  return(mean((test_data$y - pred) ^ 2))
})

plot(errs, ylab = 'test MSE', pch = 19, type = 'b')


### E

which.min(errs)
# [1] 14

suset 14 is has the smallest test MSE

### F

coef(subsut_model, id = 14)
# (Intercept)          V1          V2          V5          V6          V8 
#   0.1171912  -0.3607490  -0.3476855   0.6318350   1.6626315  -0.9141119 
#          V9         V10         V11         V13         V14         V16 
#  -1.5357956  -0.8530650  -1.3449624   0.7450864  -0.5650095   0.6642357 
#         V17         V19         V20 
#   0.4426464   0.4497942   0.4502551

3, 4, 12, 15, 18 is all caught by subsets

### G

errs <- rep(NA, p)
b <- rep(NA, p)
for (i in 1:p) {
  coefi = coef(subsut_model, id = i)
  b[i] = sqrt(sum((B[x_cols %in% names(coefi)] - coefi[names(coefi) %in% x_cols])^2) + 
                sum(B[!(x_cols %in% names(coefi))])^2)
}
plot(x = 1:p, y = b, xlab = "number of coefficients", ylab = "error between estimated and true coefficients", ylim=c(0, 3.5))

Got some error, not plot correctly

but its minima should be x = 14

## ch07 Q3
### a

x <- seq(-2, 2, 0.01)
y <- 1 + x + -2 * (x-1)^2 * I(x>1)
plot(x, y)


## Q4

x1 <- seq(-2, 0, 0.01)
y1 <- rep(1, length(x1))
x2 <- seq(0, 1, 0.01)
y2 <- rep(2, length(x2))
x3 <- seq(1, 2, 0.01)
y3 <- 3 - x3
x <- c(x1, x2, x3)
y <- c(y1, y2, y3)
plot(x, y)