#' @title Test an Indirect Effect
#'
#' @description Test an indirect effect
#' for a `power4test` object.
#'
#' @details
#' This function is to be used in
#' [power4test()] for testing an
#' indirect effect, by setting it
#' to the `test_fun` argument.
#'
#' It uses [manymome::indirect_effect()]
#' to do the test. It can be used on
#' models fitted by [lavaan::sem()]
#' or fitted by a sequence of calls
#' to [stats::lm()], although only
#' nonparametric bootstrap confidence
#' interval is supported for models
#' fitted by regression using
#' [stats::lm()].
#'
#' @return
#' In its normal usage, it returns
#' a named numeric vector with the
#' following elements:
#'
#' - `est`: The mean of the estimated
#'  indirect effect across datasets.
#'
#' - `cilo` and `cihi`: The means of the
#'  lower and upper limits of the
#'  confidence interval (95% by
#'  default), respectively.
#'
#' - `sig`: Whether a test by confidence
#'  interval is significant (`1`) or
#'  not significant (`0`).
#'
#' @param fit The fit object, to be
#' passed to [manymome::indirect_effect()].
#'
#' @param x The name of the `x`-variable,
#' the predictor.
#'
#' @param m A character vector of the
#' name(s) of mediator(s). The path
#' moves from the first mediator in the
#' vector to the last mediator in the
#' vector. Can be `NULL` and the path
#' is a direct path without mediator.
#'
#' @param y The name of the `y`-variable,
#' the outcome variable.
#'
#' @param mc_ci Logical. If `TRUE`, the
#' default, Monte Carlo confidence
#' intervals will be formed. This argument
#' and `boot_ci` cannot be both `TRUE`.
#'
#' @param mc_out The pre-generated
#' Monte Carlo estimates generated by
#' [manymome::do_mc], stored in
#' a `power4test` object. Users should
#' not set this argument and should let
#' [power4test()] to set it automatically.
#'
#' @param boot_ci Logical. If `TRUE`,
#' the default, nonparametric bootstrap
#' confidence intervals will be formed.
#' This argument
#' and `mc_ci` cannot be both `TRUE`.
#'
#' @param boot_out The pre-generated
#' bootstrap estimates generated by
#' [manymome::do_boot], stored in
#' a `power4test` object. Users should
#' not set this argument and should let
#' [power4test()] to set it automatically.
#'
#' @param check_post_check Logical. If
#' `TRUE`, the default, and the model
#' is fitted by `lavaan`, the test
#' will be conducted only if the model
#' passes the `post.check` conducted
#' by [lavaan::lavInspect()] (with
#' `what = "post.check"`).
#'
#' @param ... Additional arguments to
#' be passed to [manymome::indirect_effect()].
#'
#' @param fit_name The name of the
#' model fit object to be extracted.
#' Default is `"fit"`. Used only when
#' more than one model is fitted in
#' each replication. This should be
#' the name of the model on which the
#' test is to be conducted.
#'
#' @param get_map_names Logical. Used
#' by [power4test()] to determine how
#' to extract stored information and
#' assign them to this function. Users
#' should not use this argument.
#'
#' @param get_test_name Logical. Used
#' by [power4test()] to get the default
#' name of this test. Users should not
#' use this argument.
#'
#' @param test_method The method to do
#' the test. If `"ci"`, then the
#' confidence interval (e.g., bootstrap
#' confidence interval) will be used to
#' do the test. If
#' `"pvalue"`, then asymmetric *p*-value
#' by Asparouhov & Muthén (2021) will
#' be used to do the test, and the
#' confidence interval will not be
#' computed. If `NULL`, its value will
#' be set to `"pvalue"` if the number of
#' simulated/bootstrap samples (`R`) is
#' a value that is supported by the
#' method by Boos and Zhang (2000), and
#' set to `"ci"` otherwise.
#'
#' @references
#' Asparouhov, A., & Muthén, B. (2021). Bootstrap p-value computation.
#' Retrieved from https://www.statmodel.com/download/FAQ-Bootstrap%20-%20Pvalue.pdf
#'
#' @seealso [power4test()]
#'
#' @examples
#'
#' # Specify the model
#'
#' model_simple_med <-
#' "
#' m ~ x
#' y ~ m + x
#' "
#'
#' # Specify the population values
#'
#' model_simple_med_es <-
#' "
#' y ~ m: l
#' m ~ x: m
#' y ~ x: n
#' "
#'
#' # Simulate the data
#'
#' sim_only <- power4test(nrep = 5,
#'                        model = model_simple_med,
#'                        pop_es = model_simple_med_es,
#'                        n = 100,
#'                        R = 100,
#'                        do_the_test = FALSE,
#'                        iseed = 1234)
#'
#' # Do the test in each replication
#'
#' test_ind <- power4test(object = sim_only,
#'                        test_fun = test_indirect_effect,
#'                        test_args = list(x = "x",
#'                                         m = "m",
#'                                         y = "y",
#'                                         mc_ci = TRUE))
#' print(test_ind,
#'       test_long = TRUE)
#'
#' @export

