lav_step01_ovnames_initflat <- function(slot_par_table     = NULL,
                                               model            = NULL,
                                               dotdotdot_parser = "new") {
  # if slotPartable not NULL copy to flat_model
  # else
  #   if model is of type character
  #     parse model to flat_model
  #   else if model is a formula (** warning **)
  #     transform "~ x1 + x2 + x3" to character "f =~ x1 + x2 + x3",
  #         and parse to flat_model
  #     transform "y =~ x1 + x2 + x3" to character and parse to flat_model
  #     something else : *** error ***
  #   else if model is a lavaan object
  #     extract flat_model from @parTable
  #   else if model is a list
  #     if bare minimum present (columns lhs, op, rhs, free)
  #        flat_model = model
  #        replace column block by column group (if present)
  #     else
  #        --> *** error ***
  #   else
  #     --> ***error***
  #

  # 1a. get ov.names and ov.names.x (per group) -- needed for lav_lavdata()
  if (!is.null(slot_par_table)) {
    flat_model <- slot_par_table
  } else if (is.character(model)) {
    if (is.null(dotdotdot_parser)) {
      flat_model <- lavParseModelString(model)
    } else {
      flat_model <- lavParseModelString(model, parser = dotdotdot_parser)
    }
  } else if (inherits(model, "formula")) {
    # two typical cases:
    # 1. regression type formula
    # 2. no quotes, e.g. f =~ x1 + x2 + x3
    #    TODO: this isn't a valid formula !!!
    tmp <- as.character(model)
    if (tmp[1] == "~" && length(tmp) == 2L) {
      # looks like an unquoted single factor model f =~ something
      lav_msg_warn(
        gettext("model seems to be a formula;
                please enclose the model syntax between quotes"))
      # create model and hope for the best
      model_bis <- paste("f =", paste(tmp, collapse = " "), sep = "")
      flat_model <- lavParseModelString(model_bis)
    } else if (tmp[1] == "~" && length(tmp) == 3L) {
      # looks like a (unquoted) regression formula
      lav_msg_warn(
        gettext("model seems to be a formula;
                please enclose the model syntax between quotes"))
      # create model and hope for the best
      model_bis <- paste(tmp[2], tmp[1], tmp[3])
      flat_model <- lavParseModelString(model_bis)
    } else {
      lav_msg_stop(
        gettext("model seems to be a formula;
                please enclose the model syntax between quotes"))
    }
  } else if (inherits(model, "lavaan")) {
    # hm, a lavaan model; let's try to extract the parameter table
    # and see what happens
    flat_model <- parTable(model)
  } else if (is.list(model)) {
    # a list! perhaps a full parameter table, or an initial flat model,
    # or something else...

  # 1. flat_model already (output of lavParseModelString)?
  if (!is.null(model$lhs) && !is.null(model$op) &&
      !is.null(model$rhs) && !is.null(model$mod.idx) &&
    !is.null(attr(model, "modifiers"))) {
    flat_model <- model
    # look for the bare minimum columns: lhs - op - rhs
    } else if (!is.null(model$lhs) && !is.null(model$op) &&
      !is.null(model$rhs) && !is.null(model$free)) {
      # ok, we have something that looks like a parameter table
      flat_model <- model

      # fix semTools issue here? for auxiliary() which does not use
      # block column yet
      if (!is.null(flat_model$block)) {
        nn <- length(flat_model$lhs)
        if (length(flat_model$block) != nn) {
          flat_model$block <- flat_model$group
        }
        if (any(is.na(flat_model$block))) {
          flat_model$block <- flat_model$group
        }
      } else if (!is.null(flat_model$group)) {
        flat_model$block <- flat_model$group
      }
    } else {
      bare_minimum <- c("lhs", "op", "rhs", "free")
      missing_idx <- is.na(match(bare_minimum, names(model)))
      lav_msg_stop(
        gettextf("model is a list, but not a parameterTable?
                 missing column(s) in parameter table: [%s]",
                  lav_msg_view(bare_minimum[missing_idx], "none")))
    }
  } else {
    lav_msg_stop(gettext("model is NULL or not a valid type for it!"))
  }

  # Ok, we got a flattened model; usually this a flat_model object, but it
  # could also be an already lavaanified parTable, or a bare-minimum list with
  # lhs/op/rhs/free elements
  flat_model
}

# this function is only needed for backwards compatibility: it falls back
# to the old (<0.6-20) way of handling composites (defined by the '<~' operator)
# we do this by substituting the '<~' operator by '~', and by creating
# phantom latent variables for the LHS, and setting the residual variance
# to zero
#
# For example: "f <~ 1*income + occup + educ" is replaced by:
# "f =~ 0; f ~~ 0*f; f ~ 1*income + occup + educ"
#
lav_step01_ovnames_composites <- function(flat_model = NULL) {

  # get composite idx
  c_idx <- which(flat_model$op == "<~")
  if (length(c_idx) == 0L) {
    return(flat_model)
  }

  # flat_model info
  flat_names <- names(flat_model)
  c_names <- unique(flat_model$lhs[c_idx])
  nc <- length(c_names)
  mod_val <- max(flat_model$mod.idx)

  # check block numbers
  max_block <- max(flat_model$block)
  if (max_block > 1L) {
    lav_msg_stop(gettext(
      "composites = FALSE is not supported when multiple blocks are present;",
      " manually replace f <~ rhs by f =~ 0; f ~~ 0*f; f ~ rhs"))
  }

  block <- 1L

  # replace '<~' by '~'
  flat_model$op[c_idx] <- "~"

  # add phantom latent variables
  flat_model$lhs     <- c(flat_model$lhs, c_names)
  flat_model$op      <- c(flat_model$op,  rep("=~", nc))
  flat_model$rhs     <- c(flat_model$rhs, c_names)
  flat_model$fixed   <- c(flat_model$fixed, rep("", nc))
  flat_model$mod.idx <- c(flat_model$mod.idx, rep(0L, nc))
  flat_model$block   <- c(flat_model$block, rep(block, nc))

  # fix residual variances
  flat_model$lhs     <- c(flat_model$lhs, c_names)
  flat_model$op      <- c(flat_model$op,  rep("~~", nc))
  flat_model$rhs     <- c(flat_model$rhs, c_names)
  flat_model$fixed   <- c(flat_model$fixed, rep("0", nc)) # just for show
  flat_model$mod.idx <- c(flat_model$mod.idx, mod_val + seq_len(nc))
  flat_model$block   <- c(flat_model$block, rep(block, nc))

  # extend the 'other' columns
  other <- flat_names[!flat_names %in% c("lhs", "op", "rhs",
                                         "fixed", "mod.idx", "block")]
  for (o in other) {
    if (is.character(flat_model[[o]])) {
      flat_model[[o]] <- c(flat_model[[o]], rep("", nc * 2))
    } else if (is.integer(flat_model[[o]])) {
      flat_model[[o]] <- c(flat_model[[o]], rep(0L, nc * 2))
    } else {
      flat_model[[o]] <- c(flat_model[[o]], rep(as.numeric(NA), nc * 2))
    }
  }

  # add fixed values to the modifier attribute
  attr(flat_model, "modifiers") <- c(attr(flat_model, "modifiers"),
                                     rep(list(list(fixed = 0)), nc))

  flat_model
}

lav_step01_ovnames_ovorder <- function(flat_model = NULL,
                                              ov_order   = "model",
                                              data       = NULL,
                                              sample_cov = NULL,
                                              slot_data   = NULL) {
  # set ov_order in lowercase, check if it is "data" or "model",
  #  if not *** error ***
  # if ov_order == "data"
  #   try adapt flat_model via lav_partable_ov_from_data
  #   (** warning ** if this fails)

  # new in 0.6-14
  # if ov_order = "data", it would seem we need to intervene here;
  # ldw 1/3/2024:
  # we do this by adding an attribute "ovda" to flat_model and partable
  ov_order <- tolower(ov_order)
  if (ov_order == "data") {
    flat_model_orig <- flat_model
    try(
      flat_model <- lav_pt_ov_from_data(flat_model,
        data = data,
        sample_cov = sample_cov,
        slot_data = slot_data
      ),
      silent = TRUE
    )
    if (inherits(flat_model, "try-error")) {
      lav_msg_warn(gettext("ov_order = \"data\" setting failed;
                           switching back to ov_order = \"model\""))
      flat_model <- flat_model_orig
    }
  } else if (ov_order != "model") {
    lav_msg_stop(gettext(
      "ov_order= argument should be \"model\" (default) or \"data\""))
  }

  flat_model
}

lav_step01_ovnames_group <- function(flat_model = NULL,
                                            ngroups    = 1L) {
  # if "group :" appears in flat_model
  #   tmp.group.values: set of names in corresponding right hand sides
  #   copy flat_model without attributes and call lav_model_pt,
  #     store result in tmp.lav
  #   extract ov.names, ov.names.y, ov.names.x, lv.names from tmp.lav
  #     via lav_partable_vnames
  # else
  #   if flat_model$group not NULL and more than 1 group.value
  #     extract group.values via lav_partable_group_values
  #     extract, for each group.value,
  #       ov.names, ov.names.y, ov.names.x, lv.names from flat_model
  #       via lav_partable_vnames
  #   else
  #     extract ov.names, ov.names.y, ov.names.x, lv.names from flat_model
  #     via lav_partable_vnames
  #
  #     TODO: call lav_pt_vnames only ones and not for each type

  flat_model_2 <- NULL
  tmp_lav <- NULL
  group_values <- NULL
  ov_names  <- character(0L)
  if (any(flat_model$op == ":" & tolower(flat_model$lhs) == "group")) {
    # here, we only need to figure out:
    # - ngroups
    # - ov's per group
    #
    # - FIXME: we need a more efficient way, avoiding
    #          lav_model_pt/lav_partable_vnames
    #
    group_idx <- which(flat_model$op == ":" &
                       tolower(flat_model$lhs) == "group")
    # replace by 'group' (in case we got 'Group'):
    flat_model$lhs[group_idx] <- "group"
    tmp_group_values <- unique(flat_model$rhs[group_idx])
    tmp_ngroups <- length(tmp_group_values)

    flat_model_2 <- flat_model
    attr(flat_model_2, "modifiers") <- NULL
    attr(flat_model_2, "constraints") <- NULL
    tmp_lav <-
      lav_model_pt(flat_model_2, ngroups = tmp_ngroups, warn = FALSE)
    ov_names <- ov_names_y <- ov_names_x <- lv_names <- vector("list",
      length = tmp_ngroups
    )
    attr(tmp_lav, "vnames") <- lav_pt_vnames(tmp_lav, type = "*")
    for (g in seq_len(tmp_ngroups)) {
      ov_names[[g]] <- unique(unlist(lav_pt_vnames(tmp_lav,
        type = "ov", group = tmp_group_values[g]
      )))
      ov_names_y[[g]] <- unique(unlist(lav_pt_vnames(tmp_lav,
        type = "ov.nox", group = tmp_group_values[g]
      )))
      ov_names_x[[g]] <- unique(unlist(lav_pt_vnames(tmp_lav,
        type = "ov.x", group = tmp_group_values[g]
      )))
      lv_names[[g]] <- unique(unlist(lav_pt_vnames(tmp_lav,
        type = "lv", group = tmp_group_values[g]
      )))
    }
  } else if (!is.null(flat_model$group)) {
    # user-provided full partable with group column!
    attr(flat_model, "vnames") <- lav_pt_vnames(flat_model, type = "*")
    ngroups <- lav_pt_ngroups(flat_model)
    if (ngroups > 1L) {
      group_values <- lav_pt_group_values(flat_model)
      ov_names <- ov_names_y <- ov_names_x <- lv_names <- vector("list",
        length = ngroups
      )
      for (g in seq_len(ngroups)) {
        # collapsed over levels (if any)
        ov_names[[g]] <- unique(unlist(lav_pt_vnames(flat_model,
          type = "ov", group = group_values[g]
        )))
        ov_names_y[[g]] <- unique(unlist(lav_pt_vnames(flat_model,
          type = "ov.nox", group = group_values[g]
        )))
        ov_names_x[[g]] <- unique(unlist(lav_pt_vnames(flat_model,
          type = "ov.x", group = group_values[g]
        )))
        lv_names[[g]] <- unique(unlist(lav_pt_vnames(flat_model,
          type = "lv", group = group_values[g]
        )))
      }
    } else {
      ov_names   <- lav_pt_vnames(flat_model, type = "ov")
      ov_names_y <- lav_pt_vnames(flat_model, type = "ov.nox")
      ov_names_x <- lav_pt_vnames(flat_model, type = "ov.x")
      lv_names   <- lav_pt_vnames(flat_model, type = "lv")
    }
  } else {
    # collapse over levels (if any)
    attr(flat_model, "vnames") <- lav_pt_vnames(flat_model, type = "*")
    ov_names   <- unique(unlist(lav_pt_vnames(flat_model, type = "ov")))
    ov_names_y <- unique(unlist(lav_pt_vnames(flat_model,
      type = "ov.nox")))
    ov_names_x <- unique(unlist(lav_pt_vnames(flat_model, type = "ov.x")))
    lv_names   <- unique(unlist(lav_pt_vnames(flat_model, type = "lv")))
  }

  # sanity check (new in 0.6-8): do we have any ov.names?
  # detect early
  if (length(unlist(ov_names)) == 0L) {
    lav_msg_stop(
      gettext("ov.names is empty: model does not refer to any observed
              variables; check your syntax."))
  }

  list(
    flat_model   = flat_model,
    ov_names     = ov_names,
    ov_names_x   = ov_names_x,
    ov_names_y   = ov_names_y,
    lv_names     = lv_names,
    group_values = group_values,
    ngroups      = ngroups
  )
}

lav_step01_ovnames_checklv <- function(
    lv_names    = character(0L),
    ov_names    = character(0L),
    data        = NULL,
    sample_cov  = NULL,
    dotdotdot   = NULL,
    slot_options = NULL) {

  # latent variable names should not appear in the subset of the data
  #   that is formed by merging ov+lv names --> **warning**
  # latent interactions are not supported ---> *** error ***

  if (is.null(data) && is.null(sample_cov)) {
    return(invisible(NULL))
  }

  # handle for lv.names that are also observed variables (new in 0.6-6)
  lv_lv_names <- unique(unlist(lv_names))
  ov_ov_names <- unique(unlist(ov_names))
  if (length(lv_lv_names) > 0L) {

    # get data-based variable names
    data_names <- character(0L)
    if (!is.null(data)) {
      data_names <- names(data)
    } else if (!is.null(sample_cov)) {
      data_names <- rownames(sample_cov)
    }

    # create subset of variable names, based on the model
    model_names <- unique(c(ov_ov_names, lv_lv_names))
    subset_names <- data_names[data_names %in% model_names]
    bad_idx <- which(lv_lv_names %in% subset_names)

    if (length(bad_idx) > 0L) {
      if (!is.null(dotdotdot$check.lv.names) &&
        !dotdotdot$check.lv.names) {
        # ignore it, user switched this check off -- new in 0.6-7
      } else {
        lav_msg_warn(gettextf(
          "Some latent variable names collide with observed variable names in
           the dataset: %s. Please provide alternative names for the latent
           variables, or switch off this check using check.lv.names = FALSE",
           paste(lv_lv_names[bad_idx], collapse = " "))
        )
      }
    }
  }

  # sanity check: we do not support latent interaction yet (using the :)
  lv_int_idx <- grep(":", lv_lv_names, fixed = TRUE)
  if (length(lv_int_idx) > 0L) {
    if (!is.null(dotdotdot$check.lv.interaction) &&
      !dotdotdot$check.lv.interaction) {
      # ignore, user (or sam) switched this check off - new in 0.6-16
    } else if (!is.null(slot_options) && !slot_options$check.lv.interaction) {
      # ignore
    } else {
      lav_msg_stop(gettextf(
        "Interaction terms involving latent variables (%s) are not supported.
         Either use the sam() function, or consider using the modsem package.",
         lv_lv_names[lv_int_idx[1]]))
    }
  }

  invisible(NULL)
}

lav_step01_ovnames_namesl <- function(data = NULL,
                                      cluster      = NULL,
                                      flat_model   = NULL,
                                      group_values = NULL,
                                      ngroups      = 1L) {
  # if "level :" appears in flat_model
  #   if data not NULL, cluster must not be NULL, if it is: *** error ***
  #   compute tmp.group.values and tmp.level.values from flat_model
  #   there should be at least 2 levels, if not *** error ***
  #   copy flat_model without attributes and lav_model_pt -> tmp.lav
  #   check at least 2 levels for tmp.lav, if not *** error ***
  #   compute ov.names.l per group and per level (via lav_partable_vnames
  #     on tmp.lav)
  # else
  #   if lav_pt_nlevels(flat_model) > 0
  #   if data not NULL, cluster must not be NULL, if it is: *** error ***
  #     compute ov.names.l per group and per level (via lav_partable_vnames
  #     on flat_model)
  #   else
  #     there are no levels (ov.names.l = list())

  # handle ov.names.l
  if (any(flat_model$op == ":" & tolower(flat_model$lhs) == "level")) {
    # check for cluster argument
    if (!is.null(data) && is.null(cluster)) {
      lav_msg_stop(gettext("cluster argument is missing."))
    }

    # here, we only need to figure out:
    # - nlevels
    # - ov's per level
    # - FIXME: we need a more efficient way, avoiding lav_model_pt/vnames

    group_idx <- which(flat_model$op == ":" & flat_model$lhs == "group")
    tmp_group_values <- unique(flat_model$rhs[group_idx])
    tmp_ngroups <- max(c(length(tmp_group_values), 1))

    level_idx <- which(flat_model$op == ":" &
                       tolower(flat_model$lhs) == "level")
    # replace by "level" (in case we got 'Level')
    flat_model$lhs[level_idx] <- "level"
    tmp_level_values <- unique(flat_model$rhs[level_idx])
    tmp_nlevels <- length(tmp_level_values)

    # we need at least 2 levels (for now)
    if (tmp_nlevels < 2L) {
      lav_msg_stop(
        gettext("when data is clustered, you must specify a model
                for each level in the model syntax (for now);
                see example(Demo.twolevel)")
      )
    }

    flat_model_2 <- flat_model
    attr(flat_model_2, "modifiers") <- NULL
    attr(flat_model_2, "constraints") <- NULL
    tmp_lav <-
      lav_model_pt(flat_model_2, ngroups = tmp_ngroups, warn = FALSE)
    # check for empty levels
    if (max(tmp_lav$level) < 2L) {
      lav_msg_stop(
        gettext("at least one level has no model syntax;
                you must specify a model for each level in the model syntax;
                see example(Demo.twolevel)")
      )
    }
    ov_names_l <- vector("list", length = tmp_ngroups) # per group

    for (g in seq_len(tmp_ngroups)) {
      ov_names_l[[g]] <- vector("list", length = tmp_nlevels)
      for (l in seq_len(tmp_nlevels)) {
        if (tmp_ngroups > 1L) {
          ov_names_l[[g]][[l]] <-
            unique(unlist(lav_pt_vnames(tmp_lav,
              type = "ov",
              group = tmp_group_values[g],
              level = tmp_level_values[l]
            )))
        } else {
          ov_names_l[[g]][[l]] <-
            unique(unlist(lav_pt_vnames(tmp_lav,
              type = "ov",
              level = tmp_level_values[l]
            )))
        }
      } # levels
    } # groups
  } else {
    # perhaps model is already a parameter table
    nlevels <- lav_pt_nlevels(flat_model)
    if (nlevels > 1L) {
      # check for cluster argument (only if we have data)
      if (!is.null(data) && is.null(cluster)) {
        lav_msg_stop(gettext("cluster argument is missing."))
      }

      ngroups <- lav_pt_ngroups(flat_model)
      group_values <- lav_pt_group_values(flat_model)
      ov_names_l <- vector("list", length = ngroups)
      for (g in 1:ngroups) {
        # note: lav_object_vnames() will return a list if any level:
        ov_names_l[[g]] <-
          lav_object_vnames(flat_model, "ov", group = group_values[g])
      }
    } else {
      # no level: in model syntax
      ov_names_l <- list()
    }
  }

  list(
    flat_model = flat_model,
    ov_names_l = ov_names_l
  )
}

lav_step01_ovnames_ordered <- function(ordered    = NULL,
                                              flat_model = NULL,
                                              data       = NULL) {
  # interpretation and check ordered parameter, modify if needed

  # sanity check ordered argument (just in case, add lhs variables names)
  if (!is.null(ordered)) { # new in 0.6-4
    if (is.logical(ordered) && ordered) { # ordered = TRUE
      # assume the user means: ordered = names(Data)
      ordered <- lav_object_vnames(flat_model, "ov.nox")
                                          # new in 0.6-6: changed from ov
    } else if (is.logical(ordered) && !ordered) {
      ordered <- character(0L)
    } else if (!is.character(ordered)) {
      lav_msg_stop(gettext("ordered argument must be a character vector"))
    } else if (length(ordered) == 1L && nchar(ordered) == 0L) {
      ordered <- character(0L)
    } else {
      # check if all names in "ordered" occur in the dataset?
      if (!is.null(data)) {
        if (inherits(data, "data.frame")) {
          data_names <- names(data)
        } else if (inherits(data, "matrix")) {
          data_names <- colnames(data)
        }
        missing_idx <- which(!ordered %in% data_names)
        if (length(missing_idx) > 0L) { # FIXME: warn = FALSE has no eff
          lav_msg_warn(gettextf(
            "ordered variable(s): %s could not be found
            in the data and will be ignored",
             paste(ordered[missing_idx], collapse = " ")))
        }
      }
    }
  }

  # add the variable names that were treated as ordinal
  # in the model syntax
  ordered <- unique(c(ordered, lav_object_vnames(flat_model, "ov.ord")))

  ordered
}
