突出显示R中最佳拟合模型的预测线?

Highlight the prediction line of the best fitting model in R?

我对同一个数据拟合了几个模型。并在一个图中绘制了所有模型的预测线。

现在我想突出显示(粗体、粗线)具有最低 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) 

更新

这是我使用的模型的完整列表

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)
              )

我做了一些调整,使其在 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)