#' Score model output predictions
#'
#' Scores model outputs with a single `output_type` against observed data.
#'
#' @param model_out_tbl Model output tibble with predictions
#' @param oracle_output Predictions that would have been generated by an oracle
#' model that knew the observed target data values in advance
#' @param metrics Character vector of scoring metrics to compute. If `NULL`
#' (the default), appropriate metrics are chosen automatically. See details
#' for more.
#' @param relative_metrics Character vector of scoring metrics for which to
#' compute relative skill scores. The `relative_metrics` should be a subset of
#' `metrics` and should only include proper scores. Interval coverage metrics
#' (e.g., `"interval_coverage_90"`) and `"bias"` are not supported as relative
#' metrics: interval coverage targets a nominal level rather than a "lower is
#' better" direction, and bias is a signed quantity for which a geometric-mean
#' pairwise ratio has no clean interpretation. If `NULL` (the default), no
#' relative metrics will be computed. Relative metrics are only computed if
#' `summarize = TRUE`, and require that `"model_id"` is included in `by`.
#' Relative skill is computed within each comparison group (the `by` columns
#' other than `"model_id"`). If a comparison group contains only one model,
#' that group's relative-skill columns are filled with `1` (a model has trivial
#' skill `1` relative to itself) rather than erroring.
#' @param baseline String with the name of a model to use as a baseline for
#' relative skill scores. If a baseline is given, then a scaled relative skill
#' with respect to the baseline will be returned. By default (`NULL`), relative
#' skill will not be scaled with respect to a baseline model. If the baseline is
#' absent from a comparison group, that group's relative and scaled relative
#' skill are reported as `NA` (with a warning) while its absolute scores are
#' still returned. This `NA` case only arises when scoring is disaggregated:
#' with `by = "model_id"` alone there is a single comparison group containing
#' every model, so relative skill is always defined and is never `NA`. A
#' baseline absent from the data entirely is an error.
#' @param summarize Boolean indicator of whether summaries of forecast scores
#' should be computed. Defaults to `TRUE`.
#' @param by Character vector naming columns to summarize by. For example,
#' specifying `by = "model_id"` (the default) will compute average scores for
#' each model.
#' @param output_type_id_order For ordinal variables in pmf format, this is a
#' vector of levels for pmf forecasts, in increasing order of the levels. The
#' order of the values for the output_type_id can be found by referencing the
#' hub's tasks.json configuration file. For all output types other than pmf,
#' this is ignored.
#' @param compound_taskid_set When `NULL` (the default), sample forecasts are
#' scored marginally (each modeling task scored independently). When a character
#' vector of task ID column names is provided, it sets the compound grouping:
#' the specified columns stay constant within each sample draw, while the
#' remaining task ID dimensions vary within a draw and are scored jointly
#' (using the energy score). Only applicable when
#' `output_type == "sample"`. The value of `compound_taskid_set` can be found
#' by referencing the hub's `tasks.json` configuration file.
#' @param transform A function to apply as a scale transformation to both
#'   predictions and observations before scoring. Common choices include
#'   \code{\link[scoringutils]{log_shift}} (recommended for log transformation
#'   as it handles zeros via an offset parameter), \code{sqrt}, or
#'   \code{log1p}. Avoid using \code{log} directly if data may contain zeros.
#'   If `NULL` (the default), no transformation is applied. Only supported for
#'   quantile, mean, and median output types.
#' @param transform_append Logical. If `FALSE` (the default), scores are
#'   computed only on the transformed scale. If `TRUE`, scores are computed on
#'   both original and transformed scales, with a `scale` column distinguishing
#'   them. Ignored if `transform = NULL`.
#' @param transform_label A character string label for the transformation
#'   (e.g., "log"). If `NULL` (the default), the label is auto-generated from
#'   the function name (e.g., "log_shift" for `scoringutils::log_shift`).
#'   Required when using an anonymous transform function. Ignored if
#'   `transform = NULL`. Note: the label only appears in output when
#'   `transform_append = TRUE`, where it distinguishes transformed rows
#'   (labeled with this value) from original rows (labeled "natural") in the
#'   `scale` column.
#' @param ... Additional arguments passed to the `transform` function. For
#'   example, allows use of the `offset` and `base` arguments of
#'   [scoringutils::log_shift()]. Ignored if `transform = NULL`.
#'
#' @details
#' See the hubverse documentation for the expected format of the
#' [oracle output data](https://docs.hubverse.io/en/latest/user-guide/target-data.html#oracle-output).
#'
#' Default metrics are provided by the `scoringutils` package. You can select
#' metrics by passing in a character vector of metric names to the `metrics`
#' argument.
#'
#' The following metrics can be selected (all are used by default) for the
#' different `output_type`s:
#'
#' **Quantile forecasts:** (`output_type == "quantile"`)
#' `r ex <- c("interval_coverage_50", "interval_coverage_90")`
#' `r .metrics_list(scoringutils::example_quantile, exclude = ex)`
#' - "interval_coverage_XX": interval coverage at the "XX" level. For example,
#' "interval_coverage_95" is the 95% interval coverage rate, which would be calculated
#' based on quantiles at the probability levels 0.025 and 0.975.
#'
#' See [scoringutils::get_metrics.forecast_quantile] for details.
#'
#' **Nominal forecasts:** (`output_type == "pmf"` and `output_type_id_order` is `NULL`)
#'
#' `r .metrics_list(scoringutils::example_nominal)`
#'
#' See [scoringutils::get_metrics.forecast_nominal] for details.
#'
#' **Ordinal forecasts:** (`output_type == "pmf"` and `output_type_id_order` is a vector)
#'
#' `r .metrics_list(scoringutils::example_ordinal)`
#'
#' See [scoringutils::get_metrics.forecast_ordinal] for details.
#'
#' **Median forecasts:** (`output_type == "median"`)
#'
#' - ae_point: absolute error of the point forecast (recommended for the median, see Gneiting (2011))
#'
#' See [scoringutils::get_metrics.forecast_point] for details.
#'
#' **Mean forecasts:** (`output_type == "mean"`)
#' - `se_point`: squared error of the point forecast (recommended for the mean, see Gneiting (2011))
#'
#' **Sample forecasts (marginal):** (`output_type == "sample"`, `compound_taskid_set = NULL`)
#'
#' `r .metrics_list(scoringutils::example_sample_continuous)`
#'
#' Note: `log_score` uses kernel density estimation, which may not be
#' appropriate for integer-valued forecasts. `scoringutils` will warn when
#' this is detected.
#'
#' See [scoringutils::get_metrics.forecast_sample] for details.
#'
#' **Sample forecasts (compound):** (`output_type == "sample"`, `compound_taskid_set` provided)
#'
#' `r .metrics_list(scoringutils::example_multivariate_sample)`
#'
#' See [scoringutils::get_metrics.forecast_multivariate_sample] for details.
#' The output includes a `.mv_group_id` column assigned by `scoringutils` to
#' identify the multivariate groups used for scoring (equivalent to the
#' `compound_idx` concept in the
#' [hubverse sample output type documentation
#' ](https://docs.hubverse.io/en/latest/user-guide/sample-output-type.html)).
#' Correct scoring depends on providing the right `compound_taskid_set` from
#' the hub's `tasks.json` configuration. If the specified grouping does not
#' match the actual dependence structure of the submitted samples (e.g.,
#' because some models submitted coarser samples than configured),
#' `.mv_group_id` may not correspond to the original sample draws as
#' indicated by their `output_type_id` values.
#'
#' See [scoringutils::add_relative_skill] for details on relative skill scores.
#'
#' @examplesIf requireNamespace("hubExamples", quietly = TRUE)
#' # compute WIS and interval coverage rates at 80% and 90% levels based on
#' # quantile forecasts, summarized by the mean score for each model
#' quantile_scores <- score_model_out(
#'   model_out_tbl = hubExamples::forecast_outputs |>
#'     dplyr::filter(.data[["output_type"]] == "quantile"),
#'   oracle_output = hubExamples::forecast_oracle_output,
#'   metrics = c("wis", "interval_coverage_80", "interval_coverage_90"),
#'   relative_metrics = "wis",
#'   by = "model_id"
#' )
#' quantile_scores
#'
#' # compute log scores based on pmf predictions for categorical targets,
#' # summarized by the mean score for each combination of model and location.
#' # Note: if the model_out_tbl had forecasts for multiple targets using a
#' # pmf output_type with different bins, it would be necessary to score the
#' # predictions for those targets separately.
#' pmf_scores <- score_model_out(
#'   model_out_tbl = hubExamples::forecast_outputs |>
#'     dplyr::filter(.data[["output_type"]] == "pmf"),
#'   oracle_output = hubExamples::forecast_oracle_output,
#'   metrics = c("log_score", "rps"),
#'   by = c("model_id", "location", "horizon"),
#'   output_type_id_order = c("low", "moderate", "high", "very high")
#' )
#' head(pmf_scores)
#'
#' # Score sample forecasts marginally (each modeling task scored independently).
#' # Note: this data has compound structure (samples span horizons), but marginal
#' # scoring is still valid -- it evaluates each horizon independently.
#' sample_scores <- score_model_out(
#'   model_out_tbl = hubExamples::forecast_outputs |>
#'     dplyr::filter(.data[["output_type"]] == "sample"),
#'   oracle_output = hubExamples::forecast_oracle_output,
#'   metrics = "crps",
#'   by = "model_id"
#' )
#' sample_scores
#'
#' # Score compound sample forecasts jointly using the energy score.
#' # compound_taskid_set specifies which task IDs stay constant within
#' # a sample group -- here, each sample draw spans all horizons for a
#' # given reference_date and location (i.e., a trajectory over time).
#' compound_scores <- score_model_out(
#'   model_out_tbl = hubExamples::forecast_outputs |>
#'     dplyr::filter(.data[["output_type"]] == "sample"),
#'   oracle_output = hubExamples::forecast_oracle_output,
#'   compound_taskid_set = c("reference_date", "location"),
#'   by = "model_id"
#' )
#' compound_scores
#'
#' @return A tibble of scores, inheriting from scoringutils' `scores` class so
#' that downstream scoringutils helpers (e.g. [scoringutils::get_metrics()])
#' continue to work. The tibble has a `metrics` attribute holding the names of
#' the scoring rules that were applied.
#'
#' @references
#' Gneiting, Tilmann. 2011. "Making and Evaluating Point Forecasts." Journal of the
#' American Statistical Association 106 (494): 746–62. \doi{10.1198/jasa.2011.r10138}.
#'
#' @export
score_model_out <- function(
  model_out_tbl,
  oracle_output,
  metrics = NULL,
  relative_metrics = NULL,
  baseline = NULL,
  summarize = TRUE,
  by = "model_id",
  output_type_id_order = NULL,
  compound_taskid_set = NULL,
  transform = NULL,
  transform_append = FALSE,
  transform_label = NULL,
  ...
) {
  # check that model_out_tbl has a single output_type that is supported by this package
  # also, retrieve that output_type
  output_type <- validate_output_type(model_out_tbl)

  if (!is.null(compound_taskid_set) && output_type != "sample") {
    cli::cli_abort(
      "{.arg compound_taskid_set} is only applicable to sample output types,
      but {.arg model_out_tbl} has output type {.val {output_type}}."
    )
  }

  # Validate transformation parameters and capture expression for label inference
  transform_expr <- rlang::enexpr(transform)
  validate_transform(transform, transform_label, output_type)
  if (summarize) {
    # Note: The call to scoringutils::add_relative_skill below performs validation of `baseline`
    validate_relative_metrics(relative_metrics, metrics, by)
  }

  # assemble data for scoringutils
  su_data <- switch(
    output_type,
    quantile = transform_quantile_model_out(model_out_tbl, oracle_output),
    pmf = transform_pmf_model_out(
      model_out_tbl,
      oracle_output,
      output_type_id_order
    ),
    mean = transform_point_model_out(model_out_tbl, oracle_output, output_type),
    median = transform_point_model_out(
      model_out_tbl,
      oracle_output,
      output_type
    ),
    sample = transform_sample_model_out(
      model_out_tbl,
      oracle_output,
      compound_taskid_set
    ),
    NULL # default, should not happen because of the validation above
  )

  # Apply scale transformation if requested
  if (!is.null(transform)) {
    # Use the captured expression for label inference (e.g., "log_shift")
    label <- get_transform_label(transform_expr, transform_label)
    su_data <- scoringutils::transform_forecasts(
      su_data,
      fun = transform,
      append = transform_append,
      label = label,
      ...
    )
    validate_transform_values(su_data)
  }

  # get/validate the scoring metrics
  metrics <- get_metrics(
    forecast = su_data,
    output_type = output_type,
    select = metrics
  )

  # compute scores
  scores <- scoringutils::score(su_data, metrics)

  # switch back to hubverse naming conventions for model name
  scores <- dplyr::rename(scores, model_id = "model")

  # if requested, summarize scores, including computation of relative metrics
  if (summarize) {
    # Relative skill is a per-group quantity (one value per model per `by`
    # group, not per scored forecast unit). It is added here on the per-row
    # scores as a column that is constant within each (model_id, `by`) group,
    # then collapsed by summarize_scores() below to one row per group. Pairwise
    # comparison needs the per-row scores, so this must run before summarising.
    scores <- add_relative_skill_metrics(scores, relative_metrics, by, baseline)
    # BEGIN workaround mirror for https://github.com/epiforecasts/scoringutils/pull/1180
    # Mirror the upstream check (merged but not yet on CRAN) so the
    # user-facing behaviour of score_model_out() does not shift once we
    # bump the scoringutils minimum version and delete this block. Wording
    # and condition match the upstream implementation exactly.
    metric_cols <- intersect(colnames(scores), attr(scores, "metrics"))
    if (length(metric_cols) == 0) {
      cli::cli_abort(
        c(
          `!` = "No score columns to summarise.",
          i = "The {.cls scores} object has no columns matching its
               {.code metrics} attribute. This usually means every metric
               passed to {.fn score} failed (e.g. warned and returned no
               values)."
        )
      )
    }
    # END workaround mirror for scoringutils#1180

    # When transform_append = TRUE, scoringutils emits both natural- and
    # transformed-scale rows distinguished by a `scale` column. Include
    # "scale" in `by` for the summary so the two scales are reported
    # separately rather than collapsed into a meaningless average. The
    # user-facing `by` argument is not modified outside this block.
    summary_by <- if (isTRUE(transform_append)) union(by, "scale") else by
    scores <- scoringutils::summarize_scores(scores = scores, by = summary_by)
  }

  # Convert to tibble for friendlier user-facing behaviour, but keep the
  # `scores` class on top so scoringutils helpers (e.g. get_metrics) still
  # dispatch. The `metrics` attribute is preserved by as_tibble().
  scores <- tibble::as_tibble(scores)
  class(scores) <- c("scores", class(scores))
  scores
}


