#==========================================================
# Pattern Check
#==========================================================

#' Check Character Patterns
#'
#' Checks whether values in a character or factor variable
#' match a user-specified regular expression.
#'
#' @param data A data.frame.
#' @param variable A single character string specifying the
#'   variable to check.
#' @param pattern A single non-empty character string
#'   containing a regular expression.
#' @param ignore_case Logical. If TRUE, matching ignores
#'   letter case. Default is FALSE.
#'
#' @return A data.frame of class \code{PatternCheck}
#'   containing row-level pattern diagnostics.
#'
#' @details
#' Missing values are reported separately and are not
#' classified as matching or invalid.
#'
#' Factor variables are converted to character internally
#' for pattern matching. The original values are retained
#' in the returned data frame.
#'
#' Pattern matching is performed using \code{grepl()}.
#'
#' @examples
#' dat <- data.frame(
#'   Sample_ID = c(
#'     "SMP-001",
#'     "SMP-002",
#'     "BAD-003",
#'     NA
#'   ),
#'   stringsAsFactors = FALSE
#' )
#'
#' pattern_check(
#'   dat,
#'   variable = "Sample_ID",
#'   pattern = "^SMP-[0-9]{3}$"
#' )
#'
#' @export

pattern_check <- function(
    data,
    variable,
    pattern,
    ignore_case = FALSE
) {

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

  #---------------------------------------------
  # Validate variable
  #---------------------------------------------
  if (missing(variable) ||
      !is.character(variable) ||
      length(variable) != 1L ||
      is.na(variable) ||
      !nzchar(variable)) {

    stop(
      "'variable' must be a single non-empty character string.",
      call. = FALSE
    )
  }

  #---------------------------------------------
  # Check variable exists
  #---------------------------------------------
  if (!variable %in% names(data)) {

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

  #---------------------------------------------
  # Validate pattern
  #---------------------------------------------
  if (missing(pattern) ||
      !is.character(pattern) ||
      length(pattern) != 1L ||
      is.na(pattern) ||
      !nzchar(pattern)) {

    stop(
      "'pattern' must be a single non-empty character string.",
      call. = FALSE
    )
  }

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

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

  #---------------------------------------------
  # Extract variable
  #---------------------------------------------
  x <- data[[variable]]

  #---------------------------------------------
  # Check supported type
  #---------------------------------------------
  if (!is.character(x) &&
      !is.factor(x)) {

    stop(
      "'variable' must refer to a character or factor variable.",
      call. = FALSE
    )
  }

  #---------------------------------------------
  # Convert for matching
  #---------------------------------------------
  values <- as.character(x)

  #---------------------------------------------
  # Missing values
  #---------------------------------------------
  missing_value <- is.na(values)

  #---------------------------------------------
  # Initialize matching vector
  #---------------------------------------------
  matches <- rep(
    FALSE,
    length(values)
  )

  #---------------------------------------------
  # Match non-missing observations
  #---------------------------------------------
  observed <- !missing_value

  if (any(observed)) {

    matches[observed] <- grepl(
      pattern = pattern,
      x = values[observed],
      ignore.case = ignore_case
    )
  }

  #---------------------------------------------
  # Invalid pattern values
  #---------------------------------------------
  invalid_pattern <-
    !missing_value &
    !matches

  #---------------------------------------------
  # Construct result
  #---------------------------------------------
  result <- data.frame(
    Row = seq_along(x),
    Value = x,
    Missing = missing_value,
    Match = matches,
    InvalidPattern = invalid_pattern,
    stringsAsFactors = FALSE,
    check.names = FALSE
  )

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

  result
}
