infixer: Provides a Set of Various Infix Operators

#' Inside Subset
#'
#' Operators for checking if value is within a given interval or subset.
#'
#' Parenthesss of each operator define how the subset is specified:\cr
#' \code{\%in\{\}\%} - lists all elements of the subset\cr
#' \code{\%in[]\%} - subset specified as an closed interval\cr
#' \code{\%in()\%} - subset specified as a open interval\cr
#' \code{\%in(]\%} - interval that is open on the left and closed on the right\cr
#' \code{\%in[)\%} - interval that is closed on the left and open on the right\cr
#'
#' The \code{\%in\{\}\%} operator is a reimplementation of \code{\%in\%} that
#' preserves the dimensions of \code{x} (see examples).
#'
#' The operations using intervals are a convenient short hand for\cr\code{x > interval[1] & x < interval[2]}.
#'
#' The idea for function names is taken from the package DescTools by Andri Signorell.
#'
#' @param x vector or array of values to be matched.
#' @param subset vector or list of values to be matched against.
#' @param interval vector with two elements defining an interval range.
#'
#' @return a logical vector or an array of the same dimensions as \code{x}
#' indicating if each value of \code{x} is within the defined subset.
#'
#' @seealso \code{\%in\%}, \code{\%out\%}, \code{\link[DescTools]{\%[]\%}}
#'
#' @examples
#'   c("a", "b", "Z") %in{}% letters
#'
#'   iris %in{}% "setosa"
#'
#'   1:10 %in(]% c(2,5)
#'
#' @name in
#' @author Karolis Koncevičius
#' @export
`%in{}%` <- function(x, subset) {
  res <- FALSE
  for(el in subset) {
    if(is.na(el)) {
      res <- res | is.na(x)
    } else {
      res <- res | !is.na(x) & x == el
    }
  }
  res
}

#' @rdname in
#' @export
`%in[]%` <- function(x, interval) {
  if(length(interval) != 2) {
    stop("'interval' has to be a vector with two elements")
  } else if(interval[1] > interval[2]) {
    stop("first element of 'interval' cannot be greater than second")
  }
  x >= interval[1] & x <= interval[2]
}

#' @rdname in
#' @export
`%in()%` <- function(x, interval) {
  if(length(interval) != 2) {
    stop("'interval' has to be a vector with two elements")
  } else if(interval[1] > interval[2]) {
    stop("first element of 'interval' cannot be greater than second")
  }
  x > interval[1] & x < interval[2]
}

#' @rdname in
#' @export
`%in(]%` <- function(x, interval) {
  if(length(interval) != 2) {
    stop("'interval' has to be a vector with two elements")
  } else if(interval[1] > interval[2]) {
    stop("first element of 'interval' cannot be greater than second")
  }
  x > interval[1] & x <= interval[2]
}

#' @rdname in
#' @export
`%in[)%` <- function(x, interval) {
  if(length(interval) != 2) {
    stop("'interval' has to be a vector with two elements")
  } else if(interval[1] > interval[2]) {
    stop("first element of 'interval' cannot be greater than second")
  }
  x >= interval[1] & x < interval[2]
}