ฉันต้องการจับคู่ผลลัพธ์ของ lmer (ดูดีขึ้นจริง ๆ ) กับตัวอย่างของเล่นทวินาม ฉันอ่านบทความสั้น ๆ และเชื่อว่าฉันเข้าใจว่าเกิดอะไรขึ้น
แต่เห็นได้ชัดว่าฉันทำไม่ได้ หลังจากติดขัดฉันได้แก้ไข "ความจริง" ในแง่ของเอฟเฟกต์แบบสุ่มและไปหลังจากประเมินค่าของผลกระทบคงที่เพียงอย่างเดียว ฉันรวมรหัสนี้ไว้ด้านล่าง หากต้องการดูว่าถูกต้องคุณสามารถแสดงความคิดเห็น+ Z %*% b.kและมันจะตรงกับผลลัพธ์ของ glm ปกติ ฉันหวังว่าจะยืมพลังสมองบางส่วนเพื่อหาสาเหตุที่ฉันไม่สามารถจับคู่ผลลัพธ์ของ lmer เมื่อรวมเอฟเฟกต์แบบสุ่ม
# Setup - hard coding simple data set
df <- data.frame(x1 = rep(c(1:5), 3), subject = sort(rep(c(1:3), 5)))
df$subject <- factor(df$subject)
# True coefficient values
beta <- matrix(c(-3.3, 1), ncol = 1) # Intercept and slope, respectively
u <- matrix(c(-.5, .6, .9), ncol = 1) # random effects for the 3 subjects
# Design matrices Z (random effects) and X (fixed effects)
Z <- model.matrix(~ 0 + factor(subject), data = df)
X <- model.matrix(~ 1 + x1, data = df)
# Response
df$y <- c(1, 1, 1, 1, 1, 0, 0, 0, 1, 1, 0, 1, 0, 1, 1)
y <- df$y
### Goal: match estimates from the following lmer output!
library(lme4)
my.lmer <- lmer( y ~ x1 + (1 | subject), data = df, family = binomial)
summary(my.lmer)
ranef(my.lmer)
### Matching effort STARTS HERE
beta.k <- matrix(c(-3, 1.5), ncol = 1) # Initial values (close to truth)
b.k <- matrix(c(1.82478, -1.53618, -.5139356), ncol = 1) # lmer's random effects
# Iterative Gauss-Newton algorithm
for (iter in 1:6) {
lin.pred <- as.numeric(X %*% beta.k + Z %*% b.k)
mu.k <- plogis(lin.pred)
variances <- mu.k * (1 - mu.k)
W.k <- diag(1/variances)
y.star <- W.k^(.5) %*% (y - mu.k)
X.star <- W.k^(.5) %*% (variances * X)
delta.k <- solve(t(X.star) %*% X.star) %*% t(X.star) %*% y.star
# Gauss-Newton Update
beta.k <- beta.k + delta.k
cat(iter, "Fixed Effects: ", beta.k, "\n")
}