# Functions for constructing matrices for LMS and QML.
EMPTY_MATSTRUCT <- list(numeric = matrix(nrow = 0, ncol = 0),
                        label = matrix(nrow = 0, ncol = 0))


setMatrixConstraints <- function(X, parTable, op, RHS, LHS, type, nonFreeParams) {
  fillConstExprs(X, parTable = parTable, op = op, RHS = RHS, LHS = LHS,
                 type = type, nonFreeParams = nonFreeParams) |>
    fillDynExprs(parTable = parTable, op = op, RHS = RHS, LHS = LHS, type = type)
}


fillConstExprs <- function(X, parTable, op, RHS, LHS, type, nonFreeParams = TRUE) {
  if (!NROW(parTable)) return(X)

  constExprs <- parTable[parTable$op %in% op &
                         parTable$rhs %in% RHS &
                         parTable$lhs %in% LHS &
                         canBeNumeric(parTable$mod, includeNA = !nonFreeParams), ]
  constExprs[constExprs$op == "~1", "rhs"] <- "1"

  setVal <- getSetValFunc(type)
  for (i in seq_len(NROW(constExprs))) {
    lhs <- constExprs[i, "lhs"]
    rhs <- constExprs[i, "rhs"]
    val <- as.numeric(constExprs[i, "mod"])
    X   <- setVal(X = X, rhs = rhs, lhs = lhs, val = val)
  }

  if (type == "symmetric") X[upper.tri(X)] <- 0
  X
}


fillDynExprs <- function(X, parTable, op, RHS, LHS, type) {
  # dynamic exprs need a corresponding matrix of labels
  labelX <- as.character.matrix(X, empty = TRUE)

  if (!NROW(parTable)) return(list(numeric = X, label = labelX))

  dynamicExprs <- parTable[parTable$op %in% op &
                           parTable$rhs %in% RHS &
                           parTable$lhs %in% LHS &
                           !canBeNumeric(parTable$mod,
                                         includeNA = TRUE), ]
  dynamicExprs[dynamicExprs$op == "~1", "rhs"] <- "1"

  setVal <- getSetValFunc(type)
  for (i in seq_len(NROW(dynamicExprs))) {
    lhs <- dynamicExprs[i, "lhs"]
    rhs <- dynamicExprs[i, "rhs"]
    mod <- dynamicExprs[i, "mod"]

    if (mod == "NA") {
      X      <- setVal(X = X, rhs = rhs, lhs = lhs, val = NA)
      labelX <- setVal(X = labelX, rhs = rhs, lhs = lhs, val = "")
    } else {
      X      <- setVal(X = X, rhs = rhs, lhs = lhs, val = 0)
      labelX <- setVal(X = labelX, rhs = rhs, lhs = lhs, val = mod)
    }
  }

  list(numeric = X, label = labelX)
}


getSetValFunc <- function(type) {
  switch(type,
         rhs       = setValRhsFirst,
         lhs       = setValLhsFirst,
         symmetric = setValSymmetric,
         stop("Unrecognized type, this is probably a bug!"))
}


setValRhsFirst <- function(X, rhs, lhs, val) {
  X[rhs, lhs] <- val
  X
}


setValLhsFirst <- function(X, rhs, lhs, val) {
  X[lhs, rhs] <- val
  X
}


setValSymmetric <- function(X, rhs, lhs, val) {
  X[lhs, rhs]     <- X[rhs, lhs] <- val
  X
}


getEmptyPhi <- function(phi) {
  labelPhi <- as.character.matrix(phi, empty = TRUE)
  list(numeric = phi, label = labelPhi)
}


notFilledLambda <- function(ind, lambda) {
  !any(is.na(lambda[ind, ])) && all(lambda[ind, ] == 0)
}


