You are here

Problems with non-convex Hessian with multilevel SEM

2 posts / 0 new
Last post
Ben's picture
Ben
Offline
Joined: 06/20/2023 - 09:18
Problems with non-convex Hessian with multilevel SEM
AttachmentSize
Image icon lavaan-model.png806.51 KB

As written in this thread, I have repeated problems with a non-convex Hessian while working my way step-wise towards a 3-level SEM with latent variables and their respective measurement items in a paper in organizational psychology.

While I'm looking for general guidelines to deal with non-cenvex Hessians and status code 5-issues in that thread, it's probably good to look at my models to find issues here.

My goal is to build a model with two variables measured on the 1st "individual" level (X, Y), two variables measured on the 2nd "team" level (V, W) and a 3rd "district" level to control for shared variance between teams. All X, Y, V, W will be related through regressions on the 2nd level. I compare my models with lavaan as far as feasible (lavaan isn't able to do 3lvl MSEMs).

I get the single-level regressions and 2lvl-measurement models to agree. Yet, when trying to build a 2lvl-factor model regressing Y on X, I already run into problems.

I have attached a sketch of the lavaan model as I understand it. Here is the code, is something about my model already wrong? If not, where can I start trouble shooting?

I'm grateful for your support. I hope I've just made a simple mistake somewhere and hope it's not too stupid.

require(OpenMx)
 
dataL1 <- data
dataL2 <- data[!duplicated(data$team),]
 
mxDataL1 <- mxData(observed=dataL1, type="raw")
mxDataL2 <- mxData(observed=dataL2, type="raw", primaryKey = "team")
 
xItems <- paste0("x",1:nx)
yItems <- paste0("y",1:ny)
 
## Defining various Paths
# Paths X lvl 1
pathXItemsVar <- mxPath(from=xItems, arrows=2, free=TRUE, values = diag(var(data[xItems], na.rm=TRUE)), labels=paste0("e_x",1:nx)) # residual variances
pathXItemsMeans <- mxPath(from = "one", to = xItems, free=TRUE, values=1, labels=paste0("m_x",1:nx)) # means items
pathXItemsMeans0 <- mxPath(from = "one", to = xItems, free = FALSE, values=0, labels=paste0("m_x",1:nx)) # manifest means, constrained to 0
pathXLoadings <- mxPath(from="x", to=xItems, free=c(FALSE,rep(TRUE,nx-1)), values=1, labels=paste0("fl_x",1:nx)) # factor loadings, fixing first factor to 1
pathXLatentVar <- mxPath(from="x", arrows=2, free=TRUE, values=1, labels="var_x") # latent variance
 
# Paths Y lvl 1
pathYItemsVar <- mxPath(from=yItems, arrows=2, free=TRUE, values = diag(var(data[yItems], na.rm=TRUE)), labels=paste0("e_y",1:ny)) # residual variances
pathYItemsMeans <- mxPath(from = "one", to = yItems, free=TRUE, values=1, labels=paste0("m_y",1:ny)) # means items
pathYItemsMeans0 <- mxPath(from = "one", to = yItems, free = FALSE, values=0, labels=paste0("m_y",1:ny)) # manifest means, constrained to 0
pathYLoadings <- mxPath(from="y", to=yItems, free=c(FALSE,rep(TRUE,ny-1)), values=1, labels=paste0("fl_y",1:ny)) # factor loadings, fixing first factor to 1
pathYLatentVar <- mxPath(from="y", arrows=2, free=TRUE, values = 1, labels="var_y") # latent variance
 
# Paths X lvl 2
pathXItemsVarL2 <- mxPath(from=xItems, arrows=2, free=TRUE, values = diag(var(data[xItems], na.rm=TRUE)), labels=paste0("e_l2x",1:nx)) # (latent) items variance
pathXItemsMeansL2 <- mxPath(from = "one", to = xItems, free=TRUE, values=1, labels=paste0("m_l2x",1:nx)) # (latent) items means
pathXLoadingsL2 <- mxPath(from = "xTeam", to = xItems,free = c(FALSE,rep(TRUE,nx-1)), values = 1, labels = paste0("fl_x",1:nx)) # latent Team factor, loadings constrained to same as on within level, first fixed to 1
pathXLatentVarL2 <- mxPath(from = "xTeam", arrows = 2, values = .25, free = TRUE, labels = "xTeam_var") # latent team factor, variance
 
# Paths Y lvl 2
pathYItemsVarL2 <- mxPath(from=yItems, arrows=2, free=TRUE, values = diag(var(data[yItems], na.rm=TRUE)), labels=paste0("e_l2y",1:ny)) # (latent) items variance
pathYItemsMeansL2 <- mxPath(from = "one", to = yItems, free=TRUE, values=1, labels=paste0("m_l2y",1:ny)) # (latent) items means
pathYLoadingsL2 <- mxPath(from = "yTeam", to = yItems,free = c(FALSE,rep(TRUE,ny-1)), values = 1, labels = paste0("fl_y",1:ny)) # latent Team factor, loadings constrained to same as on within level, first fixed to 1
pathYLatentVarL2 <- mxPath(from = "yTeam", arrows = 2, values = .25, free = TRUE, labels = "yTeam_var") # latent team factor, variance
 
# Regression
pathRegXY <- mxPath(from = "x", to = "y", arrows = 1, free = TRUE, value = 1, labels = "x_to_y_within")
pathRegXYTeam <- mxPath(from = "xTeam", to = "yTeam", arrows = 1, free = TRUE, value = 1, labels = "x_to_y_between")
 
## Lavaan model
require(lavaan)
 
lmodelXYL12 <- '
  level: 1
    xw =~ a1 * x1 + a2 * x2 + a3 * x3 + a4 * x4 + a5 * x5 + a6 * x6 + a7 * x7 + a8 * x8 + a9 * x9 + a10 * x10 + a11 * x11 + a12 * x12 + a13 * x13 + a14 * x14
    yw =~ b1 * y1 + b2 * y2 + b3 * y3 + b4 * y4 + b5 * y5 + b6 * y6 + b7 * y7 + b8 * y8 + b9 * y9 + b10 * y10 + b11 * y11 + b12 * y12
    yw ~ xw
  level: 2
    xb =~ a1 * x1 + a2 * x2 + a3 * x3 + a4 * x4 + a5 * x5 + a6 * x6 + a7 * x7 + a8 * x8 + a9 * x9 + a10 * x10 + a11 * x11 + a12 * x12 + a13 * x13 + a14 * x14
    yb =~ b1 * y1 + b2 * y2 + b3 * y3 + b4 * y4 + b5 * y5 + b6 * y6 + b7 * y7 + b8 * y8 + b9 * y9 + b10 * y10 + b11 * y11 + b12 * y12
    yb ~ xb
'
 
lfitXYL12 <- sem(model = lmodelXYL12, data = dataL1, cluster = "team")
summary(lfitXYL12) # the factor loadings and other measures are the same as with OpenMx
 
## OpenMx Models
pathRegXY <- mxPath(from = "x", to = "y", arrows = 1, free = TRUE, value = 1, labels = "x_to_y")
pathRegXYTeam <- mxPath(from = "xTeam", to = "yTeam", arrows = 1, free = TRUE, value = 1, labels = "x_to_y")
 
modelXYLatentL2 <- mxModel(
  model = "between",
  type = "RAM",
  manifestVars = c(),
  latentVars = c("xTeam","yTeam",xItems,yItems),
  mxDataL2,
  pathXItemsMeansL2, pathXItemsVarL2,
  pathYItemsMeansL2, pathYItemsVarL2,
  pathXLatentVarL2, pathXLoadingsL2,
  pathYLatentVarL2, pathYLoadingsL2,
  pathRegXYTeam,
  mxCI(c("x_to_y_between"))
)
 
modelXYLatentL12 <- mxModel(
  model = "within",
  type = "RAM",
  modelXYLatentL2,
  manifestVars = c(xItems,yItems),
  latentVars = c("x","y"),
  mxDataL1,
  mxPath(from = paste0("between.",xItems), to = xItems, values=1, free=FALSE, joinKey="team"), #linking (latent) between lvl Items to manifest vars
  mxPath(from = paste0("between.",yItems), to = yItems, values=1, free=FALSE, joinKey="team"), #linking (latent) between lvl Items to manifest vars
  pathXItemsMeans0, pathXItemsVar,
  pathYItemsMeans0, pathYItemsVar,
  pathXLatentVar, pathXLoadings,
  pathYLatentVar, pathYLoadings,
  pathRegXY,
  mxCI(c("x_to_y_within"))
)
 
fitXYLatentL12 <- mxRun(modelXYLatentL12, intervals = TRUE)
summary(fitXYLatentL12)
Ben's picture
Ben
Offline
Joined: 06/20/2023 - 09:18
Solved: The issue had something to do with missing data

I found a way to solved the converge issue, but I had to omit all missing data from the data set in advance. Probably lavaan deals differently with missing data than OpenMx, and from all I read earlier I thought just keeping missing data in as is is the better approach, as the program takes what it needs.

I'm not sure what exactly the problem is and can probably live with this way of doing things, but I think it would be very very very valuable for other people to get an error message to hint that the problem might be the data and not the model, as I was spending dozens of hours trying to find other solutions, playing with the models, doing research, etc.