0

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

我的数据看起来像~ 表格链接

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)

每组平均年龄调整

有什么建议么？

4

2 回答 2

0

这就是我想你所追求的。

首先，我们需要拟合更复杂的模型，因为 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()
于 2019-08-30T15:00:22.470 回答
0

一种方法是使用 Age 作为模型中的附加预测变量来运行模型。然后使用predictCI 获得预测值。附加到您的数据，然后使用 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()
于 2019-08-30T15:00:38.207 回答