RXR-567: handle zero-length input in %>=%

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(print,nca_output)
+export("%<=%")
 export(absolute2relative_bsa)
 export(accumulation_ratio)
 export(add_ruv)

R/utils.R

@@ -28,5 +28,21 @@ remove_lt_gt <- function(x) {
 #' @param x Numeric vector
 #' @param y Numeric vector
 `%>=%` <- function(x, y) {
+  if (length(x) == 0 | length(y) == 0) {
+    return(logical(0))
+  }
   x > y | mapply(function(x, y) isTRUE(all.equal(x, y)), x, y)
 }
+
+#' Less-than-or-equal-to with a little room for floating point precision
+#' issues
+#'
+#' @param x Numeric vector
+#' @param y Numeric vector
+#' @export
+`%<=%` <- function(x, y) {
+  if (length(x) == 0 | length(y) == 0) {
+    return(logical(0))
+  }
+  x < y | mapply(function(x, y) isTRUE(all.equal(x, y)), x, y)
+}

tests/testthat/test_utils.R

@@ -39,6 +39,10 @@ test_that("%>=% operator works", {
   expect_true((0.7 - 0.4) %>=% 0.3)
 })
 
+test_that("%<=% operator works", {
+  expect_true((0.1 + 0.2) %<=% 0.3)
+})
+
 test_that("%>=% operator works on vectors", {
   res <- c(1, 2, 3, 4) %>=% c(0, 3, 1, 5)
   expect_equal(res, c(TRUE, FALSE, TRUE, FALSE))
@@ -55,3 +59,8 @@ test_that("%>=% operator handles vectors of different lengths", {
   expect_equal(2 %>=% c(1, 3), c(TRUE, FALSE))
   expect_equal(c(1, 3) %>=% 2, c(FALSE, TRUE))
 })
+
+test_that("%>=% handles zero-length input", {
+  expect_equal(c(1, 3) %>=% numeric(0), logical(0))
+  expect_equal(numeric(0) %>=% 5, logical(0))
+})