#' Add relative-skill columns to a per-row scores object
#'
#' Validates that any requested `baseline` is present in the data (a baseline
#' absent entirely is a user error), then delegates to
#' [add_relative_skill_by_group()], which computes relative skill within each
#' comparison group and gracefully handles groups scoringutils cannot compare
#' (single-model groups, or groups missing the baseline) instead of aborting.
#'
#' @noRd
add_relative_skill_metrics <- function(scores, relative_metrics, by, baseline) {
  if (length(relative_metrics) == 0L) {
    return(scores)
  }

  models <- unique(scores[["model_id"]])

  # A baseline must exist somewhere in the data. (A baseline missing from only
  # *some* comparison groups is handled gracefully by
  # add_relative_skill_by_group(); one absent entirely is a typo-style user
  # error and aborts here.)
  if (!is.null(baseline) && !baseline %in% models) {
    cli::cli_abort(c(
      "Requested {.arg baseline} {.val {baseline}} is not present in the data.",
      "i" = "Available models: {.val {models}}."
    ))
  }

  add_relative_skill_by_group(scores, relative_metrics, by, baseline)
}


#' Column names added by relative-skill scoring
#'
#' For each requested metric, scoringutils adds `<metric>_relative_skill`, plus
#' `<metric>_scaled_relative_skill` when a `baseline` is supplied. Returns those
#' names in the order the columns are produced.
#'
#' @noRd
relative_skill_col_names <- function(relative_metrics, baseline) {
  suffixes <- if (is.null(baseline)) {
    "_relative_skill"
  } else {
    c("_relative_skill", "_scaled_relative_skill")
  }
  purrr::map(relative_metrics, \(metric) paste0(metric, suffixes)) |>
    purrr::list_c()
}


