#' Parameters standardization
#'
#' Compute standardized model parameters (coefficients).
#'
#' @param model A statistical model.
#' @param method The method used for standardizing the parameters. Can be
#'   `"refit"` (default), `"posthoc"`, `"smart"`, `"basic"` or `"pseudo"`. See
#'   'Details'.
#' @param include_response If `TRUE` (default), the response value will also be
#'   standardized. If `FALSE`, only the predictors will be standardized. For
#'   GLMs the response value will never be standardized (see *Generalized Linear
#'   Models* section).
#' @inheritParams standardize.default
#' @inheritParams chisq_to_phi
#' @param ... For `standardize_parameters()`, arguments passed to
#'   [parameters::model_parameters], such as:
#' - `ci_method`, `centrality` for Mixed models and Bayesian models...
#' - `exponentiate`, ...
#' - etc.
#' @param parameters Deprecated.
#'
#' @details
#'
#' # Standardization Methods:
#' - **refit**: This method is based on a complete model re-fit with a
#' standardized version of the data. Hence, this method is equal to
#' standardizing the variables before fitting the model. It is the "purest" and
#' the most accurate (Neter et al., 1989), but it is also the most
#' computationally costly and long (especially for heavy models such as Bayesian
#' models). This method is particularly recommended for complex models that
#' include interactions or transformations (e.g., polynomial or spline terms).
#' The `robust` (default to `FALSE`) argument enables a robust standardization
#' of data, i.e., based on the `median` and `MAD` instead of the `mean` and
#' `SD`. **See [standardize()] for more details.**
#'   - **Note** that `standardize_parameters(method = "refit")` may not return
#'   the same results as fitting a model on data that has been standardized with
#'   `standardize()`; `standardize_parameters()` used the data used by the model
#'   fitting function, which might not be same data if there are missing values.
#'   see the `remove_na` argument in `standardize()`.
#' - **posthoc**: Post-hoc standardization of the parameters, aiming at
#' emulating the results obtained by "refit" without refitting the model. The
#' coefficients are divided by the standard deviation (or MAD if `robust`) of
#' the outcome (which becomes their expression 'unit'). Then, the coefficients
#' related to numeric variables are additionally multiplied by the standard
#' deviation (or MAD if `robust`) of the related terms, so that they correspond
#' to changes of 1 SD of the predictor (e.g., "A change in 1 SD of `x` is
#' related to a change of 0.24 of the SD of `y`). This does not apply to binary
#' variables or factors, so the coefficients are still related to changes in
#' levels. This method is not accurate and tend to give aberrant results when
#' interactions are specified.
#' - **basic**: This method is similar to `method = "posthoc"`, but treats all
#' variables as continuous: it also scales the coefficient by the standard
#' deviation of model's matrix' parameter of factors levels (transformed to
#' integers) or binary predictors. Although being inappropriate for these cases,
#' this method is the one implemented by default in other software packages,
#' such as [lm.beta::lm.beta()].
#' - **smart** (Standardization of Model's parameters with Adjustment,
#' Reconnaissance and Transformation - *experimental*): Similar to `method =
#' "posthoc"` in that it does not involve model refitting. The difference is
#' that the SD (or MAD if `robust`) of the response is computed on the relevant
#' section of the data. For instance, if a factor with 3 levels A (the
#' intercept), B and C is entered as a predictor, the effect corresponding to B
#' vs. A will be scaled by the variance of the response at the intercept only.
#' As a results, the coefficients for effects of factors are similar to a Glass'
#' delta.
#' - **pseudo** (*for 2-level (G)LMMs only*): In this (post-hoc) method, the
#' response and the predictor are standardized based on the level of prediction
#' (levels are detected with [performance::check_heterogeneity_bias()]): Predictors
#' are standardized based on their SD at level of prediction (see also
#' [datawizard::demean()]); The outcome (in linear LMMs) is standardized based
#' on a fitted random-intercept-model, where `sqrt(random-intercept-variance)`
#' is used for level 2 predictors, and `sqrt(residual-variance)` is used for
#' level 1 predictors (Hoffman 2015, page 342). A warning is given when a
#' within-group varialbe is found to have access between-group variance.
#'
#' # Transformed Variables
#' When the model's formula contains transformations (e.g. `y ~ exp(X)`) `method
#' = "refit"` will give different results compared to `method = "basic"`
#' (`"posthoc"` and `"smart"` do not support such transformations): While
#' `"refit"` standardizes the data *prior* to the transformation (e.g.
#' equivalent to `exp(scale(X))`), the `"basic"` method standardizes the
#' transformed data (e.g. equivalent to `scale(exp(X))`).
#' \cr\cr
#' See the *Transformed Variables* section in [standardize.default()] for more
#' details on how different transformations are dealt with when `method =
#' "refit"`.
#'
#' # Confidence Intervals
#' The returned confidence intervals are re-scaled versions of the
#' unstandardized confidence intervals, and not "true" confidence intervals of
#' the standardized coefficients (cf. Jones & Waller, 2015).
#'
#' @inheritSection standardize.default Generalized Linear Models
#' @inheritSection standardize.default Dealing with Factors
#'
#' @return A data frame with the standardized parameters (`Std_*`, depending on
#'   the model type) and their CIs (`CI_low` and `CI_high`). Where applicable,
#'   standard errors (SEs) are returned as an attribute (`attr(x,
#'   "standard_error")`).
#'
#' @family standardize
#' @family effect size indices
#'
#' @examples
#' library(effectsize)
#'
#' model <- lm(len ~ supp * dose, data = ToothGrowth)
#' standardize_parameters(model, method = "refit")
#' \donttest{
#' standardize_parameters(model, method = "posthoc")
#' standardize_parameters(model, method = "smart")
#' standardize_parameters(model, method = "basic")
#'
#' # Robust and 2 SD
#' standardize_parameters(model, robust = TRUE)
#' standardize_parameters(model, two_sd = TRUE)
#'
#'
#' model <- glm(am ~ cyl * mpg, data = mtcars, family = "binomial")
#' standardize_parameters(model, method = "refit")
#' standardize_parameters(model, method = "posthoc")
#' standardize_parameters(model, method = "basic", exponentiate = TRUE)
#' }
#'
#' \donttest{
#' if (require("lme4")) {
#'   m <- lmer(mpg ~ cyl + am + vs + (1 | cyl), mtcars)
#'   standardize_parameters(m, method = "pseudo", ci_method = "satterthwaite")
#' }
#'
#'
#' \dontrun{
#' if (require("rstanarm")) {
#'   model <- stan_glm(rating ~ critical + privileges, data = attitude, refresh = 0)
#'   standardize_posteriors(model, method = "refit")
#'   standardize_posteriors(model, method = "posthoc")
#'   standardize_posteriors(model, method = "smart")
#'   head(standardize_posteriors(model, method = "basic"))
#' }
#' }
#' }
#'
#' @references
#' - Hoffman, L. (2015). Longitudinal analysis: Modeling within-person fluctuation and change. Routledge.
#' - Jones, J. A., & Waller, N. G. (2015). The normal-theory and asymptotic distribution-free (ADF) covariance matrix of standardized regression coefficients: theoretical extensions and finite sample behavior. Psychometrika, 80(2), 365-378.
#' - Neter, J., Wasserman, W., & Kutner, M. H. (1989). Applied linear regression models.
#' - Gelman, A. (2008). Scaling regression inputs by dividing by two standard deviations. Statistics in medicine, 27(15), 2865-2873.
#'
#' @export
standardize_parameters <- function(model, method = "refit", ci = 0.95, robust = FALSE, two_sd = FALSE, include_response = TRUE, verbose = TRUE, parameters, ...) {
  if (!missing(parameters)) {
    warning(
      "'parameters' argument is deprecated, and will not be used.",
      immediate. = TRUE
    )
  }

  UseMethod("standardize_parameters")
}

