R 适合“GEE”类型的GEE模型；“可交换”；与gamm

我想估计一些协变量

N

在R中“可交换”类型的边际模型中的平滑效应，其中聚类变量为

S

。据我所知，这应该是可能的：

geeglm（…，id=S，corstr=“可交换”）

以及：

gamm（…，correlation=corCompSymm（form=~1|S））

下面你可以找到一个例子，从某种意义上说，两个估计值非常接近，结果看起来不错。然而，如果我使用我们项目的真实数据，估计的平滑效果往往会非常不同。我不能在这里发布，但也许有人仍然可以在代码中发现一些问题。例如（见下文），

gamm

-对象显示

组数：1

，这让我很担心，因为显然有不止一个集群

（是的，这是通过构造实现的随机效应模型，但这将导致给出答案的所需模型。）

########
##包裹
########
图书馆（GG2）
图书馆（mgcv）
图书馆（dplyr）
图书馆（geepack）
库（样条曲线）
########
##数据模拟
########
fGAMM使用惩罚样条曲线，因此生成的样条曲线（更平滑）使用的自由度可能略小于要求的基本尺寸，即10。GEE正在安装未启用的模型。在所有其他条件相同的情况下，未实施惩罚的模式将比实施惩罚的模式更加摇摆不定

要在一个共同的基础上比较这些方法，您需要确保
bs（）
和
s（x，bs='bs'）
都产生相同数量的基函数（the
s（）
version可以少生成一个，因为它将消除截取项的不可识别性，而在
bs（）
version）中省略截取项

在确保获得相同的基本尺寸后，可以通过将
fx=TRUE
添加到公式中的
s（…）
项，使GAMM拟合未启用的样条曲线

这样做之后，两个模型都应该估计相似的平滑效果

然而，我建议你使用惩罚；对于GAMM模型，使用
fx=FALSE
，然后在估计模型后运行
gam。检查（模型$gam）
（用拟合的模型对象替换
model
），并查看是否通过了平滑模型的基础尺寸检查

########
## Packages
########
library(ggplot2)
library(mgcv)
library(dplyr)
library(geepack)
library(splines)

########
## Data Simulation
########
f        <- function(N) {return((-200+(N-25)^2)/100)}

N        <- sort(sample(1:50, 10, replace = T))
S        <- as.character(1:10)
S_Effect <- rnorm(length(S),0,1)
S_Effect <- rep(S_Effect,N)
S        <- rep(S,N)
N        <- rep(N,N)
E        <- runif(length(N))

data     <- data.frame(O        = rep(0,length(N)),
                       E        = E,
                       N        = N,
                       S        = as.factor(S),
                       S_Effect = S_Effect)

for (i in 1:length(N)) {
  data$O[i] <- rbinom(1, 1, plogis(f(N[i]) + qlogis(E[i]) + S_Effect[i]))}

data <- data %>% mutate(E = qlogis(E))



########
## Fitting
########
formula_gamm   <- as.formula("O ~ 1 + offset(E) + s(N, bs = 'bs')")
model_gamm     <- gamm(formula_gamm, family = binomial(), correlation = corCompSymm(form=~1|S), data = data)
model_gamm

formula_geeglm <- as.formula("O ~ 1 + offset(E) + bs(N)")
model_geeglm   <- geeglm(formula_geeglm, family = binomial(), corstr = "exchangeable", id = S, data = data)



########
## Plot
########
pred_gamm      <- plot.gam(model_gamm$gam, select = 1)
x <- pred_gamm[[1]]$x
pred_geeglm  <- predict(model_geeglm, type = "terms", newdata = data.frame(E = rep(0,length(x)), N = x))

z                 <- qnorm(0.9)

tmp               <- data.frame(x = x,
                               y = pred_gamm[[1]]$fit,
                               group = rep("estimate gamm",length(x)))
tmp2               <- data.frame(x = x,
                                y = as.numeric(pred_geeglm),
                                group = rep("estimate geeglm",length(x)))
tmp3              <- data.frame(x = x,
                               y = f(x),
                               group = rep("actual function",length(x)))

data_pred = bind_rows(tmp,tmp2,tmp3) %>% mutate(group = as.factor(group))

p <- ggplot(data = data_pred, aes(x = x, y = y, color = group)) +
     geom_line(size = 2) +
     xlab("N") +
     ylab("f(N)")
p