# Format ------------------------------------------------------------------

#' @rdname print.estimate_contrasts
#' @export
format.estimate_contrasts <- function(
  x,
  format = NULL,
  select = getOption("modelbased_select", NULL),
  include_grid = getOption("modelbased_include_grid", FALSE),
  ...
) {
  # for joint test, no select and include_grid options
  if (isTRUE(attributes(x)$joint_test)) {
    select <- NULL
    include_grid <- FALSE
  }
  # change parameter name for context effects
  if (isTRUE(attributes(x)$context_effects)) {
    x$Parameter <- NULL
  }

  # don't print columns of adjusted_for variables
  adjusted_for <- attr(x, "adjusted_for", exact = TRUE)
  if (
    !is.null(adjusted_for) && all(adjusted_for %in% colnames(x)) && !isTRUE(include_grid)
  ) {
    # remove non-focal terms from data frame
    x[adjusted_for] <- NULL
  } else if (isTRUE(include_grid)) {
    # we include the data grid, so we don't need to add the same information
    # to the footer
    table_footer <- attributes(x)$table_footer
    if (!is.null(table_footer)) {
      # (Predictors controlled.*?): This is the first capturing group.
      # - `Predictors controlled`: Matches the literal string "Predictors controlled".
      # - `.*?`: Matches any character (.) zero or more times (*), but as few
      #    times as possible (?). This is important to avoid matching across
      #    multiple lines. This is a non-greedy quantifier.
      # `(\n|$)`: This is the second capturing group.
      # - \n: Matches a newline character.
      # - $: Matches the end of the string.
      # - |: Acts as an "OR" operator. So, this part matches either a newline
      #   or the end of the string. This is necessary to capture the last match
      #   if it's at the very end of the string and not followed by a newline.
      # (powered by Gemini)
      pattern <- "(Predictors controlled.*?)(\n|$)"
      table_footer[1] <- gsub(pattern, "", table_footer[1])
      # add back modified footer
      attr(x, "table_footer") <- table_footer
    }
  }

  # arrange columns (not for contrast now)
  by <- rev(attr(x, "focal_terms", exact = TRUE))
  # add "Level" columns from contrasts
  if (all(c("Level1", "Level2") %in% colnames(x))) {
    by <- unique(by, c("Level1", "Level2"))
  }
  # add "group" columns from multivariate models
  if ("group" %in% colnames(x)) {
    by <- unique("group", by)
  }
  # for emmeans, when we predict the grand mean, by is `~1` to avoid errors when
  # selecting "by" from the data below, we set it to NULL here
  if (is.language(by)) {
    by <- NULL
  }
  # check which columns actually exist
  if (!is.null(by)) {
    by <- intersect(by, colnames(x))
  }
  # sort
  if (length(by)) {
    # arrange predictions
    x <- datawizard::data_arrange(x, select = by)
    # protect integers, only for focal terms
    for (i in by) {
      if (is.numeric(x[[i]])) {
        x[[i]] <- insight::format_value(x[[i]], protect_integers = TRUE, ...)
      }
    }
  }

  # remove all-NA columns
  x <- datawizard::remove_empty_columns(x)

  # remove df column if it's only "Inf" (new since version ‘0.25.1.8’)
  all_inf_values <- vapply(x, function(i) all(is.infinite(i)), logical(1))
  if (any(all_inf_values)) {
    x[all_inf_values] <- NULL
  }

  # add back adjusted_for variables when we have custom column layouts
  if (!is.null(select)) {
    attr(x, "focal_terms") <- unique(c(attr(x, "focal_terms"), adjusted_for))
  }

  if (!is.null(format) && format %in% c("md", "markdown", "html")) {
    insight::format_table(
      x,
      ci_brackets = c("(", ")"),
      select = select,
      format = format,
      ...
    )
  } else {
    insight::format_table(x, select = select, ...)
  }
}

#' @export
format.estimate_means <- format.estimate_contrasts

#' @export
format.estimate_slopes <- format.estimate_contrasts

#' @export
format.estimate_predicted <- format.estimate_contrasts

#' @export
format.estimate_grouplevel <- format.estimate_contrasts


