[Fix #658] Accept a list of intervals in %within%

NEWS.md

@@ -1,6 +1,10 @@
 Version 1.7.3.9000
 ==================
 
+### NEW FEATURES
+
+* [#658](https://github.com/tidyverse/lubridate/issues/658) `%within%` now accepts a list of intervals, in which case an instant is checked if it occurs within any of the supplied intervals.
+
 ### CHANGES
 
 * [#661](https://github.com/tidyverse/lubridate/issues/661) Throw error on invalid multi-unit rounding.

R/intervals.r

@@ -521,32 +521,51 @@ setMethod("setdiff", signature(x = "Interval", y = "Interval"), function(x, y) {
 
 #' Tests whether a date or interval falls within an interval
 #'
-#' %within% returns TRUE if a falls within interval b, FALSE otherwise.
-#' If a is an interval, both its start and end dates must fall within b
-#' to return TRUE.
+#' %within% returns TRUE if `a` falls within interval `b`. Both `a` and `b` are
+#' recycled according to standard R rules. If `b` is a list of intervals, `a` is
+#' checked if it falls within any of the intervals in `b`. If a is an interval,
+#' both its start and end dates must fall within b to return TRUE.
 #'
 #' @export
 #' @rdname within-interval
 #' @aliases %within%,Interval,Interval-method %within%,ANY,Interval-method
 #' @param a An interval or date-time object
-#' @param b An interval
+#' @param b An interval or a list of intervals (see examples)
 #' @return A logical
 #' @examples
+#'
 #' int <- interval(ymd("2001-01-01"), ymd("2002-01-01"))
 #' int2 <- interval(ymd("2001-06-01"), ymd("2002-01-01"))
 #'
 #' ymd("2001-05-03") %within% int # TRUE
 #' int2 %within% int # TRUE
 #' ymd("1999-01-01") %within% int # FALSE
+#'
+#' ## recycling
+#' dates <- ymd(c("2014-12-20", "2014-12-30", "2015-01-01", "2015-01-03"))
+#' blackouts<- c(interval(ymd("2014-12-30"), ymd("2014-12-31")),
+#'               interval(ymd("2014-12-30"), ymd("2015-01-03")))
+#' testdates %within% blackouts
+#'
+#' ## within ANY of the intervals of a list
+#' dates <- ymd(c("2014-12-20", "2014-12-30", "2015-01-01", "2015-01-03"))
+#' blackouts<- list(interval(ymd("2014-12-30"), ymd("2014-12-31")),
+#'                  interval(ymd("2014-12-30"), ymd("2015-01-03")))
+#' testdates %within% blackouts
+
 "%within%" <- function(a, b) standardGeneric("%within%")
 
 #' @export
 setGeneric("%within%")
 
+.within <- function(a, int) {
+  as.numeric(a) - as.numeric(int@start) <= int@.Data & as.numeric(a) - as.numeric(int@start) >= 0
+}
+
 setMethod("%within%", signature(b = "Interval"), function(a, b) {
   if (!is.instant(a)) stop("Argument 1 is not a recognized date-time")
   a <- as.POSIXct(a)
-  as.numeric(a) - as.numeric(b@start) <= b@.Data & as.numeric(a) - as.numeric(b@start) >= 0
+  .within(a, b)
 })
 
 setMethod("%within%", signature(a = "Interval", b = "Interval"), function(a, b) {
@@ -557,6 +576,28 @@ setMethod("%within%", signature(a = "Interval", b = "Interval"), function(a, b)
   start.in & end.in
 })
 
+setMethod("%within%", signature(a = "Interval", b = "Interval"), function(a, b) {
+  a <- int_standardize(a)
+  b <- int_standardize(b)
+  start.in <- as.numeric(a@start) >= as.numeric(b@start)
+  end.in <- (as.numeric(a@start) + a@.Data) <= (as.numeric(b@start) + b@.Data)
+  start.in & end.in
+})
+
+.within_instant <- function(a, b) {
+  if (!all(sapply(b, is.interval)))
+    stop("When second argument to %within% is a list it must contain interval objects only")
+  a <- as.POSIXct(a)
+  out <- FALSE
+  for (int in b) {
+    out <- out | .within(a, int)
+  }
+  out
+}
+
+setMethod("%within%", signature(a = "POSIXt", b = "list"), .within_instant)
+setMethod("%within%", signature(a = "Date", b = "list"), .within_instant)
+
 #' @export
 as.list.Interval <- function(x, ...) {
   lapply(seq_along(x), function(i) x[[i]])

tests/testthat/test-intervals.R

@@ -594,6 +594,27 @@ test_that("%within% works as expected", {
 
 })
 
+
+test_that("%with% recycles both arguments", {
+  blackouts<- c(interval(ymd("2014-12-30"), ymd("2014-12-31")),
+                interval(ymd("2014-12-30"), ymd("2015-01-03")))
+  testdates <-c(ymd("2014-12-20", ymd("2014-12-30"), ymd("2015-01-01"), ymd("2015-01-03")))
+  expect_equal(testdates %within% blackouts, c(F, T, F, T))
+})
+
+test_that("%with% works with list of intervals", {
+
+  testdates <-ymd(c("2014-12-20", "2014-12-30", "2015-01-01", "2015-01-03"))
+  blackouts<- list(interval(ymd("2014-12-30"), ymd("2014-12-31")),
+                   interval(ymd("2014-12-30"), ymd("2015-01-03")))
+  expect_equal(testdates %within% blackouts, c(F, T, T, T))
+  testdates <-c(ymd(c("2014-12-20", "2014-12-30", "2015-01-01", "2015-01-03"), tz = "UTC"))
+  blackouts<- list(interval(ymd("2014-12-30"), ymd("2014-12-31")),
+                   interval(ymd("2014-12-30"), ymd("2015-01-03")))
+  expect_equal(testdates %within% blackouts, c(F, T, T, T))
+
+})
+
 test_that("summary.Interval creates useful summary", {
   time1 <- as.POSIXct("2001-01-01", tz = "UTC")
   time2 <- as.POSIXct("2003-01-01", tz = "UTC")