# ============================================================
#  signed_depth.R
#  1. reference_curve()          — median curve from combined sample
#  2. signed_distance_integral() — area between each curve and reference
#  3. signed_depth()             — main transformation for all classifiers
# ============================================================


#' Reference (Median) Curve
#'
#' Returns the curve (or average of curves) that attains the maximum
#' Fraiman-Muniz depth over the combined sample — the functional analogue
#' of the median.
#'
#' @param X Numeric matrix (\eqn{N \times M}) of curves.
#' @param depth Numeric vector of length \eqn{N} of pre-computed FM depth
#'   values. If \code{NULL} (default), \code{\link{fm_depth}} is called
#'   internally with \code{type = "tukey"}.
#' @param ... Additional arguments forwarded to \code{\link{fm_depth}} when
#'   \code{depth} is \code{NULL}.
#'
#' @return A numeric vector of length \eqn{M}.
#'
#' @examples
#' set.seed(1)
#' X <- matrix(rnorm(50 * 100), nrow = 50)
#' ref <- reference_curve(X)
#' plot(ref, type = "l", xlab = "t", ylab = "x(t)",
#'      main = "Reference (median) curve")
#'
#' @export
reference_curve <- function(X, depth = NULL, ...) {
  if (is.null(depth)) depth <- fm_depth(X, ...)
  max_depth <- max(depth)
  idx       <- which(depth == max_depth)
  if (length(idx) == 1L) return(X[idx, , drop = TRUE])
  colMeans(X[idx, , drop = FALSE])
}


#' Signed Distance Integral
#'
#' For each curve \eqn{x_i(t)}, computes
#' \deqn{\int_I \bigl(x_i(t) - x_{\mathrm{ref}}(t)\bigr)\,dt,}
#' which is positive when the curve lies predominantly above the reference
#' and negative when it lies below. This integral assigns a sign to the depth
#' of each curve (equation 3.1 of Perez Ruiz, 2020).
#'
#' @param X Numeric matrix (\eqn{N \times M}).
#' @param x_ref Numeric vector of length \eqn{M}: the reference curve.
#'   If \code{NULL} (default), \code{\link{reference_curve}} is called
#'   internally.
#' @param grid Numeric vector of length \eqn{M} with observation times.
#'   Defaults to equally spaced points on \eqn{[0, 1]}.
#'
#' @return A numeric vector of length \eqn{N}.
#'
#' @seealso \code{\link{signed_depth}}, \code{\link{reference_curve}}
#'
#' @examples
#' set.seed(1)
#' X <- matrix(rnorm(40 * 80), nrow = 40)
#' sdi <- signed_distance_integral(X)
#' hist(sdi, main = "Signed distance integrals", xlab = "SDI")
#'
#' @export
signed_distance_integral <- function(X, x_ref = NULL, grid = NULL) {
  if (!is.matrix(X) || !is.numeric(X))
    stop("'X' must be a numeric matrix.")
  M <- ncol(X)
  if (is.null(grid))  grid  <- seq(0, 1, length.out = M)
  if (is.null(x_ref)) x_ref <- reference_curve(X, grid = grid)
  if (length(x_ref) != M)
    stop("'x_ref' must have the same length as ncol(X).")
  widths   <- diff(grid)
  diff_mat <- sweep(X, 2, x_ref, "-")
  as.numeric(diff_mat[, -1, drop = FALSE] %*% widths)
}


#' Signed Depth
#'
#' The core transformation of the k-RNN pipeline. For each curve computes
#' \deqn{\mathrm{sdp}(x_i(t)) =
#'   \mathrm{sgn}\!\left\{\int_I(x_i(t)-x_{\mathrm{ref}}(t))\,dt\right\}
#'   \times D(x_i(t)),}
#' where \eqn{D(\cdot)} is the Fraiman-Muniz depth and the sign is derived
#' from the signed distance integral (equation 3.2 of Perez Ruiz, 2020).
#' Curves above the reference receive a positive signed depth; curves below
#' receive a negative one.
#'
#' @param X Numeric matrix (\eqn{N \times M}) with curves in rows.
#' @param grid Numeric vector of length \eqn{M}. Defaults to equally spaced
#'   points on \eqn{[0, 1]}.
#' @param type Depth variant: \code{"tukey"} (default) or
#'   \code{"simplicial"}.
#' @param x_ref Optional pre-computed reference curve (numeric vector of
#'   length \eqn{M}). Computed internally if \code{NULL}.
#' @param depth Optional pre-computed FM depth vector of length \eqn{N}.
#'   Computed internally if \code{NULL}.
#'
#' @return An object of class \code{"fd_signed_depth"} with components:
#'   \describe{
#'     \item{sdp}{Numeric vector of length \eqn{N}: the signed depths.}
#'     \item{depth}{Numeric vector of length \eqn{N}: raw FM depths.}
#'     \item{sdi}{Numeric vector of length \eqn{N}: signed distance
#'       integrals.}
#'     \item{x_ref}{Numeric vector of length \eqn{M}: reference curve.}
#'     \item{grid}{Numeric vector of length \eqn{M}: time grid used.}
#'     \item{type}{Character: depth variant used.}
#'     \item{N}{Number of curves.}
#'     \item{M}{Number of time points.}
#'   }
#'
#' @references
#' Perez Ruiz, D. A. (2020). \emph{Supervised Classification for Functional
#' Data}. PhD thesis, University of Manchester.
#'
#' @examples
#' set.seed(42)
#' N <- 60; M <- 100
#' t  <- seq(0, 1, length.out = M)
#' X0 <- t(replicate(N / 2, sin(2 * pi * t) + rnorm(M, sd = 0.3)))
#' X1 <- t(replicate(N / 2, cos(2 * pi * t) + rnorm(M, sd = 0.3)))
#' X  <- rbind(X0, X1)
#' sd_obj <- signed_depth(X)
#' plot(sd_obj$sdp, col = rep(1:2, each = N / 2),
#'      xlab = "Curve index", ylab = "Signed depth",
#'      main = "Signed depth by group")
#' abline(h = 0, lty = 2)
#'
#' @export
signed_depth <- function(X, grid = NULL, type = c("tukey", "simplicial"),
                         x_ref = NULL, depth = NULL) {
  type <- match.arg(type)
  if (!is.matrix(X) || !is.numeric(X))
    stop("'X' must be a numeric matrix with curves in rows.")
  N <- nrow(X); M <- ncol(X)
  if (is.null(grid))  grid  <- seq(0, 1, length.out = M)
  if (is.null(depth)) depth <- fm_depth(X, grid = grid, type = type)
  if (is.null(x_ref)) x_ref <- reference_curve(X, depth = depth)
  sdi <- signed_distance_integral(X, x_ref = x_ref, grid = grid)
  sdp <- sign(sdi) * depth
  structure(
    list(sdp = sdp, depth = depth, sdi = sdi,
         x_ref = x_ref, grid = grid, type = type, N = N, M = M),
    class = "fd_signed_depth"
  )
}

#' @param x A \code{"fd_signed_depth"} object.
#' @param ... Ignored.
#' @return Invisibly returns \code{x}.
#' @rdname signed_depth
#' @export
print.fd_signed_depth <- function(x, ...) {
  cat("Signed depth summary\n")
  cat("  Curves (N)     :", x$N, "\n")
  cat("  Time points (M):", x$M, "\n")
  cat("  Depth type     :", x$type, "\n")
  cat("  sdp range      : [", round(min(x$sdp), 4), ",",
      round(max(x$sdp), 4), "]\n")
  invisible(x)
}
