#==========================================================
# Data Audit
#==========================================================

#' Perform a General Data Quality Audit
#'
#' Performs a general audit of a data frame and summarizes
#' common data-quality problems including missing values,
#' blank values, infinite values, constant variables,
#' near-zero variance variables, and duplicated rows.
#'
#' @param data A data.frame.
#' @param include_nzv Logical. If TRUE, near-zero variance
#'   variables are included in the audit. Default is TRUE.
#' @param rules Optional object of class \code{DataAuditRules}
#'   created by \code{\link{audit_rules}}. When supplied,
#'   the rules are evaluated and included in the audit
#'   report.
#'
#' @return An object of class \code{DataAuditReport}.
#'
#' @details
#' \code{audit_data()} is intended as a general first-pass
#' audit requiring minimal user configuration.
#'
#' More specialized checks such as ranges, categories,
#' patterns, identifiers, dates, dependencies, and
#' cross-variable consistency can be performed using the
#' corresponding DataAudit functions.
#'
#' Custom validation rules created with
#' \code{\link{audit_rules}} can be supplied through
#' \code{rules}. These rules are evaluated using
#' \code{\link{apply_audit_rules}}.
#'
#' The returned object contains:
#'
#' \itemize{
#'   \item \code{overview}: basic dataset information.
#'   \item \code{variables}: variable-level audit summary.
#'   \item \code{duplicates}: duplicated-row diagnostics.
#'   \item \code{summary}: overall audit statistics.
#'   \item \code{rules}: custom rule results, or NULL when
#'     no rules are supplied.
#' }
#'
#' @examples
#' dat <- data.frame(
#'   ID = c(1, 2, 2, 4),
#'   Species = c("Dog", "", "", "Cat"),
#'   Value = c(10, NA, Inf, 20),
#'   Constant = 1
#' )
#'
#' audit_data(dat)
#'
#' rules <- audit_rules(
#'   range = list(
#'     Value = c(0, 100)
#'   ),
#'   required = "Species"
#' )
#'
#' audit_data(
#'   dat,
#'   rules = rules
#' )
#'
#' @export