#' Add relative-skill columns, classifying groups by how skill is produced
#'
#' Relative skill is computed within each comparison group: one combination of
#' the disaggregation columns (`by` without `"model_id"`), or a single group
#' spanning the whole data when there is no disaggregation. A group scoringutils
#' cannot score would otherwise abort the whole run (e.g. "Baseline comparator
#' `<name>` missing."), so each group is classified and handled instead.
#' Predictions in every group are still scoreable, so absolute scores stay
#' intact; only relative skill needs special handling.
#'
#' Each comparison group is one of:
#' * **computable** (>= 2 models, and the baseline present if one is requested):
#'   scored by scoringutils.
#' * **trivial** (a single model, with no baseline requested or where that lone
#'   model is the baseline): relative skill is `1` (a model has skill `1`
#'   relative to itself). This subsumes the single-model-everywhere case.
#' * **skipped** (a baseline was requested but is absent from the group, e.g. a
#'   baseline missing some of the `reference_date`s being scored when
#'   disaggregating by `reference_date`): relative skill is `NA`, with one
#'   warning naming the affected group levels. See #135.
#'
#' The caller ([add_relative_skill_metrics()]) has already checked that any
#' `baseline` is present somewhere in the data.
#'
#' @return `scores` with relative-skill columns added.
#' @noRd
add_relative_skill_by_group <- function(
  scores,
  relative_metrics,
  by,
  baseline
) {
  group_cols <- by[by != "model_id"]
  orig_metrics <- attr(scores, "metrics")
  skill_cols <- relative_skill_col_names(relative_metrics, baseline)

  # Classify each comparison group by how its relative skill must be produced
  # (see the function docs): computable groups are scored, trivial single-model
  # groups get 1, and groups missing a requested baseline are skipped to NA.
  # With no disaggregation `group_cols` is empty and this is a single group
  # spanning the whole data: that case (and single-model data) runs through
  # this same path rather than a fast early return, so the two cannot drift
  # apart, which is worth more than the small summarise/join overhead.
  group_status <- scores |>
    dplyr::group_by(dplyr::across(dplyr::all_of(group_cols))) |>
    dplyr::summarise(
      has_baseline = is.null(baseline) || baseline %in% .data[["model_id"]],
      n_models = dplyr::n_distinct(.data[["model_id"]]),
      .groups = "drop"
    )
  has_baseline <- group_status[["has_baseline"]]
  n_models <- group_status[["n_models"]]
  computable_groups <- group_status[
    has_baseline & n_models >= 2L,
    group_cols,
    drop = FALSE
  ]
  trivial_groups <- group_status[
    has_baseline & n_models < 2L,
    group_cols,
    drop = FALSE
  ]
  skipped_groups <- group_status[!has_baseline, group_cols, drop = FALSE]

  # Assemble one (model_id, group) -> relative-skill lookup, then broadcast it
  # onto the full scores. Skipped groups are absent from the lookup, so they
  # find no match in the join and become NA by construction.
  lookup <- dplyr::bind_rows(
    compute_skills(
      scores,
      computable_groups,
      group_cols,
      skill_cols,
      relative_metrics,
      baseline
    ),
    assign_trivial_skills(scores, trivial_groups, group_cols, skill_cols)
  )
  scores <- dplyr::left_join(scores, lookup, by = c("model_id", group_cols))
  attr(scores, "metrics") <- c(orig_metrics, skill_cols)

  if (nrow(skipped_groups) > 0L) {
    warn_relative_skill_skipped(skipped_groups, group_cols, baseline)
  }
  scores
}