test_indirect_effect <- function(fit = fit,
                                 x = NULL,
                                 m = NULL,
                                 y = NULL,
                                 mc_ci = TRUE,
                                 mc_out = NULL,
                                 boot_ci = FALSE,
                                 boot_out = NULL,
                                 check_post_check = TRUE,
                                 test_method = NULL,
                                 ...,
                                 fit_name = "fit",
                                 get_map_names = FALSE,
                                 get_test_name = FALSE) {

  # ==== Enable pvalue? ====

  args <- list(...)
  if (!is.null(mc_out)) {
    R <- length(mc_out)
  } else if (!is.null(boot_out)) {
    R <- length(boot_out)
  } else {
    R <- NULL
  }
  ci_level <- args$level %||% formals(manymome::indirect_effect)$level
  R_bz_ok <- isTRUE(R %in% R_extrapolate(alpha = 1 - ci_level))
  bz_not_FALSE <- !isFALSE(options("power4mome.bz"))
  test_method_NULL <- is.null(test_method)
  if (R_bz_ok &&
      bz_not_FALSE &&
      test_method_NULL) {
    test_method <- "pvalue"
  } else {
    test_method <- match.arg(test_method,
                             c("ci", "pvalue"))
  }
  internal_options <- list()
  if (test_method == "pvalue") {
    internal_options <- utils::modifyList(internal_options,
                                          list(skip_ci = TRUE,
                                               pvalue_min_size = -Inf))
  }
  if (test_method == "ci") {
    internal_options <- utils::modifyList(internal_options,
                                          list(skip_ci = FALSE))
  }
  if (fit_name != "fit") {
    mc_name <- paste0(fit_name, "_mc_out")
    boot_name <- paste0(fit_name, "_boot_out")
  } else {
    mc_name <- "mc_out"
    boot_name <- "boot_out"
  }
  map_names <- c(fit = fit_name,
                 mc_out = mc_name,
                 boot_out = boot_name)
  if (get_map_names) {
    return(map_names)
  }
  if (get_test_name) {
    tmp <- paste0(c(x, m, y),
                  collapse = "->")
    args <- as.list(match.call())
    tmp2 <- character(0)
    if (isTRUE(args$standardized_x) && !isTRUE(args$standardized_y)) {
      tmp <- paste0(tmp, " ('x' standardized)")
    }
    if (!isTRUE(args$standardized_x) && isTRUE(args$standardized_y)) {
      tmp <- paste0(tmp, " ('y' standardized)")
    }
    if (isTRUE(args$standardized_x) && isTRUE(args$standardized_y)) {
      tmp <- paste0(tmp, " ('x' and 'y' standardized)")
    }
    return(paste0("test_indirect: ", tmp, collapse = ""))
  }
  if (boot_ci) mc_ci <- FALSE
  if (inherits(fit, "lavaan")) {
    fit_ok <- lavaan::lavInspect(fit, "converged") &&
              (suppressWarnings(lavaan::lavInspect(fit, "post.check") ||
               !check_post_check))
  } else {
    fit_ok <- TRUE
  }
  if (fit_ok) {
    out <- tryCatch(manymome::indirect_effect(
                                   x = x,
                                   y = y,
                                   m = m,
                                   fit = fit,
                                   mc_ci = mc_ci,
                                   mc_out = mc_out,
                                   boot_ci = boot_ci,
                                   boot_out = boot_out,
                                   progress = FALSE,
                                   ...,
                                   internal_options = internal_options),
                  error = function(e) e)
  } else {
    out <- NA
  }
  if (inherits(out, "error") ||
      identical(out, NA)) {
    out2 <- c(est = as.numeric(NA),
              cilo = as.numeric(NA),
              cihi = as.numeric(NA),
              sig = as.numeric(NA),
              pvalue = as.numeric(NA))
    return(out2)
  }
  bz_alpha_ok <- isTRUE(all.equal(1 - out$level,
                                  getOption("power4mome.bz.alpha",
                                                      default = .05)))
  if (test_method == "ci") {
    ci0 <- stats::confint(out)
    out1 <- ifelse((ci0[1, 1] > 0) || (ci0[1, 2] < 0),
                    yes = 1,
                    no = 0)
  }
  if (test_method == "pvalue") {
    ci0 <- matrix(
              as.numeric(NA),
              nrow = 1,
              ncol = 2
            )
    if (bz_alpha_ok) {
      boot_est <- out$boot_indirect %||% out$mc_indirect
      boot_sig <- bz_sig_partition(
                    boot_est,
                    alpha = 1 - out$level
                  )
    } else {
      boot_sig <- NULL
    }
    if (isTRUE(boot_ci)) {
      out1a <- out$boot_p %||% as.numeric(NA)
      R <- length(out$boot_indirect)
      nlt0 <- sum(as.numeric(out$boot_indirect < 0))
    } else if (isTRUE(mc_ci)) {
      out1a <- out$mc_p %||% as.numeric(NA)
      R <- length(out$mc_indirect)
      nlt0 <- sum(as.numeric(out$mc_indirect < 0))
    } else {
      out1a <- as.numeric(NA)
      R <- as.numeric(NA)
      nlt0 <- as.numeric(NA)
    }
    out1 <- ifelse(
                out1a < (1 - out$level),
                yes = 1,
                no = 0
              )
  }
  out2 <- c(est = unname(stats::coef(out)),
            cilo = ci0[1, 1],
            cihi = ci0[1, 2],
            sig = out1,
            pvalue = out$mc_p %||% (out$boot_p %||% as.numeric(NA)))
  if (test_method == "pvalue") {
    # For Boos & Zhang (2000)
    out2 <- c(out2, R = R, nlt0 = nlt0,
              alpha = 1 - out$level,
              boot_sig)
  }
  return(out2)
}
