Q1) Bias Variance Tradeoff

\[ y=\text{sin}(x)+\text{ln}(x) \]

set.seed(123)
# 1000 N(0,1) samp.
x <- runif(30, .1,10)# ln(0) undef.
y <- sin(x)+log(x) # signal
df <- data.frame(x,y)
set.seed(122)
rand_noise <- runif(30, 0,1)# ln(0) undef.
y <- y + rand_noise

Draw Sample

population <- y

# Sample 50% -- 50% test set
train_ind <- sample(1:30, 15)

ytrain <- population[train_ind]
ytest  <- population[-train_ind]

xtrain <- x[train_ind]
xtest  <- x[-train_ind]

# Create data frames
train <- data.frame(x = xtrain, y = ytrain)
test  <- data.frame(x = xtest, y = ytest)
# Plot training data
plot(train$x, train$y,
     main="Realworld = signal + noise",
     col = "forestgreen",
     pch = 19)

# Overlay test data
points(test$x, test$y,
       col = "black",
       pch = 19)

# Add legend
legend("topright",
       legend = c("Train", "Test"),
       col = c("forestgreen", "black"),
       pch = 19,
       cex=.5)

# 1. Simple model: log(x)
mdl_log <- lm(y ~ log(x), data = train)

# 2. Correct functional form: sin(x) + log(x)
mdl_true <- lm(y ~ sin(x) + log(x), data = train)

# 3. Degree-14 polynomial
# 15 training points -> degree 14 can interpolate them
mdl_poly <- lm(y ~ poly(x, 14, raw = TRUE), data = train)
# Plot training data first
plot(
  train$x,
  train$y,
  main = "Realworld = signal + noise",
  col = "forestgreen",
  pch = 19
)

# Overlay test data
points(
  test$x,
  test$y,
  col = "black",
  pch = 19
)

# Create x-values for a smooth curve
x_grid <- seq(
  min(c(train$x, test$x)),
  max(c(train$x, test$x)),
  length.out = 500
)

# Get predictions from mdl_true
y_true <- predict(
  mdl_true,
  newdata = data.frame(x = x_grid)
)

# Add mdl_true curve
lines(
  x_grid,
  y_true,
  col = "blue",
  lwd = 2
)

# Add legend
legend(
  "topleft",
  legend = c("Train", "Test", "True model"),
  col = c("forestgreen", "black", "blue"),
  pch = c(19, 19, NA),
  lty = c(NA, NA, 1),
  lwd = c(NA, NA, 2),
  cex = 0.5
)

# Plot training data first
plot(
  train$x,
  train$y,
  main = "High Bias, Low Var",
  col = "forestgreen",
  pch = 19
)

# Overlay test data
points(
  test$x,
  test$y,
  col = "black",
  pch = 19
)

# Create x-values for a smooth curve
x_grid <- seq(
  min(c(train$x, test$x)),
  max(c(train$x, test$x)),
  length.out = 500
)

# Get predictions from mdl_log
y_log <- predict(
  mdl_log,
  newdata = data.frame(x = x_grid)
)

# Add log model curve
lines(
  x_grid,
  y_log,
  col = "red",
  lwd = 2
)

# Add legend
legend(
  "topleft",
  legend = c("Train", "Test", "Log model"),
  col = c("forestgreen", "black", "red"),
  pch = c(19, 19, NA),
  lty = c(NA, NA, 1),
  lwd = c(NA, NA, 2),
  cex = 0.5
)

# Plot training data first
plot(
  train$x,
  train$y,
  main = "High Variance, Low Bias",
  col = "forestgreen",
  pch = 19
)

# Overlay test data
points(
  test$x,
  test$y,
  col = "black",
  pch = 19
)

# Create x-values for a smooth curve
x_grid <- seq(
  min(c(train$x, test$x)),
  max(c(train$x, test$x)),
  length.out = 500
)

# Get predictions from mdl_poly
y_poly <- predict(
  mdl_poly,
  newdata = data.frame(x = x_grid)
)
## Warning in predict.lm(mdl_poly, newdata = data.frame(x = x_grid)): prediction
## from rank-deficient fit; attr(*, "non-estim") has doubtful cases
# Add polynomial model curve
lines(
  x_grid,
  y_poly,
  col = "red",
  lwd = 2
)

# Add legend
legend(
  "topleft",
  legend = c("Train", "Test", "Polynomial model"),
  col = c("forestgreen", "black", "red"),
  pch = c(19, 19, NA),
  lty = c(NA, NA, 1),
  lwd = c(NA, NA, 2),
  cex = 0.5
)