library(yardstick)
library(rlang)

# -------------------------
# interne Implementierung
# -------------------------
fin_impact_impl <- function(truth,
                            estimate,
                            event_level = "first",
                            costs = c(tp = 0, fp = 0, fn = 0, tn = 0)) {
  
  # Basic checks on `costs`
  required_names <- c("tp", "fp", "fn", "tn")
  if (!all(required_names %in% names(costs))) {
    abort("`costs` must be a named numeric vector with names 'tp', 'fp', 'fn', 'tn'.")
  }
  costs <- costs[required_names]  # ensure correct order
  
  # Confusion matrix (rows = estimate, cols = truth)
  xtab <- table(estimate, truth)
  
  if (nrow(xtab) != 2 || ncol(xtab) != 2) {
    abort("`fin_impact` is a binary metric. `truth` and `estimate` must have 2 levels.")
  }
  
  # Determine which column is the event (positive class)
  event_col <- if (identical(event_level, "first")) {
    colnames(xtab)[1]
  } else {
    colnames(xtab)[2]
  }
  nonevent_col <- setdiff(colnames(xtab), event_col)
  
  # Extract counts
  tp <- xtab[event_col, event_col]
  fp <- xtab[event_col, nonevent_col]
  fn <- xtab[nonevent_col, event_col]
  tn <- xtab[nonevent_col, nonevent_col]
  
  # Financial impact
  total_financial <-
    tp * costs["tp"] +
    fp * costs["fp"] +
    fn * costs["fn"] +
    tn * costs["tn"]
  
  # mean impact per observation
  total_financial / length(truth)
}

# -------------------------
# Vektor-Methode
# -------------------------
fin_impact_vec <- function(truth,
                           estimate,
                           estimator = NULL,
                           na_rm = TRUE,
                           case_weights = NULL,
                           event_level = "first",
                           costs = c(tp = 0, fp = 0, fn = 0, tn = 0),
                           ...) {
  
  estimator <- finalize_estimator(truth, estimator)
  check_class_metric(truth, estimate, case_weights, estimator)
  
  if (na_rm) {
    rm <- yardstick_remove_missing(truth, estimate, case_weights)
    truth <- rm$truth
    estimate <- rm$estimate
    case_weights <- rm$case_weights
  } else if (yardstick_any_missing(truth, estimate, case_weights)) {
    return(NA_real_)
  }
  
  # NOTE: `case_weights` werden aktuell nicht in der Berechnung verwendet.
  fin_impact_impl(
    truth = truth,
    estimate = estimate,
    event_level = event_level,
    costs = costs
  )
}

# -------------------------
# Generics + Registrierung
# -------------------------
fin_impact <- function(data, ...) {
  UseMethod("fin_impact")
}

# Als yardstick-Klassifikationsmetrik registrieren
fin_impact <- new_class_metric(fin_impact, direction = "maximize")

# -------------------------
# data.frame-Methode
# -------------------------
fin_impact.data.frame <- function(data,
                                  truth,
                                  estimate,
                                  estimator = NULL,
                                  na_rm = TRUE,
                                  case_weights = NULL,
                                  event_level = "first",
                                  costs = c(tp = 0, fp = 0, fn = 0, tn = 0),
                                  ...) {
  
  class_metric_summarizer(
    name = "fin_impact",
    fn = fin_impact_vec,
    data = data,
    truth = !!enquo(truth),
    estimate = !!enquo(estimate),
    estimator = estimator,
    na_rm = na_rm,
    case_weights = !!enquo(case_weights),
    event_level = event_level,
    costs = costs,
    ...
  )
}