Выделите линию прогноза лучшей подходящей модели в R?

Question

Я приспособил несколько моделей к одним и тем же данным. И нанесли линии predction для всех моделей на одном графике.

Теперь я хотел бы выделить (жирной, жирной линией) линию прогнозирования модели с самым низким AIC. Не могу найти ресурсы по этому вопросу, поэтому я немного застрял.

library(ggplot2)
set.seed(101)

x <- rnorm(100)
y <- rweibull(100,1)
d <- data.frame(x,y)

model1 <- lm(y~1, data = d)
model2 <- lm(y~x, data = d)
model3 <- lm(y~abs(x), data = d)

newvalsforx <- function(x) {
  xrng <- seq(min(x), max(x), length.out=100)
  function(m) data.frame(x=xrng, y=predict(m, data.frame(x=xrng)))
}
pred <- newvalsforx(d$x)

ggplot(d, aes(x,y)) +
  geom_point() + 
  geom_line(data=pred(model1), color="red") + 
  geom_line(data=pred(model2), color="blue") + 
  geom_line(data=pred(model3), color="green")

AIC1 <- AIC(model1
AIC2 <- AIC(model2)
AIC3 <- AIC(model3) 

UPDATE

это полный список моделей, с которыми я работаю

abs.x <- abs(x)
ipos <- (x>0)

models <- list("model1" = lm(y~1, data = d), 
               "model2" = lm(y~x, data = d), 
               "model3" = lm(y~abs(x), data = d),
               "model4" = lm(y~abs.x + ipos, data = d),
               "model5" = lm(y~abs.x : ipos, data = d),
               "model6" = lm(y~abs.x * ipos, data = d),
               "model7" = mgcv::gam(y ~ abs.x + ipos, data = d)
              )

Answer 1

Я сделал несколько настроек, чтобы сделать это немного более осуществимым с ggplot2 (длинный формат и т. Д.). Дайте мне знать, если вы понимаете. Поиграйте со значениями 1,5 и 0,5, чтобы получить правильную толщину кривой с минимальным AIC! Поздравил

set.seed(101)
library(ggplot2)
xrng <- 
x <- rnorm(100)
y <- rweibull(100,1)
ipos <- (x>0)
abs.x <- abs(x)
d <- data.frame(x,y, ipos, abs.x)



models <- list("model1" = lm(y~1, data = d), 
               "model2" = lm(y~x, data = d), 
               "model3" = lm(y~abs.x, data = d),
               "model4" = lm(y~abs.x + ipos, data = d),
               "model5" = lm(y~abs.x : ipos, data = d),
               "model6" = lm(y~abs.x * ipos, data = d),
               "model7" = mgcv::gam(y ~ abs.x + ipos, data = d)
)
newvalsforx <- function(x) {
  xrng <- seq(min(x), max(x), length.out=100)
  function(m) data.frame(x=xrng, y=predict(m, newdata = data.frame(x=xrng, ipos=(xrng>0), abs.x=abs(xrng))))
}
pred <- newvalsforx(d$x)

pred_df <- do.call("rbind", lapply(models, pred))
pred_df <- cbind(rep(names(models), each=length(y)), pred_df)
names(pred_df) = c("model", "x", "pred")
which_model_is_min <- names(which.min(unlist(lapply(models, AIC))))
pred_df[["linewidth"]] = ifelse(pred_df$model == which_model_is_min, 1.5, 0.5)

ggplot(d, aes(x,y)) +
  geom_point() + 
  geom_line(data=pred_df, aes(x = x, y = pred, color=model), size = pred_df$linewidth)