#==========================================================
# Consistency Check
#==========================================================

#' Check Consistency Between Two Variables
#'
#' Checks whether values in two variables satisfy a specified
#' logical relationship.
#'
#' @param data A data.frame.
#' @param variable1 A single character string specifying the
#'   first variable.
#' @param variable2 A single character string specifying the
#'   second variable.
#' @param relationship A character string specifying the
#'   expected relationship between the variables. Supported
#'   relationships are \code{"<"}, \code{"<="}, \code{">"},
#'   \code{">="}, \code{"=="}, and \code{"!="}.
#'
#' @return A data.frame of class \code{ConsistencyCheck}
#'   containing row-level consistency diagnostics.
#'
#' @details
#' The function evaluates the relationship as
#' \code{variable1 relationship variable2}.
#'
#' For example, when checking whether an end date occurs on
#' or after a start date, use:
#'
#' \code{variable1 = "EndDate"},
#' \code{variable2 = "StartDate"}, and
#' \code{relationship = ">="}.
#'
#' Rows containing a missing value in either variable are
#' reported separately and are not classified as consistent.
#'
#' The two variables must have compatible types for the
#' requested comparison.
#'
#' @examples
#' dat <- data.frame(
#'   StartDate = as.Date(c(
#'     "2026-01-01",
#'     "2026-02-01",
#'     "2026-03-01"
#'   )),
#'   EndDate = as.Date(c(
#'     "2026-01-10",
#'     "2026-01-20",
#'     "2026-03-15"
#'   ))
#' )
#'
#' consistency_check(
#'   dat,
#'   variable1 = "EndDate",
#'   variable2 = "StartDate",
#'   relationship = ">="
#' )
#'
#' @export

consistency_check <- function(
    data,
    variable1,
    variable2,
    relationship
) {

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

  #---------------------------------------------
  # Helper: validate variable name
  #---------------------------------------------
  validate_variable <- function(variable, argument) {

    if (
      !is.character(variable) ||
      length(variable) != 1L ||
      is.na(variable) ||
      !nzchar(variable)
    ) {
      stop(
        sprintf(
          "'%s' must be a single non-empty character string.",
          argument
        ),
        call. = FALSE
      )
    }

    if (!variable %in% names(data)) {
      stop(
        sprintf(
          "Variable '%s' was not found in 'data'.",
          variable
        ),
        call. = FALSE
      )
    }

    invisible(TRUE)
  }

  #---------------------------------------------
  # Validate required variables
  #---------------------------------------------
  if (missing(variable1)) {
    stop(
      "'variable1' must be supplied.",
      call. = FALSE
    )
  }

  if (missing(variable2)) {
    stop(
      "'variable2' must be supplied.",
      call. = FALSE
    )
  }

  validate_variable(
    variable1,
    "variable1"
  )

  validate_variable(
    variable2,
    "variable2"
  )

  #---------------------------------------------
  # Variables must differ
  #---------------------------------------------
  if (identical(variable1, variable2)) {
    stop(
      "'variable1' and 'variable2' must refer to different variables.",
      call. = FALSE
    )
  }

  #---------------------------------------------
  # Validate relationship
  #---------------------------------------------
  supported_relationships <- c(
    "<",
    "<=",
    ">",
    ">=",
    "==",
    "!="
  )

  if (
    missing(relationship) ||
    !is.character(relationship) ||
    length(relationship) != 1L ||
    is.na(relationship) ||
    !relationship %in% supported_relationships
  ) {
    stop(
      paste0(
        "'relationship' must be one of: ",
        "'<', '<=', '>', '>=', '==', or '!='."
      ),
      call. = FALSE
    )
  }

  #---------------------------------------------
  # Extract variables
  #---------------------------------------------
  x <- data[[variable1]]
  y <- data[[variable2]]

  #---------------------------------------------
  # Missing observations
  #---------------------------------------------
  missing_value <- is.na(x) | is.na(y)

  #---------------------------------------------
  # Evaluate relationship
  #---------------------------------------------
  consistent <- rep(
    FALSE,
    length(x)
  )

  valid_index <- which(!missing_value)

  if (length(valid_index) > 0L) {

    comparison <- tryCatch(
      {
        switch(
          relationship,
          "<" = x[valid_index] < y[valid_index],
          "<=" = x[valid_index] <= y[valid_index],
          ">" = x[valid_index] > y[valid_index],
          ">=" = x[valid_index] >= y[valid_index],
          "==" = x[valid_index] == y[valid_index],
          "!=" = x[valid_index] != y[valid_index]
        )
      },
      error = function(e) {
        stop(
          paste0(
            "The selected variables cannot be compared ",
            "using relationship '",
            relationship,
            "'."
          ),
          call. = FALSE
        )
      }
    )

    #-------------------------------------------
    # Protect against undefined comparisons
    #-------------------------------------------
    comparison[is.na(comparison)] <- FALSE

    consistent[valid_index] <- comparison
  }

  #---------------------------------------------
  # Inconsistency
  #---------------------------------------------
  inconsistent <-
    !missing_value &
    !consistent

  #---------------------------------------------
  # Construct result
  #---------------------------------------------
  result <- data.frame(
    Row = seq_along(x),
    Value1 = x,
    Value2 = y,
    Missing = missing_value,
    Consistent = consistent,
    Inconsistent = inconsistent,
    stringsAsFactors = FALSE,
    check.names = FALSE
  )

  #---------------------------------------------
  # Assign class
  #---------------------------------------------
  class(result) <- c(
    "ConsistencyCheck",
    "data.frame"
  )

  result
}