#' @export
format.estimate_smooth <- function(x, ...) {
  # Colnames
  if ("Size" %in% names(x)) {
    x$Size <- ifelse(x$Size < 1, paste0(insight::format_value(x$Size * 100), "%"), "100%")
  }
  if ("Part" %in% names(x)) {
    x$Part <- insight::format_value(x$Part, protect_integers = TRUE)
  }

  insight::format_table(x, ...)
}


#' @export
format.visualisation_matrix <- function(x, ...) {
  x
}


#' @export
format.summary_estimate_slopes <- function(x, ...) {
  dots <- list(...)
  dots$select <- NULL
  do.call(insight::format_table, c(list(x, select = NULL), dots))
}


#' @export
format.marginaleffects_means <- function(x, model, ci = 0.95, ...) {
  # model information
  model_data <- insight::get_data(model, verbose = FALSE)
  info <- attributes(x)$model_info
  if (is.null(info)) {
    info <- insight::model_info(model, response = 1)
  }
  non_focal <- setdiff(colnames(model_data), attr(x, "focal_terms"))
  predict_type <- attributes(x)$predict
  transform <- attributes(x)$transform
  context_effects <- attributes(x)$context_effects

  # special attributes we get from "get_marginalcontrasts()"
  comparison <- list(...)$hypothesis
  is_contrast_analysis <- !is.null(comparison)

  # define all columns that should be removed
  remove_columns <- c("s.value", "S", "CI", "rowid_dedup", non_focal, equivalence_columns)

  # do we have contrasts? For contrasts, we want to keep p-values
  if (.is_inequality_comparison(comparison)) {
    estimate_name <- switch(
      comparison,
      inequality_ratio_pairwise = "Mean_Ratio_Difference",
      inequality_ratio = "Mean_Ratio",
      "Mean_Difference"
    )
    # for inequality analysis, we want to keep the stratification variable
    remove_columns <- setdiff(remove_columns, attributes(x)$hypothesis_by)
  } else if (isTRUE(context_effects)) {
    # for contrasting average slopes (context effects), the estimate might be
    # an odds ratio or IRR by default - thus, we want to keep those names
    estimate_name <- .guess_estimate_name(predict_type, transform, info)
    if (identical(estimate_name, "Mean")) {
      estimate_name <- "Difference"
    }
    # for context analysis, we want to keep the stratification variable
    remove_columns <- setdiff(remove_columns, attributes(x)$hypothesis_by)
  } else if (is_contrast_analysis) {
    estimate_name <- "Difference"
  } else if (inherits(x, "marginal_jointtest")) {
    estimate_name <- "Estimate"
  } else {
    # for simple means, we don't want p-values
    remove_columns <- c(remove_columns, "p")
    # estimate name
    estimate_name <- .guess_estimate_name(predict_type, transform, info)
  }

  # reshape and format columns
  params <- .standardize_marginaleffects_columns(
    x,
    remove_columns,
    model,
    model_data,
    info,
    ci,
    estimate_name,
    is_contrast_analysis,
    ...
  )

  .set_back_attributes(x, params)
}


#' @export
format.marginaleffects_slopes <- function(x, model, ci = 0.95, ...) {
  # model information
  info <- attributes(x)$model_info
  if (is.null(info)) {
    info <- insight::model_info(model, response = 1)
  }
  model_data <- insight::get_data(model, verbose = FALSE)
  # define all columns that should be removed
  remove_columns <- c(
    "Predicted",
    "s.value",
    "S",
    "CI",
    "rowid_dedup",
    equivalence_columns
  )
  # for contrasting slope, we need to keep the "Parameter" column
  # however, for estimating trends/slope, the "Parameter" column is usually
  # redundant. Since we cannot check for class-attributes, we simply check if
  # all values are identical
  if ("term" %in% colnames(x) && insight::has_single_value(x$term, remove_na = TRUE)) {
    remove_columns <- c("Parameter", remove_columns)
  }
  # there are some exceptions for `estimate_slope()`, when the `Comparison`
  # column contains information about the type of slope (dx/dy etc.). we want
  # to remove this here, but add information as attribute.
  if ("contrast" %in% colnames(x) && all(x$contrast %in% .marginaleffects_slopes())) {
    remove_columns <- c("Comparison", "contrast", remove_columns)
    attr(x, "slope") <- unique(x$contrast)
  }
  # reshape and format columns
  params <- .standardize_marginaleffects_columns(
    x,
    remove_columns,
    model,
    model_data,
    info,
    ci,
    estimate_name = "Slope",
    ...
  )

  .set_back_attributes(x, params)
}