#' Subset scores to the rows whose group is in `groups`
#'
#' A `semi_join` on `group_cols`. When `group_cols` is empty (no disaggregation)
#' there is a single group spanning all of `scores`, so there is nothing to
#' subset by and every row is returned unchanged; handling that explicitly also
#' avoids dplyr's deprecated empty-key cross join.
#'
#' @noRd
subset_scores_to_groups <- function(scores, groups, group_cols) {
  if (length(group_cols) == 0L) {
    # No grouping columns: a single group spans all of `scores`, so every row
    # is already in it. There is nothing to subset by, so keep all rows.
    scores
  } else {
    dplyr::semi_join(scores, groups, by = group_cols)
  }
}


#' Per-(model_id, group) relative skill for groups scoringutils can score
#'
#' Scores the computable subset with [scoringutils::add_relative_skill()] (once
#' per metric) and reduces it to one row per `(model_id, group)`, since relative
#' skill is constant within a group. Returns `NULL` when there are no computable
#' groups, so [dplyr::bind_rows()] drops it.
#'
#' @param scores The full per-row scores object.
#' @param computable_groups One row per computable group, holding its
#'   `group_cols` values.
#' @param group_cols Character vector of disaggregation column names.
#' @param skill_cols Names of the relative-skill columns to return, as produced
#'   by [relative_skill_col_names()] (e.g. `"wis_relative_skill"`, plus
#'   `"wis_scaled_relative_skill"` when a baseline is given).
#' @param relative_metrics Character vector of metrics to score relative skill for.
#' @param baseline The requested baseline model, or `NULL`.
#' @noRd
compute_skills <- function(
  scores,
  computable_groups,
  group_cols,
  skill_cols,
  relative_metrics,
  baseline
) {
  if (nrow(computable_groups) == 0L) {
    return(NULL)
  }
  computable_scores <- subset_scores_to_groups(
    scores,
    computable_groups,
    group_cols
  )
  for (metric in relative_metrics) {
    computable_scores <- scoringutils::add_relative_skill(
      computable_scores,
      compare = "model_id",
      by = group_cols,
      metric = metric,
      baseline = baseline
    )
  }
  # The lookup we merge back onto the scored data needs only the join keys
  # (model_id, group_cols) and the skill columns. Scoring above used the per-row
  # metric columns, so we drop them and de-dup to one row per group here, after
  # add_relative_skill().
  computable_scores |>
    tibble::as_tibble() |>
    dplyr::select(dplyr::all_of(c("model_id", group_cols, skill_cols))) |>
    dplyr::distinct()
}


