[英]R: Modeling random intercepts from lme4 or brms objects
是否有某種方法可以直接(聯合)對使用lme4
的lmer()
或brms
估計的隨機截距進行建模? 例如,在下面的代碼中,我擬合了一個分層模型,提取隨機截距,然后對其進行建模。
這種兩步法的一個缺點是我忽略了攔截中的錯誤。 這可以通過穩健的協方差矩陣、加權最小二乘等輕松解決。但是,最好在單個模型中聯合估計所有這些。
對於上下文:我對此感興趣,因為我正在估計一個項目響應模型,其中每個隨機截距都是一個人在每個時間點的能力,我想預測這些能力。 我將在一個更復雜的貝葉斯模型中完成所有這些工作。
library(lme4)
library(tibble)
set.seed(123)
# Simulate longitudinal data
N <- 100
time <- 2
# Time-varying data
df <- tibble(person = rep(1:N, time),
x = rnorm(N*time),
y = 2 + x*runif(N*time))
# Fit hierarchical model
mod <- lmer(y ~ -1 + (1 | person), df)
# Time-invariant data (constant within person)
df_person <- data.frame(ints = data.frame(ranef(mod))$condval,
sex = rbinom(N, size = 1, prob = 0.5))
# Model intercepts as function of time-invariant feature
summary(lm(ints ~ 1 + sex, df_person))
我不知道lme4
或brms
,但可以直接在 Stan 中完成。 這是一種復制模型的方法,但所有內容都是共同估計的; 有關更多信息,請參見此示例(在 Python 中,而不是 R 中)和本文。
我們用逐人隨機截距對y的觀測值進行建模(一個對於每個人j ) 和一個尺度參數
.
我們將逐人隨機截距建模為人的性別和系數的函數 ,加上第二個比例參數
.
這是上述模型的 Stan 代碼。 它使用非中心參數化:“原始”值有一個標准的正常先驗,我們轉換為“真實”值
使用
和
.
data {
int<lower=0> N_obs; // number of observations
int<lower=2> N_person; // number of persons
int<lower=1,upper=N_person> person[N_obs]; // person associated with each observation
vector<lower=0,upper=1>[N_person] sex; // sex of each person
vector[N_obs] y; // observed outcomes
}
parameters {
real<lower=0> sigma; // observation-level variation
vector[N_person] alpha_person_raw; // random intercepts for persons
real mu_alpha; // mean of random intercepts for persons
real<lower=0> sigma_alpha; // scale of random intercepts for persons
real beta; // coefficients for sex
}
transformed parameters {
vector[N_person] alpha_person = (alpha_person_raw * sigma_alpha) +
mu_alpha +
(sex * beta);
}
model {
sigma ~ exponential(1);
alpha_person_raw ~ std_normal();
mu_alpha ~ std_normal();
sigma_alpha ~ exponential(1);
beta ~ std_normal();
y ~ normal(alpha_person[person], sigma);
}
我使用與原始示例中相同的規則重新創建了數據集,但格式略有不同,這對 Stan 來說更容易使用。
library(tidyverse)
person.df = data.frame(person = 1:N, sex = rbinom(N, size = 1, prob = 0.5))
obs.df = data.frame(person = rep(1:N, time),
x = rnorm(N * time)) %>%
mutate(y = 2 + (x * runif(N * time)))
library(rstan)
stan.data = list(
N_obs = nrow(obs.df),
N_person = nrow(person.df),
person = obs.df$person,
sex = person.df$sex,
y = obs.df$y
)
stan.model = stan("two_level_model.stan", data = stan.data, chains = 3)
首先,我使用新數據集重新擬合兩階段模型。
first.level.m = lmer(y ~ -1 + (1 | person), obs.df)
second.level.m = lm(intercept ~ 1 + sex,
person.df %>%
mutate(intercept = ranef(first.level.m)$person[["(Intercept)"]]))
現在,讓我們比較估計的參數值。 這兩種方法一致認為性別的影響包括 0,並且隨機截距的平均值約為 2。(自然,這些估計受到x
尚未作為預測變量包含在模型中這一事實的影響。)
library(tidybayes)
bind_rows(
spread_draws(stan.model, mu_alpha, beta) %>%
ungroup() %>%
dplyr::select(.draw, mu_alpha, beta) %>%
pivot_longer(cols = -.draw, names_to = "parameter") %>%
group_by(parameter) %>%
summarise(lower.95 = quantile(value, 0.025),
lower.50 = quantile(value, 0.25),
est = median(value),
upper.50 = quantile(value, 0.75),
upper.95 = quantile(value, 0.975)) %>%
ungroup() %>%
mutate(parameter = case_when(parameter == "mu_alpha" ~ "(Intercept)",
parameter == "beta" ~ "sex"),
model = "joint"),
summary(second.level.m)$coefficients %>%
data.frame() %>%
rownames_to_column("parameter") %>%
mutate(lower.95 = Estimate + (Std..Error * qt(0.025, second.level.m$df.residual)),
lower.50 = Estimate + (Std..Error * qt(0.25, second.level.m$df.residual)),
est = Estimate,
upper.50 = Estimate + (Std..Error * qt(0.75, second.level.m$df.residual)),
upper.95 = Estimate + (Std..Error * qt(0.975, second.level.m$df.residual)),
model = "two-stage") %>%
dplyr::select(model, parameter, est, matches("lower|upper"))
) %>%
ggplot(aes(x = parameter, color = model)) +
geom_linerange(aes(ymin = lower.95, ymax = upper.95), size = 1,
position = position_dodge(width = 0.3)) +
geom_linerange(aes(ymin = lower.50, ymax = upper.50), size = 2,
position = position_dodge(width = 0.3)) +
geom_point(aes(y = est), size = 3, position = position_dodge(width = 0.3)) +
labs(x = "Parameter", y = "Estimated parameter value", color = "Model") +
coord_flip() +
theme_bw()
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.