constructLambda <- function(lVs, indsLVs, parTable, auto.fix.first = TRUE, mode = "a") {
  numLVs        <- length(lVs)
  indsLVs       <- indsLVs[lVs] # make sure it is sorted
  allIndsLVs    <- unique(unlist(indsLVs))
  numAllIndsLVs <- length(allIndsLVs)
  firstVal      <- ifelse(auto.fix.first, 1, NA)

  lambda <- matrix(0, nrow = numAllIndsLVs, ncol = numLVs,
                   dimnames = list(allIndsLVs, lVs))

  for (lV in lVs) {
    firstFilled <- FALSE
    for (ind in indsLVs[[lV]]) {
      # TODO: make this work when duplicates appear seperately in lambdaY and lambdaX
      if (!firstFilled && auto.fix.first && notFilledLambda(ind, lambda)) {
        lambda[ind, lV] <- firstVal
        firstFilled <- TRUE
      } else lambda[ind, lV] <- NA
    }
  }

  switch(tolower(mode),
    a = {
      op <- "=~"
      composites <- getComposites(parTable)
      lambda[,intersect(colnames(lambda), composites)] <- 0
    },
    b = {
      op <- "<~"
      composites <- getComposites(parTable)
      lambda[,setdiff(colnames(lambda), composites)] <- 0
    },
    mod_msg_stop(paste0("Unsupported mode: ", mode, "!"))
  )

  setMatrixConstraints(X = lambda, parTable = parTable, op = op,
                       RHS = allIndsLVs, LHS = lVs, type = "rhs",
                       nonFreeParams = TRUE) # first params are by default set to 1
}


constructT <- function(lVs, indsLVs, parTable,
                       fix.composite.var = TRUE,
                       data = NULL, missing = "listwise",
                       sampling.weights = NULL) {
  indsLVs <- indsLVs[lVs] # make sure it is sorted
  allInds <- unique(unlist(indsLVs))
  k       <- length(allInds)

  T <- matrix(
    0, nrow = k, ncol = k,
    dimnames = list(allInds, allInds)
  )

  composites <- intersect(lVs, getComposites(parTable))
  compositeInds <- unique(unlist(indsLVs[composites]))

  for (composite in composites) {
    idx <- intersect(rownames(T), indsLVs[[composite]])

    if (fix.composite.var && !is.null(data$data.full)) {
      X <- data$data.full[,idx, drop = FALSE]

      S <- lavaan::lavCor(
        object           = X,
        missing          = missing,
        sampling.weights = sampling.weights,
        output           = "cov"
      )

      T[idx, idx] <- S[idx, idx]

    } else {
      T[idx, idx] <- NA

    }
  }

  setMatrixConstraints(X = T, parTable = parTable, op = "~~",
                       RHS = compositeInds, LHS = compositeInds,
                       type = "symmetric", nonFreeParams = FALSE)
}


constructTau <- function(lVs, indsLVs, parTable, mean.observed = TRUE) {
  indsLVs       <- indsLVs[lVs] # make sure it is sorted
  allIndsLVs    <- unique(unlist(indsLVs))
  numAllIndsLVs <- length(allIndsLVs)
  default       <- ifelse(mean.observed, NA, 0)
  lavOptimizerSyntaxAdditions <- ""

  tau <- matrix(default, nrow = numAllIndsLVs, ncol = 1,
                dimnames = list(allIndsLVs, "1"))
  for (lV in lVs) { # set first ind to 0, if lV has meanstructure
    subPT <- parTable[parTable$lhs == lV & parTable$op == "~1", ]
    indsLV <- indsLVs[[lV]]

    if (NROW(subPT) && length(indsLV)) {
      firstInd         <- indsLV[[1]]
      tau[firstInd, 1] <- 0
      lavOptimizerSyntaxAdditions <-
        getFixedInterceptSyntax(indicator = firstInd, parTable = parTable,
                                syntax = lavOptimizerSyntaxAdditions)
    }
  }

  c(setMatrixConstraints(X = tau, parTable = parTable, op = "~1",
                         RHS = "", LHS = allIndsLVs, type = "lhs",
                         nonFreeParams = FALSE),
    list(syntaxAdditions = lavOptimizerSyntaxAdditions))
}


constructTheta <- function(lVs, indsLVs, parTable, auto.fix.single = TRUE) {
  numLVs        <- length(lVs)
  indsLVs       <- indsLVs[lVs] # make sure it is sorted
  numIndsLVs    <- lapply(indsLVs, FUN = length)
  allIndsLVs    <- unique(unlist(indsLVs))
  numAllIndsLVs <- length(allIndsLVs)

  theta <- matrix(0, nrow = numAllIndsLVs, ncol = numAllIndsLVs,
                  dimnames = list(allIndsLVs, allIndsLVs))
  diag(theta) <- NA

  if (auto.fix.single) {
    for (lV in lVs) { # set to 0 if there is only a single indicator
      if (numIndsLVs[[lV]] != 1) next
      theta[indsLVs[[lV]], indsLVs[[lV]]] <- 0
    }
  }

  compositeIndicators <- getCompositeIndicators(parTable)
  isCompositeInd <- allIndsLVs %in% compositeIndicators
  theta[isCompositeInd, isCompositeInd] <- 0

  setMatrixConstraints(X = theta, parTable = parTable, op = "~~",
                       RHS = allIndsLVs, LHS = allIndsLVs, type = "symmetric",
                       nonFreeParams = FALSE)
}


