# File getCatchments.R                                                         #
# Part of the RcamelsCL R package, https://gitlab.com/hgarcesf/RcamelsCL       #
#                                  https://CRAN.R-project.org/package=RcamelsCL#
# Copyright 2024-2026 Hector Garces-Figueroa and Mauricio Zambrano-Bigiarini   #
# Distributed under GPL 2 or later                                             #
################################################################################
#                             'getCatchments'                                  #
################################################################################
# Function that selects catchments from the CAMELS-CL dataset based on         #
# user-defined attribute filters                                               #
################################################################################
# Author : Hector Garces-Figueroa                                              #
################################################################################
# Started: December 2025                                                       #
# Updates: 2026-May-02                                                         #
################################################################################
# 'attr'            : Character. Name of the catchment attribute used for      #
#                     filtering. See RcamelsCL:::.print_attr_names() for the   #
#                     list of valid attribute names.                           #
#                                                                              #
# 'op'              : Character. Comparison operator applied to 'attr'.        #
#                     Valid values are: "==", "<", "<=", ">", ">="             #
#                     or "between"                                             #
#                                                                              #
# 'attr.val'        : Numeric or character. Threshold used together with 'op'  #
#                     to filter the selected attribute. When op = "between",   #
#                     'attr.val' defines the lower limit of the range.         #
#                                                                              #
# 'include.values'  : Logical. If TRUE, the output includes both the catchment #
#                     IDs and their attribute values. If FALSE, only the IDs   #
#                     are returned. Default is FALSE.                          #
#                                                                              #
# 'attr.val2'       : Numeric. Upper limit of the range when op = "between"    #
#                                                                              #
# 'include.lower'   : Logical. Should the lower limit defined in 'attr.val'    #
#                     be included in the "between" operation? Default is TRUE. #
#                                                                              #
# 'include.upper'   : Logical. Should the upper limit defined in 'attr.val2'   #
#                     be included in the "between" operation? Default is TRUE. #
#                                                                              #
# 'get.data'        : Logical. If TRUE, the function returns the data for each #
#                     identified catchment using RcamelsCL::getData().         #
#                     If FALSE, only the matching catchment IDs are returned.  #
#                     Default is FALSE.                                        #
#                                                                              #
# '...'             : Additional arguments passed to RcamelsCL::getData()      #
#                     when get.data = TRUE. See ?RcamelsCL::getData for        #
#                     details on the supported options.                        #
################################################################################

getCatchments <- function(attr,
                          op,
                          attr.val,
                          include.values = FALSE,
                          attr.val2 = NULL,
                          include.lower = TRUE,
                          include.upper = TRUE,
                          get.data = FALSE,
                          ...) {

  UseMethod("getCatchments")
}

getCatchments.default <- function(attr,
                                  op = c("==",
                                         "<",
                                         "<=",
                                         ">",
                                         ">=",
                                         "between"),
                                  attr.val,
                                  include.values = FALSE,
                                  attr.val2 = NULL,
                                  include.lower = TRUE,
                                  include.upper = TRUE,
                                  get.data = FALSE,
                                  ...) {

  if (missing(attr)) stop("'attr' argument must be specified!")
  attr.names <- names(.catchAttr)

  if (!inherits(attr, "character")) stop("'attr' must be of class character !")

  if (!attr %in% attr.names) {
    stop("'attr' not found !
        Check RcamelsCL:::.print_attr_names() for more details")
  } # IF end

  op <- match.arg(op)
  if (missing(attr.val)) {
    stop("'attr.val' argument must be specified to perform '", op,
         "' operation")
  } # IF end

  is.categorical <- .is_attr_categorical(x = attr)
  if (is.categorical && !identical(op, "==")) {
    stop("'==' is the only admited operation for caterogical attributes !")
  } # IF end

  if (!inherits(attr.val, c("numeric", "character"))) {
    stop("'attr.val' must be of class character for categorical attributes or
        numeric for continuous ones")
  } # IF end

  if (identical(op, "between") && inherits(attr.val2, "NULL")) {
    stop("'attr.val' must be specified to performo 'between' operation !")
  } # IF end

  if (!inherits(attr.val2, "NULL")) {

    if (!inherits(attr.val2, "numeric")) {
      stop("'attr.val2' must be numeric to perform 'between' operation !")
    } # IF end

    if (attr.val >= attr.val2) {
      stop("'attr.val' must be greater then attr.val2 !")
    } # IF end

  } # IF end

  # TODO: implement getCatchment for multiple attributes and operations
  out <- .find_catchment(attribute = attr,
                         operation = op,
                         val1 = attr.val,
                         val2 = attr.val2,
                         upper = include.upper,
                         lower = include.lower,
                         is.cat = is.categorical,
                         include.vals = include.values)
  n.out <- length(out)
  if (n.out == 0) get.data  <- FALSE

  if (get.data) {
    if (include.values) {
      n.out  <- dim(out)[[1]]
      aux.df <- out
      out    <- out[[1]]
    }
    if (n.out == 1) {
      data <- getData(x = out, ...)
    } else {
      data <- vector("list", length = length(out))
      names(data) <- paste0("X_", out)
      for (i in seq_len(n.out)) data[[i]] <- getData(x = out[[i]], ...)
    } # IF end

    aux <- vector("list", length = 2)
    names(aux) <- c("Catchment_ID", "Catchment_Data")
    aux[["Catchment_ID"]]   <- if (include.values) aux.df else out
    aux[["Catchment_Data"]] <- data
    out <- aux
  } # IF end

  return(out)
}

# core function to run filter_by_attr()
.find_catchment <- function(attribute, operation, val1, val2, upper, lower,
                            is.cat, include.vals) {
  trgt.data <- .catchAttr[, attribute]

  if (!identical(operation, "between")) {
    operation <- match.fun(operation)
    row.pos <- which(operation(trgt.data, val1))
  } else {
    op1 <- match.fun(">=")
    op2 <- match.fun("<=")
    if (lower == FALSE) op1 <- match.fun(">")
    if (upper == FALSE) op2 <- match.fun("<")
    row.pos <- which(op1(trgt.data, val1) & op2(trgt.data, val2))
  } # IF end

  if (length(row.pos) == 0) {
    warning("no catchment met the indicated criterion !")
    if (is.cat) {
      cat.options <- unique(.catchAttr[, attribute])
      cat.options <- paste0(cat.options, collapse = "\n")
      warning("available options for ", attribute, ":\n", cat.options)
    }
    out <- NULL
  } else {
    trgt.col <- "gauge_id"
    if (include.vals) trgt.col <- c(trgt.col, attribute)
    out <- .catchAttr[row.pos, trgt.col]
    rownames(out) <- NULL
  } # IF end

  return(out)
}

# auxiliary function that returns CAMELS-CL attribute names
.print_attr_names <- function() {
  names(.catchAttr)
}

# auxiliary function to determine if the specified attribute is categorical
.is_attr_categorical <- function(x) {
  is.categorical <- FALSE
  categorical.attr <- c("gauge_name",
                        "geol_class_1st",
                        "geol_class_2nd",
                        "lc_dom_name")
  if (x %in% categorical.attr) is.categorical <- TRUE

  return(is.categorical)
}