#' @importFrom parameters model_parameters
#' @importFrom insight model_info
#' @export
standardize_parameters.default <- function(model, method = "refit", ci = 0.95, robust = FALSE, two_sd = FALSE, include_response = TRUE, verbose = TRUE, ...) {
  object_name <- deparse(substitute(model), width.cutoff = 500)
  method <- match.arg(method, c("refit", "posthoc", "smart", "basic", "classic", "pseudo"))

  m_info <- insight::model_info(model)
  include_response <- include_response && .safe_to_standardize_response(m_info, verbose = verbose)

  if (method == "refit") {
    model <- standardize(model,
                         robust = robust, two_sd = two_sd, include_response = include_response,
                         verbose = verbose, m_info = m_info)
  }

  # need model_parameters to return the parameters, not the terms
  if (inherits(model, "aov")) class(model) <- class(model)[class(model) != "aov"]
  pars <- parameters::model_parameters(model, ci = ci, standardize = NULL, effects = "fixed", ...)

  # should post hoc exponentiate?
  dots <- list(...)
  exponentiate <- "exponentiate" %in% names(dots) && dots$exponentiate
  coefficient_name <- attr(pars, "coefficient_name")

  if (method %in% c("posthoc", "smart", "basic", "classic", "pseudo")) {
    if (m_info$is_multivariate) {
      # TODO FIX
      stop('Cannot post-hoc standardize multivariate models. Try using method "refit" instead.')
    }

    pars <- .standardize_parameters_posthoc(pars, method, model, robust, two_sd, exponentiate, include_response, verbose)

    method <- attr(pars, "std_method")
    robust <- attr(pars, "robust")
  }

  ## clean cols
  if (!is.null(ci)) pars$CI <- attr(pars, "ci")
  colnm <- c("Component", "Response", "Group", "Parameter", head(.col_2_scale, -2), "CI", "CI_low", "CI_high")
  pars <- pars[, colnm[colnm %in% colnames(pars)]]

  if (!is.null(coefficient_name) && coefficient_name %in% c("Odds Ratio", "Risk Ratio", "IRR")) {
    colnames(pars)[colnames(pars) == "Coefficient"] <- gsub(" ", "_", coefficient_name)
  }

  i <- colnames(pars) %in% c("Coefficient", "Median", "Mean", "MAP", c("Odds_Ratio", "Risk_Ratio", "IRR"))
  colnames(pars)[i] <- paste0("Std_", colnames(pars)[i])

  ## SE attribute?
  if ("SE" %in% colnames(pars)) {
    attr(pars, "standard_error") <- pars$SE
    pars$SE <- NULL
  }

  ## attributes
  attr(pars, "std_method") <- method
  attr(pars, "two_sd") <- two_sd
  attr(pars, "robust") <- robust
  attr(pars, "object_name") <- object_name
  attr(pars, "ci") <- ci
  attr(pars, "include_response") <- include_response
  class(pars) <- c("effectsize_std_params", "effectsize_table", "see_effectsize_table", "data.frame")
  return(pars)
}