constructGamma <- function(DVs, IVs, parTable, auto.fix.first = TRUE) {
  if (!length(DVs)) return(EMPTY_MATSTRUCT)

  notInt <- !grepl(":", parTable$rhs)
  exprsGamma1 <- parTable[parTable$op == "~" & notInt & parTable$lhs %in% DVs &
                          parTable$rhs %in% IVs, , drop = FALSE]
  exprsGamma2 <- parTable[parTable$op == "=~" & notInt & parTable$rhs %in% DVs &
                          parTable$lhs %in% IVs, , drop = FALSE]

  if (NROW(exprsGamma2)) {
    exprsGamma3 <- exprsGamma2
    exprsGamma3$lhs <- exprsGamma2$rhs
    exprsGamma3$op  <- "~"
    exprsGamma3$rhs <- exprsGamma2$lhs
  } else exprsGamma3 <- NULL

  exprsGamma <- rbind(exprsGamma1, exprsGamma3)


  numDVs <- length(DVs)
  numIVs <- length(IVs)
  gamma  <- matrix(0, nrow = numDVs, ncol = numIVs, dimnames = list(DVs, IVs))

  gamma <- setMatrixConstraints(X = gamma, parTable = exprsGamma, op = c("~", "=~"),
                                RHS = IVs, LHS = DVs, type = "lhs",
                                nonFreeParams = FALSE)

  higherOrderLVs <- unique(exprsGamma2[exprsGamma2$op == "=~", "lhs"])
  for (lVh in higherOrderLVs) {
    firstFilled <- FALSE
    inds <- exprsGamma2[exprsGamma2$op == "=~" &
                        exprsGamma2$lhs == lVh, "rhs"]
    ind1 <- inds[[1L]]

    if (auto.fix.first) gamma$numeric[ind1, lVh] <- 1
  }

  gamma
}


constructPsi <- function(etas, parTable, orthogonal.y = FALSE) {
  if (!length(etas)) return(EMPTY_MATSTRUCT)

  numEtas   <- length(etas)
  psi       <- matrix(0, nrow = numEtas, ncol = numEtas,
                      dimnames = list(etas, etas))
  diag(psi) <- NA

  if (!orthogonal.y) {
    for (i in seq_len(NROW(psi))) for (j in seq_len(i - 1)) {
      eta_i <- etas[[i]]
      eta_j <- etas[[j]]

      if (isPureEta(eta_i, parTable) && isPureEta(eta_j, parTable))
        psi[i, j] <- NA
    }
  }

  setMatrixConstraints(X = psi, parTable = parTable, op = "~~",
                       RHS = etas, LHS = etas, type = "symmetric",
                       nonFreeParams = FALSE)
}


constructPhi <- function(xis, method = "lms", cov.syntax = NULL,
                         parTable, parTableCovModel = NULL,
                         orthogonal.x = FALSE) {
  if (!length(xis)) return(EMPTY_MATSTRUCT)

  numXis <- length(xis)
  phi    <- matrix(0, nrow = numXis, ncol = numXis,
                   dimnames = list(xis, xis))

  if (method != "lms" && is.null(cov.syntax) && is.null(parTableCovModel)) {
    if (!orthogonal.x) phi[lower.tri(phi, diag = TRUE)] <- NA
    else               diag(phi) <- NA

    setMatrixConstraints(X = phi, parTable = parTable, op = "~~",
                         RHS = xis, LHS = xis, type = "symmetric",
                         nonFreeParams = FALSE)
  } else getEmptyPhi(phi = phi)
}