#' @export
format.marginaleffects_contrasts <- function(
  x,
  model = NULL,
  p_adjust = NULL,
  comparison = NULL,
  ...
) {
  predict <- attributes(x)$predict
  by <- attributes(x)$by
  contrast <- attributes(x)$contrast
  contrast_filter <- attributes(x)$contrast_filter
  focal_terms <- attributes(x)$focal_terms
  dgrid <- attributes(x)$datagrid

  # for slopes, sanity check - we may have duplicated "by" columns, e.g. when
  # user requests grouping for by-terms by combining "by" and "comparison" with
  # group-formula:
  # estimate_contrasts(m, "time", by = c("education", "grp"), comparison = ~pairwise | grp)
  # in this example, we would have "grp" and "grp.1"
  if (inherits(x, "estimate_slopes")) {
    x[paste0(by, ".1")] <- NULL
  }

  # sanity check - method "get_marginalmeans()" calls "format.estimate_means()"
  # for printing, and that method doesn't pass "comparison" - thus, we have to
  # extract it from the attributes
  if (is.null(comparison)) {
    comparison <- attributes(x)$comparison
  }

  # clean "by" and contrast variable names, for the special cases. for example,
  # if we have `by = "name [fivenum]"`, we just want "name"
  for (i in focal_terms) {
    if (!is.null(by) && any(startsWith(by, i)) && !any(by %in% i)) {
      # this line could be replaced by strsplit(by, "[^0-9A-Za-z\\._]")[[1]][1]
      by[startsWith(by, i)] <- i
    }
    if (!is.null(contrast) && any(startsWith(contrast, i)) && !any(contrast %in% i)) {
      contrast[startsWith(contrast, i)] <- i
    }
  }

  # check type of contrast
  is_ratio_comparison <- inherits(comparison, "formula") &&
    identical(deparse(comparison[[2]]), "ratio")

  # Column name for coefficient - fix needed for contrasting slopes and ratios
  colnames(x)[colnames(x) == "Slope"] <- "Difference"
  separator <- "-"

  # for ratios, we want different column name, and we need to set the separator
  if (is_ratio_comparison) {
    colnames(x)[colnames(x) == "Difference"] <- "Ratio"
    separator <- "/"
  }

  # for contrasting slopes, we do nothing more here. for other contrasts,
  # we prettify labels now. For special inequality contrasts, we also need no
  # cleaning, so we skip here, too

  if (!is.null(comparison) && !.is_inequality_comparison(comparison)) {
    # the goal here is to create tidy columns with the comparisons.
    # marginaleffects returns a single column that contains all levels that
    # are contrasted. We want to have the contrasted levels per predictor in
    # a separate column. This is what we do here...
    params <- as.data.frame(do.call(
      rbind,
      lapply(x$Parameter, .split_at_minus_outside_parentheses, separator = separator)
    ))

    # we *could* stop here and simply rename the split columns, but then
    # we cannot filter by `by` - thus, we go on, extract all single levels,
    # combine only relevant levels and then we're able to filter...

    # If we have, for example, `contrast = c("vs", "am"), by = "gear='5'"`, the
    # `by` column is the one with one unique value only, we thus have to update
    # `by`, and also `contrast` (the latter not(!) for numerics)...
    by <- by[lengths(lapply(dgrid[by], unique)) > 1]

    # for slopes, we have our "levels" in the by-variable, because `by` indicates
    # the levels for which slopes are contrasted - thus, we replace contrast with by
    if (inherits(x, "estimate_slopes")) {
      contrast <- by
      by <- NULL
    }

    # for contrasts, we also filter variables with one unique value, but we
    # keep numeric variables. When these are hold constant in the data grid,
    # they are set to their mean value - meaning, they only have one unique
    # value in the data grid, anyway. so we need to keep them.
    keep_contrasts <- lengths(lapply(dgrid[contrast], unique)) > 1 |
      vapply(dgrid[contrast], is.numeric, logical(1)) # nolint
    contrast <- contrast[keep_contrasts]

    # set to NULL, if all by-values have been removed here
    if (!length(by)) {
      by <- NULL
    }

    # if we have no contrasts left, e.g. due to `contrast = "time = factor(2)"`,
    # we error here - we have no contrasts to show
    if (!length(contrast)) {
      insight::format_error("No contrasts to show. Please adjust `contrast`.")
    }

    # for more than one term, we have comma-separated levels.
    if (length(contrast) > 1) {
      # levels may contain the separator char. to be 100% certain we extract
      # levels correctly, we now replace levels with a special "token", and later
      # replace those tokens with the original levels again

      # extract all comparison levels, separately for numerics and factors/character
      # we have to do this for numeric values and factors&character separately,
      # because we need different regular expressions when "escaping" the "levels"
      # of our focal predictors. we do this escaping because we want each
      # contrasted level-combination in an own column.
      all_levels <- all_num_levels <- NULL
      # find numeric focal terms
      numeric_focals <- vapply(dgrid[contrast], is.numeric, logical(1))
      # extract levels of non-numerics
      if (!all(numeric_focals)) {
        all_levels <- unlist(
          lapply(dgrid[contrast[!numeric_focals]], function(i) as.character(unique(i))),
          use.names = FALSE
        )
      }
      # extract levels of non-numerics
      if (any(numeric_focals)) {
        all_num_levels <- unlist(
          lapply(dgrid[contrast[numeric_focals]], function(i) as.character(unique(i))),
          use.names = FALSE
        )
      }
      # create replacement vector
      replace_levels <- replace_num_levels <- NULL
      # this looks strange, but we need to make sure we have unique tokens that
      # do not contain any letters or numbers, or similar characters that may
      # appear as a single level in the data. thus, we use a sequence of "~"
      # characters, which are unlikely to appear in the data
      for (i in seq_along(all_levels)) {
        replace_levels <- c(
          replace_levels,
          paste0("#", paste(rep_len("~", i), collapse = ""), "#")
        )
      }
      for (i in seq_along(all_num_levels)) {
        replace_num_levels <- c(
          replace_num_levels,
          paste0("#", paste(rep_len("@", i), collapse = ""), "#")
        )
      }

      # replace all comparison levels with tokens
      params[] <- lapply(params, function(comparison_pair) {
        for (j in seq_along(all_num_levels)) {
          comparison_pair <- sub(
            all_num_levels[j],
            replace_num_levels[j],
            comparison_pair
          )
        }
        for (j in seq_along(all_levels)) {
          comparison_pair <- sub(
            paste0("\\<", all_levels[j], "\\>"),
            replace_levels[j],
            comparison_pair
          )
        }
        # remove multiple spaces
        gsub("[[:space:]]{2,}", " ", comparison_pair)
      })

      # we now have a data frame with each comparison-pairs as single column.
      # next, we need to separate the levels from the different variables at the
      # separator char, "," for old marginaleffects, "_" for new marginaleffects
      params <- datawizard::data_separate(
        params,
        separator = "[_, ]",
        guess_columns = "max",
        verbose = FALSE
      )
      new_colnames <- paste0(rep.int(contrast, 2), rep(1:2, each = length(contrast)))

      # finally, replace all tokens with original comparison levels again
      params[] <- lapply(params, function(comparison_pair) {
        for (j in seq_along(all_levels)) {
          comparison_pair <- sub(
            replace_levels[j],
            all_levels[j],
            comparison_pair,
            fixed = TRUE
          )
        }
        for (j in seq_along(all_num_levels)) {
          comparison_pair <- sub(
            replace_num_levels[j],
            all_num_levels[j],
            comparison_pair,
            fixed = TRUE
          )
        }
        comparison_pair
      })
    } else {
      new_colnames <- paste0(contrast, 1:2)
    }

    # sanity check - for some edgecases, we have fewer columns than expected
    # then just don't prettify anything
    if (length(new_colnames) == ncol(params)) {
      colnames(params) <- new_colnames

      # make sure all whitespaces are removed
      params[] <- lapply(params, insight::trim_ws)

      # if we have more than one contrast term, we unite the levels from
      # all contrast terms that belong to one "contrast group", separated
      # by comma, and each the two "new contrast groups" go into separate
      # columns named "Level1" and "Level2". For one contrast term, we just
      # need to rename the columns
      if (length(contrast) == 1) {
        # we define this object to avoid scoping issues in data_rename(),
        # see https://github.com/easystats/modelbased/issues/401
        rename_columns <- paste0(contrast, 1:2)
        # rename columns
        params <- datawizard::data_rename(
          params,
          select = rename_columns,
          replacement = c("Level1", "Level2"),
          verbose = FALSE
        )
      } else {
        # prepare all contrast terms
        for (i in 1:2) {
          contrast_names <- paste0(contrast, i)
          params <- .fix_duplicated_contrastlevels(params, contrast_names)
          # finally, unite levels back into single column
          rename_columns <- paste0("Level", i)
          params <- datawizard::data_unite(
            params,
            new_column = rename_columns,
            select = contrast_names,
            separator = ", ",
            verbose = FALSE
          )
        }
      }

      # we need to update these variables, because these are the new column
      # names for contrasts and focal terms
      contrast <- c("Level1", "Level2")

      # remove old column
      x$Parameter <- NULL

      # add back new columns
      x <- cbind(params[contrast], x)

      # make sure terms are factors, for data_arrange later
      for (i in contrast) {
        x[[i]] <- factor(x[[i]], levels = unique(x[[i]]))
      }

      # filter contrast-predictor levels, if requested (e.g., `contrast = "x=c('a', 'b')"`)
      # we also need to include non-filtered contrast-predictors here, because
      # if we have more than one contrast-predictor, we don't have the single
      # values, but comma-separated levels from all predictor-combinations. we
      # need to reconstruct these combinations for proper filtering
      if (!is.null(contrast_filter)) {
        # make sure we also have all levels for non-filtered variables
        contrast_filter <- insight::compact_list(c(
          lapply(
            dgrid[setdiff(focal_terms, unique(c(by, names(contrast_filter))))],
            unique
          ),
          contrast_filter
        ))
        # now create combinations of all filter variables
        filter_levels <- apply(expand.grid(contrast_filter), 1, paste, collapse = ", ")
        # sanity check anything left after filtering? else, filter already worked before
        filtered_rows <- x$Level1 %in% filter_levels & x$Level2 %in% filter_levels
        # filter...
        if (any(filtered_rows)) {
          x <- x[filtered_rows, ]
        }
      }
    }
  }

  # remove () for single columns
  if ("Parameter" %in% colnames(x)) {
    x$Parameter <- gsub("(", "", gsub(")", "", x$Parameter, fixed = TRUE), fixed = TRUE)
  }

  x
}


