#' Win/Loss Ratios with Nearest Neighbor Matching
#'
#' `nn_win_ratio()` calculates the win/loss proportion, win ratio, and net benefit
#' by performing nearest-neighbor matching between individuals in the treatment group
#' and those in the control group based on a specified ground distance. After matching,
#' the outcomes of paired individuals are compared to determine winners and losers.
#' @param base A data frame with n rows (individuals) and p columns.
#' It must include a treatment column and one or more outcome columns.
#' All remaining columns are considered covariates for matching.
#' The data frame should not contain missing values. All covariates must be either numeric or factors.
#' @param treatment_name A character vector of length one for the treatment column name, must be in `names(base)`.
#' The treatment column should contain only zeros and ones, with ones indicating the treatment group.
#' @param outcome_names A character vector specifying the names of outcome columns.
#' All names must exist in `names(base)`. Each outcome column should be numeric or binary and
#' binary outcomes must be encoded as 0 and 1.
#' @param win_function By default, this function compares outcomes lexicographically according to the column order in the data frame,
#' treating higher values as better. Once a distinct outcome is found, the function yields 1 (a win) if that outcome is larger
#'  for the treated individual and 0 otherwise; in case of a tie, it yields 0.
#' To change the priority of outcomes, simply reorder the columns of the data frame.
#' Alternatively, `win_function` can be a custom function that takes two arguments, each corresponding to a row of the data frame:
#' `win_function(base[i, ], base[j, ])`
#' where the first argument represents a treated individual and the second a control individual.
#' The function must return a value between 0 and 1, with 1 indicating a win for the treated individual.
#' @param distance A function that is used to compute the nearest neighbor matching on covariates.
#' The distance function will be passed as an argument to \code{\link[MatchIt]{matchit}} (see  \code{\link[MatchIt]{distance}}).
#'
#' **Default Distance Settings**
#'
#' The default value for the distance parameter is `NULL`. If no distance is provided, the function assigns defaults based on the type of covariates:
#'
#' - **Numeric covariates:** Sets distance to `"euclidean"`.
#' - **Categorical covariates:** Applies Multiple Correspondence Analysis (see \code{\link[FactoMineR]{MCA}}) transformation to the covariates and sets distance to `"euclidean"`.
#' - **Mixed covariates:** Applies Factor Analysis of Mixed Data transformation (see \code{\link[FactoMineR]{FAMD}}) to the covariates and sets distance to `"euclidean"`.
#' @returns A list of six elements, each of which is a list structured as follows:
#'
#' The first element, `win_proportion`, is a list with two components: `value` and `std`,
#' where `std` represents the standard deviation.
#'
#' The second element, `lose_proportion`, is a list with two components: `value` and `std`,
#' where `std` represents the standard deviation.
#'
#' The third element, `win_ratio`, is a list containing three components: `value`, `lower_CI`,
#' and `upper_CI`, with `lower_CI` and `upper_CI` representing the confidence interval bounds.
#'
#' The fourth element, `net_benefit`, is a list containing three components: `value`, `lower_CI`,
#' and `upper_CI`, with `lower_CI` and `upper_CI` representing the confidence interval bounds.
#'
#' The fifth and sixth elements, `win_vector` and `lose_vector`, are numeric vectors representing the number of wins and losses
#' for each matched element, respectively. Their entries follow the same order as the rows in `base`.
#' @export
#'
#' @examples
#' ## Mixed Covariates ##
#'
#' set.seed(123)
#' n <- 100
#' base <- data.frame(
#'   X1 = rnorm(n, mean = 5, sd = 2), # numeric covariate 1
#'   X2 = rnorm(n, mean = 10, sd = 3), # numeric covariate 2
#'   X3 = factor(sample(c("A", "B", "C"), n, replace = TRUE)), # factor covariate
#'   Y1 = rnorm(n, mean = 50, sd = 10), # numeric outcome 1
#'   Y2 = rnorm(n, mean = 100, sd = 20), # numeric outcome 2
#'   arm = sample(c(0, 1), n, replace = TRUE) # binary treatment arm
#' )
#' treatment_name <- "arm"
#' outcome_names <- c("Y1", "Y2")
#' res <- nn_win_ratio(
#'   base = base,
#'   treatment_name = treatment_name,
#'   outcome_names = outcome_names
#' )
#'
#' ## Categorical Covariates ##
#'
#' set.seed(123)
#' n <- 100
#' base <- data.frame(
#'   X1 = factor(sample(c("A", "B", "C"), n, replace = TRUE)), # factor covariate
#'   X2 = factor(sample(c("A", "B", "C"), n, replace = TRUE)), # factor covariate
#'   X3 = factor(sample(c("A", "B", "C"), n, replace = TRUE)), # factor covariate
#'   Y1 = rnorm(n, mean = 50, sd = 10), # numeric outcome 1
#'   Y2 = rnorm(n, mean = 100, sd = 20), # numeric outcome 2
#'   arm = sample(c(0, 1), n, replace = TRUE) # binary treatment arm
#' )
#' treatment_name <- "arm"
#' outcome_names <- c("Y1", "Y2")
#' res <- nn_win_ratio(
#'   base = base,
#'   treatment_name = treatment_name,
#'   outcome_names = outcome_names
#' )
#'
#' ## Input a Distance Matrix ##
#'
#' set.seed(123)
#' n <- 100
#' base <- data.frame(
#'   X1 = rnorm(n, mean = 5, sd = 2), # numeric covariate 1
#'   X2 = rnorm(n, mean = 5, sd = 2), # numeric covariate 2
#'   X3 = rnorm(n, mean = 5, sd = 2), # numeric covariate 3
#'   Y1 = rnorm(n, mean = 50, sd = 10), # numeric outcome 1
#'   Y2 = rnorm(n, mean = 100, sd = 20), # numeric outcome 2
#'   arm = sample(c(0, 1), n, replace = TRUE) # binary treatment arm
#' )
#' treatment_name <- "arm"
#' outcome_names <- c("Y1", "Y2")
#'
#' covariate_names <- setdiff(colnames(base), c(outcome_names, treatment_name))
#' covariate_data <- base[, covariate_names, drop = FALSE]
#' distance_matrix <- as.matrix(dist(covariate_data, method = "euclidean"))
#'
#' res_dist <- nn_win_ratio(
#'   base = base,
#'   treatment_name = treatment_name,
#'   outcome_names = outcome_names,
#'   distance = distance_matrix
#' )
#'
#' res <- nn_win_ratio(
#'   base = base,
#'   treatment_name = treatment_name,
#'   outcome_names = outcome_names
#' )
#'
#' res <- unlist(res)
#' res_dist <- unlist(res_dist)
#'
#' print(all.equal(res, res_dist))
#'
#' ## Input a Win function ##
#'
#' set.seed(123)
#' n <- 100
#' base <- data.frame(
#'   X1 = rnorm(n, mean = 5, sd = 2), # numeric covariate 1
#'   X2 = rnorm(n, mean = 5, sd = 2), # numeric covariate 2
#'   X3 = rnorm(n, mean = 5, sd = 2), # numeric covariate 3
#'   Y1 = rbinom(n, size = 1, prob = 0.5), # binary outcome 1 (0/1) with 50% chance
#'   Y2 = rbinom(n, size = 10, prob = 0.7), # counts out of 10 trials with 70% success rate
#'   arm = sample(c(0, 1), n, replace = TRUE) # binary treatment arm
#' )
#' treatment_name <- "arm"
#' outcome_names <- c("Y1", "Y2")
#'
#' # Contrary to the default win function, which yields 0 for ties,
#' # the following win function yields 0.5.
#'
#' win_function <- function(treated_row, control_row) {
#'   y <- as.matrix(treated_row[, outcome_names], drop = FALSE)
#'   z <- as.matrix(control_row[, outcome_names], drop = FALSE)
#'   if (all(y == z)) {
#'     return(0.5) # Tie, a zero in the default win function
#'   }
#'   result <- (y > z)[which.max(y != z)] * 1
#'   return(result)
#' }
#'
#' res <- nn_win_ratio(
#'   base = base,
#'   treatment_name = treatment_name,
#'   outcome_names = outcome_names,
#'   win_function = win_function
#' )
nn_win_ratio <- function(base,
                         treatment_name,
                         outcome_names,
                         win_function = "lexicographic",
                         distance = NULL) {
  # Check/Preprocess Input --------------------------------------------------
  if (any(is.na(base))) {
    stop("The data frame has missing values. Please remove or impute NAs before using this function.")
  }

  validate_input(base, treatment_name, outcome_names, win_function, distance = distance)

  if (any(is.na(base))) {
    stop("The data frame has missing values. Please remove or impute NAs before using this function.")
  }

  covariate_names <- setdiff(colnames(base), c(outcome_names, treatment_name))
  preprocessed_data <- base
  matching_formula <- stats::as.formula(paste(treatment_name, "~", paste(covariate_names, collapse = " + ")))

  if (is.null(distance) && categorical(base[covariate_names])) {
    message("Covariates are categorical.")
    message("No custom distance was provided.")
    message("Performing MCA and setting distance to 'euclidean'.")
    message("Specify a distance function to override this choice.")
    preprocess <- preprocess(base,
      covariate_names = covariate_names,
      treatment_name = treatment_name,
      transformation = "MCA"
    )
    preprocessed_data <- preprocess$preprocessed_data
    matching_formula <- preprocess$matching_formula
    distance <- "euclidean"
  }

  if (is.null(distance) && mixed(base[covariate_names])) {
    message("Covariates are both categorical and numerical.")
    message("No custom distance was provided.")
    message("Performing FAMD and setting distance to 'euclidean'.")
    message("Specify a distance function to override this choice.")
    preprocess <- preprocess(base,
      covariate_names = covariate_names,
      treatment_name = treatment_name,
      transformation = "FAMD"
    )
    preprocessed_data <- preprocess$preprocessed_data
    matching_formula <- preprocess$matching_formula
    distance <- "euclidean"
  }

  if (is.null(distance) && numerical(base[covariate_names])) {
    message("No custom distance was provided. Euclidean distance will be used for matching.")
    message("Specify a distance function to override this choice.")
    distance <- "euclidean"
  }

  if (is.character(win_function) && length(win_function) == 1 && win_function == "lexicographic") {
    win_function <- build_default_win_function(outcome_names)
  }

  lose_function <- function(treated_row, control_row) {
    win_function(control_row, treated_row)
  }

  # Create Pairs ------------------------------------------------------------

  treated_to_control <- nneighbor_match(preprocessed_data,
    matching_formula,
    distance,
    estimand = "ATT"
  )

  control_to_treated <- nneighbor_match(preprocessed_data,
    matching_formula,
    distance,
    estimand = "ATC"
  )

  # Compute Win/Lose vectors ------------------------------------------------

  n_of_individuals <- nrow(base)
  win_vector <- numeric(n_of_individuals)
  lose_vector <- numeric(n_of_individuals)

  treated_to_control_win <- apply_fun_to_pairs(
    base = base,
    pair_matrix = treated_to_control,
    funct = win_function
  )

  treated_to_control_lose <- apply_fun_to_pairs(
    base = base,
    pair_matrix = treated_to_control,
    funct = lose_function
  )

  control_to_treated_win <- apply_fun_to_pairs(
    base = base,
    pair_matrix = control_to_treated,
    funct = win_function
  )

  control_to_treated_lose <- apply_fun_to_pairs(
    base = base,
    pair_matrix = control_to_treated,
    funct = lose_function
  )

  win_vector[treated_to_control[, 1]] <- treated_to_control_win
  lose_vector[treated_to_control[, 1]] <- treated_to_control_lose
  win_vector[control_to_treated[, 2]] <- control_to_treated_win
  lose_vector[control_to_treated[, 2]] <- control_to_treated_lose

  # Compute Win/Lose Metrics ------------------------------------------------

  res <- compute_metrics(win_vector, lose_vector)
  res$win_vector <- win_vector
  res$lose_vector <- lose_vector

  return(res)
}

nneighbor_match <- function(preprocessed_data, matching_formula, distance, estimand = "ATT") {
  # Create pairs
  matchings <- MatchIt::matchit(
    formula = matching_formula,
    data = preprocessed_data,
    method = "nearest",
    distance = distance,
    ratio = 1,
    replace = TRUE,
    estimand = estimand
  )
  pairs <- matchings$match.matrix

  if (estimand == "ATT") {
    treated <- as.numeric(rownames(pairs))
    control <- as.numeric(pairs)
  } else {
    control <- as.numeric(rownames(pairs))
    treated <- as.numeric(pairs)
  }

  pair_matrix <- cbind(treated, control)

  # Drop lines that yielded (if any) missing values
  pair_matrix <- pair_matrix[stats::complete.cases(pair_matrix), , drop = FALSE]

  return(pair_matrix)
}

apply_fun_to_pairs <- function(base, pair_matrix, funct) {
  n_rows <- nrow(pair_matrix)

  res <- vapply(
    seq_len(n_rows),
    function(k) {
      funct(base[pair_matrix[k, 1], ], base[pair_matrix[k, 2], ])
    },
    FUN.VALUE = 0
  )

  return(res)
}
