如何在中断的分段时间序列回归中向ggplot添加线性段

Question

我已经安装了一个中断的时间序列回归来计算数据，并希望显示与此类似的结果

摘自：Lindstrand A，Bennet R，Galanis I，et al。引入肺炎球菌结合疫苗后鼻窦炎和肺炎住院治疗。儿科。 2014; 134（6）：e1528-36。 DOI：10.1542 / peds.2013-4177

具体来说，我正在尝试（和失败）再现的是分别添加品红色和青色趋势线。我一直试图在ggplot中这样做。问题是我的模型适合glm(family = poisson)，因此系数不是原始尺度。更复杂的是，我提供了风险人口作为偏移量，即glm(count ~ ., offset(log(at_risk)), family = poisson, data = df)，但希望在Y轴上将数据显示为(count / at_risk)*1000。

set.seed(42)
int = 85
df <- data.frame(
    count = as.integer(rpois(132, 9) + rnorm(132, 1, 1)),
    time = 1:132,
    at_risk = rep(
        c(4305, 4251, 4478, 4535, 4758, 4843, 4893, 4673, 4522, 4454, 4351),
        each  = 12
    )
)
df$month <- factor(month.name, levels = month.name)
df$intv <- ifelse(df$time >= int, 1, 0)
df$intv_trend <- c(rep(0, (int - 1)),
                   1:(length(unique(df$time)) - (int - 1)))
df <-
    df %>%
    mutate(lag_count = dplyr::lag(count))

fit <- glm(
    count ~ month + time + intv + intv_trend +
        log(lag_count) + offset(log(at_risk)),
    family = "poisson",
    data = df
)
df$fit <- exp(c(NA, predict(fit)))


ggplot(df, aes(x = time, y = (fit / at_risk) * 1000)) +
    geom_line()

（我已经绘制了我希望能够在生成的ggplot线图中创建的线条）

有一个连续的长期趋势time由伪等式count ~ intercept + B1 * time给出，我希望将其截断，使其大致停留在time = 72。这类似于上图中的洋红色线。干扰intv发生在time = 85，导致级别intv发生变化，斜率intv_trend发生变化。 intv效果线相对于时间的伪代码是count ~ intercept + intv + B1 * time + B2* intv_trend，类似于上面的青色线。

我尝试使用不同版本的geom_abline()等exp(coef(fit)[1] ...，但我无法在剧情中显示该行。

有什么想法吗？

Answer 1

正如我在评论中所说，如果你有办法识别变更点，你可以添加一个名为group的列，并标记预测行Control的第一部分，第二个Intervention（或您喜欢的任何标签）。然后在你的情节中使用group作为颜色美学来获得两条不同的线条。在下面的代码中，我手动添加了分组变量。要获得有关数据规模的预测，请将type="response"添加到predict。

首先，设置数据：

library(ggplot2)
library(dplyr)

int = 85
set.seed(42)
df <- data.frame(
  count = as.integer(rpois(132, 9) + rnorm(132, 1, 1)),
  time = 1:132,  
  at_risk = rep(
    c(4305, 4251, 4478, 4535, 4758, 4843, 4893, 4673, 4522, 4454, 4351),
    each  = 12
  )
)

df$month <- factor(month.name, levels = month.name)
df$intv <- ifelse(df$time >= int, 1, 0)
df$intv_trend <- c(rep(0, (int - 1)),
                   1:(length(unique(df$time)) - (int - 1)))
df <- df %>%
  mutate(lag_count = dplyr::lag(count))

创建模型并获得预测：

fit <- glm(
  count ~ month + time + intv + intv_trend +
    log(lag_count) + offset(log(at_risk)),
  family = "poisson",
  data = df
)

df$fit <- exp(c(NA, predict(fit)))

# Get predictions on the same scale as the data
df$fit2 = c(NA, predict(fit, type="response"))

# Add a grouping variable manually
df$group = rep(c("Control","Intervention"), c(72, 132 - 72))

简介：

ggplot(df, aes(x = time, y = fit2)) +
  geom_line() +
  geom_smooth(method="lm", se=FALSE, aes(colour=group)) +
  theme_bw() +
  labs(colour="")