#' @export
standardize_parameters.mediate <- function(model, method = "refit", ci = 0.95, robust = FALSE, two_sd = FALSE, include_response = TRUE, verbose = TRUE, ...) {
  if (method != "refit")
    warning("Only method = 'refit' is supported for mediation models.", immediate. = TRUE)

  NextMethod("standardize_parameters", method = "refit", ci = ci, robust = robust, two_sd = two_sd, include_response = include_response, verbose = verbose)
}

#' @export
standardize_parameters.parameters_model <- function(model, method = "refit", ci = NULL, robust = FALSE, two_sd = FALSE, include_response = TRUE, verbose = TRUE, ...) {
  if (method == "refit") {
    stop("Method 'refit' not supported for 'model_parameters()", call. = TRUE)
  }

  if (!is.null(ci)) {
    warnings("Argument 'ci' argument not supported for 'model_parameters(). It is ignored.", call. = TRUE)
  }

  pars <- model
  ci <- attr(pars, "ci")
  model <- .get_object(pars)
  if (is.null(model)) model <- attr(pars, "object")

  m_info <- insight::model_info(model)
  include_response <- include_response && .safe_to_standardize_response(m_info, verbose = verbose)

  if (is.null(exponentiate <- attr(pars, "exponentiate"))) exponentiate <- FALSE
  pars <- .standardize_parameters_posthoc(pars, method, model, robust, two_sd, exponentiate, include_response, verbose)
  method <- attr(pars, "std_method")
  robust <- attr(pars, "robust")

  ## clean cols
  if (!is.null(ci)) pars$CI <- attr(pars, "ci")
  colnm <- c("Component", "Response", "Group", "Parameter", head(.col_2_scale, -2), "CI", "CI_low", "CI_high")
  pars <- pars[, colnm[colnm %in% colnames(pars)]]
  i <- colnames(pars) %in% c("Coefficient", "Median", "Mean", "MAP")
  colnames(pars)[i] <- paste0("Std_", colnames(pars)[i])

  ## SE attribute?
  if ("SE" %in% colnames(pars)) {
    attr(pars, "standard_error") <- pars$SE
    pars$SE <- NULL
  }

  ## attributes
  attr(pars, "std_method") <- method
  attr(pars, "two_sd") <- two_sd
  attr(pars, "robust") <- robust
  attr(pars, "ci") <- ci
  attr(pars, "include_response") <- include_response
  class(pars) <- c("effectsize_std_params", "effectsize_table", "see_effectsize_table", "data.frame")
  return(pars)
}