constructA <- function(xis, method = "lms", cov.syntax = NULL,
                       parTable, parTableCovModel = NULL, orthogonal.x = FALSE) {
  if (!length(xis))
    return(EMPTY_MATSTRUCT)

  numXis <- length(xis)
  A      <- matrix(0, nrow = numXis, ncol = numXis,
                   dimnames = list(xis, xis))
  if (method == "lms" && is.null(cov.syntax) && is.null(parTableCovModel)) {
    if (!orthogonal.x) A[lower.tri(A, diag = TRUE)] <- NA
    else               diag(A) <- NA

    A <- setMatrixConstraints(X = A, parTable = parTable, op = "~~",
                              RHS = xis, LHS = xis, type = "symmetric",
                              nonFreeParams = FALSE)

    if (!any(is.na(A$numeric))) {
      Phi <- A$numeric
      Phi[upper.tri(Phi)] <- t(Phi)[upper.tri(Phi)]
      A$numeric <- t(chol(Phi))
    }

    A

  } else getEmptyPhi(phi = A)
}


constructCovZetaXi <- function(xis, etas, method = "lms", parTable) {
  if (method != "lms" || !length(xis) || !length(etas))
    return(EMPTY_MATSTRUCT)

  numXis <- length(xis)
  numEtas <- length(etas)

  covZetaXi <- matrix(
    0, nrow = numEtas, ncol = numXis,
    dimnames = list(etas, xis)
  )

  parTableResCov <- parTable[
    parTable$op == "~~" &
    ((parTable$lhs %in% etas & parTable$rhs %in% xis) |
     (parTable$lhs %in% xis & parTable$rhs %in% etas)),
    , drop = FALSE
  ]

  swap <- parTableResCov$lhs %in% xis
  lhs <- parTableResCov$lhs[swap]
  parTableResCov$lhs[swap] <- parTableResCov$rhs[swap]
  parTableResCov$rhs[swap] <- lhs

  setMatrixConstraints(
    X = covZetaXi, parTable = parTableResCov, op = "~~",
    RHS = c(xis, etas), LHS = c(xis, etas),
    type = "lhs", nonFreeParams = FALSE
  )
}


constructAlpha <- function(etas, parTable, mean.observed = TRUE) {
  if (!length(etas)) return(EMPTY_MATSTRUCT)

  numEtas <- length(etas)
  default <- if (mean.observed) 0 else NA

  alpha <- matrix(default, nrow = numEtas, ncol = 1,
                  dimnames = list(etas, "1"))

  if (!mean.observed) {
    for (i in seq_len(numEtas)) {
      eta <- etas[[i]]
      fill <- if (intTermsAffectLV(eta, parTable)) NA else 0
      alpha[eta, 1] <- fill
    }
  }

  setMatrixConstraints(X = alpha, parTable = parTable, op = "~1",
                       RHS = "", LHS = etas, type = "lhs",
                       nonFreeParams = FALSE)
}


selectScalingY <- function(lambdaY, method = "qml") {
  if (method != "qml") return(NULL)
  matrix(apply(lambdaY, MARGIN = 2, FUN = isScalingY),
         nrow = nrow(lambdaY), ncol = ncol(lambdaY),
         dimnames = dimnames(lambdaY))
}


selectBetaRows <- function(lambdaY, method = "qml") {
  if (method != "qml") return(NULL)
  scalingYs <- selectScalingY(lambdaY, method = "qml")
  matrix(apply(scalingYs, MARGIN = 1, FUN = function(x )!all(x)),
         nrow = nrow(lambdaY), ncol = 1,
         dimnames = list(rownames(lambdaY), "1"))
}


constructR <- function(etas, indsEtas, lambdaY, method = "qml") {
  if (method != "qml") return(NULL)
  hasMultipleInds <- vapply(indsEtas, FUN = function(x) length(x) > 1,
                            FUN.VALUE = logical(1L))
  etas <- names(indsEtas)[hasMultipleInds]
  indsEtas <- indsEtas[etas]
  if (length(etas) == 0) return(NULL)

  numEtas <- length(etas)
  numIndsEtas <- lapply(indsEtas, FUN = length)
  allIndsEtas <- unique(unlist(indsEtas))
  numAllIndsEtas <- length(allIndsEtas)
  selectBetaRows <- selectBetaRows(lambdaY, method = method)
  rowNamesR <- rownames(lambdaY)[selectBetaRows]

  R <- matrix(0, nrow = numAllIndsEtas - numEtas,
              ncol = numAllIndsEtas,
              dimnames = list(rowNamesR[seq_len(numAllIndsEtas - numEtas)],
                              allIndsEtas))

  lastRow <- lastCol <- 0
  for (i in seq_len(numEtas)) {
    nInds <- numIndsEtas[[etas[[i]]]] - 1
    if (nInds == 0) mod_msg_stop("Etas in QML must have at least two indicators")
    # free params
    R[seq_len(nInds) + lastRow, lastCol + 1] <- NA
    R[seq_len(nInds) + lastRow,
      seq_len(nInds) + lastCol + 1] <- diag(nInds)
    lastRow <- lastRow + nInds
    lastCol <- lastCol + nInds + 1
  }
  R
}


getLatentEtasQml <- function(indsEtas, method = "qml") {
  if (method != "qml") return(NULL)
  hasMultipleInds <- vapply(indsEtas, FUN = function(x) length(x) > 1,
                            FUN.VALUE = logical(1L))
  etas <- names(indsEtas)[hasMultipleInds]
  if (length(etas) == 0) return(NULL)
  etas
}


getColsU <- function(etas, indsEtas, lambdaY, method = "qml") {
  numEtas         <- length(etas)
  numIndsEtas     <- lapply(indsEtas, FUN = length)
  allIndsEtas     <- unique(unlist(indsEtas))
  numAllIndsEtas  <- length(allIndsEtas)
  selectBetaRows  <- selectBetaRows(lambdaY, method = "qml")
  rowNamesR       <- rownames(lambdaY)[selectBetaRows]

  hasMultipleInds <- vapply(indsEtas, FUN = function(x) length(x) > 1,
                            FUN.VALUE = logical(1L))
  if (sum(hasMultipleInds) == 0) return(NULL)

  colsU <- rowNamesR[seq_len(numAllIndsEtas - sum(hasMultipleInds))]
  colsU[is.na(colsU)] <- paste0("__FILL__ZERO__", seq_len(sum(is.na(colsU))))

  colsU
}


constructFullU <- function(fullL2, N, etas, method = "qml") {
  if (method != "qml" || N == 0) return(NULL)

  if (is.null(fullL2)) nCols <- length(etas)
  else nCols <- NCOL(fullL2)

  matrix(0, nrow = N, ncol = nCols, dimnames = list(NULL, colnames(fullL2)))
}


constructFullR <- function(etas, indsEtas, lambdaY, method = "qml") {
  if (method != "qml") return(NULL)

  numEtas <- length(etas)
  numIndsEtas <- lapply(indsEtas, FUN = length)
  allIndsEtas <- unlist(indsEtas)
  numAllIndsEtas <- length(allIndsEtas)
  selectBetaRows <- selectBetaRows(lambdaY, method = "qml")
  rowNamesR <- rownames(lambdaY)[selectBetaRows]
  hasMultipleInds <- vapply(indsEtas, FUN = function(x) length(x) > 1,
                            FUN.VALUE = logical(1L))
  if (sum(hasMultipleInds) == 0) return(NULL)

  matrix(0, nrow = numAllIndsEtas - sum(hasMultipleInds),
         ncol = numAllIndsEtas,
         dimnames = list(rowNamesR[seq_len(numAllIndsEtas - sum(hasMultipleInds))],
                                           allIndsEtas))

}


constructFullSigma2ThetaEpsilon <- function(psi, method = "qml") {
  if (method != "qml") return(NULL)
  matrix(0, nrow = nrow(psi), ncol = ncol(psi),
         dimnames = dimnames(psi))
}


getSelectSubSigma2ThetaEpsilon <- function(fullSigma2ThetaEpsilon,
                                           latentEtas, method = "qml") {
  if (method != "qml") return(NULL)
  select <- as.logical.matrix(fullSigma2ThetaEpsilon)
  select[TRUE] <- FALSE
  select[latentEtas, latentEtas] <- TRUE
  select
}


constructFullL2 <- function(colsU, etas, method = "qml") {
  if (method != "qml") return(NULL)

  if (is.null(colsU)) nCols <- length(etas)
  else nCols <- length(colsU)
  matrix(0, nrow = length(etas), ncol = nCols,
         dimnames = list(etas, colsU))
}


getSelectSubL2 <- function(fullL2, colsU, latentEtas, method = "qml") {
  if (method != "qml") return(NULL)
  select <- as.logical.matrix(fullL2)
  select[TRUE] <- FALSE
  select[latentEtas, !grepl("__FILL__ZERO__", colnames(select))] <- TRUE
  select
}


getScalingInds <- function(indsEtas, R, latentEtas, method = "qml") {
  if (method != "qml") return(NULL)
  allIndsEtas <- unique(unlist(indsEtas[latentEtas]))
  scalingInds <- allIndsEtas[!allIndsEtas %in% rownames(R)]
  scalingInds
}


selectThetaEpsilon1 <- function(indsEtas, thetaEpsilon, scalingInds,
                                method = "qml") {
  if (method != "qml") return(NULL)
  selectThetaEpsilon <- as.logical.matrix(thetaEpsilon)
  selectThetaEpsilon[TRUE] <- FALSE
  diag(selectThetaEpsilon)[scalingInds] <- TRUE
  selectThetaEpsilon
}


selectThetaEpsilon2 <- function(indsEtas, thetaEpsilon, scalingInds,
                                method = "qml") {
  if (method != "qml") return(NULL)
  selectThetaEpsilon <- as.logical.matrix(thetaEpsilon)
  selectThetaEpsilon[TRUE] <- FALSE

  allScalingInds <- vapply(indsEtas, FUN.VALUE = character(1L), FUN = \(x) x[1L])
  nonLatentScalingInds <- allScalingInds[!allScalingInds %in% scalingInds]

  diag(selectThetaEpsilon)[nonLatentScalingInds] <- TRUE
  selectThetaEpsilon
}


constructSubThetaEpsilon1 <- function(indsEtas, thetaEpsilon, scalingInds,
                                      method = "qml") {
  if (method != "qml") return(NULL)
  subThetaEpsilon <- matrix(0, nrow = length(scalingInds),
                            ncol = length(scalingInds),
                            dimnames = list(scalingInds, scalingInds))
  diag(subThetaEpsilon) <- NA
  subThetaEpsilon
}


constructSubThetaEpsilon2 <- function(indsEtas, thetaEpsilon, scalingInds,
                                      method = "qml") {
  if (method != "qml") return(NULL)

  allScalingInds <- vapply(indsEtas, FUN.VALUE = character(1L), FUN = \(x) x[1L])
  nonLatentScalingInds <- allScalingInds[!allScalingInds %in% scalingInds]

  subThetaEpsilon <- matrix(0, nrow = length(nonLatentScalingInds),
                            ncol = length(nonLatentScalingInds),
                            dimnames = list(nonLatentScalingInds,
                                            nonLatentScalingInds))

  diag(subThetaEpsilon) <- NA
  subThetaEpsilon
}


getScalingLambdaY <- function(lambdaY, indsEtas, etas, method = "qml") {
  if (method != "qml") return(NULL)
  hasMultipleInds <- vapply(indsEtas, FUN = function(x) length(x) > 1,
                            FUN.VALUE = logical(1L))
  latentEtas <- names(indsEtas)[hasMultipleInds]
  indsLatentEtas <- unlist(indsEtas[latentEtas])
  lambdaY[indsLatentEtas, latentEtas]
}


sortXisConstructOmega <- function(xis, varsInts, etas, intTerms,
                                  method = "lms", double = FALSE,
                                  structovs = NULL, composites = NULL) {
  checkVarsIntsDA(varsInts, lVs = c(etas, xis))

  listSortedXis <- sortXis(
    xis = xis, varsInts = varsInts, etas = etas, intTerms = intTerms,
    double = double, structovs = structovs, composites = composites
  )

  sortedXis    <- listSortedXis$sortedXis
  nonLinearXis <- listSortedXis$nonLinearXis

  omegaXiXi <- constructOmegaXiXi(xis = xis, etas = etas,
                                  sortedXis = sortedXis,
                                  nonLinearXis = nonLinearXis,
                                  varsInts = varsInts,
                                  intTerms = intTerms)
  omegaEtaXi <- constructOmegaEtaXi(xis = xis, etas = etas,
                                    sortedXis = sortedXis,
                                    nonLinearXis = nonLinearXis,
                                    varsInts = varsInts,
                                    intTerms = intTerms)

  list(sortedXis = sortedXis, nonLinearXis = nonLinearXis,
       omegaXiXi = omegaXiXi, omegaEtaXi = omegaEtaXi,
       k = length(nonLinearXis))
}


sortXis <- function(xis, varsInts, etas, intTerms, double, structovs = NULL,
                    composites = NULL) {
  # allVarsInInts should be sorted according to which variables
  # occur in the most interaction terms (makes it more efficient)
  allVarsInInts <- unique(unlist(varsInts))
  freqInIntTerms <- lapply(varsInts, FUN = unique) |> unlist() |>
    table() |> oneWayTableToDataFrame()

  sortedXis <- c(allVarsInInts, xis[!xis %in% allVarsInInts])
  nonLinearXis <- character(0L)

  for (interaction in varsInts) {
    if (any(interaction %in% nonLinearXis) && !double ||
        all(interaction %in% nonLinearXis) && double) next # no need to add it again

    mod_stopif(length(interaction) > 2, "Only interactions between two variables are allowed")
    mod_stopif(all(interaction %in% etas),
           paste0("Interactions between two endogenous variables are not allowed!",
           "You can try passing `auto.split.syntax=TRUE` to fix the issue.",
           "See \nvignette(\"interaction_two_etas\", \"modsem\")."))

    choice <- unique(interaction[which(!interaction %in% etas &
                                       !interaction %in% nonLinearXis)])

    if (length(choice) > 1L && !double) {
      freq <- freqInIntTerms[choice, "freq"]
      choice <- choice[whichIsMax(freq)]

      is.ov <- choice %in% structovs
      is.composite <- choice %in% composites

      if (any(is.ov) && !all(is.ov)) {
        # only possible if length(choice) > 1
        k <- which(!is.ov)

      } else if (any(is.composite) && !all(is.composite)) {
        # only possible if length(choice) > 1
        k <- which(!is.composite)

      } else {
        k <- 1L # pick first if both are equal

      }

      choice <- choice[[k]]
    }

    nonLinearXis <- c(nonLinearXis, choice)
  }

  linearXis <- xis[!xis %in% nonLinearXis]

  list(
    linearXis = linearXis,
    sortedXis = c(nonLinearXis, linearXis),
    nonLinearXis = nonLinearXis
  )
}


constructOmegaEtaXi <- function(xis, etas, sortedXis, nonLinearXis,
                                varsInts, intTerms) {
  omega      <- NULL
  labelOmega <- NULL

  for (eta in etas) {
    subOmega <- matrix(0, nrow = length(xis), ncol = length(etas),
                            dimnames = list(sortedXis, etas))
    subLabelOmega <- as.character.matrix(subOmega, empty = TRUE)

    for (row in varsInts[intTerms$lhs == eta]) {
      if (!any(row %in% etas) || all(row %in% etas)) next

      whichXi  <- which(!row %in% etas)
      whichEta <- which(row %in% etas)

      subOmega[row[[whichXi]], row[[whichEta]]] <-
        getFreeOrConstIntTerms(row, eta, intTerms)
      subLabelOmega[row[[whichXi]], row[[whichEta]]] <-
        getLabelIntTerms(row, eta, intTerms)
    }

    omega      <- rbind(omega, labelRowsOmega(subOmega, eta = eta))
    labelOmega <- rbind(labelOmega, labelRowsOmega(subLabelOmega, eta = eta))
  }
  list(numeric = omega, label = labelOmega)
}


constructOmegaXiXi <- function(xis, etas, sortedXis, nonLinearXis,
                               varsInts, intTerms) {
  omega      <- NULL
  labelOmega <- NULL
  for (eta in etas) {
    subOmega <- matrix(0, nrow = length(sortedXis), ncol = length(sortedXis),
                       dimnames = list(sortedXis, sortedXis))
    subLabelOmega <- as.character.matrix(subOmega, empty = TRUE)

    for (row in varsInts[intTerms$lhs == eta]) {
       if (!all(row %in% sortedXis)) next

       whichRow <- which(row %in% nonLinearXis)[[1]] # if quadratic term pick first
       whichCol <- ifelse(whichRow == 1, 2, 1)

       subOmega[row[[whichRow]], row[[whichCol]]] <-
         getFreeOrConstIntTerms(row, eta, intTerms)
       subLabelOmega[row[[whichRow]], row[[whichCol]]] <-
         getLabelIntTerms(row, eta, intTerms)
    }

    omega      <- rbind(omega, labelRowsOmega(subOmega, eta = eta))
    labelOmega <- rbind(labelOmega, labelRowsOmega(subLabelOmega, eta = eta))
  }

  list(numeric = omega, label = labelOmega)
}


labelRowsOmega <- function(X, eta) {
  rownames(X) <- paste0(eta, "~", rownames(X))
  X
}
