时间戳

首页 > 解决方案 > 为 geom_smooth 添加年龄调整

r - 为 geom_smooth 添加年龄调整

问题描述

我需要在我添加到我的 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)

每组平均年龄调整

有什么建议么？

标签： rstatic-methodsadjustment

解决方案

这就是我想你所追求的。

首先，我们需要拟合更复杂的模型，因为 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()

推荐阅读