# Helper ----------------------------------------------------------------------
# -----------------------------------------------------------------------------

# since we combine levels from different factors, we have to make
# sure levels are unique across different terms. If not, paste
# variable names to levels. We first find the intersection of all
# levels from all current contrast terms

.fix_duplicated_contrastlevels <- function(params, contrast_names) {
  multiple_levels <- Reduce(
    function(i, j) intersect(i, j),
    lapply(params[contrast_names], unique),
    accumulate = FALSE
  )
  # if we find any intersections, we have identical labels for different
  # terms in one "contrast group" - we thus add the variable name to the
  # levels, to avoid identical levels without knowing to which factor
  # it belongs
  if (length(multiple_levels)) {
    for (cn in contrast_names) {
      params[[cn]] <- paste(gsub(".{1}$", "", cn), params[[cn]])
    }
  }
  params
}


# fmt: skip
equivalence_columns <- c(
  "statistic.noninf", "statistic.nonsup", "p.value.noninf", "p.value.nonsup",
  "p_Nonsuperiority", "p_Noninferiority"
)


# This function renames columns to have a consistent naming scheme,
# and relocates columns to get a standardized column order across all
# outputs from {marginaleffects}

#' @keywords internal
.standardize_marginaleffects_columns <- function(
  x,
  remove_columns,
  model,
  model_data,
  info,
  ci = 0.95,
  estimate_name = NULL,
  is_contrast_analysis = FALSE,
  ...
) {
  # tidy output - we want to tidy the output, using `model_parameters()` or
  # `describe_posterior()` for Bayesian models. We also need to know how the
  # coefficient column is named, because we replace that column name with an
  # appropriate name of the predictions (e.g. "Difference", "Probability" or
  # "Mean")
  params <- .safe(suppressWarnings(parameters::model_parameters(
    x,
    ci = ci,
    diagnostic = NULL,
    verbose = FALSE,
    ...
  )))

  # sanity check - if we have joint tests for categorical predictors, we
  # cannot clean using `model_parameters()`
  if (is.null(params)) {
    params <- insight::standardize_names(as.data.frame(x))
  }

  # the different functions and models (Bayesian, frequentist) have different
  # column names for their "coefficient". We now extract the relevant one.
  possible_colnames <- c(
    attributes(params)$coefficient_name,
    "Coefficient",
    "Slope",
    "Predicted",
    "Median",
    "Mean",
    "MAP"
  )
  coefficient_name <- intersect(possible_colnames, colnames(params))[1]
  # we need to remove some more columns
  remove_columns <- c(remove_columns, "rowid")
  # and modify the estimate name - if it's not a dpar
  if (
    .is_bayesian_marginaleffects(x) &&
      !is.null(estimate_name) &&
      !tolower(estimate_name) %in% .brms_aux_elements()
  ) {
    estimate_name <- coefficient_name
  }
  # rename the "term" and "hypothesis" column (which we get from contrasts)
  colnames(params)[colnames(params) == "term"] <- "Parameter"
  colnames(params)[colnames(params) == "hypothesis"] <- "Parameter"

  # add back ci? these are missing when contrasts are computed
  params <- .add_contrasts_ci(is_contrast_analysis, params)

  # fmt: skip
  # relocate columns - this is the standardized column order for all outputs
  relocate_columns <- intersect(
    unique(c(
      coefficient_name, "Coefficient", "Slope", "Predicted", "Median", "Mean",
      "MAP", "SE", "CI_low", "CI_high", "Statistic", "df", "df_error", "pd",
      "ps", "ROPE_low", "ROPE_high", "ROPE_Percentage", "p", "p_Equivalence"
    )),
    colnames(params)
  )
  params <- params[c(setdiff(colnames(params), relocate_columns), relocate_columns)]

  # relocate focal terms to the beginning
  by <- attr(x, "focal_terms", exact = TRUE)
  if (!is.null(by) && all(by %in% colnames(params))) {
    params <- datawizard::data_reorder(params, by, verbose = FALSE)
  }

  # rename coefficient name and statistics columns
  if (!is.null(estimate_name)) {
    colnames(params)[colnames(params) == coefficient_name] <- estimate_name
  }
  # marginaleffects objects return z-statistic by default, unless we change it
  # via the degrees-of-freedom argument
  if (inherits(x, "marginal_jointtest")) {
    if (all(c("df1", "df2") %in% colnames(params))) {
      stat_column <- "F"
    } else {
      stat_column <- "Chi2"
    }
  } else if (is.null(params$df) || all(is.infinite(params$df))) {
    stat_column <- "z"
  } else {
    stat_column <- "t"
  }
  colnames(params)[colnames(params) == "Statistic"] <- stat_column

  # remove redundant columns
  params <- datawizard::data_remove(params, remove_columns, verbose = FALSE) # nolint

  # remove df column if it's only "Inf" (new since version ‘0.25.1.8’)
  all_inf_values <- vapply(params, function(i) all(is.infinite(i)), logical(1))
  if (any(all_inf_values)) {
    params[all_inf_values] <- NULL
  }

  # Rename for Categorical family
  if (
    info$is_multinomial ||
      info$is_categorical ||
      info$is_ordinal ||
      info$is_cumulative ||
      insight::is_multivariate(model)
  ) {
    params <- .safe(datawizard::data_rename(params, "group", "Response"), params)
  } else if (info$is_mixture) {
    params <- .safe(datawizard::data_rename(params, "group", "Class"), params)
  }

  # extract information for potential inequality analysis
  by_terms <- attributes(x)$hypothesis_by
  comparison_hypothesis <- list(...)$hypothesis

  # fix labels for inequality pairwise analysis
  if (.is_inequality_comparison(comparison_hypothesis)) {
    # fix for pairwise inequality labels - these are named like "(b1) - (b2)" etc.
    # but we want the original labels instead of b1, b2 etc.
    if (
      comparison_hypothesis %in%
        c("inequality_pairwise", "inequality_ratio_pairwise") &&
        !is.null(by_terms)
    ) {
      # clean parameter names
      parameter_names <- gsub(
        ")",
        "",
        gsub("(", "", params$Parameter, fixed = TRUE),
        fixed = TRUE
      )
      # extract data for by-variable
      by_var <- model_data[[by_terms]]
      # make sure we have a factor
      if (is.character(by_var)) {
        by_var <- factor(by_var, levels = unique(by_var))
      }
      # extract levels
      by_levels <- levels(by_var)
      # iterate over all parameter names and replace b1 to bx with the by-levels
      parameter_names <- vapply(
        parameter_names,
        function(i) {
          # replace b1 with first by-level, b2 with second by-level, etc.
          for (j in seq_along(by_levels)) {
            i <- sub(paste0("b", j), by_levels[j], i, fixed = TRUE)
          }
          i
        },
        character(1)
      )
      # finally, assign back to the Parameter column
      params$Parameter <- parameter_names
    }

    # fix labels for inequality analysis for slopes
    if (
      comparison_hypothesis %in%
        c("inequality", "inequality_ratio") &&
        isTRUE(attributes(x)$contrast_slopes)
    ) {
      # for slopes, we either have the trend variable, or only the grouping,
      # but not the "inequality" variabe (the first in "by"). Update labels,
      # so users know by which variables slopes are averaged and grouped
      if (is.null(by_terms)) {
        params$Parameter <- attributes(x)$by
      } else {
        colnames(params)[colnames(params) == by_terms] <- "Parameter"
        params$Parameter <- paste0(attributes(x)$by[1], ": ", params$Parameter)
      }
    }
  }

  # finally, make sure we have original data types
  params <- data.frame(datawizard::data_restoretype(params, model_data))

  # add posterior draws?
  insight::check_if_installed("marginaleffects", minimum_version = "0.29.0")
  posterior_draws <- suppressWarnings(as.data.frame(marginaleffects::get_draws(
    x,
    shape = "PxD"
  )))

  if (nrow(posterior_draws) > 0) {
    # how many?
    keep_iterations <- attributes(x)$keep_iterations
    # check if user wants to keep any posterior draws
    if (isTRUE(keep_iterations) || is.numeric(keep_iterations)) {
      # keep all iterations when `TRUE`
      if (isTRUE(keep_iterations)) {
        keep_iterations <- ncol(posterior_draws)
      }
      colnames(posterior_draws) <- paste0("iter_", seq_len(ncol(posterior_draws)))
      params <- cbind(params, posterior_draws[, 1:keep_iterations, drop = FALSE])
    }
  }

  params
}


