将年龄调整添加到 geom_smooth

Question

我需要在添加到我的 ggscatter 图中的 geom_smooth 行中包含年龄调整。

我的数据长这样~ table link

structure(list(Time = c(0L, 0L, 0L, 0L, 6L, 12L, 18L, 18L, 0L, 
12L, 18L, 6L), group = structure(c(1L, 1L, 2L, 2L, 1L, 3L, 3L, 
3L, 3L, 4L, 4L, 1L), .Label = c("A", "B", "C", "D"), class = "factor"), 
    Age = c(77, 70.2, 69.9, 65.7, 66.2, 66.7, 67.2, 67.7, 66.8, 
    67.8, 68.3, 68.8), Average = c(96L, 90L, 94L, 94L, 96L, 96L, 
    92L, 120L, 114L, 109L, 113L, 103L)), row.names = c(NA, 12L
), class = "data.frame")

我目前拥有的（“平均”值依赖于年龄……）：

ggscatter(dtable, "Time","Average",conf.int = TRUE)+theme_bw()+
geom_smooth(aes(group=1),method='lm')+facet_wrap(~groups)

我想要的是这样的：

ggscatter(dtable, "Time","Average",conf.int = TRUE)+theme_bw()+
geom_smooth(aes(group=1),method='lm', adjust= ~age)+facet_wrap(~groups)

每组调整平均年龄

有什么建议吗？

Answer 1

这是我认为你想要的。

首先，我们需要拟合更复杂的模型，因为 ggplot 还没有多变量模型的功能（还）

fit <- lm(Average ~ Time + group + Age, data = tdata)

然后我们可以使用 broom 包中的一些功能来添加预测和相关的标准错误。有了这些，我们可以使用 geom_line 和 geom_ribbon geoms

手动构建绘图

library(broom)
tdata %>% 
  bind_cols(augment(fit)) %>% 
  ggplot(aes(Time, Average))+
  geom_point()+
  geom_line(aes(x = Time, y = .fitted), size = 2, color = "blue")+
  geom_ribbon(aes(ymin = .fitted + .se.fit*2, ymax = .fitted - .se.fit*2), alpha = .2)+
  facet_wrap(~group)+
  theme_bw()

此外，如果您想查看合并估计与非合并估计

fit_no_pool <- lm(Average ~ Time + group + Age, data = tdata)
fit_complete_pool <- lm(Average ~ Time + Age, data = tdata)

library(broom)
tdata %>% 
  bind_cols(augment(fit_no_pool) %>% setNames(sprintf("no_pool%s", names(.)))) %>% 
  bind_cols(augment(fit_complete_pool) %>% setNames(sprintf("pool%s", names(.)))) %>% 
  ggplot(aes(Time, Average))+
  geom_point()+
  # Non-Pooled Estimates
  geom_line(aes(x = Time, y = no_pool.fitted, color = "blue"), size = 2)+
  geom_ribbon(aes(ymin = no_pool.fitted + no_pool.se.fit*2, 
                  ymax = no_pool.fitted - no_pool.se.fit*2), alpha = .2)+
  # Pooled Estimates
  geom_line(aes(x = Time, y = pool.fitted, color = "orange"), size = 2)+
  geom_ribbon(aes(ymin = pool.fitted + pool.se.fit*2, 
                  ymax = pool.fitted - pool.se.fit*2), alpha = .2)+
  facet_wrap(~group)+
  scale_color_manual(name = "Regression", 
                       labels = c("Pooled", "Non-Pooled"), 
                     values = c("blue", "orange"))+
  theme_bw()

Answer 2

一种方法是运行您的模型将年龄作为模型中的附加预测变量。然后使用 predict 获得带 CI 的预测值。附加到您的数据，然后使用 ggplot 绘图。我知道您想按 group 进行分面，因此也可能值得将其放入您的模型中。只是一个想法。步骤是一样的。

df <- structure(list(Time = c(0L, 0L, 0L, 0L, 6L, 12L, 18L, 18L, 0L, 
    12L, 18L, 6L), group = structure(c(1L, 1L, 2L, 2L, 1L, 3L, 3L, 
    3L, 3L, 4L, 4L, 1L), .Label = c("A", "B", "C", "D"), class = "factor"), 
    Age = c(77, 70.2, 69.9, 65.7, 66.2, 66.7, 67.2, 67.7, 66.8, 
    67.8, 68.3, 68.8), Average = c(96L, 90L, 94L, 94L, 96L, 96L, 
    92L, 120L, 114L, 109L, 113L, 103L)), row.names = c(NA, 12L
    ), class = "data.frame")


#model adjusted for age
mod <- lm(Average ~ Time + Age, data = df)
#get prediction with CIS
premod <- predict(mod, interval = "predict")
#append to data
df2 <- cbind(df,premod)
#add prediction to ggplot with scatter plot
ggplot(df2) + 
    geom_point(aes(x=Time,y=Average)) +
    geom_line(aes(x=Time, y = fit)) +
    geom_ribbon(aes(x = Time,ymin = lwr, ymax = upr), alpha = .1)+
    facet_wrap(~group)+
    theme_bw()

将年龄调整添加到 geom_smooth

Add age adjustment to geom_smooth

static-methods

r

adjustment