在多个估算数据集上运行潜在类增长分析

Question

对于我正在从事的项目的数据分析，我必须执行潜在类别增长分析 (LCGA) 来识别我的结果变量随时间推移的不同轨迹。由于我有许多缺失的变量，我首先必须使用多重插补来构建完整的数据集，然后我可以将其用于 LCGA。 我设法弄清楚了我在学习如何执行插补和 LCGA 时遇到的大部分问题/问题，但我不知道如何在插补数据集上运行 LCGA，然后将结果汇总以获得轨迹基于汇总结果。

使用的包：

library(tidyverse)
library(mice)
library(miceadds)
library(micemd)
library(parallel)
library(lcmm)

我的插补代码是数据集“数据”：

set.seed(2555)
#create a predictormatrix to use in the mice function
pred <- quickpred(data, mincor = 0.5, minpuc = 0.3) 
#parallel mice function to speed up computation, using a CPU with 32 logical cores and maxit=0 to keep computational times low as I test the code
imputed <- parlmice(data, n.core = 31, n.imp.core = 1, pred = pred, maxit=0, cluster.seed = 2555) 

此时我遇到的问题是 LCGA 需要长格式的数据才能工作。所以此时我必须将 parlmice 函数创建的 mids 对象转换为数据框。然后将数据帧转换为 LCGA 的长格式并像这样运行 LCGA：

#create dataframe from mids object 'imputed'
lcmm <- complete(imputed, include = FALSE)

#convert dataframe 'lcmm' to long format based on the outcome variable measured at different time points
lcmmlong <- NA
lcmmlong <- lcmm %>% select(ID, x_1:x_14) %>% pivot_longer(
  cols = c('x_1': 'x_14'),
  names_to = "time",
  names_prefix = "x_",
  names_sep = NULL,
  names_pattern = NULL,
  names_ptypes = list(),
  names_transform = list(),
  names_repair = "check_unique",
  values_to = "x",
  values_drop_na = TRUE,
  values_ptypes = list(),
  values_transform = list()
)

#run lcga on the long formate dataframe
lcga1 <-hlme(x ~ time, random=~-1, subject = "ID", ng = 1, data = lcmmlong) 
lcga2 <-gridsearch(rep = 100, maxiter = 10, minit = lcga1,hlme(x ~ time, random=~-1, subject = "ID", ng = 2, data = lcmmlong, mixture = ~ time)) 
lcga3 <-gridsearch(rep = 100, maxiter = 10, minit = lcga1,hlme(x ~ time, random=~-1, subject = "ID", ng = 3, data = lcmmlong, mixture = ~ time))

这当然行不通，因为 complete() 函数将所有插补数据集扔到同一个数据框中。我可以以长格式或宽格式执行此操作，但无论哪种方式，LCGA 都无法在此数据帧上运行。 解决方案是在插补中的每个单独的数据集上运行 LCGA，然后汇集结果。我已经为几种不同的分析找到了解决方案，例如来自“mice”包本身的示例：

imp <- mice(nhanes, seed = 123, print = FALSE)
fit <- with(imp, lm(chl ~ age + bmi + hyp))
est1 <- pool(fit)

但是，我不知道如何将从宽格式到长格式数据帧的转换以及不同的 lcga 步骤添加到mice()、with() 和 pool() 工作流程中。 据我所知，我必须在每个估算的数据库上单独手动运行 LCGA，然后手动合并结果。

#Extract imputed databases one by one for databases 1 through n.
lcmmn <- complete(imputed, action = n, include = FALSE)

即便如此，运行 lcga 是一回事，但需要采取更多行动来确定最佳轨迹数等等。 所以我的问题是： 如何在估算的数据库上运行 LCGA 并汇集结果，然后我可以使用这些结果来确定最佳轨迹数？

Answer 1

FIML 小旅行

