# YR 19 September 2022
#
# Entry function to handle noniterative estimators


lav_optim_noniter <- function(lavmodel = NULL, lavsamplestats = NULL,
                              lavpartable = NULL, lavh1 = NULL,
                              lavdata = NULL, lavoptions = NULL) {
  lavpta <- lav_pt_attributes(lavpartable)
  lavpartable <- lav_pt_set_cache(lavpartable, lavpta)

  # no support for many things:
  # (the IV estimator supports multiple groups, including cross-group equality
  # constraints for measurement invariance)
  if (lavmodel@ngroups > 1L && !identical(lavoptions$estimator, "IV")) {
    lav_msg_stop(gettext(
      "multiple groups not supported (yet) with optim.method = 'NONITER'."))
  }

  if (lavdata@nlevels > 1L) {
    lav_msg_stop(gettext(
      "multilevel not supported (yet) with optim.method = 'NONITER'."))
  }

  # no support (yet) for nonlinear constraints
  nonlinear_idx <- c(
    lavmodel@ceq.nonlinear.idx,
    lavmodel@cin.nonlinear.idx
  )
  if (length(nonlinear_idx) > 0L) {
    lav_msg_stop(gettext(
      "nonlinear constraints not supported (yet) with optim.method = 'NONITER'."
      ))
  }

  # no support (yet) for inequality constraints
  if (!lavmodel@cin.simple.only && !is.null(body(lavmodel@cin.function))) {
    lav_msg_stop(gettext(
    "inequality constraints not supported (yet) with optim.method = 'NONITER'."
    ))
  }

  # linear equality constraints are supported by the IV estimator (handled by
  # a constrained system solve); other noniterative estimators do not (yet)
  # support them
  if (length(lavmodel@ceq.linear.idx) > 0L &&
      !identical(lavoptions$estimator, "IV")) {
    lav_msg_stop(gettext(
      "equality constraints not supported (yet) with optim.method = 'NONITER'."
      ))
  }

  # extract current set of free parameters
  x_old <- lav_model_get_parameters(lavmodel)
  # npar <- length(x_old)


  # fabin?
  ok_flag <- FALSE
  if (lavoptions$estimator %in% c("FABIN2", "FABIN3")) {
    x <- try(lav_cfa_fabin_internal(
      lavmodel = lavmodel,
      lavsamplestats = lavsamplestats, lavpartable = lavpartable,
      lavoptions = lavoptions
    ), silent = TRUE)
  } else if (lavoptions$estimator == "MGM") {
    x <- try(lav_cfa_guttman1952_internal(
      lavmodel = lavmodel,
      lavsamplestats = lavsamplestats, lavpartable = lavpartable,
      lavoptions = lavoptions
    ), silent = TRUE)
  } else if (lavoptions$estimator == "BENTLER1982") {
    x <- try(lav_cfa_bentler1982_internal(
      lavmodel = lavmodel,
      lavsamplestats = lavsamplestats, lavpartable = lavpartable,
      lavoptions = lavoptions
    ), silent = TRUE)
  } else if (lavoptions$estimator %in% c("JS", "JSA")) {
    x <- try(lav_cfa_jamesstein_internal(
      lavmodel = lavmodel,
      lavsamplestats = lavsamplestats, lavpartable = lavpartable,
      lavdata = lavdata,
      lavoptions = lavoptions
    ), silent = TRUE)
  } else if (lavoptions$estimator == "BENTLER1982") {
    x <- try(lav_cfa_bentler1982_internal(
      lavmodel = lavmodel,
      lavsamplestats = lavsamplestats, lavpartable = lavpartable,
      lavoptions = lavoptions
    ), silent = TRUE)
  } else if (lavoptions$estimator == "IV") {
    x <- try(lav_sem_miiv_internal(
      lavmodel = lavmodel, lavdata = lavdata, lavh1 = lavh1,
      lavsamplestats = lavsamplestats, lavpartable = lavpartable,
      lavoptions = lavoptions
    ), silent = TRUE)
  } else {
    lav_msg_warn(
      gettextf("unknown (noniterative) estimator: %s
               (returning starting values)", lavoptions$estimator)
    )
  }
  if (inherits(x, "try-error")) {
    x <- x_old
  } else {
    ok_flag <- TRUE
  }

  # closing
  fx <- 0
  attr(fx, "fx.group") <- rep(0, lavmodel@ngroups)
  if (ok_flag) {
    attr(x, "converged") <- TRUE
    attr(x, "warn.txt") <- ""
  } else {
    attr(x, "converged") <- FALSE
    attr(x, "warn.txt") <- "noniterative estimation failed"
  }
  attr(x, "iterations") <- 1L
  attr(x, "control") <- list()
  attr(x, "fx") <- fx

  x
}