audit_data <- function(
    data,
    include_nzv = TRUE,
    rules = NULL
) {

  #---------------------------------------------
  # Validate data
  #---------------------------------------------
  validate_data(data)

  #---------------------------------------------
  # Validate include_nzv
  #---------------------------------------------
  if (
    !is.logical(include_nzv) ||
    length(include_nzv) != 1L ||
    is.na(include_nzv)
  ) {

    stop(
      "'include_nzv' must be TRUE or FALSE.",
      call. = FALSE
    )
  }

  #---------------------------------------------
  # Validate rules
  #---------------------------------------------
  if (
    !is.null(rules) &&
    !inherits(
      rules,
      "DataAuditRules"
    )
  ) {

    stop(
      "'rules' must be NULL or an object created by audit_rules().",
      call. = FALSE
    )
  }

  #---------------------------------------------
  # Basic dimensions
  #---------------------------------------------
  n_rows <- nrow(data)
  n_variables <- ncol(data)

  variable_names <- names(data)

  #---------------------------------------------
  # Missing values
  #---------------------------------------------
  missing_n <- vapply(
    data,
    function(x) {
      sum(is.na(x))
    },
    numeric(1)
  )

  missing_percent <-
    100 * missing_n / n_rows

  #---------------------------------------------
  # Blank values
  #---------------------------------------------
  blank_n <- vapply(
    data,
    function(x) {

      if (
        is.character(x) ||
        is.factor(x)
      ) {

        y <- as.character(x)

        return(
          sum(
            !is.na(y) &
              grepl(
                "^[[:space:]]*$",
                y
              )
          )
        )
      }

      0
    },
    numeric(1)
  )

  #---------------------------------------------
  # Infinite values
  #---------------------------------------------
  infinite_n <- vapply(
    data,
    function(x) {

      if (is.numeric(x)) {

        return(
          sum(
            is.infinite(x),
            na.rm = TRUE
          )
        )
      }

      0
    },
    numeric(1)
  )

  #---------------------------------------------
  # Unique non-missing values
  #---------------------------------------------
  unique_n <- vapply(
    data,
    function(x) {

      length(
        unique(
          x[!is.na(x)]
        )
      )
    },
    integer(1)
  )

  #---------------------------------------------
  # Constant variables
  #---------------------------------------------
  constant <-
    unique_n <= 1L

  #---------------------------------------------
  # Near-zero variance
  #---------------------------------------------
  near_zero_variance <- rep(
    FALSE,
    n_variables
  )

  if (include_nzv) {

    near_zero_variance <- vapply(
      data,
      function(x) {

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

        if (length(y) == 0L) {
          return(TRUE)
        }

        tab <- table(
          y,
          useNA = "no"
        )

        if (length(tab) <= 1L) {
          return(TRUE)
        }

        sorted_counts <- sort(
          as.numeric(tab),
          decreasing = TRUE
        )

        frequency_ratio <-
          sorted_counts[1L] /
          sorted_counts[2L]

        percent_unique <-
          100 *
          length(tab) /
          length(y)

        frequency_ratio > 19 &&
          percent_unique <= 10
      },
      logical(1)
    )
  }

  #---------------------------------------------
  # Variable classes
  #---------------------------------------------
  variable_class <- vapply(
    data,
    function(x) {
      class(x)[1L]
    },
    character(1)
  )

  #---------------------------------------------
  # Variable-level issue
  #---------------------------------------------
  variable_issue <-
    missing_n > 0 |
    blank_n > 0 |
    infinite_n > 0 |
    constant |
    near_zero_variance

  #---------------------------------------------
  # Variable summary
  #---------------------------------------------
  variables <- data.frame(
    Variable = variable_names,
    Class = variable_class,
    Missing = as.integer(missing_n),
    MissingPercent =
      as.numeric(missing_percent),
    Blank = as.integer(blank_n),
    Infinite = as.integer(infinite_n),
    Unique = as.integer(unique_n),
    Constant = constant,
    NearZeroVariance =
      near_zero_variance,
    Issue = variable_issue,
    stringsAsFactors = FALSE,
    check.names = FALSE
  )

  #---------------------------------------------
  # Duplicate rows
  #---------------------------------------------
  duplicate_flag <-
    duplicated(data) |
    duplicated(
      data,
      fromLast = TRUE
    )

  duplicates <- data.frame(
    Row = seq_len(n_rows),
    Duplicate = duplicate_flag,
    stringsAsFactors = FALSE
  )

  #---------------------------------------------
  # Overview
  #---------------------------------------------
  overview <- data.frame(
    Metric = c(
      "Rows",
      "Variables",
      "Missing values",
      "Blank values",
      "Infinite values",
      "Duplicated rows",
      "Constant variables",
      "Near-zero variance variables",
      "Variables with issues"
    ),
    Value = c(
      n_rows,
      n_variables,
      sum(missing_n),
      sum(blank_n),
      sum(infinite_n),
      sum(duplicate_flag),
      sum(constant),
      sum(near_zero_variance),
      sum(variable_issue)
    ),
    stringsAsFactors = FALSE
  )

  #---------------------------------------------
  # Automatic audit issue count
  #---------------------------------------------
  total_issues <-
    sum(missing_n) +
    sum(blank_n) +
    sum(infinite_n) +
    sum(duplicate_flag) +
    sum(constant) +
    sum(near_zero_variance)

  #---------------------------------------------
  # Apply custom audit rules
  #---------------------------------------------
  rule_results <- NULL

  if (!is.null(rules)) {

    rule_results <- apply_audit_rules(
      data,
      rules
    )
  }

  #---------------------------------------------
  # Rule violation count
  #---------------------------------------------
  rule_violations <- if (
    is.null(rule_results)
  ) {

    0L

  } else {

    as.integer(
      rule_results$total_violations
    )
  }

  #---------------------------------------------
  # Overall summary
  #---------------------------------------------
  summary <- data.frame(
    Rows = n_rows,
    Variables = n_variables,
    VariablesWithIssues =
      sum(variable_issue),
    DuplicateRows =
      sum(duplicate_flag),
    TotalIssues =
      total_issues,
    RuleViolations =
      rule_violations,
    OverallIssues =
      total_issues +
      rule_violations,
    stringsAsFactors = FALSE
  )

  #---------------------------------------------
  # Construct report
  #---------------------------------------------
  result <- list(
    overview = overview,
    variables = variables,
    duplicates = duplicates,
    summary = summary,
    rules = rule_results
  )

  class(result) <- c(
    "DataAuditReport",
    "list"
  )

  result
}
