# compare two nested models, by default using the chi-square
# difference test

# - in 0.5-16, SB.classic = TRUE is the default again (for now)
# - in 0.5-18, SB.classic is replaced by 'method', with the following
#   options:
#     method = "default" (we choose a default method, based on the estimator)
#     method = "standard" (option to explicitly avoid robust adjustment)
#     method = "Satorra.2000"
#     method = "Satorra.Bentler.2001"
#     method = "Satorra.Bentler.2010"
#     method = "mean.var.adjusted.PLRT"
#
# - 0.6-13: RMSEA.D (also known as 'RDR') is added to the table (also if scaled,
#           since 0.6-20)
# - 0.6-13: fix multiple-group UG^2 bug in Satorra.2000 (reported by
#           Gronneberg, Foldnes and Moss)
#
# - 0.6-18:
#     New option method = "standard" (to explicitly avoid robust adjustment)
#     New test= argument to select scaled stat when
#                           method="satorra.bentler.2001/2010"


lavTestLRT <- function(object, ..., method = "default", test = "default",   # nolint
                       a_method = "delta", scaled_shifted = TRUE, # only when method="Satorra.2000"
                       type = "Chisq", model_names = NULL) {
  dotdotdot <- list(...)
  lav_adapt_func(environment(), dotdotdot, FALSE)
  type <- tolower(type[1])
  test <- tolower(test[1])
  method_orig <- method[1]
  method <- tolower(gsub("[-_\\.]", "", method[1]))
  if (type %in% c("browne", "browne.residual.adf", "browne.residual.nt")) {
    if (type == "browne") {
      type <- "browne.residual.adf"
    }
    if (!method %in% c("default", "standard")) {
      lav_msg_stop(gettext(
        "method cannot be used if type is browne.residual.adf or
        browne.residual.nt"))
    }
    method <- "default"
  }

  # NOTE: if we add additional arguments, it is not the same generic
  # anova() function anymore, and match.call will be screwed up

  mcall <- match.call(expand.dots = TRUE)
  modp <- if (length(dotdotdot)) {
    sapply(dotdotdot, inherits, "lavaan")
  } else {
    logical(0L)
  }
  # check object
  object <- lav_object_check_version(object)
  # check models in dotdotdot
  dotdotdot[modp] <- lapply(dotdotdot[modp], lav_object_check_version)

  # sam objects (issue #517): when comparing multiple models that were all
  # fitted with sam() and a local sam.method, delegate to the stored step-2
  # structural fits: the LRT then compares the structural parts, assuming
  # identical (fixed) step-1 measurement models. (A single local sam object
  # needs no special treatment: its @test slot already holds the structural
  # test statistics.)
  if (any(modp)) {
    all_mods <- c(list(object), dotdotdot[modp])
    local_flags <- vapply(all_mods, lav_sam_local_flag, logical(1L))
    if (all(local_flags)) {
      struc_list <- lapply(all_mods, lav_sam_struc_object)
      if (any(vapply(struc_list, is.null, logical(1L)))) {
        lav_msg_stop(gettext(
          "no stored structural fit found for at least one model: sam
           object(s) created by an older version of lavaan; please rerun
           sam()."))
      }
      # the comparison only makes sense if the measurement part is the same
      mm_1 <- all_mods[[1]]@internal$sam.mm.table
      same_mm <- vapply(all_mods[-1], function(x) {
        isTRUE(all.equal(x@internal$sam.mm.table, mm_1))
      }, logical(1L))
      if (!all(same_mm)) {
        lav_msg_warn(gettext(
          "the models do not share the same measurement blocks; the
           chi-square difference test of the structural parts may not be
           meaningful"))
      }
      lav_msg_note(gettext(
        "the chi-square difference test compares the structural parts only,
         conditional on identical (fixed) step-1 measurement models."))
      object <- struc_list[[1]]
      dotdotdot[modp] <- struc_list[-1]
    } else if (any(local_flags)) {
      lav_msg_stop(gettext(
        "lavTestLRT() cannot compare a model fitted with sam() (using a
         local sam.method) with other models."))
    }
  }

  # some general properties (taken from the first model)
  estimator <- object@Options$estimator
  ngroups <- object@Data@ngroups
  ntotal <- object@SampleStats@ntotal

  # TDJ: check for user-supplied h1 model
  user_h1_exists <- FALSE
  if (!is.null(object@external$h1.model)) {
    if (inherits(object@external$h1.model, "lavaan")) {
      user_h1_exists <- TRUE
    }
  }

  # shortcut for single argument (just plain LRT)
  if (!any(modp) && !user_h1_exists) {
    if (lav_test_fmg_is_preset(test)) {
      test <- lav_test_fmg_resolve_preset(
        test, nested = FALSE, ngroups = ngroups
      )
    }
    if (type == "cf") {
      lav_msg_warn(gettext("`type' argument is ignored for a single model"))
    }
    return(lav_test_lrt_single_model(object, method = method,
       test = test, type = type))
  }

  # list of models
  mods <- c(list(object), dotdotdot[modp])
  if (!is.null(model_names)) {
    names(mods) <- model_names
  } else {
    names(mods) <- sapply(
      as.list(mcall)[which(c(FALSE, TRUE, modp))],
      function(x) deparse(x)
    )
  }
  # TDJ: Add user-supplied h1 model, if it exists
  if (user_h1_exists) mods$user_h1 <- object@external$h1.model

  # ensure model names are unique (they are used as row.names later)
  names(mods) <- make.unique(names(mods))

  # put them in order (using degrees of freedom)
  ndf <- sapply(mods, function(x) x@test[[1]]$df)
  order_idx <- order(ndf)
  mods <- mods[order_idx]
  ndf <- ndf[order_idx]

  if (lav_test_fmg_is_preset(test)) {
    test <- lav_test_fmg_resolve_preset(
      test, nested = TRUE, ngroups = ngroups
    )
  }

  # here come the checks -- eventually, an option may skip this
  if (TRUE) {
    # 1. same set of observed variables?
    ov_names <- lapply(mods, function(x) {
      sort(lav_object_vnames(x))
    })
    ov <- ov_names[[1L]] # the observed variable names of the first model
    if (!all(sapply(ov_names, function(x) identical(x, ov)))) {
      lav_msg_warn(gettext(
        "some models are based on a different set of observed variables"))
    }
    ## wow FIXME: we may need to reorder the rows/columns first!!
    # COVS <- lapply(mods, function(x) slot(slot(x, "Sample"), "cov")[[1]])
    # if(!all(sapply(COVS, all.equal, COVS[[1]]))) {
    #    stop("lavaan ERROR: models must be fit to the same data")
    # }
    # 2. nested models? *different* npars?

    # TODO!

    # 3. all meanstructure?
    mean_structure <- sapply(mods, lavInspect, "meanstructure")
    if (sum(mean_structure) > 0L &&
      sum(mean_structure) < length(mean_structure)) {
      lav_msg_warn(gettext("not all models have a meanstructure"))
    }

    # 4. all converged?
    if (!all(sapply(mods, lavInspect, "converged"))) {
      lav_msg_warn(gettext("not all models converged"))
    }
  }

  if (type == "chisq" && lav_test_fmg_is_fmg(test)) {
    return(lav_test_lrt_fmg(
      mods = mods,
      test = test,
      method = method,
      method_orig = method_orig,
      estimator = estimator,
      ntotal = ntotal,
      ngroups = ngroups,
      missing = object@Options$missing
    ))
  }

  mods_scaled <- unlist(lapply(mods, function(x) {
    any(c(
      "satorra.bentler", "yuan.bentler", "yuan.bentler.mplus",
      "mean.var.adjusted", "scaled.shifted",
      "mean.var.adjusted.corrected", "scaled.shifted.corrected"
    ) %in%
      unlist(sapply(slot(x, "test"), "[[", "test")))
  }))

  if (all(mods_scaled | ndf == 0) && any(mods_scaled)) {
    # Note: if df=0, test is not really robust, hence the above condition
    scaled <- TRUE
    # which test to choose by default?
    # i.e., not determined by method=
    scaled_list <- sapply(mods[[which(ndf > 0)[1]]]@test,
                         # first mod with df>0
                         #FIXME: ? If no mods have df > 0,
                         #         this still yields error
                         function(x) !is.null(x$scaled.test.stat))
    if (!any(scaled_list)) {
      # no test entry carries a scaled.test.stat field (eg PML objects
      # created before 0.7-1): fall back to matching the scaled-test names
      scaled_list <- sapply(mods[[which(ndf > 0)[1]]]@test,
        function(x) {
          x$test[1] %in% c(
            "satorra.bentler", "yuan.bentler", "yuan.bentler.mplus",
            "mean.var.adjusted", "scaled.shifted",
            "mean.var.adjusted.corrected", "scaled.shifted.corrected"
          )
        })
    }
    scaled_idx <- which(scaled_list)[[1]]
    default_test <- object@test[[scaled_idx]]$test
    if (test == "default") {
      test_1 <- default_test
    } else if (!test %in% c("satorra.bentler", "yuan.bentler",
     "yuan.bentler.mplus", "mean.var.adjusted", "scaled.shifted",
     "mean.var.adjusted.corrected", "scaled.shifted.corrected")) {
      lav_msg_stop(gettextf(
        "test = %s not found in object. See available tests in
        lavInspect(object, \"options\")$test.", dQuote(test)))
    } else {
      test_1 <- test
    }

    ## is the test available from all models?
    check_scaled <- unlist(lapply(mods, function(x) {
      test_1 %in% unlist(sapply(slot(x, "test"), "[[", "test"))
    }))

    if (any(!check_scaled)) {
      lav_msg_stop(gettextf(
        "test = %1$s not found in model(s): %2$s. Find available tests per model
        using lavInspect(fit, \"options\")$test.", dQuote(test),
        lav_msg_view(names(mods)[which(!check_scaled)], "none")))
    }

  } else if (!any(mods_scaled)) { # thanks to R.M. Bee to fix this
    scaled <- FALSE
    # if the user explicitly requested a robust difference test, but none of
    # the models were fitted with a robust (scaled) test statistic, the
    # method= argument cannot be honored: warn that it is ignored and a
    # standard (regular) chi-squared difference test is computed instead
    # (see GitHub issue #383)
    if (method %in% c("satorra2000", "satorrabentler2001",
                      "satorrabentler2010", "meanvaradjustedplrt")) {
      lav_msg_warn(gettextf(
        "method = %s requires robust test statistics, but none of the models
        were fitted with a robust test; the method= argument is ignored, and a
        standard (regular) chi-squared difference test is computed instead.",
        dQuote(method_orig)))
    }
    test_1 <- "standard"
    method <- "standard"
  } else {
    lav_msg_stop(gettext(
      "some models (but not all) have scaled test statistics"))
  }

  if (type %in% c("browne.residual.adf", "browne.residual.nt")) {
    scaled <- FALSE
    method <- "standard"
  }

  if (method == "standard") {
    scaled <- FALSE
  }

  # select method
  if (method == "default") {
    if (estimator == "PML") {
      method <- "mean.var.adjusted.PLRT"
    } else if (scaled) {
      if (test_1 %in% c(
        "satorra.bentler", "yuan.bentler",
        "yuan.bentler.mplus"
      )) {
        method <- "satorra.bentler.2001"
      } else {
        method <- "satorra.2000"
        if (test_1 %in% c(
          "mean.var.adjusted.corrected", "scaled.shifted.corrected"
        )) {
          # the corrected (Hayakawa 2018) trace estimator is not (yet)
          # available for difference tests
          lav_msg_warn(gettext(
            "the difference test uses the standard (uncorrected) trace
            estimates, not the corrected (Hayakawa 2018) versions."))
        }
      }
    } else {
      # nothing to do
    }
  } else if (method == "meanvaradjustedplrt" ||
    method == "mean.var.adjusted.PLRT") {
    method <- "mean.var.adjusted.PLRT"
    stopifnot(estimator == "PML")
  } else if (method == "satorra2000") {
    method <- "satorra.2000"
  } else if (method == "satorrabentler2001") {
    method <- "satorra.bentler.2001"
  } else if (method == "satorrabentler2010") {
    method <- "satorra.bentler.2010"

    ## only option left:
  } else if (method != "standard") {
    lav_msg_stop(
      gettextf("Unknown method for scaled difference test: %s.", method))
  }

  ## in case users specify method= or test= (but still type="chisq"),
  ## make sure the arguments are consistent for scaled tests
  if (method %in% c("satorra.bentler.2001", "satorra.bentler.2010") && scaled &&
    (!test_1 %in% c("satorra.bentler", "yuan.bentler", "yuan.bentler.mplus"))) {
    lav_msg_stop(gettextf(
      "method = %s only available when models are fitted with test =
      \"satorra.bentler\", \"yuan.bentler\", or \"yuan.bentler.mplus\".",
      dQuote(method)))
  } else {
    ## method="satorra.2000" still available when test_1 != scaled_shifted
    ## Or !scaled, so nothing to do.
  }

  # NOTE: when scaled = FALSE, method has already been reset to "standard"
  # above (either because none of the models used a robust test statistic --
  # in which case a warning was issued -- or because the user explicitly
  # requested method = "standard" or a Browne residual type). So there is no
  # need to check for a robust method here anymore.

  # which models have used a MEANSTRUCTURE?
  mods_meanstructure <- sapply(mods, function(x) {
    unlist(slot(
      slot(x, "Model"),
      "meanstructure"
    ))
  })
  if (!all(mods_meanstructure) && sum(mods_meanstructure) != 0) {
    lav_msg_stop(gettext("some models (but not all) have a meanstructure"))
  }

  # collect statistics for each model
  if (type == "chisq") {
    df_1 <- sapply(mods, function(x) slot(x, "test")[[1]]$df)
    stat_1 <- sapply(mods, function(x) slot(x, "test")[[1]]$stat)
  } else if (type == "browne.residual.nt") {
    testlist <- lapply(
      mods,
      function(x) lavTest(x, test = "browne.residual.nt",
                          drop_list_single = FALSE)
    )
    df_1 <- sapply(testlist, function(x) x[[type]]$df)
    stat_1 <- sapply(testlist, function(x) x[[type]]$stat)
  } else if (type == "browne.residual.adf") {
    testlist <- lapply(
      mods,
      function(x) lavTest(x, test = "browne.residual.adf",
                          drop_list_single = FALSE)
    )
    df_1 <- sapply(testlist, function(x) x[[type]]$df)
    stat_1 <- sapply(testlist, function(x) x[[type]]$stat)
  } else if (type == "cf") {
    tmp <- lapply(mods, lavTablesFitCf)
    stat_1 <- unlist(tmp)
    df_1 <- unlist(lapply(tmp, attr, "DF"))
  } else {
    lav_msg_stop(gettextf("test type unknown: %s", type))
  }

  # difference statistics
  stat_delta <- stat_delta_orig <- c(NA, diff(stat_1))
  df_delta <- df_delta_orig <- c(NA, diff(df_1))

  # check for negative values in stat_delta
  # but with a tolerance (0.6-12)!
  if (any(stat_delta[-1] < -1 * .Machine$double.eps^(1 / 3))) {
    lav_msg_warn(gettextf(
      "Some restricted models fit better than less restricted models; either
      these models are not nested, or the less restricted model failed to reach
      a global optimum. Smallest difference = %s.", min(stat_delta[-1])))
  }

  # prepare for scaling versions
  if (method == "satorra.2000" && scaled_shifted) {
    a_delta <- b_delta <- rep(as.numeric(NA), length(stat_1))
    c_delta <- NULL
  } else if (method %in% c("satorra.bentler.2001",
           "satorra.bentler.2010", "satorra.2000")) {
    c_delta <- rep(as.numeric(NA), length(stat_1))
  } else {
    # eg method = "mean.var.adjusted.PLRT" or "standard": no scaling
    # attributes (c_delta is consulted below, so it must exist)
    c_delta <- NULL
  }

  # correction for scaled test statistics
  if (type == "chisq" && scaled) {
    if (method == "satorra.bentler.2001") {
      # use formula from Satorra & Bentler 2001
      for (m in seq_len(length(mods) - 1L)) {
        out <- lav_test_diff_sb2001(mods[[m]], mods[[m + 1]],
                                                # in case not @test[[2]]:
                                                test = test_1)
        stat_delta[m + 1] <- out$T.delta
        df_delta[m + 1] <- out$df.delta
        c_delta[m + 1] <- out$scaling.factor
      }
    } else if (method == "mean.var.adjusted.PLRT") {
      for (m in seq_len(length(mods) - 1L)) {
        out <- lav_pml_test_plrt(mods[[m]], mods[[m + 1]])
        stat_delta[m + 1] <- out$FSMA.PLRT
        df_delta[m + 1] <- out$adj.df
      }
    } else if (method == "satorra.bentler.2010") {
      for (m in seq_len(length(mods) - 1L)) {
        out <- lav_test_diff_sb2010(mods[[m]], mods[[m + 1]],
          test = test_1, # in case not @test[[2]]
          h1 = FALSE
        ) # must be F

        stat_delta[m + 1] <- out$T.delta
        df_delta[m + 1] <- out$df.delta
        c_delta[m + 1] <- out$scaling.factor
      }
    } else if (method == "satorra.2000") {
      for (m in seq_len(length(mods) - 1L)) {
        if (test_1 %in% c(
          "satorra.bentler", "yuan.bentler",
          "yuan.bentler.mplus"
        )) {
          satterthwaite <- FALSE
        } else {
          satterthwaite <- TRUE
         }
        out <- lav_test_diff_satorra2000(mods[[m]], mods[[m + 1]],
          h1 = TRUE,
          satterthwaite = satterthwaite,
          scaled_shifted = scaled_shifted,
          a_method = a_method
        )
        stat_delta[m + 1] <- out$t_delta
        df_delta[m + 1] <- out$df_delta
        if (scaled_shifted) {
          a_delta[m + 1] <- out$a
          b_delta[m + 1] <- out$b
        } else {
          c_delta[m + 1] <- out$scaling.factor
        }
      }
    }
  }

  # check if scaled diff failed somehow
  if (scaled &&
     ((method %in% c("satorra.bentler.2001", "satorra.bentler.2010") &&
          is.na(out$scaling.factor)) ||
         (method == "satorra.2000" && scaled_shifted && is.na(out$a)) ||
         (method == "satorra.2000" && !scaled_shifted &&
          is.na(out$scaling.factor)))
     ) {
    scaled <- FALSE
  }


  # unname
  stat_delta <- unname(stat_delta)
  # zap small values (for near-zero values) (anova class does not use rounding)
  stat_delta <- round(stat_delta, 10)
  df_delta <- unname(df_delta)
  stat_delta_orig <- unname(stat_delta_orig)
  df_delta_orig <- unname(df_delta_orig)
  if (scaled && !is.null(c_delta)) {
    c_delta <- unname(c_delta)
  }

  # Pvalue
  pvalue_delta <- pchisq(stat_delta, df_delta, lower.tail = FALSE)

  # new in 0.6-13: RMSEA (RMSEA.D or RDR)
  if (object@Options$missing == "listwise") {
    if (scaled && !is.null(c_delta)) {
      c_hat <- c_delta[-1]
    } else {
      c_hat <- rep(1, length(stat_delta_orig) - 1L)
    }
    rmsea_delta <- c(NA, lav_fit_rmsea(
      x2 = stat_delta_orig[-1],
      df = df_delta_orig[-1],
      n = ntotal,
      g = ngroups,
      c_hat = c_hat
    ))
  }

  # AIC/BIC
  aic <- bic <- rep(NA, length(mods))
  if (estimator == "ML") {
    aic <- sapply(mods, FUN = AIC)
    bic <- sapply(mods, FUN = BIC)
  } else if (estimator == "PML") {
    out_1 <- lapply(mods, lav_pml_object_aic_bic)
    aic <- sapply(out_1, "[[", "PL_AIC")
    bic <- sapply(out_1, "[[", "PL_BIC")
  }

  if (estimator == "PML") {
    val <- data.frame(
      Df = df_1,
      PL_AIC = aic,
      PL_BIC = bic,
      Chisq = stat_1,
      "Chisq diff" = stat_delta,
      "Df diff" = df_delta,
      "Pr(>Chisq)" = pvalue_delta,
      row.names = names(mods),
      check.names = FALSE
    )
  } else if (object@Options$missing == "listwise") {
    val <- data.frame(
      Df = df_1,
      AIC = aic,
      BIC = bic,
      Chisq = stat_1,
      "Chisq diff" = stat_delta,
      "RMSEA" = rmsea_delta,
      "Df diff" = df_delta,
      "Pr(>Chisq)" = pvalue_delta,
      row.names = names(mods),
      check.names = FALSE
    )
  } else {
    val <- data.frame(
      Df = df_1,
      AIC = aic,
      BIC = bic,
      Chisq = stat_1,
      "Chisq diff" = stat_delta,
      #"RMSEA" = rmsea_delta, # if missing, not yet...
      "Df diff" = df_delta,
      "Pr(>Chisq)" = pvalue_delta,
      row.names = names(mods),
      check.names = FALSE
    )
  }

  # catch df_delta == 0 cases (reported by Florian Zsok in Zurich)
  # but only if there are no inequality constraints! (0.6-1)
  idx <- which(val[, "Df diff"] == 0)
  if (length(idx) > 0L) {
    # remove models with inequality constraints
    ineq_idx <- which(sapply(lapply(mods, function(x) {
      slot(slot(x, "Model"), "x.cin.idx")
    }), length) > 0L)
    rm_idx <- which(idx %in% ineq_idx)
    if (length(rm_idx) > 0L) {
      idx <- idx[-rm_idx]
    }
  }
  if (length(idx) > 0L) {
    val[idx, "Pr(>Chisq)"] <- as.numeric(NA)
    lav_msg_warn(gettext("some models have the same degrees of freedom"))
  }

  if (type == "chisq") {
    if (scaled) {
      txt <- paste("The ", dQuote("Chisq"), " column contains standard ",
        "test statistics, not the robust test that should be ",
        "reported per model. A robust difference test is a ",
        "function of two standard (not robust) statistics.",
        sep = ""
      )
      # describe the difference test that is actually computed, so the title
      # is not misleading (see GitHub issue #523). For method="satorra.2000"
      # the exact statistic depends on both scaled_shifted= and the test that
      # was used to fit the models (test_1); see lav_test_diff_satorra2000().
      if (method == "satorra.2000" && scaled_shifted) {
        stat_label <- "Scaled and Shifted"
      } else if (method == "satorra.2000" &&
        !test_1 %in% c("satorra.bentler", "yuan.bentler",
          "yuan.bentler.mplus")) {
        # satterthwaite-style (mean and variance adjusted) difference test
        stat_label <- "Mean and Variance Adjusted"
      } else if (method == "mean.var.adjusted.PLRT") {
        stat_label <- "Mean and Variance Adjusted"
      } else {
        # satorra.bentler.2001 / satorra.bentler.2010, or satorra.2000 with a
        # satorra.bentler/yuan.bentler test: a (Satorra-Bentler) scaled test
        stat_label <- "Scaled"
      }
      attr(val, "heading") <-
        paste("\n", stat_label, " Chi-Squared Difference Test (method = ",
          dQuote(method), ")\n\n",
          lav_msg(paste("lavaan NOTE:", txt), showheader = TRUE),
          "\n",
          sep = ""
        )
      if (method == "satorra.2000" && scaled_shifted) {
        attr(val, "scale") <- a_delta
        attr(val, "shift") <- b_delta
      } else if (method %in% c("satorra.bentler.2001",
                "satorra.bentler.2010", "satorra.2000")) {
        attr(val, "scale") <- c_delta
      }
    } else {
      attr(val, "heading") <- "\nChi-Squared Difference Test\n"
    }
  } else if (type == "browne.residual.adf") {
    attr(val, "heading") <-
      "\nChi-Squared Difference Test based on Browne's residual (ADF) Test\n"
  } else if (type == "browne.residual.nt") {
    attr(val, "heading") <-
      "\nChi-Squared Difference Test based on Browne's residual (NT) Test\n"
  } else if (type == "cf") {
    colnames(val)[c(3, 4)] <- c("Cf", "Cf diff")
    attr(val, "heading") <- "\nCf Difference Test\n"
  }
  class(val) <- c("anova", class(val))

  val
}


# anova table for a single model
lav_test_lrt_single_model <- function(object, method = "default",
                                      test = "default", type = "Chisq") {
  estimator <- object@Options$estimator

  aic <- bic <- c(NA, NA)
  if (estimator == "ML") {
    aic <- c(NA, AIC(object))
    bic <- c(NA, BIC(object))
  }

  ## determine which @test element
  tn <- names(object@test)
  if (is.null(tn)) {
    tn <- "standard" # for lavaan <0.6 objects
  }
  if (length(tn) == 1L) {
    test_1 <- 1L # only choice

    ## More than 1.  Cycle through possible user specifications:
  } else if (method[1] == "standard") {
    test_1 <- 1L
  } else if (grepl("browne", type, fixed = TRUE) && type %in% tn) {
    test_1 <- type
  } else if (test %in% tn) {
    test_1 <- test
  } else {
    ## Nothing explicitly (or validly) requested.
    ## But there is > 1 test, so take the second element (old default)
    test_1 <- 2L
  }

  ## anova table
  val <- data.frame(
    Df = c(0, object@test[[test_1]]$df),
    AIC = aic,
    BIC = bic,
    Chisq = c(0, object@test[[test_1]]$stat),
    "Chisq diff" = c(NA, object@test[[test_1]]$stat),
    "Df diff" = c(NA, object@test[[test_1]]$df),
    "Pr(>Chisq)" = c(NA, object@test[[test_1]]$pvalue),
    row.names = c("Saturated", "Model"),
    check.names = FALSE
  )
  ## scale/shift attributes
  if (!is.null(object@test[[test_1]]$scaling.factor)) {
    attr(val, "scale") <- c(NA, object@test[[test_1]]$scaling.factor)
  }
  if (!is.null(object@test[[test_1]]$shift.parameter)) {
    attr(val, "shift") <- c(NA, object@test[[test_1]]$shift.parameter)
  }

  ## heading
  if (grepl(pattern = "browne", x = test_1, fixed = TRUE)) {
    attr(val, "heading") <- object@test[[test_1]]$label

  } else if (test_1 == 1L) {
    attr(val, "heading") <- "Chi-Squared Test Statistic (unscaled)\n"

  } else {
    label <- object@test[[test_1]]$label
    attr(val, "heading") <- paste0("Chi-Squared Test Statistic (scaled",
                                   ifelse(test_1 == "scaled.shifted",
                                          yes = " and shifted)", no = ")"),
                                   ifelse(is.null(label),
                                          yes = "\n", no = paste("\n ", label)),
                                   "\n")
  }

  class(val) <- c("anova", class(val))

  val
}

lav_test_lrt_fmg <- function(mods, test = "pall_ug_ml", method = "default",
                             method_orig = method,
                             estimator = "ML", ntotal = NULL,
                             ngroups = NULL, missing = "listwise") {
  if (!method %in% c("default", "standard", "satorra2000")) {
    lav_msg_stop(gettextf(
      "FMG nested tests require method= %1$s, %2$s, or %3$s; found %4$s.",
      dQuote("default"), dQuote("standard"), dQuote("satorra.2000"),
      dQuote(method_orig)
    ))
  }
  invisible(lapply(
    mods,
    function(x) {
      lav_test_fmg_check_estimator(x@Options, context = "FMG nested tests")
      lav_test_fmg_check_mi(x@Options, context = "FMG nested tests")
    }
  ))
  estimators <- vapply(mods, function(x) x@Options$estimator.orig,
                       character(1L))
  if (length(unique(estimators)) > 1L) {
    lav_msg_stop(gettextf(
      "FMG nested tests require all models to use the same estimator; found %1$s.",
      lav_msg_view(unique(estimators), "and")
    ))
  }

  parsed <- lav_test_fmg_parse(test)
  chisq <- lav_test_fmg_resolve_chisq(parsed, lavoptions = mods[[1]]@Options)
  unbiased <- lav_test_fmg_resolve_unbiased(
    parsed, lavoptions = mods[[1]]@Options
  )
  label <- lav_test_fmg_label(parsed, unbiased = unbiased, chisq = chisq)
  heading_label <- sub(" p-value test \\(", "; ", label)
  heading_label <- sub("\\)$", "", heading_label)

  if (chisq == "rls") {
    TESTlist <- lapply(
      mods,
      function(x) lav_test_fmg_browne_nt_model(lavobject = x)
    )
    Df <- sapply(TESTlist, function(x) x$df)
    STAT <- sapply(TESTlist, function(x) x$stat)
  } else {
    Df <- sapply(mods, function(x) slot(x, "test")[[1]]$df)
    STAT <- sapply(mods, function(x) slot(x, "test")[[1]]$stat)
  }

  stat_delta <- stat_delta_orig <- c(NA, diff(STAT))
  df_delta <- df_delta_orig <- c(NA, diff(Df))
  pvalue_delta <- rep(as.numeric(NA), length(mods))

  if (length(mods) > 1L) {
    for (m in seq_len(length(mods) - 1L)) {
      out <- lav_test_fmg_nested(
        m0 = mods[[m + 1L]],
        m1 = mods[[m]],
        test = test
      )
      stat_delta[m + 1L] <- out$stat
      df_delta[m + 1L] <- out$df
      pvalue_delta[m + 1L] <- out$pvalue
    }
  }

  stat_delta <- round(unname(stat_delta), 10)
  df_delta <- unname(df_delta)
  stat_delta_orig <- unname(stat_delta_orig)
  df_delta_orig <- unname(df_delta_orig)

  aic <- bic <- rep(NA, length(mods))
  if (estimator == "ML") {
    aic <- sapply(mods, FUN = AIC)
    bic <- sapply(mods, FUN = BIC)
  } else if (estimator == "PML") {
    OUT <- lapply(mods, lav_pml_object_aic_bic)
    aic <- sapply(OUT, "[[", "PL_AIC")
    bic <- sapply(OUT, "[[", "PL_BIC")
  }

  if (missing == "listwise") {
    rmsea_delta <- c(NA, lav_fit_rmsea(
      x2 = stat_delta_orig[-1],
      df = df_delta_orig[-1],
      n = ntotal,
      g = ngroups,
      c_hat = rep(1, length(stat_delta_orig) - 1L)
    ))

    val <- data.frame(
      Df = Df,
      AIC = aic,
      BIC = bic,
      Chisq = STAT,
      "Chisq diff" = stat_delta,
      "RMSEA" = rmsea_delta,
      "Df diff" = df_delta,
      "Pr(>Chisq)" = pvalue_delta,
      row.names = names(mods),
      check.names = FALSE
    )
  } else {
    val <- data.frame(
      Df = Df,
      AIC = aic,
      BIC = bic,
      Chisq = STAT,
      "Chisq diff" = stat_delta,
      "Df diff" = df_delta,
      "Pr(>Chisq)" = pvalue_delta,
      row.names = names(mods),
      check.names = FALSE
    )
  }

  idx <- which(val[, "Df diff"] == 0)
  if (length(idx) > 0L) {
    val[idx, "Pr(>Chisq)"] <- as.numeric(NA)
    lav_msg_warn(gettext("some models have the same degrees of freedom"))
  }

  txt <- if (chisq == "rls") {
    paste("The ", dQuote("Chisq"), " column contains source RLS ",
      "test statistics, not the FMG test that should be reported per ",
      "model. An FMG difference test is a function of two source ",
      "statistics.",
      sep = ""
    )
  } else {
    paste("The ", dQuote("Chisq"), " column contains standard ",
      "test statistics, not the FMG test that should be reported per ",
      "model. An FMG difference test is a function of two standard ",
      "(not FMG) statistics.",
      sep = ""
    )
  }
  note <- paste(strwrap(
    paste("lavaan NOTE:", txt),
    width = getOption("width", 80L) - 3L
  ), collapse = "\n")
  note <- paste0(
    "lavaan->lavTestLRT():  \n   ",
    gsub("\n", "\n   ", note, fixed = TRUE)
  )
  attr(val, "heading") <- paste0(
    "\nFMG Chi-Squared Difference Test (", heading_label, ")\n\n",
    note,
    "\n"
  )
  class(val) <- c("anova", class(val))

  val
}
