1. ホーム
  2. r

[解決済み] Rでベストフィッティングモデルの予測線を強調表示する?

2022-02-17 22:13:28

質問内容

同じデータに対して、いくつかのモデルを当てはめたことがあります。そして、すべてのモデルの予測線を1つのプロットにプロットしました。

そこで、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)