ggplot2:使用facet_wrap返回“完整”或“子集”glm模型的逻辑结果的stat_smooth

时间:2011-12-28 22:28:41

标签: r plot ggplot2

我正在开发一个逻辑回归模型,其中包含一个连续预测变量和一个具有多个级别的分类预测变量。我想使用ggplot2显示结果,并利用facet_wrap显示分类预测变量的每个级别的回归线。这样做时,我注意到stat_smooth提供的拟合曲线只考虑特定方面的数据,而不是整个数据集。这是一个很小的差异,但在查看从predict.glm返回的情节与预测值时,这是一个显着的差异。

以下是使用代码后面的图形重新创建问题的示例。

library(boot)    # needed for inv.logit function
library(ggplot2) # version 0.8.9

set.seed(42)
n <- 100

df <- data.frame(location = rep(LETTERS[1:4], n),
                 score    = sample(45:80, 4*n, replace = TRUE))

df$p    <- inv.logit(0.075 * df$score + rep(c(-4.5, -5, -6, -2.8), n))
df$pass <- sapply(df$p, function(x){rbinom(1, 1, x)}) 

gplot <- ggplot(df, aes(x = score, y = pass)) + 
            geom_point() + 
            facet_wrap( ~ location) + 
            stat_smooth(method = 'glm', family = 'binomial') 

# 'full' logistic model
g <- glm(pass ~ location + score, data = df, family = 'binomial')
summary(g)

# new.data for predicting new observations
new.data <- expand.grid(score    = seq(46, 75, length = n), 
                        location = LETTERS[1:4])

new.data$pred.full <- predict(g, newdata = new.data, type = 'response')

pred.sub <- NULL
for(i in LETTERS[1:4]){
  pred.sub <- c(pred.sub,
    predict(update(g, formula = . ~ score, subset = location %in% i), 
            newdata = data.frame(score = seq(46, 75, length = n)), 
            type = 'response'))
}

new.data$pred.sub <- pred.sub

gplot + 
  geom_line(data = new.data, aes(x = score, y = pred.full), color = 'green') + 
  geom_line(data = new.data, aes(x = score, y = pred.sub),  color = 'red')

enter image description here

我注意到并且关注的是在方面B中容易看到。红色曲线是仅考虑一个位置的模型的预测值,而绿色曲线是使用完整数据集的预测。基于数据子集的模型与stat_smooth的图匹配。

我想通过ggplot2绘制标准错误着色的绿色曲线。我确定在我可以使用的代码中有一个选项可以做到这一点,但我还没有找到它,或者我可能会遵循不同的顺序或步骤从{{1获得绿色曲线调用。我在一个方面绘制所有内容并使用颜色或群体美感时发现了类似的问题。

任何建议都将不胜感激。

1 个答案:

答案 0 :(得分:8)

你是正确的,这样做的方法是在 ggplot2 之外拟合模型,然后计算你喜欢的拟合值和间隔,并分别传递这些数据。

实现您所描述的内容的一种方法是:

preds <- predict(g, newdata = new.data, type = 'response',se = TRUE)
new.data$pred.full <- preds$fit

new.data$ymin <- new.data$pred.full - 2*preds$se.fit
new.data$ymax <- new.data$pred.full + 2*preds$se.fit  

ggplot(df,aes(x = score, y = pass)) + 
    facet_wrap(~location) + 
    geom_point() + 
    geom_ribbon(data = new.data,aes(y = pred.full, ymin = ymin, ymax = ymax),alpha = 0.25) +
    geom_line(data = new.data,aes(y = pred.full),colour = "blue")

enter image description here

这伴随着关于拟合值的间隔的通常警告:由您来确保您正在绘制的间隔是您真正想要的。关于“预测间隔”往往存在很多混淆。