#' @export
standardize_parameters.bootstrap_model <-
  function(model,
           method = "refit",
           ci = 0.95,
           robust = FALSE,
           two_sd = FALSE,
           include_response = TRUE,
           verbose = TRUE,
           ...) {
    object_name <- deparse(substitute(model), width.cutoff = 500)
    method <- match.arg(method, c("refit", "posthoc", "smart", "basic", "classic", "pseudo"))

    pars <- model
    model <- attr(pars, "original_model")

    m_info <- insight::model_info(model)
    include_response <- include_response && .safe_to_standardize_response(m_info, verbose = verbose)

    if (method == "refit") {
      stop("The 'refit' method is not supported for bootstrapped models.")
      ## But it would look something like this:
      # model <- standardize(model, robust = robust, two_sd = two_sd, verbose = verbose, m_info = m_info)
      # model <- parameters::bootstrap_model(model, iterations = 1000, verbose = verbose)
      # return(model)
    }

    # need model_parameters to return the parameters, not the terms
    if (inherits(model, "aov")) class(model) <- class(model)[class(model) != "aov"]


    if (method %in% c("posthoc", "smart", "basic", "classic", "pseudo")) {
      pars <- .standardize_posteriors_posthoc(pars, method, model, robust, two_sd, include_response, verbose)

      method <- attr(pars, "std_method")
      robust <- attr(pars, "robust")
    }

    pars <- bayestestR::describe_posterior(pars, centrality = "median",
                                           ci = ci, ci_method = "quantile",
                                           test = NULL)
    names(pars)[names(pars) == "Median"] <- "Std_Coefficient"


    attr(pars, "std_method") <- method
    attr(pars, "two_sd") <- two_sd
    attr(pars, "robust") <- robust
    attr(pars, "object_name") <- object_name
    attr(pars, "ci") <- ci
    attr(pars, "include_response") <- include_response
    class(pars) <- c("effectsize_std_params", "effectsize_table", "see_effectsize_table", "data.frame")
    return(pars)
  }

#' @export
standardize_parameters.bootstrap_parameters <-
  function(model,
           method = "refit",
           ci = 0.95,
           robust = FALSE,
           two_sd = FALSE,
           include_response = TRUE,
           verbose = TRUE,
           ...) {

    standardize_parameters(attr(model, "boot_samples"),
                           method = method,
                           ci = ci,
                           robust = robust,
                           two_sd = two_sd,
                           include_response = include_response,
                           verbose = verbose,
                           ...)
  }