#' Per-(model_id, group) relative skill of 1 for single-model groups
#'
#' A group with one model has no comparator, so relative (and scaled relative)
#' skill is `1` by the single-model convention. Returns one row per `(model_id,
#' group)` with every relative-skill column set to `1`, or `NULL` when there are
#' no such groups.
#'
#' @param scores The full per-row scores object.
#' @param trivial_groups One row per single-model group, holding its
#'   `group_cols` values.
#' @param group_cols Character vector of disaggregation column names.
#' @param skill_cols Names of the relative-skill columns to set to `1`, as
#'   produced by [relative_skill_col_names()].
#' @noRd
assign_trivial_skills <- function(
  scores,
  trivial_groups,
  group_cols,
  skill_cols
) {
  if (nrow(trivial_groups) == 0L) {
    return(NULL)
  }
  # The same merge-back lookup (join keys + skill columns, one row per group),
  # but nothing is scored here, so unlike compute_skills we drop the metric
  # columns and de-dup to the keys up front, then assign 1 to the skill columns.
  trivial_scores <- subset_scores_to_groups(
    scores,
    trivial_groups,
    group_cols
  ) |>
    tibble::as_tibble() |>
    dplyr::distinct(dplyr::across(dplyr::all_of(c("model_id", group_cols))))
  for (col in skill_cols) {
    trivial_scores[[col]] <- 1
  }
  trivial_scores
}


