Checking interval membership in a tidy-ish way

interval-checking.R

library(dplyr)
library(purrr)


#### setup ####

tbl <- tibble(
  id = 1:25
)

# tidy way to store many intervals with minimal restriction
interval_tbl <- tribble(
       ~id, ~lower, ~upper,
     "foo",      0,       2,
     "bar",     10,      12,
     "baz",     20,      22,
  "foobar",      2,      10,  # overlap at bounds
  "barbaz",     11,      21   # further overlap
)


#### functions ####

in_any_interval <- function(x, interval_tbl) {
  
  interval_tbl %>%
    select(lower, upper) %>% 
    pmap(~ between(x, ..1, ..2)) %>%
    pmap_lgl(any)
}

# minor change
how_many_intervals <- function(x, interval_tbl) {
  
  interval_tbl %>%
    select(lower, upper) %>% 
    pmap(~ between(x, ..1, ..2)) %>%
    pmap_int(sum)
}

# bit weirder
which_intervals <- function(x, interval_tbl) {
  
  interval_tbl %>%
    select(lower, upper) %>% 
    pmap(~ between(x, ..1, ..2)) %>%
    pmap(lift_vd(which))
}


#### usage ####

# one at a time
# inefficient if you actually want more than one of these
naive_result <- tbl %>%
  mutate(
    in_any_interval    = in_any_interval(   id, interval_tbl),
    how_many_intervals = how_many_intervals(id, interval_tbl),
    which_intervals    = which_intervals(   id, interval_tbl)
  )

# more efficient
# everything can be computed from which
better_result <- tbl %>%
  mutate(
    which_intervals    = which_intervals(id, interval_tbl),
    how_many_intervals = map_int(which_intervals, length),
    in_any_interval    = map_lgl(which_intervals, ~ length(.x) > 0)
  )

# apparently all.equal/all_equal hates list cols
results <- list(naive_result, better_result)
results %>%
  map(select, -which_intervals) %>%
  reduce(all_equal)
results %>%
  map(pull, which_intervals) %>%
  reduce(all.equal)