Как мне наложить данные (Glmnet) на лассо и ребристую регрессию?

Question

У меня есть данные (ниже), и я провел линейную, гребневую и лассо-регрессию. Для регрессии лассо и гребня я нашел оптимальную лямбду, используя перекрестную проверку. Теперь я хочу наложить подогнанные модели на график y против x моих исходных данных. У меня есть линейная модель на графике, я просто не могу понять, как заставить появиться две другие. Я попытался сделать это в ggplot, но ответ из базы R тоже был бы очень полезен! Даже если бы вы могли указать мне правильное направление, это было бы здорово.

У меня все модели работают нормально. У меня есть линия линейной регрессии на графике. Однако, когда я пытаюсь нанести два других подбора таким же образом, это не сработает.

код для создания данных

set.seed(1)
x <- rnorm(100)
y <- 1 + .2*x+3*x^2+.6*x^3 + rnorm(100)
d <- data.frame(x=x,y=y)
d$x2 <- d$x^2
d$x3 <- d$x^3
d$x4 <-d$x^4
d$x5 <-d$x^5

линейная регрессия

f <- lm(y ~ ., data=d)

регрессия гребня

library(glmnet) 
x <- model.matrix(y ~ ., data=d)
y <- d$y

grid <- 0.001:50
ridge.fit <- glmnet(x,y,alpha=0, lambda = grid)

cv <- cv.glmnet(x,y)
r.fit.new <-  glmnet(x,y,alpha=0, lambda = cv$lambda.min)

лассо

lasso.fit <- glmnet(x,y,alpha=1, lambda = grid) 
l.fit.new <- glmnet(x,y,alpha=1, lambda = cv$lambda.min)

график

ggplot(data=d, aes(x=x, y=y)) + geom_point() + geom_line(aes(y=fitted(f)), colour="blue") 

Answer 1

немного изменил ваш код для создания данных

set.seed(1)
x <- rnorm(100)
y <- 1 + .2*x+3*x^2+.6*x^3 + rnorm(100)
d <- data.frame(x.values=x,y=y)
d$x2 <- d$x.values^2
d$x3 <- d$x.values^3
d$x4 <-d$x.values^4
d$x5 <-d$x.values^5

остальной код для создания матрицы моделей и выполнения моделей в том виде, как они есть.

Некоторое изменение в форматированииданные для построения

library(dplyr)
data.for.plot <- d%>%
select(x.values,y) %>%
mutate(fitted_lm = as.numeric(fitted(f)),
fitted_ridge_lm = as.numeric(predict(r.fit.new, newx= x)),
fitted_lasso_lm = as.numeric(predict(l.fit.new, newx= x)))

#Plot
ggplot(data.for.plot, aes(x = x.values, y = y)) + 
  geom_point() + 
  geom_line(aes(y=fitted_lm), colour="blue") + 
  geom_line(aes(y=fitted_ridge_lm), colour="red") + 
  geom_line(aes(y= fitted_lasso_lm),color="grey75") + theme_bw()

Теперь вы заметите, что трудно увидеть припадки, поскольку они довольно близки друг к другу (прекрасно, что модели согласны).Итак, давайте немного отформатируем данные и используем фасетирование в ggplot, чтобы увидеть подгонки по отдельности

library(tidyr)
data.for.plot.long <- gather(data.for.plot, key= fit_type, value = fits, -x.values,-y)
ggplot(data.for.plot.long, aes(y = y, x = x.values)) +
    geom_point() + 
    geom_line(aes(y = fits,colour=fit_type))+facet_wrap(~fit_type, ncol = 1,scales = "free") + theme_bw()

Результирующий график: