R/lav_samplestats_wls_obs.R

In yrosseel/lavaan: Latent Variable Analysis

lav_samplestats_wls_obs <- function(mean.g, cov.g, var.g,
                                    th.g, th.idx.g,
                                    res.int.g, res.cov.g, res.var.g, res.th.g,
                                    res.slopes.g,
                                    group.w.g,
                                    categorical = FALSE,
                                    conditional.x = FALSE,
                                    meanstructure = FALSE,
                                    correlation = FALSE,
                                    slopestructure = FALSE,
                                    group.w.free = FALSE) {
  # WLS.obs
  if (categorical) {
    # order of elements is important here:
    # 1. thresholds + (negative) means (interleaved)
    # 2. slopes (if any)
    # 3. variances (if any)
    # 4. covariance matrix (no diagonal!)

    # NOTE: prior to 0.5-17, we had this:
    # TH[ov.types == "numeric"] <- -1*TH[ov.types == "numeric"]
    # which is WRONG if we have more than one threshold per variable
    # (thanks to Sacha Epskamp for spotting this!)
    if (conditional.x) {
      TH <- res.th.g
      TH[th.idx.g == 0] <- -1 * TH[th.idx.g == 0]

      nvar <- length(res.var.g)
      num.idx <- which(!seq_len(nvar) %in% th.idx.g)

      WLS.obs <- c(
        TH,
        lav_matrix_vec(res.slopes.g),
        res.var.g[num.idx],
        lav_matrix_vech(res.cov.g, diagonal = FALSE)
      )
    } else {
      TH <- th.g
      TH[th.idx.g == 0] <- -1 * TH[th.idx.g == 0]

      nvar <- length(var.g)
      num.idx <- which(!seq_len(nvar) %in% th.idx.g)

      WLS.obs <- c(
        TH,
        var.g[num.idx],
        lav_matrix_vech(cov.g, diagonal = FALSE)
      )
    }
  } else {
    # CONTINUOUS:
    DIAG <- TRUE
    if (correlation) {
      DIAG <- FALSE
    }
    if (conditional.x) {
      if (meanstructure) {
        if (slopestructure) {
          # order = vec(Beta), where first row are intercepts
          # cbind(res.int, res.slopes) is t(Beta)
          # so we need vecr
          WLS.obs <- c(
            lav_matrix_vecr(cbind(
              res.int.g,
              res.slopes.g
            )),
            lav_matrix_vech(res.cov.g, diagonal = DIAG)
          )
        } else {
          WLS.obs <- c(
            res.int.g,
            lav_matrix_vech(res.cov.g, diagonal = DIAG)
          )
        }
      } else {
        if (slopestructure) {
          WLS.obs <- c(
            lav_matrix_vecr(res.slopes.g),
            lav_matrix_vech(res.cov.g, diagonal = DIAG)
          )
        } else {
          WLS.obs <- lav_matrix_vech(res.cov.g, diagonal = DIAG)
        }
      }
    } else {
      if (meanstructure) {
        WLS.obs <- c(
          mean.g,
          lav_matrix_vech(cov.g, diagonal = DIAG)
        )
      } else {
        WLS.obs <- lav_matrix_vech(cov.g, diagonal = DIAG)
      }
    }
  }

  # group.w.free?
  if (group.w.free) {
    WLS.obs <- c(group.w.g, WLS.obs)
  }

  WLS.obs
}