首先让我注意到，还有第二种使用 lavaan 处理缺失数据的方法，即完整信息最大似然（FIML，在?lavOptions 手册中，请参阅missing 的选项标签）。您还可以使用 R 包 semTools 中的包装函数 growth.auxiliary 包含辅助变量。

在 MI 数据上使用 lavaan

我不完全确定如何使用mice 或lavaan 中的开箱即用方法来实现这一点。

lavaan.survey. 应该有一个名为 lavaan.survey 的包装器包。但是lavaan 先进，lavaan.survey 的最后一次更新是从 2016 年开始的。在最近的方法中，我向lavaan.survey 的作者报告了一个计算标准错误的错误，该错误尚未修复。

手动。完全可以手动计算：

• 系数池化（例如由lavaan::parameterEstimates 给出）是一个相当简单的mean 汇总所有估算数据

• 至于标准错误，您需要包含两个术语；一个用于抽样方差，一个用于插补方差

  1. 抽样误差可以是所有估算数据中标准误差的mean
  2. 插补方差计算为(1+1/n) * sum_i^n(coef_i-mean(coef)) / (n-1)

BIFIEsurvey。 但是，有一个名为BIFIEsurvey 的R 包旨在简化此类任务。甚至还有一个 lavaan 的包装器，使用多重推算数据，（编辑）BIFIE.lavaan.survey（/编辑）——我没有使用太多，我认为它无法处理 SEM 的测量部分（编辑：我联系了包的维护者）。但是有可能定义自定义分析函数。我使用改编自semtools的自定义示例进行说明

## linear growth model with a time-varying covariate
library(lavaan)
targetModel <- '
  # intercept and slope with fixed coefficients
    i =~ 1*t1 + 1*t2 + 1*t3 + 1*t4
    s =~ 0*t1 + 1*t2 + 2*t3 + 3*t4

  # regressions
    i ~ x1 + x2
    s ~ x1 + x2

  # time-varying covariates
    t1 ~ c1
    t2 ~ c2
    t3 ~ c3
    t4 ~ c4
'

fit <- growth(targetModel, data = Demo.growth)
summary(fit)

## using semTools (cf. ?growth.auxiliary)
library(semTools)
dat1 <- Demo.growth
dat1$z <- rnorm(nrow(dat1))
dat1$x1 <- ifelse(dat1$z < quantile(dat1$z, .3), NA, dat1$x1)
dat1$x2 <- ifelse(dat1$z > quantile(dat1$z, .8), NA, dat1$x2)

fitaux1 <- growth.auxiliary(targetModel, data = dat1, aux = "z",
                         missing = "fiml", estimator = "mlr")
summary(fitaux1)

## using BIFIEsurvey on multiply imputed data (cf. ?BIFIE.lavaan.survey)
imp <- mice(dat1, seed = 123, print = FALSE)
imp_list <- mice::complete(imp, action = "all", include = FALSE)
bdat <- BIFIE.data(imp_list)
bdat$dat1

userfct <- function(X, w) { #X <- bdat$dat1; w <- bdat$wgt;
  X1 <- as.data.frame(X)
  colnames(X1) <- bdat$varnames
  
  fit <- growth(model = targetModel, data = X1)
  
  lavaan_coef <- methods::getMethod("coef", "lavaan")
  est <- lavaan_coef(fit)
  
  return(c(est,
           lavaan::fitMeasures(fit)[c("cfi","tli")]))
}
parnames <- names(userfct(bdat$dat1, bdat$wgt))
fitbsurv <-  BIFIEsurvey::BIFIE.by(bdat, vars = bdat$varnames, userfct = userfct,
                                   userparnames = parnames)

summary(fitbsurv, digits = 3)

请注意，对于BIFIE.by，来自lavaan 的估计标准误差不会传递给BIFIEsurvey。 BIFIEsurvey 旨在处理复杂的复制设计。如果您没有这样的设计，您可以使用BIFIE.data.jack 使用多个随机折刀组（选项jktype="JK_RANDOM"）。