#' Warn that relative skill could not be scaled to the baseline for some groups
#'
#' Only baseline-absent groups are skipped to `NA`; single-model groups are
#' filled with `1` and do not warn. A skipped group therefore always implies a
#' `baseline` was requested.
#'
#' @param skipped_groups Data frame of disaggregation-column values for the
#'   groups from which the baseline is absent.
#' @param group_cols Character vector of disaggregation column names.
#' @param baseline The requested baseline model.
#' @noRd
warn_relative_skill_skipped <- function(skipped_groups, group_cols, baseline) {
  labels <- apply(skipped_groups, 1L, function(row) {
    paste(group_cols, row, sep = " = ", collapse = ", ")
  })
  n <- length(labels)
  shown <- utils::head(labels, 5L)
  if (n > length(shown)) {
    shown <- c(shown, "...")
  }
  cli::cli_warn(c(
    "!" = "Relative skill could not be scaled to the baseline
           {.val {baseline}} for {n} disaggregation group{?s} with no baseline
           prediction; reporting NA for them.",
    "i" = "Affected levels of {.val {group_cols}}: {.val {shown}}."
  ))
}


#' Get scoring metrics
#'
#' @param forecast A scoringutils `forecast` object (see
#' [scoringutils' general information on creating a forecast object][scoringutils::as_forecast_doc_template()]
#' for details).
#' @inheritParams score_model_out
#'
#' @return a list of metric functions as required by scoringutils::score()
#'
#' @noRd
get_metrics <- function(forecast, output_type, select = NULL) {
  forecast_type <- class(forecast)[1]

  # process quantile metrics separately to allow better selection of interval
  # coverage metrics
  if (forecast_type == "forecast_quantile") {
    # split into metrics for interval coverage and others
    interval_metric_inds <- is_interval_coverage_metric(select)
    interval_metrics <- select[interval_metric_inds]
    other_metrics <- select[!interval_metric_inds]

    other_metric_fns <- scoringutils::get_metrics(
      forecast,
      select = other_metrics
    )

    # assemble interval coverage functions
    interval_metric_fns <- lapply(
      interval_metrics,
      function(metric) {
        level_str <- substr(metric, 19, nchar(metric))
        level <- suppressWarnings(as.numeric(level_str))
        if (is.na(level) || level <= 0 || level >= 100) {
          cli::cli_abort(c(
            "Invalid interval coverage level: {level_str}",
            "i" = "must be a number between 0 and 100 (exclusive)"
          ))
        }
        purrr::partial(scoringutils::interval_coverage, interval_range = level)
      }
    )
    names(interval_metric_fns) <- interval_metrics

    metric_fns <- c(other_metric_fns, interval_metric_fns)
    return(metric_fns)
  }

  # leave validation of user selection to scoringutils
  metric_fns <- scoringutils::get_metrics(forecast, select = select)
  if (output_type == "mean") {
    metric_fns <- scoringutils::select_metrics(metric_fns, "se_point")
  } else if (output_type == "median") {
    metric_fns <- scoringutils::select_metrics(metric_fns, "ae_point")
  }

  metric_fns
}


#' Determine whether metric is an interval coverage metric
#'
#' @param metrics Character vector of metric names
#' @return Logical vector indicating whether each metric is an interval coverage metric
#' @noRd
is_interval_coverage_metric <- function(metric) {
  grepl(pattern = "^interval_coverage_", metric)
}
