#==========================================================
# Outlier Check
#==========================================================

#' Check Numeric Outliers
#'
#' Identifies potential outliers in numeric variables using
#' the interquartile range (IQR) method.
#'
#' @param data A data.frame.
#' @param k A single positive numeric value controlling the
#'   IQR multiplier. Default is 1.5.
#'
#' @return A data.frame of class \code{OutlierCheck}
#'   containing variable-level outlier diagnostics.
#'
#' @details
#' For each numeric variable, the lower and upper limits are:
#'
#' \deqn{Q1 - k * IQR}
#'
#' and
#'
#' \deqn{Q3 + k * IQR}
#'
#' Values strictly below the lower limit or strictly above
#' the upper limit are classified as potential outliers.
#'
#' Missing and infinite values are excluded from the
#' calculation of quartiles and outliers. They are reported
#' separately.
#'
#' Non-numeric variables are retained in the output but are
#' not evaluated for outliers.
#'
#' @examples
#' dat <- data.frame(
#'   x = c(10, 11, 12, 13, 100),
#'   group = c("A", "A", "B", "B", "B")
#' )
#'
#' outlier_check(dat)
#'
#' outlier_check(dat, k = 3)
#'
#' @export

outlier_check <- function(data, k = 1.5) {

  #---------------------------------------------
  # Validation
  #---------------------------------------------
  validate_data(data)

  if (!is.numeric(k) ||
      length(k) != 1L ||
      is.na(k) ||
      !is.finite(k)) {

    stop(
      "'k' must be a single finite numeric value.",
      call. = FALSE
    )
  }

  if (k <= 0) {

    stop(
      "'k' must be greater than zero.",
      call. = FALSE
    )
  }

  #---------------------------------------------
  # Analyze one variable
  #---------------------------------------------
  analyse_variable <- function(x) {

    numeric_variable <- is.numeric(x)

    missing <- sum(is.na(x))

    if (!numeric_variable) {

      return(
        list(
          Numeric = FALSE,
          Missing = missing,
          Infinite = 0L,
          Observed = NA_integer_,
          Q1 = NA_real_,
          Q3 = NA_real_,
          IQR = NA_real_,
          LowerBound = NA_real_,
          UpperBound = NA_real_,
          LowerOutliers = NA_integer_,
          UpperOutliers = NA_integer_,
          Outliers = NA_integer_,
          OutlierPercent = NA_real_
        )
      )
    }

    #-------------------------------------------
    # Infinite values
    #-------------------------------------------
    infinite <- sum(
      is.infinite(x),
      na.rm = TRUE
    )

    #-------------------------------------------
    # Keep only finite observed values
    #-------------------------------------------
    observed <- x[
      !is.na(x) &
        is.finite(x)
    ]

    n_observed <- length(observed)

    #-------------------------------------------
    # No finite observations
    #-------------------------------------------
    if (n_observed == 0L) {

      return(
        list(
          Numeric = TRUE,
          Missing = missing,
          Infinite = as.integer(infinite),
          Observed = 0L,
          Q1 = NA_real_,
          Q3 = NA_real_,
          IQR = NA_real_,
          LowerBound = NA_real_,
          UpperBound = NA_real_,
          LowerOutliers = 0L,
          UpperOutliers = 0L,
          Outliers = 0L,
          OutlierPercent = NA_real_
        )
      )
    }

    #-------------------------------------------
    # Quartiles
    #-------------------------------------------
    quartiles <- stats::quantile(
      observed,
      probs = c(0.25, 0.75),
      names = FALSE,
      type = 7
    )

    q1 <- as.numeric(quartiles[1L])
    q3 <- as.numeric(quartiles[2L])

    #-------------------------------------------
    # IQR
    #-------------------------------------------
    iqr <- q3 - q1

    #-------------------------------------------
    # Bounds
    #-------------------------------------------
    lower_bound <- q1 - k * iqr
    upper_bound <- q3 + k * iqr

    #-------------------------------------------
    # Outliers
    #-------------------------------------------
    lower_outliers <- sum(
      observed < lower_bound
    )

    upper_outliers <- sum(
      observed > upper_bound
    )

    outliers <-
      lower_outliers +
      upper_outliers

    #-------------------------------------------
    # Percentage
    #-------------------------------------------
    outlier_percent <-
      100 * outliers / n_observed

    list(
      Numeric = TRUE,
      Missing = missing,
      Infinite = as.integer(infinite),
      Observed = as.integer(n_observed),
      Q1 = q1,
      Q3 = q3,
      IQR = iqr,
      LowerBound = lower_bound,
      UpperBound = upper_bound,
      LowerOutliers = as.integer(lower_outliers),
      UpperOutliers = as.integer(upper_outliers),
      Outliers = as.integer(outliers),
      OutlierPercent = outlier_percent
    )
  }

  #---------------------------------------------
  # Apply analysis
  #---------------------------------------------
  diagnostics <- lapply(
    data,
    analyse_variable
  )

  #---------------------------------------------
  # Construct result
  #---------------------------------------------
  result <- data.frame(

    Variable = names(data),

    Numeric = vapply(
      diagnostics,
      function(x) x$Numeric,
      logical(1)
    ),

    Missing = vapply(
      diagnostics,
      function(x) x$Missing,
      integer(1)
    ),

    Infinite = vapply(
      diagnostics,
      function(x) x$Infinite,
      integer(1)
    ),

    Observed = vapply(
      diagnostics,
      function(x) x$Observed,
      integer(1)
    ),

    Q1 = vapply(
      diagnostics,
      function(x) x$Q1,
      numeric(1)
    ),

    Q3 = vapply(
      diagnostics,
      function(x) x$Q3,
      numeric(1)
    ),

    IQR = vapply(
      diagnostics,
      function(x) x$IQR,
      numeric(1)
    ),

    LowerBound = vapply(
      diagnostics,
      function(x) x$LowerBound,
      numeric(1)
    ),

    UpperBound = vapply(
      diagnostics,
      function(x) x$UpperBound,
      numeric(1)
    ),

    LowerOutliers = vapply(
      diagnostics,
      function(x) x$LowerOutliers,
      integer(1)
    ),

    UpperOutliers = vapply(
      diagnostics,
      function(x) x$UpperOutliers,
      integer(1)
    ),

    Outliers = vapply(
      diagnostics,
      function(x) x$Outliers,
      integer(1)
    ),

    OutlierPercent = vapply(
      diagnostics,
      function(x) x$OutlierPercent,
      numeric(1)
    ),

    stringsAsFactors = FALSE,
    check.names = FALSE
  )

  #---------------------------------------------
  # Flag variables
  #---------------------------------------------
  result$HasOutlier <-
    !is.na(result$Outliers) &
    result$Outliers > 0L

  #---------------------------------------------
  # Round reporting values
  #---------------------------------------------
  numeric_columns <- c(
    "Q1",
    "Q3",
    "IQR",
    "LowerBound",
    "UpperBound",
    "OutlierPercent"
  )

  result[numeric_columns] <- lapply(
    result[numeric_columns],
    function(x) round(x, 2)
  )

  #---------------------------------------------
  # Class
  #---------------------------------------------
  class(result) <- c(
    "OutlierCheck",
    "data.frame"
  )

  result
}
