Merge pull request #237 from jmbarbone/120-between

120 between

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: mark
 Type: Package
 Title: Miscellaneous, Analytic R Kernels
-Version: 0.8.0.9004
+Version: 0.8.0.9005
 Authors@R:
     person(given   = "Jordan Mark",
            family  = "Barbone",

NAMESPACE

@@ -107,6 +107,7 @@ export(assign_labels)
 export(base_alpha)
 export(base_n)
 export(between_more)
+export(betwixt)
 export(bump_date_version)
 export(bump_version)
 export(char2fact)

NEWS.md

@@ -3,6 +3,7 @@
 * `write_file_md5()` now supports `"feather"` and `"parquet"` methods as wrappers for [`{arrow}`]() [#234](https://github.com/jmbarbone/mark/issues/234)
 * `md5()` added to provide MD5 check sums for objects [#233](https://github.com/jmbarbone/jmbarbone/mark/issues/233)
 * `unique_rows()` added to subset on (non-)duplicated rows in a `data.frame` [#87](https://github.com/jmbarbone/mark/issues/87)
+* `betwixt()` added as an alternative to `between_more()` [#120](https://github.com/jmbarbone/mark/issues/120)
 * test updated for upcoming R release [#240](https://github.com/jmbarbone/mark/issues/240)
 
 # mark 0.8.0

R/between.R

@@ -0,0 +1,116 @@
+#' Betwixt boundaries
+#'
+#' Compare a vector betwitx (between) other values
+#'
+#' @param x A numeric vector of values
+#' @param left,right Boundary values.  For [betwixt()], when `NULL` no
+#'   comparison is made for that boundary.  When both are `NULL`, `x` is just
+#'   returned.
+#'
+#' @details `type``, `bounds`` can be one of the below:
+#'
+#' \describe{
+#'  \item{g,(}{is greater than (>)}
+#'  \item{ge,[}{greater than or equal to (>=)}
+#'  \item{l,))}{less than (<)}
+#'  \item{le,[]}{less than or equal to (<=)}
+#' }
+#'
+#' Note: [between_more()] may be deprecated in the future in favor of just
+#' [betwixt()]
+#'
+#' @returns A logical vector
+#'
+#' @examples
+#'
+#' between_more(2:10, 2, 10, "gl")
+#' betwixt(2:10, 2, bounds = "()")
+#' between_more(10, 2, 10, "gle")
+#' betwixt(2:10, bounds = "(]")
+#' betwixt(1:5, c(3, 3, 2, 2, 1), 5)
+#' @name betwixt
+#' @aliases between betwee_more
+NULL
+
+# TODO consider deprecating `between_more()` in favor of `betwixt()``
+
+#' @rdname betwixt
+#' @export
+#' @param type Abbreviation for the evaluation of `left` on `right` (see
+#'   details)
+between_more <- function(x, left, right, type = c("gele", "gel", "gle", "gl")) {
+  type <- match_param(type)
+
+  if (any(left > right, na.rm = TRUE)) {
+    warning(cond_between_more_lr())
+  }
+
+  switch(
+    type,
+    gele = x >= left & x <= right,
+    gel  = x >= left & x < right,
+    gle  = x > left & x <= right,
+    gl   = x > left & x < right
+  )
+}
+
+#' @rdname betwixt
+#' @export
+#' @param bounds Boundaries for comparisons of `left` and `right` (see details)
+betwixt <- function(
+    x,
+    left = NULL,
+    right = NULL,
+    bounds = c("[]", "[)", "(]", "()")
+) {
+  left_null <- is.null(left)
+  right_null <- is.null(right)
+
+  if (left_null && right_null) {
+    return(x)
+  }
+
+  if (any(left > right, na.rm = TRUE)) {
+    warning(cond_betwixt_lr())
+  }
+
+  funs <- switch(
+    match_param(bounds),
+    "[]" = c(">=", "<="),
+    "[)" = c(">=", "<"),
+    "(]" = c(">", "<="),
+    "()" = c(">", "<")
+  )
+
+  if (left_null) {
+    left <- TRUE
+  } else {
+    left <- do.call(funs[1], list(x, left))
+  }
+
+  if (right_null) {
+    right <- TRUE
+  } else {
+    right <- do.call(funs[2], list(x, right))
+  }
+
+  left & right
+}
+
+# conditions --------------------------------------------------------------
+
+cond_between_more_lr <- function() {
+  new_condition(
+    "`left` > `right`",
+    "between_more_lr",
+    type = "warning"
+  )
+}
+
+cond_betwixt_lr <- function() {
+  new_condition(
+    "`left` > `right`",
+    "betwixt_lr",
+    type = "warning"
+  )
+}

tests/testthat/test-between-more.R

@@ -36,3 +36,40 @@ test_that("between_more() works", {
     class = "betweenMoreLrWarning"
   )
 })
+
+
+test_that("betwixt()", {
+  x <- 1:20
+  ss <- x >= 5 & x <= 10
+  sr <- x >= 5 & x <  10
+  rs <- x >  5 & x <= 10
+  rr <- x >  5 & x <  10
+
+  expect_equal(betwixt(x, 5, 10, "[]"), ss)
+  expect_equal(betwixt(x, 5, 10, "[)"), sr)
+  expect_equal(betwixt(x, 5, 10, "(]"), rs)
+  expect_equal(betwixt(x, 5, 10, "()"), rr)
+
+  # vectors for left or right
+
+  x <- 1:5
+  left <- c(2, 2, 3, 2, 4)
+  right <- c(3, 3, 4, 3, 4)
+
+  res <- c(FALSE, TRUE, TRUE, TRUE, TRUE)
+  expect_identical(betwixt(x, left), res)
+
+  res <- c(FALSE, FALSE, TRUE, FALSE, FALSE)
+  expect_identical(betwixt(x, 3, right), res)
+
+  res <- c(FALSE, TRUE, TRUE, FALSE, FALSE)
+  expect_identical(betwixt(x, left, right), res)
+
+  expect_identical(betwixt(x), x)
+
+  expect_warning(
+    betwixt(1:2, 3, 2),
+    "`left` > `right`",
+    class = "betwixtLrWarning"
+  )
+})