#' @export
standardize_parameters.model_fit <-
  function(model,
           method = "refit",
           ci = 0.95,
           robust = FALSE,
           two_sd = FALSE,
           include_response = TRUE,
           verbose = TRUE,
           ...) {

    standardize_parameters(
      model$fit,
      method = method,
      ci = ci,
      robust = robust,
      two_sd = two_sd,
      include_response = include_response,
      verbose = verbose,
      ...
    )
  }



#' @keywords internal
#' @importFrom insight model_info find_random
.standardize_parameters_posthoc <- function(pars, method, model, robust, two_sd, exponentiate, include_response, verbose) {
  # Sanity Check for "pseudo"
  method <- .should_pseudo(method, model)

  method <- .cant_smart_or_posthoc(method, model, pars$Parameter)

  if (robust && method == "pseudo") {
    warning("'robust' standardization not available for 'pseudo' method.",
      call. = FALSE
    )
    robust <- FALSE
  }


  ## Get scaling factors
  deviations <- standardize_info(model, robust = robust, include_pseudo = method == "pseudo", two_sd = two_sd)
  i_missing <- setdiff(seq_len(nrow(pars)), seq_len(nrow(deviations)))
  unstd <- pars
  if (length(i_missing)) {
    deviations[i_missing, ] <- NA
  }

  if (method == "basic") {
    col_dev_resp <- "Deviation_Response_Basic"
    col_dev_pred <- "Deviation_Basic"
  } else if (method == "posthoc") {
    col_dev_resp <- "Deviation_Response_Basic"
    col_dev_pred <- "Deviation_Smart"
  } else if (method == "smart") {
    col_dev_resp <- "Deviation_Response_Smart"
    col_dev_pred <- "Deviation_Smart"
  } else if (method == "pseudo") {
    col_dev_resp <- "Deviation_Response_Pseudo"
    col_dev_pred <- "Deviation_Pseudo"
  } else {
    stop("'method' must be one of 'basic', 'posthoc', 'smart' or 'pseudo'.")
  }


  .dev_pred <- deviations[[col_dev_pred]]
  .dev_resp <- deviations[[col_dev_resp]]
  if (!include_response) .dev_resp <- 1
  .dev_factor <- .dev_pred / .dev_resp

  # Sapply standardization
  pars[, colnames(pars) %in% .col_2_scale] <- lapply(
    pars[, colnames(pars) %in% .col_2_scale, drop = FALSE],
    function(x) {
      if (exponentiate) {
        x ^ .dev_factor
      } else {
        x * .dev_factor
      }
    }
  )

  to_complete <- apply(pars[, colnames(pars) %in% .col_2_scale], 1, anyNA)
  if (length(i_missing) || any(to_complete)) {
    i_missing <- union(i_missing, which(to_complete))

    pars[i_missing, colnames(pars) %in% .col_2_scale] <-
      unstd[i_missing, colnames(pars) %in% .col_2_scale]
  }

  attr(pars, "std_method") <- method
  attr(pars, "two_sd") <- two_sd
  attr(pars, "robust") <- robust

  return(pars)
}

#' @keywords internal
.col_2_scale <- c("Coefficient", "Median", "Mean", "MAP", "SE", "CI_low", "CI_high")


# standardize_posteriors --------------------------------------------------