# This function ensures that the formatted object still has all relevant
# information saved as attributes

#' @keywords internal
.set_back_attributes <- function(x, formatted_params) {
  attributes(formatted_params) <- utils::modifyList(
    attributes(formatted_params),
    attributes(x)[.info_elements()]
  )
  formatted_params
}


# for contrasts analysis, CIs are not computed automatically. The `format()`
# methods adds back those CIs by calling this function.

#' @keywords internal
.add_contrasts_ci <- function(is_contrast_analysis, params) {
  if (
    is_contrast_analysis && !"CI_low" %in% colnames(params) && "SE" %in% colnames(params)
  ) {
    # extract ci-level
    if ("CI" %in% colnames(params)) {
      ci <- params[["CI"]][1]
    } else {
      ci <- attributes(params)$ci
    }
    if (is.null(ci)) {
      ci <- 0.95
    }
    # get degrees of freedom
    if ("df" %in% colnames(params)) {
      dof <- params[["df"]]
    } else {
      dof <- Inf
    }
    # critical test value
    crit <- stats::qt((1 + ci) / 2, df = dof)
    # add CI
    params$CI_low <- params$Predicted - crit * params$SE
    params$CI_high <- params$Predicted + crit * params$SE
  }
  params
}


# this function tries to find the most approriate name of the estimates / predictions,
# based on on which scale predictions were requested

