使用facet绘制线性时间趋势

Question

我想使用facet wrap：

在数据点上叠加线性趋势回归模型

我正在寻找的线性回归是

value ~ time其中时间是seq(1:length(dates))

在下面的例子中，A组有3次观察，B组有4次观察

我的代码是

dates = as.Date(c("2017-01-01", "2017-02-01", "2017-03-01", "2017-01-01", "2017-02-01", 
    "2017-03-01", "2017-04-01"))
group = c("A", "A", "A", "B", "B", "B", "B")
value = c(2, 3, 1, 1, 3, 2, 5)
data = data.frame(dates = dates, group = group, value = value)


ggplot(data = data, aes(x = factor(dates), y = value, group = 1)) + 
    geom_point() + 
    geom_line() + 
    geom_smooth(method = "lm", formula = value ~ seq(1:length(dates))) + 
    facet_wrap(~group, ncol = 1, scales = "free_y")

我还想在图表上打印回归的斜率系数

任何想法？

Answer 1

通过一点点整齐的魔法，你可以将你的模型保存在data.frame中，这样你就可以绘制你想要的任何东西：

library(tidyverse)

data %>% nest(-group) %>% 
    mutate(model = map(data, ~lm(value ~ dates, data = .x)), 
           predictions = map(model, predict), 
           slope = map_dbl(model, ~coef(.x)[2])) %>% 
    unnest(data, predictions) %>% 
    ggplot(aes(dates, value)) + 
    geom_line(color = 'gray50') + 
    geom_point() + 
    geom_line(aes(y = predictions), color = 'blue', size = .75) + 
    geom_text(aes(label = paste('beta==', round(slope, 5)), 
                  x = min(dates) + 1, 
                  y = max(value)), 
              hjust = 0, parse = TRUE) + 
    facet_wrap(~group, ncol = 1, scales = 'free_y')

如果您愿意，也可以手动绘制置信区间图，或者像往常一样使用geom_smooth：

data %>% nest(-group) %>% 
    mutate(model = map(data, ~lm(value ~ dates, data = .x)), 
           slope = map_dbl(model, ~coef(.x)[2])) %>% 
    unnest(data) %>% 
    ggplot(aes(dates, value)) + 
    geom_line(color = 'gray50') + 
    geom_point() + 
    geom_smooth(method = 'lm') +
    geom_text(aes(label = paste('beta==', round(slope, 5)), 
                  x = min(dates) + 1, 
                  y = max(value)), 
              hjust = 0, parse = TRUE) + 
    facet_wrap(~group, ncol = 1, scales = 'free_y')

注意这种方法的计算量更大，因为geom_smooth改编了模型。如果你愿意，扫帚和模型也可以用于修改模型。

Answer 2

你可以试试这个：

data$id <- ave(data$value, data$group, FUN=seq_along)

ggplot(data = data, aes(x = factor(dates), y = value, group = group)) + 
  geom_point() + 
  geom_line() + 
  geom_smooth(method = "lm", aes(x=id, y=value)) + 
  facet_wrap(~group, ncol = 1, scales = "free_y")