#' @rdname standardize_parameters
#' @export
standardize_posteriors <- function(model, method = "refit", robust = FALSE, two_sd = FALSE, include_response = TRUE, verbose = TRUE, ...) {
  object_name <- deparse(substitute(model), width.cutoff = 500)

  m_info <- insight::model_info(model)
  include_response <- include_response && .safe_to_standardize_response(m_info, verbose = verbose)

  if (method == "refit") {
    model <- standardize(model, robust = robust, two_sd = two_sd, include_response = include_response,
                         verbose = verbose, m_info = m_info)
  }

  pars <- insight::get_parameters(model)


  if (method %in% c("posthoc", "smart", "basic", "classic", "pseudo")) {
    pars <- .standardize_posteriors_posthoc(pars, method, model, robust, two_sd, include_response, verbose)

    method <- attr(pars, "std_method")
    robust <- attr(pars, "robust")
  }

  ## attributes
  attr(pars, "std_method") <- method
  attr(pars, "two_sd") <- two_sd
  attr(pars, "robust") <- robust
  attr(pars, "include_response") <- include_response
  attr(pars, "object_name") <- object_name
  class(pars) <- c("effectsize_std_params", class(pars))
  return(pars)
}



#' @keywords internal
#' @importFrom insight model_info find_random
.standardize_posteriors_posthoc <- function(pars, method, model, robust, two_sd, include_response, verbose) {
  # Sanity Check for "pseudo"
  method <- .should_pseudo(method, model)

  method <- .cant_smart_or_posthoc(method, model, pars$Parameter)

  if (robust && method == "pseudo") {
    warning("'robust' standardization not available for 'pseudo' method.",
      call. = FALSE
    )
    robust <- FALSE
  }

  ## Get scaling factors
  deviations <- standardize_info(model, robust = robust, include_pseudo = method == "pseudo", two_sd = two_sd)
  i <- match(deviations$Parameter, colnames(pars))
  pars <- pars[, i]

  if (method == "basic") {
    col_dev_resp <- "Deviation_Response_Basic"
    col_dev_pred <- "Deviation_Basic"
  } else if (method == "posthoc") {
    col_dev_resp <- "Deviation_Response_Basic"
    col_dev_pred <- "Deviation_Smart"
  } else if (method == "smart") {
    col_dev_resp <- "Deviation_Response_Smart"
    col_dev_pred <- "Deviation_Smart"
  } else if (method == "pseudo") {
    col_dev_resp <- "Deviation_Response_Pseudo"
    col_dev_pred <- "Deviation_Pseudo"
  } else {
    stop("'method' must be one of 'basic', 'posthoc', 'smart' or 'pseudo'.")
  }

  .dev_pred <- deviations[[col_dev_pred]]
  .dev_resp <- deviations[[col_dev_resp]]
  if (!include_response) .dev_resp <- 1
  .dev_factor <- .dev_pred / .dev_resp

  # Sapply standardization
  pars <- t(t(pars) * .dev_factor)
  pars <- as.data.frame(pars)

  attr(pars, "std_method") <- method
  attr(pars, "two_sd") <- two_sd
  attr(pars, "robust") <- robust

  return(pars)
}


# util --------------------------------------------------------------------



#' @keywords internal
.cant_smart_or_posthoc <- function(method, model, params) {
  if (method %in% c("smart", "posthoc")) {
    cant_posthocsmart <- FALSE

    if (insight::model_info(model)$is_linear) {
      if (!colnames(model.frame(model))[1] == insight::find_response(model)) {
        can_posthocsmart <- TRUE
      }
    }

    # factors are allowed
    if (!cant_posthocsmart &&
        !all(params == insight::clean_names(params) |
             grepl("(as.factor|factor)\\(", params))) {
      cant_posthocsmart <- TRUE
    }

    if (cant_posthocsmart) {
      warning("Method '", method, "' does not currently support models with transformed parameters.",
              "\nReverting to 'basic' method. Concider using the 'refit' method directly.",
              call. = FALSE
      )
      method <- "basic"
    }
  }
  method
}


#' @keywords internal
.should_pseudo <- function(method, model) {
  if (method == "pseudo" &&
      !(insight::model_info(model)$is_mixed &&
        length(insight::find_random(model)$random) == 1)) {
    warning(
      "'pseudo' method only available for 2-level (G)LMMs.\n",
      "Setting method to 'basic'.",
      call. = FALSE
    )
    method <- "basic"
  }
  method
}