#' @keywords internal
.guess_estimate_name <- function(predict_type, transform = NULL, info) {
  # estimate name
  if (is.null(predict_type)) {
    estimate_name <- "Mean"
  } else if (tolower(predict_type) %in% .brms_aux_elements()) {
    # for Bayesian models with distributional parameter
    estimate_name <- tools::toTitleCase(predict_type)
  } else if (
    !predict_type %in% c("none", "link") &&
      (info$is_binomial || info$is_bernoulli || info$is_multinomial)
  ) {
    # here we add all models that model the probability of an outcome, such as
    # binomial, multinomial, or Bernoulli models
    estimate_name <- "Probability"
  } else if (
    predict_type %in%
      c("none", "link") &&
      identical(transform, "exp") &&
      (info$is_binomial || info$is_bernoulli || info$is_multinomial)
  ) {
    # here we add all models that have odds ratios as exponentiated coefficients
    estimate_name <- "Odds_Ratio"
  } else if (
    predict_type %in% c("none", "link") && identical(transform, "exp") && (info$is_count)
  ) {
    # here we add all models that have IRRs as exponentiated coefficients
    estimate_name <- "IRR"
  } else if (predict_type == "survival" && info$is_survival) {
    # this is for survival models, where we want to predict the survival probability
    estimate_name <- "Probability"
  } else if (predict_type %in% c("zprob", "zero")) {
    # this is for zero-inflated models, where we want to predict the probability
    # of a zero-inflated outcome
    estimate_name <- "Probability"
  } else if (
    predict_type %in%
      c("response", "invlink(link)") &&
      (info$is_beta || info$is_orderedbeta)
  ) {
    # this is for beta regression models, where we want to predict the mean
    # value of the outcome, which is a proportion
    estimate_name <- "Proportion"
  } else {
    # for all other models, we simply use "Mean"
    estimate_name <- "Mean"
  }
  estimate_name
}


