#==========================================================
# Near-Zero Variance Check
#==========================================================

#' Check Near-Zero Variance Variables
#'
#' Identifies variables with zero or near-zero variance
#' based on the percentage of unique values and the
#' frequency ratio of the two most common values.
#'
#' @param data A data.frame.
#' @param unique_cut Numeric. Maximum percentage of unique
#'   values used to identify near-zero variance variables.
#'   Default is 10.
#' @param freq_cut Numeric. Minimum frequency ratio used to
#'   identify near-zero variance variables. Default is 19.
#'
#' @return A data.frame of class \code{NZVCheck} containing
#'   variable-level near-zero variance diagnostics.
#'
#' @details
#' Missing values are excluded when calculating the number
#' of unique values, percentage of unique values, and
#' frequency ratio.
#'
#' A variable is classified as having zero variance when it
#' contains one or fewer unique non-missing values.
#'
#' A non-constant variable is classified as near-zero
#' variance when both:
#'
#' \itemize{
#'   \item PercentUnique is less than or equal to
#'   \code{unique_cut}.
#'   \item FrequencyRatio is greater than \code{freq_cut}.
#' }
#'
#' Variables with zero variance are also flagged in the
#' \code{NearZeroVariance} column.
#'
#' @examples
#' dat <- data.frame(
#'   x = 1:100,
#'   y = c(rep(0, 99), 1),
#'   z = rep(5, 100)
#' )
#'
#' nzv_check(dat)
#'
#' nzv_check(
#'   dat,
#'   unique_cut = 20,
#'   freq_cut = 10
#' )
#'
#' @export

nzv_check <- function(
    data,
    unique_cut = 10,
    freq_cut = 19
) {

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

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

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

  if (unique_cut < 0 || unique_cut > 100) {

    stop(
      "'unique_cut' must be between 0 and 100.",
      call. = FALSE
    )
  }

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

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

  if (freq_cut < 0) {

    stop(
      "'freq_cut' must be non-negative.",
      call. = FALSE
    )
  }

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

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

    observed <- x[!is.na(x)]

    n_observed <- length(observed)

    unique_values <- length(
      unique(observed)
    )

    #-------------------------------------------
    # Percentage unique
    #-------------------------------------------
    if (n_observed == 0L) {

      percent_unique <- NA_real_

    } else {

      percent_unique <-
        100 * unique_values / n_observed
    }

    #-------------------------------------------
    # Frequency ratio
    #-------------------------------------------
    if (unique_values <= 1L) {

      frequency_ratio <- Inf

    } else {

      frequencies <- sort(
        table(observed),
        decreasing = TRUE
      )

      frequency_ratio <-
        as.numeric(frequencies[1L]) /
        as.numeric(frequencies[2L])
    }

    #-------------------------------------------
    # Zero variance
    #-------------------------------------------
    zero_variance <- unique_values <= 1L

    #-------------------------------------------
    # Near-zero variance
    #-------------------------------------------
    if (zero_variance) {

      near_zero_variance <- TRUE

    } else {

      near_zero_variance <-
        percent_unique <= unique_cut &&
        frequency_ratio > freq_cut
    }

    list(
      Observed = n_observed,
      Missing = missing,
      UniqueValues = unique_values,
      PercentUnique = percent_unique,
      FrequencyRatio = frequency_ratio,
      ZeroVariance = zero_variance,
      NearZeroVariance = near_zero_variance
    )
  }

  #---------------------------------------------
  # Apply to variables
  #---------------------------------------------
  diagnostics <- lapply(
    data,
    analyse_variable
  )

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

    Variable = names(data),

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

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

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

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

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

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

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

    stringsAsFactors = FALSE,
    check.names = FALSE
  )

  #---------------------------------------------
  # Round percentages
  #---------------------------------------------
  result$PercentUnique <- round(
    result$PercentUnique,
    2
  )

  result$FrequencyRatio <- round(
    result$FrequencyRatio,
    2
  )

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

  result
}
