創建和繪制置信區間

Question

我已經為我的數據安裝了一個高斯 GLM model，我現在希望創建 95% CI 並將它們安裝到我的數據中。 我在繪圖時遇到了幾個問題，因為我無法讓它們捕獲我的數據，它們似乎 plot 與 model 在同一行，但沒有捕獲數據點。 此外，我也不確定我是否以正確的方式在此處創建了我的 CI。 如果有人知道如何解決這個問題，我在下面輸入了我的數據和代碼

使用的數據

aids
 cases quarter  date
1      2       1 83.00
2      6       2 83.25
3     10       3 83.50
4      8       4 83.75
5     12       1 84.00
6      9       2 84.25
7     28       3 84.50
8     28       4 84.75
9     36       1 85.00
10    32       2 85.25
11    46       3 85.50
12    47       4 85.75
13    50       1 86.00
14    61       2 86.25
15    99       3 86.50
16    95       4 86.75
17   150       1 87.00
18   143       2 87.25
19   197       3 87.50
20   159       4 87.75
21   204       1 88.00
22   168       2 88.25
23   196       3 88.50
24   194       4 88.75
25   210       1 89.00
26   180       2 89.25
27   277       3 89.50
28   181       4 89.75
29   327       1 90.00
30   276       2 90.25
31   365       3 90.50
32   300       4 90.75
33   356       1 91.00
34   304       2 91.25
35   307       3 91.50
36   386       4 91.75
37   331       1 92.00
38   368       2 92.25
39   416       3 92.50
40   374       4 92.75
41   412       1 93.00
42   358       2 93.25
43   416       3 93.50
44   414       4 93.75
45   496       1 94.00

我的代碼用於在繪圖之前創建 model 和間隔

#creating the model
model3 = glm(cases ~ date,
         data = aids,
         family = poisson(link='log'))

#now to add approx. 95% confidence envelope around this line
#predict again but at the linear predictor level along with standard errors
my_preds <- predict(model3, newdata=data.frame(aids), se.fit=T, type="link") 

#calculate CI limit since linear predictor is approx. Gaussian
upper <- my_preds$fit+1.96*my_preds$se.fit #this might be logit not log
lower <- my_preds$fit-1.96*my_preds$se.fit

#transform the CI limit to get one at the level of the mean
upper <- exp(upper)/(1+exp(upper)) 
lower <- exp(lower)/(1+exp(lower))

#plotting data
plot(aids$date, aids$cases,
 xlab = 'Date', ylab = 'Cases', pch = 20)

#adding CI lines
plot(aids$date, exp(my_preds$fit), type = "link",
 xlab = 'Date', ylab = 'Cases') #add title
lines(aids$date,exp(my_preds$fit+1.96*my_preds$se.fit),lwd=2,lty=2)
lines(aids$date,exp(my_preds$fit-1.96*my_preds$se.fit),lwd=2,lty=2)

結果我目前沒有數據點，model 在這里是正確的但是 CI 不是因為我沒有數據點，所以我認為 CI 是錯誤的

Answer 1

編輯：對 OP 提供完整數據集的回應。

這最初是關於在同一圖表上繪制數據和模型的問題，但已經發生了很大變化。 您似乎對原始問題有答案。 下面是解決 rest 的一種方法。

看看你的（和我的）圖，很明顯泊松 glm 不是一個好的 model。換句話說，案例數量可能隨日期而變化，但也受到其他因素的影響，而不是你的 model（外部回歸變量） .

僅繪制您的數據強烈表明您至少有兩種甚至更多的制度：案件增長遵循不同模型的時間范圍。

ggplot(aids, aes(x=date)) + geom_point(aes(y=cases))

這表明分段回歸。 與 R 中的大多數內容一樣，有一個 package（實際上不止一個）。 下面的代碼使用segmented的 package 使用 1 個斷點（兩個區域）構建連續的泊松 glm。

library(data.table)
library(ggplot2)
library(segmented)
setDT(aids)        # convert aids to a data.table
aids[, pred:=
       predict(
         segmented(glm(cases~date, .SD, family = poisson), seg.Z = ~date, npsi=1), 
         type='response', se.fit=TRUE)$fit]
ggplot(aids, aes(x=date))+ geom_line(aes(y=pred))+ geom_point(aes(y=cases))

請注意，我們需要告訴segmented斷點的數量，而不是斷點的位置——算法會為您計算出來。 所以在這里，我們看到 3Q87 之前的狀態使用泊松 glm 很好地建模，而之后的狀態則不是。 這是一種奇特的說法，即 87 年 3 季度前后“發生了一些事情”，它改變了疾病的進程（至少在這個數據中是這樣）。

下面的代碼做同樣的事情，但有 1 到 4 個斷點。

get.pred <- \(p.n, p.DT) {
  fit     <- glm(cases~date, p.DT, family=poisson)
  seg.fit <- segmented(fit, seg.Z = ~date, npsi=p.n)
  predict(seg.fit, type='response', se.fit=TRUE)[c('fit', 'se.fit')]
}
gg.dt <- rbindlist(lapply(1:4, \(x) { copy(aids)[, c('pred', 'se'):=get.pred(x, .SD)][, npsi:=x] } ))
ggplot(gg.dt, aes(x=date))+
  geom_ribbon(aes(ymin=pred-1.96*se, ymax=pred+1.96*se), fill='grey80')+
  geom_line(aes(y=pred))+
  geom_point(aes(y=cases))+
  facet_wrap(~npsi)

請注意，第一個斷點的位置似乎沒有改變，而且，盡管使用了泊松 glm，但除第一個區域外，所有區域的增長都是線性的。

package 文檔中描述了擬合優度指標，可幫助您確定多少斷點與您的數據最一致。

最后，還有mcp package，它功能更強大，但使用起來也更復雜。

原始響應：這是構建 model 預測和標准的一種方法。 data.table中的錯誤，然后使用ggplot 。

library(data.table)
library(ggplot2)
setDT(aids)        # convert aids to a data.table
aids[, c('pred', 'se', 'resid.scale'):=predict(glm(cases~date, data=.SD, family=poisson), type='response', se.fit=TRUE)]
ggplot(aids, aes(x=date))+
  geom_ribbon(aes(ymin=pred-1.96*se, ymax=pred+1.96*se), fill='grey80')+
  geom_line(aes(y=pred))+
  geom_point(aes(y=cases))

或者，您可以讓ggplot為您完成所有工作。

ggplot(aids, aes(x=date, y=cases))+
  stat_smooth(method = glm, method.args=list(family=poisson))+
  geom_point()