# this function is used for "estimate_contrasts()", to split the Parameter
# column into single term columns. {marginaleffects} combines factor levels of
# different comparisons using "-". For factor levels containing "-", the groups
# are put in parentheses. This function splits a string at "-" if it's outside
# parentheses

#' @keywords internal
.split_at_minus_outside_parentheses <- function(input_string, separator = "-") {
  # we split at "-" for differences, and at "/" for ratios
  if (identical(separator, "/")) {
    parts <- unlist(strsplit(input_string, "/", fixed = TRUE), use.names = FALSE)
  } else {
    pattern <- "\\(([^()]*)\\)|-" # find all the parentheses and the -
    matches <- gregexpr(pattern, input_string, perl = TRUE)
    match_positions <- matches[[1]]
    match_lengths <- attr(matches[[1]], "match.length")

    split_positions <- 0
    for (i in seq_along(match_positions)) {
      if (substring(input_string, match_positions[i], match_positions[i]) == "-") {
        inside_parentheses <- FALSE
        for (j in seq_along(match_positions)) {
          if (
            i != j &&
              match_positions[i] > match_positions[j] &&
              match_positions[i] < (match_positions[j] + match_lengths[j])
          ) {
            inside_parentheses <- TRUE
            break
          }
        }
        if (!inside_parentheses) {
          split_positions <- c(split_positions, match_positions[i])
        }
      }
    }
    split_positions <- c(split_positions, nchar(input_string) + 1)

    parts <- NULL
    for (i in 1:(length(split_positions) - 1)) {
      parts <- c(
        parts,
        substring(input_string, split_positions[i] + 1, split_positions[i + 1] - 1)
      )
    }
  }

  parts <- insight::trim_ws(parts)
  gsub("(", "", gsub(")", "", parts, fixed = TRUE), fixed = TRUE)
}
