R Under development (unstable) (2024-05-17 r86566 ucrt) -- "Unsuffered Consequences" Copyright (C) 2024 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > #devtools::install_github("psolymos/intrval") > > library(intrval) > > ## run examples with \dontrun sections > > help_pages <- c("%[]%", "%[o]%", "%ni%") > > for (i in help_pages) { + cat("\n\n---------- intrval example:", i, "----------\n\n") + eval(parse(text=paste0("example('", i, + "', package = 'intrval', run.dontrun = TRUE)"))) + } ---------- intrval example: %[]% ---------- %[]%> ## motivating example from example(lm) %[]%> %[]%> ## Annette Dobson (1990) "An Introduction to Generalized Linear Models". %[]%> ## Page 9: Plant Weight Data. %[]%> ctl <- c(4.17,5.58,5.18,6.11,4.50,4.61,5.17,4.53,5.33,5.14) %[]%> trt <- c(4.81,4.17,4.41,3.59,5.87,3.83,6.03,4.89,4.32,4.69) %[]%> group <- gl(2, 10, 20, labels = c("Ctl","Trt")) %[]%> weight <- c(ctl, trt) %[]%> lm.D9 <- lm(weight ~ group) %[]%> ## compare 95% confidence intervals with 0 %[]%> (CI.D9 <- confint(lm.D9)) 2.5 % 97.5 % (Intercept) 4.56934 5.4946602 groupTrt -1.02530 0.2833003 %[]%> 0 %[]% CI.D9 (Intercept) groupTrt FALSE TRUE %[]%> ## comparing dates %[]%> %[]%> DATE <- as.Date(c("2000-01-01","2000-02-01", "2000-03-31")) %[]%> DATE %[<]% as.Date(c("2000-01-151", "2000-03-15")) [1] TRUE FALSE FALSE %[]%> DATE %[]% as.Date(c("2000-01-151", "2000-03-15")) [1] FALSE TRUE FALSE %[]%> DATE %[>]% as.Date(c("2000-01-151", "2000-03-15")) [1] FALSE FALSE TRUE %[]%> ## interval formats %[]%> %[]%> x <- rep(4, 5) %[]%> a <- 1:5 %[]%> b <- 3:7 %[]%> cbind(x=x, a=a, b=b) x a b [1,] 4 1 3 [2,] 4 2 4 [3,] 4 3 5 [4,] 4 4 6 [5,] 4 5 7 %[]%> x %[]% cbind(a, b) # matrix [1] FALSE TRUE TRUE TRUE FALSE %[]%> x %[]% data.frame(a=a, b=b) # data.frame [1] FALSE TRUE TRUE TRUE FALSE %[]%> x %[]% list(a, b) # list [1] FALSE TRUE TRUE TRUE FALSE %[]%> ## helper functions %[]%> %[]%> intrval_types() # print Expression Visual Condition %[]% x %[]% c(a, b) ---x===x--- x >= a & x <= b %)(% x %)(% c(a, b) ===o---o=== x < a | x > b %[<]% x %[<]% c(a, b) ===o---o--- x < a %[>]% x %[>]% c(a, b) ---o---o=== x > b %[)% x %[)% c(a, b) ---x===o--- x >= a & x < b %)[% x %)[% c(a, b) ===o---x=== x < a | x >= b %[<)% x %[<)% c(a, b) ===o---o--- x < a %[>)% x %[>)% c(a, b) ---o---x=== x >= b %(]% x %(]% c(a, b) ---o===x--- x > a & x <= b %](% x %](% c(a, b) ===x---o=== x <= a | x > b %(<]% x %(<]% c(a, b) ===x---o--- x <= a %(>]% x %(>]% c(a, b) ---o---o=== x > b %()% x %()% c(a, b) ---o===o--- x > a & x < b %][% x %][% c(a, b) ===x---x=== x <= a | x >= b %(<)% x %(<)% c(a, b) ===x---o--- x <= a %(>)% x %(>)% c(a, b) ---o---x=== x >= b %[]%> intrval_types(plot = TRUE) # plot %[]%> ## graphical examples %[]%> %[]%> ## bounding box %[]%> set.seed(1) %[]%> n <- 10^4 %[]%> x <- runif(n, -2, 2) %[]%> y <- runif(n, -2, 2) %[]%> iv1 <- x %[]% c(-1, 1) & y %[]% c(-1, 1) %[]%> plot(x, y, pch = 19, cex = 0.25, col = iv1 + 1, main = "Bounding box") %[]%> ## time series filtering %[]%> x <- seq(0, 4*24*60*60, 60*60) %[]%> dt <- as.POSIXct(x, origin="2000-01-01 00:00:00") %[]%> f <- as.POSIXlt(dt)$hour %[]% c(0, 11) %[]%> plot(sin(x) ~ dt, type="l", col="grey", %[]%+ main = "Filtering date/time objects") %[]%> points(sin(x) ~ dt, pch = 19, col = f + 1) %[]%> ## watch precedence %[]%> (2 * 1:5) %[]% (c(2, 3) * 2) [1] FALSE TRUE TRUE FALSE FALSE %[]%> 2 * 1:5 %[]% (c(2, 3) * 2) [1] 0 0 0 2 2 %[]%> (2 * 1:5) %[]% c(2, 3) * 2 [1] 2 0 0 0 0 %[]%> 2 * 1:5 %[]% c(2, 3) * 2 [1] 0 4 4 0 0 ---------- intrval example: %[o]% ---------- %[o]%> ## motivating examples from example(lm) %[o]%> %[o]%> ## Annette Dobson (1990) "An Introduction to Generalized Linear Models". %[o]%> ## Page 9: Plant Weight Data. %[o]%> ctl <- c(4.17,5.58,5.18,6.11,4.50,4.61,5.17,4.53,5.33,5.14) %[o]%> trt <- c(4.81,4.17,4.41,3.59,5.87,3.83,6.03,4.89,4.32,4.69) %[o]%> group <- gl(2, 10, 20, labels = c("Ctl","Trt")) %[o]%> weight <- c(ctl, trt) %[o]%> lm.D90 <- lm(weight ~ group - 1) # omitting intercept %[o]%> ## compare 95% confidence of the 2 groups to each other %[o]%> (CI.D90 <- confint(lm.D90)) 2.5 % 97.5 % groupCtl 4.56934 5.49466 groupTrt 4.19834 5.12366 %[o]%> CI.D90[1,] %[o]% CI.D90[2,] 2.5 % TRUE %[o]%> ## simple interval comparisons %[o]%> c(2:3) %[o]% c(0:1) [1] FALSE %[o]%> ## vectorized comparisons %[o]%> c(2:3) %[o]% list(0:4, 1:5) [1] FALSE TRUE TRUE TRUE FALSE %[o]%> c(2:3) %[o]% cbind(0:4, 1:5) [1] FALSE TRUE TRUE TRUE FALSE %[o]%> c(2:3) %[o]% data.frame(a=0:4, b=1:5) [1] FALSE TRUE TRUE TRUE FALSE %[o]%> list(0:4, 1:5) %[o]% c(2:3) [1] FALSE TRUE TRUE TRUE FALSE %[o]%> cbind(0:4, 1:5) %[o]% c(2:3) [1] FALSE TRUE TRUE TRUE FALSE %[o]%> data.frame(a=0:4, b=1:5) %[o]% c(2:3) [1] FALSE TRUE TRUE TRUE FALSE %[o]%> list(0:4, 1:5) %[o]% cbind(rep(2,5), rep(3,5)) [1] FALSE TRUE TRUE TRUE FALSE %[o]%> cbind(rep(2,5), rep(3,5)) %[o]% list(0:4, 1:5) [1] FALSE TRUE TRUE TRUE FALSE %[o]%> cbind(rep(3,5),rep(4,5)) %)o(% cbind(1:5, 2:6) [1] TRUE FALSE FALSE FALSE TRUE %[o]%> cbind(rep(3,5),rep(4,5)) %[ cbind(rep(3,5),rep(4,5)) %[o>]% cbind(1:5, 2:6) [1] TRUE FALSE FALSE FALSE FALSE %[o]%> ## open intervals %[o]%> %[o]%> list(0:4, 1:5) %(o)% cbind(rep(2,5), rep(3,5)) [1] FALSE FALSE TRUE FALSE FALSE %[o]%> cbind(rep(2,5), rep(3,5)) %(o)% list(0:4, 1:5) [1] FALSE FALSE TRUE FALSE FALSE %[o]%> cbind(rep(3,5),rep(4,5)) %]o[% cbind(1:5, 2:6) [1] TRUE TRUE FALSE TRUE TRUE %[o]%> cbind(rep(3,5),rep(4,5)) %( cbind(rep(3,5),rep(4,5)) %(o>)% cbind(1:5, 2:6) [1] TRUE TRUE FALSE FALSE FALSE %[o]%> dt1 <- as.Date(c("2000-01-01", "2000-03-15")) %[o]%> dt2 <- as.Date(c("2000-03-15", "2000-06-07")) %[o]%> dt1 %[]o[]% dt2 [1] TRUE %[o]%> dt1 %[]o[)% dt2 [1] TRUE %[o]%> dt1 %[]o(]% dt2 [1] FALSE %[o]%> dt1 %[]o()% dt2 [1] FALSE %[o]%> dt1 %[)o[]% dt2 [1] FALSE %[o]%> dt1 %[)o[)% dt2 [1] FALSE %[o]%> dt1 %[)o(]% dt2 [1] FALSE %[o]%> dt1 %[)o()% dt2 [1] FALSE %[o]%> dt1 %(]o[]% dt2 [1] TRUE %[o]%> dt1 %(]o[)% dt2 [1] TRUE %[o]%> dt1 %(]o(]% dt2 [1] FALSE %[o]%> dt1 %(]o()% dt2 [1] FALSE %[o]%> dt1 %()o[]% dt2 [1] FALSE %[o]%> dt1 %()o[)% dt2 [1] FALSE %[o]%> dt1 %()o(]% dt2 [1] FALSE %[o]%> dt1 %()o()% dt2 [1] FALSE %[o]%> ## watch precedence %[o]%> (2 * c(1, 3)) %[o]% (c(2, 4) * 2) [1] TRUE %[o]%> (2 * c(1, 3)) %[o]% c(2, 4) * 2 [1] 2 %[o]%> 2 * c(1, 3) %[o]% (c(2, 4) * 2) [1] 0 %[o]%> 2 * c(1, 3) %[o]% c(2, 4) * 2 [1] 4 ---------- intrval example: %ni% ---------- %ni%> 1:10 %ni% c(1,3,5,9) [1] FALSE TRUE FALSE TRUE FALSE TRUE TRUE TRUE FALSE TRUE %ni%> 1:10 %nin% c(1,3,5,9) [1] FALSE TRUE FALSE TRUE FALSE TRUE TRUE TRUE FALSE TRUE %ni%> 1:10 %notin% c(1,3,5,9) [1] FALSE TRUE FALSE TRUE FALSE TRUE TRUE TRUE FALSE TRUE %ni%> sstr <- c("c","ab","B","bba","c",NA,"@","bla","a","Ba","%") %ni%> sstr[sstr %ni% c(letters, LETTERS)] [1] "ab" "bba" NA "@" "bla" "Ba" "%" > > ## testing > > test_fun <- function(xchr, achr, bchr, printout=TRUE, expect_NA=FALSE) { + tab <- intrval_types(type=NULL) + ex <- tab[,"Expression"] + cond <- tab[,"Condition"] + eval(parse(text=paste0("x <- ", xchr))) + eval(parse(text=paste0("a <- ", achr))) + eval(parse(text=paste0("b <- ", bchr))) + for (i in seq_len(nrow(tab))) { + xpt <- eval(parse(text=cond[i])) + got <- eval(parse(text=ex[i])) + if (printout) { + cat("\n", rownames(tab)[i], "\n") + mat <- rbind(Expect=xpt, Found=got) + print(mat) + } + allOK <- if (expect_NA) + all(is.na(got)) else all(xpt == got) + stopifnot(allOK) + } + invisible(NULL) + } > > ## integer > test_fun("1L:5L", "2L", "4L") Expression Visual Condition %[]% x %[]% c(a, b) ---x===x--- x >= a & x <= b %)(% x %)(% c(a, b) ===o---o=== x < a | x > b %[<]% x %[<]% c(a, b) ===o---o--- x < a %[>]% x %[>]% c(a, b) ---o---o=== x > b %[)% x %[)% c(a, b) ---x===o--- x >= a & x < b %)[% x %)[% c(a, b) ===o---x=== x < a | x >= b %[<)% x %[<)% c(a, b) ===o---o--- x < a %[>)% x %[>)% c(a, b) ---o---x=== x >= b %(]% x %(]% c(a, b) ---o===x--- x > a & x <= b %](% x %](% c(a, b) ===x---o=== x <= a | x > b %(<]% x %(<]% c(a, b) ===x---o--- x <= a %(>]% x %(>]% c(a, b) ---o---o=== x > b %()% x %()% c(a, b) ---o===o--- x > a & x < b %][% x %][% c(a, b) ===x---x=== x <= a | x >= b %(<)% x %(<)% c(a, b) ===x---o--- x <= a %(>)% x %(>)% c(a, b) ---o---x=== x >= b %[]% [,1] [,2] [,3] [,4] [,5] Expect FALSE TRUE TRUE TRUE FALSE Found FALSE TRUE TRUE TRUE FALSE %)(% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE FALSE TRUE Found TRUE FALSE FALSE FALSE TRUE %[<]% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE FALSE FALSE Found TRUE FALSE FALSE FALSE FALSE %[>]% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE FALSE TRUE Found FALSE FALSE FALSE FALSE TRUE %[)% [,1] [,2] [,3] [,4] [,5] Expect FALSE TRUE TRUE FALSE FALSE Found FALSE TRUE TRUE FALSE FALSE %)[% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE TRUE TRUE Found TRUE FALSE FALSE TRUE TRUE %[<)% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE FALSE FALSE Found TRUE FALSE FALSE FALSE FALSE %[>)% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE TRUE TRUE Found FALSE FALSE FALSE TRUE TRUE %(]% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE TRUE TRUE FALSE Found FALSE FALSE TRUE TRUE FALSE %](% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE FALSE TRUE Found TRUE TRUE FALSE FALSE TRUE %(<]% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE FALSE FALSE Found TRUE TRUE FALSE FALSE FALSE %(>]% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE FALSE TRUE Found FALSE FALSE FALSE FALSE TRUE %()% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE TRUE FALSE FALSE Found FALSE FALSE TRUE FALSE FALSE %][% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE TRUE TRUE Found TRUE TRUE FALSE TRUE TRUE %(<)% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE FALSE FALSE Found TRUE TRUE FALSE FALSE FALSE %(>)% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE TRUE TRUE Found FALSE FALSE FALSE TRUE TRUE > ## numeric > test_fun("(1:5)+0.5", "2.5","4.5") Expression Visual Condition %[]% x %[]% c(a, b) ---x===x--- x >= a & x <= b %)(% x %)(% c(a, b) ===o---o=== x < a | x > b %[<]% x %[<]% c(a, b) ===o---o--- x < a %[>]% x %[>]% c(a, b) ---o---o=== x > b %[)% x %[)% c(a, b) ---x===o--- x >= a & x < b %)[% x %)[% c(a, b) ===o---x=== x < a | x >= b %[<)% x %[<)% c(a, b) ===o---o--- x < a %[>)% x %[>)% c(a, b) ---o---x=== x >= b %(]% x %(]% c(a, b) ---o===x--- x > a & x <= b %](% x %](% c(a, b) ===x---o=== x <= a | x > b %(<]% x %(<]% c(a, b) ===x---o--- x <= a %(>]% x %(>]% c(a, b) ---o---o=== x > b %()% x %()% c(a, b) ---o===o--- x > a & x < b %][% x %][% c(a, b) ===x---x=== x <= a | x >= b %(<)% x %(<)% c(a, b) ===x---o--- x <= a %(>)% x %(>)% c(a, b) ---o---x=== x >= b %[]% [,1] [,2] [,3] [,4] [,5] Expect FALSE TRUE TRUE TRUE FALSE Found FALSE TRUE TRUE TRUE FALSE %)(% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE FALSE TRUE Found TRUE FALSE FALSE FALSE TRUE %[<]% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE FALSE FALSE Found TRUE FALSE FALSE FALSE FALSE %[>]% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE FALSE TRUE Found FALSE FALSE FALSE FALSE TRUE %[)% [,1] [,2] [,3] [,4] [,5] Expect FALSE TRUE TRUE FALSE FALSE Found FALSE TRUE TRUE FALSE FALSE %)[% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE TRUE TRUE Found TRUE FALSE FALSE TRUE TRUE %[<)% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE FALSE FALSE Found TRUE FALSE FALSE FALSE FALSE %[>)% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE TRUE TRUE Found FALSE FALSE FALSE TRUE TRUE %(]% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE TRUE TRUE FALSE Found FALSE FALSE TRUE TRUE FALSE %](% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE FALSE TRUE Found TRUE TRUE FALSE FALSE TRUE %(<]% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE FALSE FALSE Found TRUE TRUE FALSE FALSE FALSE %(>]% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE FALSE TRUE Found FALSE FALSE FALSE FALSE TRUE %()% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE TRUE FALSE FALSE Found FALSE FALSE TRUE FALSE FALSE %][% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE TRUE TRUE Found TRUE TRUE FALSE TRUE TRUE %(<)% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE FALSE FALSE Found TRUE TRUE FALSE FALSE FALSE %(>)% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE TRUE TRUE Found FALSE FALSE FALSE TRUE TRUE > ## character > test_fun("c('a','b','c','d','e')", "'b'","'d'") Expression Visual Condition %[]% x %[]% c(a, b) ---x===x--- x >= a & x <= b %)(% x %)(% c(a, b) ===o---o=== x < a | x > b %[<]% x %[<]% c(a, b) ===o---o--- x < a %[>]% x %[>]% c(a, b) ---o---o=== x > b %[)% x %[)% c(a, b) ---x===o--- x >= a & x < b %)[% x %)[% c(a, b) ===o---x=== x < a | x >= b %[<)% x %[<)% c(a, b) ===o---o--- x < a %[>)% x %[>)% c(a, b) ---o---x=== x >= b %(]% x %(]% c(a, b) ---o===x--- x > a & x <= b %](% x %](% c(a, b) ===x---o=== x <= a | x > b %(<]% x %(<]% c(a, b) ===x---o--- x <= a %(>]% x %(>]% c(a, b) ---o---o=== x > b %()% x %()% c(a, b) ---o===o--- x > a & x < b %][% x %][% c(a, b) ===x---x=== x <= a | x >= b %(<)% x %(<)% c(a, b) ===x---o--- x <= a %(>)% x %(>)% c(a, b) ---o---x=== x >= b %[]% [,1] [,2] [,3] [,4] [,5] Expect FALSE TRUE TRUE TRUE FALSE Found FALSE TRUE TRUE TRUE FALSE %)(% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE FALSE TRUE Found TRUE FALSE FALSE FALSE TRUE %[<]% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE FALSE FALSE Found TRUE FALSE FALSE FALSE FALSE %[>]% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE FALSE TRUE Found FALSE FALSE FALSE FALSE TRUE %[)% [,1] [,2] [,3] [,4] [,5] Expect FALSE TRUE TRUE FALSE FALSE Found FALSE TRUE TRUE FALSE FALSE %)[% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE TRUE TRUE Found TRUE FALSE FALSE TRUE TRUE %[<)% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE FALSE FALSE Found TRUE FALSE FALSE FALSE FALSE %[>)% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE TRUE TRUE Found FALSE FALSE FALSE TRUE TRUE %(]% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE TRUE TRUE FALSE Found FALSE FALSE TRUE TRUE FALSE %](% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE FALSE TRUE Found TRUE TRUE FALSE FALSE TRUE %(<]% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE FALSE FALSE Found TRUE TRUE FALSE FALSE FALSE %(>]% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE FALSE TRUE Found FALSE FALSE FALSE FALSE TRUE %()% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE TRUE FALSE FALSE Found FALSE FALSE TRUE FALSE FALSE %][% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE TRUE TRUE Found TRUE TRUE FALSE TRUE TRUE %(<)% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE FALSE FALSE Found TRUE TRUE FALSE FALSE FALSE %(>)% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE TRUE TRUE Found FALSE FALSE FALSE TRUE TRUE > ## ordered > test_fun("as.ordered(c('a','b','c','d','e'))", "'b'","'d'") Expression Visual Condition %[]% x %[]% c(a, b) ---x===x--- x >= a & x <= b %)(% x %)(% c(a, b) ===o---o=== x < a | x > b %[<]% x %[<]% c(a, b) ===o---o--- x < a %[>]% x %[>]% c(a, b) ---o---o=== x > b %[)% x %[)% c(a, b) ---x===o--- x >= a & x < b %)[% x %)[% c(a, b) ===o---x=== x < a | x >= b %[<)% x %[<)% c(a, b) ===o---o--- x < a %[>)% x %[>)% c(a, b) ---o---x=== x >= b %(]% x %(]% c(a, b) ---o===x--- x > a & x <= b %](% x %](% c(a, b) ===x---o=== x <= a | x > b %(<]% x %(<]% c(a, b) ===x---o--- x <= a %(>]% x %(>]% c(a, b) ---o---o=== x > b %()% x %()% c(a, b) ---o===o--- x > a & x < b %][% x %][% c(a, b) ===x---x=== x <= a | x >= b %(<)% x %(<)% c(a, b) ===x---o--- x <= a %(>)% x %(>)% c(a, b) ---o---x=== x >= b %[]% [,1] [,2] [,3] [,4] [,5] Expect FALSE TRUE TRUE TRUE FALSE Found FALSE TRUE TRUE TRUE FALSE %)(% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE FALSE TRUE Found TRUE FALSE FALSE FALSE TRUE %[<]% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE FALSE FALSE Found TRUE FALSE FALSE FALSE FALSE %[>]% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE FALSE TRUE Found FALSE FALSE FALSE FALSE TRUE %[)% [,1] [,2] [,3] [,4] [,5] Expect FALSE TRUE TRUE FALSE FALSE Found FALSE TRUE TRUE FALSE FALSE %)[% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE TRUE TRUE Found TRUE FALSE FALSE TRUE TRUE %[<)% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE FALSE FALSE Found TRUE FALSE FALSE FALSE FALSE %[>)% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE TRUE TRUE Found FALSE FALSE FALSE TRUE TRUE %(]% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE TRUE TRUE FALSE Found FALSE FALSE TRUE TRUE FALSE %](% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE FALSE TRUE Found TRUE TRUE FALSE FALSE TRUE %(<]% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE FALSE FALSE Found TRUE TRUE FALSE FALSE FALSE %(>]% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE FALSE TRUE Found FALSE FALSE FALSE FALSE TRUE %()% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE TRUE FALSE FALSE Found FALSE FALSE TRUE FALSE FALSE %][% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE TRUE TRUE Found TRUE TRUE FALSE TRUE TRUE %(<)% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE FALSE FALSE Found TRUE TRUE FALSE FALSE FALSE %(>)% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE TRUE TRUE Found FALSE FALSE FALSE TRUE TRUE > ## factor -- leads to NA > suppressWarnings(test_fun("as.factor(c('a','b','c','d','e'))", "'b'","'d'", + expect_NA=TRUE)) Expression Visual Condition %[]% x %[]% c(a, b) ---x===x--- x >= a & x <= b %)(% x %)(% c(a, b) ===o---o=== x < a | x > b %[<]% x %[<]% c(a, b) ===o---o--- x < a %[>]% x %[>]% c(a, b) ---o---o=== x > b %[)% x %[)% c(a, b) ---x===o--- x >= a & x < b %)[% x %)[% c(a, b) ===o---x=== x < a | x >= b %[<)% x %[<)% c(a, b) ===o---o--- x < a %[>)% x %[>)% c(a, b) ---o---x=== x >= b %(]% x %(]% c(a, b) ---o===x--- x > a & x <= b %](% x %](% c(a, b) ===x---o=== x <= a | x > b %(<]% x %(<]% c(a, b) ===x---o--- x <= a %(>]% x %(>]% c(a, b) ---o---o=== x > b %()% x %()% c(a, b) ---o===o--- x > a & x < b %][% x %][% c(a, b) ===x---x=== x <= a | x >= b %(<)% x %(<)% c(a, b) ===x---o--- x <= a %(>)% x %(>)% c(a, b) ---o---x=== x >= b %[]% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %)(% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %[<]% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %[>]% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %[)% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %)[% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %[<)% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %[>)% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %(]% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %](% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %(<]% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %(>]% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %()% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %][% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %(<)% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %(>)% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA > ## date > test_fun("as.Date(1:5,origin='2000-01-01')", + "as.Date(2,origin='2000-01-01')", "as.Date(4,origin='2000-01-01')") Expression Visual Condition %[]% x %[]% c(a, b) ---x===x--- x >= a & x <= b %)(% x %)(% c(a, b) ===o---o=== x < a | x > b %[<]% x %[<]% c(a, b) ===o---o--- x < a %[>]% x %[>]% c(a, b) ---o---o=== x > b %[)% x %[)% c(a, b) ---x===o--- x >= a & x < b %)[% x %)[% c(a, b) ===o---x=== x < a | x >= b %[<)% x %[<)% c(a, b) ===o---o--- x < a %[>)% x %[>)% c(a, b) ---o---x=== x >= b %(]% x %(]% c(a, b) ---o===x--- x > a & x <= b %](% x %](% c(a, b) ===x---o=== x <= a | x > b %(<]% x %(<]% c(a, b) ===x---o--- x <= a %(>]% x %(>]% c(a, b) ---o---o=== x > b %()% x %()% c(a, b) ---o===o--- x > a & x < b %][% x %][% c(a, b) ===x---x=== x <= a | x >= b %(<)% x %(<)% c(a, b) ===x---o--- x <= a %(>)% x %(>)% c(a, b) ---o---x=== x >= b %[]% [,1] [,2] [,3] [,4] [,5] Expect FALSE TRUE TRUE TRUE FALSE Found FALSE TRUE TRUE TRUE FALSE %)(% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE FALSE TRUE Found TRUE FALSE FALSE FALSE TRUE %[<]% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE FALSE FALSE Found TRUE FALSE FALSE FALSE FALSE %[>]% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE FALSE TRUE Found FALSE FALSE FALSE FALSE TRUE %[)% [,1] [,2] [,3] [,4] [,5] Expect FALSE TRUE TRUE FALSE FALSE Found FALSE TRUE TRUE FALSE FALSE %)[% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE TRUE TRUE Found TRUE FALSE FALSE TRUE TRUE %[<)% [,1] [,2] [,3] [,4] [,5] Expect TRUE FALSE FALSE FALSE FALSE Found TRUE FALSE FALSE FALSE FALSE %[>)% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE TRUE TRUE Found FALSE FALSE FALSE TRUE TRUE %(]% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE TRUE TRUE FALSE Found FALSE FALSE TRUE TRUE FALSE %](% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE FALSE TRUE Found TRUE TRUE FALSE FALSE TRUE %(<]% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE FALSE FALSE Found TRUE TRUE FALSE FALSE FALSE %(>]% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE FALSE TRUE Found FALSE FALSE FALSE FALSE TRUE %()% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE TRUE FALSE FALSE Found FALSE FALSE TRUE FALSE FALSE %][% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE TRUE TRUE Found TRUE TRUE FALSE TRUE TRUE %(<)% [,1] [,2] [,3] [,4] [,5] Expect TRUE TRUE FALSE FALSE FALSE Found TRUE TRUE FALSE FALSE FALSE %(>)% [,1] [,2] [,3] [,4] [,5] Expect FALSE FALSE FALSE TRUE TRUE Found FALSE FALSE FALSE TRUE TRUE > ## NA > test_fun("c(NA, NA, NA, 1, 2)", "NA", "NA", expect_NA=TRUE) Expression Visual Condition %[]% x %[]% c(a, b) ---x===x--- x >= a & x <= b %)(% x %)(% c(a, b) ===o---o=== x < a | x > b %[<]% x %[<]% c(a, b) ===o---o--- x < a %[>]% x %[>]% c(a, b) ---o---o=== x > b %[)% x %[)% c(a, b) ---x===o--- x >= a & x < b %)[% x %)[% c(a, b) ===o---x=== x < a | x >= b %[<)% x %[<)% c(a, b) ===o---o--- x < a %[>)% x %[>)% c(a, b) ---o---x=== x >= b %(]% x %(]% c(a, b) ---o===x--- x > a & x <= b %](% x %](% c(a, b) ===x---o=== x <= a | x > b %(<]% x %(<]% c(a, b) ===x---o--- x <= a %(>]% x %(>]% c(a, b) ---o---o=== x > b %()% x %()% c(a, b) ---o===o--- x > a & x < b %][% x %][% c(a, b) ===x---x=== x <= a | x >= b %(<)% x %(<)% c(a, b) ===x---o--- x <= a %(>)% x %(>)% c(a, b) ---o---x=== x >= b %[]% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %)(% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %[<]% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %[>]% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %[)% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %)[% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %[<)% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %[>)% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %(]% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %](% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %(<]% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %(>]% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %()% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %][% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %(<)% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA %(>)% [,1] [,2] [,3] [,4] [,5] Expect NA NA NA NA NA Found NA NA NA NA NA > > ## overlap > a1 <- 0:4 > b1 <- 1:5 > a2 <- rep(2,5) > b2 <- rep(3,5) > ab1 <- list(a1, b1) > ab2 <- list(a2, b2) > > ex <- ab1 %[o]% ab2 > cond <- a1 %[]% ab2 | b1 %[]% ab2 > stopifnot(all(cond == ex)) > > ex <- ab1 %)o(% ab2 > cond <- !(a1 %[]% ab2 | b1 %[]% ab2) > stopifnot(all(cond == ex)) > > ex <- ab1 %[ cond <- pmax(a1, b1) < pmin(a2, b2) > stopifnot(all(cond == ex)) > > ex <- ab1 %[o>]% ab2 > cond <- pmin(a1, b1) > pmax(a2, b2) > stopifnot(all(cond == ex)) > > ## ensuring that a <= b, a1 <= b1, a2 <= b2 > stopifnot(identical(1:5 %[)% c(2,4), 1:5 %[)% c(4,2))) > stopifnot(identical(c(1,3) %[o]% c(2,4), c(3,1) %[o]% c(4,2))) > > ## nested intervals > TEST <- c( + c(1,4) %[o]% c(2,3), + c(2,3) %[o]% c(1,4), + c(1,4) %[o]% c(1,3), + c(1,3) %[o]% c(1,4), + c(1,3) %[o]% c(1,3), + !(c(1,4) %)o(% c(2,3)), + !(c(2,3) %)o(% c(1,4)), + !(c(1,4) %)o(% c(1,3)), + !(c(1,3) %)o(% c(1,4)), + !(c(1,3) %)o(% c(1,3)), + !(c(1,4) %[]% c(2,3)), + !(c(2,3) %[o>]% c(1,4)), + !(c(1,4) %[o>]% c(1,3)), + !(c(1,3) %[o>]% c(1,4)), + !(c(1,3) %[o>]% c(1,3)) + ) > stopifnot(all(TEST)) > > ## random overlap testing > overlap_fun <- function(i) { + i1 <- sort(i[1]:i[2]) + i2 <- sort(i[3]:i[4]) + list( + intervals=i, + expected=c( + any(i1 %in% i2), + all(!(i1 %in% i2)), + max(i1) < min(i2), + min(i1) > max(i2)), + found=c( + i[1:2] %[o]% i[3:4], + i[1:2] %)o(% i[3:4], + i[1:2] %[]% i[3:4]) + ) + } > overlap_check <- function(x) { + all(x$expected == x$found) + } > res <- list() > set.seed(as.integer(Sys.time())) > for (j in 1:(10^4)) { + res[[j]] <- overlap_fun(sample(10, 4, replace=TRUE)) + } > stopifnot(all(sapply(res, overlap_check))) > str(res[!sapply(res, overlap_check)]) list() > > ## interesting cases: degenerate intervals > > stopifnot(all( + 0 %[]% c(0,0), # TRUE + !(0 %[)% c(0,0)), # FALSE + !(0 %(]% c(0,0)), # FALSE + !(0 %()% c(0,0)) # FALSE + )) > > ## NA handling > > x <- c(NA, 1, 1, 1, NA, NA, NA) > a <- c(2, NA, 2, NA, NA, 1, NA) > b <- c(2, 2, NA, NA, 1, NA, NA) > stopifnot(all(is.na(x %[]% list(a, b)))) > > ## Annette Dobson (1990) "An Introduction to Generalized Linear Models". > ## Page 9: Plant Weight Data. > ctl <- c(4.17,5.58,5.18,6.11,4.50,4.61,5.17,4.53,5.33,5.14) > trt <- c(4.81,4.17,4.41,3.59,5.87,3.83,6.03,4.89,4.32,4.69) > group <- gl(2, 10, 20, labels = c("Ctl","Trt")) > weight <- c(ctl, trt) > lm.D9 <- lm(weight ~ group) > ## compare 95\% confidence intervals with 0 > (CI.D9 <- confint(lm.D9)) 2.5 % 97.5 % (Intercept) 4.56934 5.4946602 groupTrt -1.02530 0.2833003 > 0 %[]% CI.D9 (Intercept) groupTrt FALSE TRUE > lm.D90 <- lm(weight ~ group - 1) # omitting intercept > ## compare 95\% confidence of the 2 groups to each other > (CI.D90 <- confint(lm.D90)) 2.5 % 97.5 % groupCtl 4.56934 5.49466 groupTrt 4.19834 5.12366 > CI.D90[1,] %[o]% CI.D90[2,] 2.5 % TRUE > > ## comparing dates > DATE <- as.Date(c("2000-01-01","2000-02-01", "2000-03-31")) > DATE %[<]% as.Date(c("2000-01-15", "2000-03-15")) [1] TRUE FALSE FALSE > DATE %[]% as.Date(c("2000-01-15", "2000-03-15")) [1] FALSE TRUE FALSE > DATE %[>]% as.Date(c("2000-01-15", "2000-03-15")) [1] FALSE FALSE TRUE > > ## simple case with integers > 1:5 %[]% c(2,4) [1] FALSE TRUE TRUE TRUE FALSE > 1:5 %[)% c(2,4) [1] FALSE TRUE TRUE FALSE FALSE > 1:5 %(]% c(2,4) [1] FALSE FALSE TRUE TRUE FALSE > 1:5 %()% c(2,4) [1] FALSE FALSE TRUE FALSE FALSE > > 1:5 %][% c(2,4) [1] TRUE TRUE FALSE TRUE TRUE > 1:5 %](% c(2,4) [1] TRUE TRUE FALSE FALSE TRUE > 1:5 %)[% c(2,4) [1] TRUE FALSE FALSE TRUE TRUE > 1:5 %)(% c(2,4) [1] TRUE FALSE FALSE FALSE TRUE > > ## interval formats > x <- rep(4, 5) > a <- 1:5 > b <- 3:7 > cbind(x=x, a=a, b=b) x a b [1,] 4 1 3 [2,] 4 2 4 [3,] 4 3 5 [4,] 4 4 6 [5,] 4 5 7 > x %[]% cbind(a, b) # matrix [1] FALSE TRUE TRUE TRUE FALSE > x %[]% data.frame(a=a, b=b) # data.frame [1] FALSE TRUE TRUE TRUE FALSE > x %[]% list(a, b) # list [1] FALSE TRUE TRUE TRUE FALSE > > ## NULL > NULL %[]% c(1,2) logical(0) > NULL %[]% NULL logical(0) > NULL %[]% list(NULL, NULL) logical(0) > > ## logical > c(TRUE, FALSE) %[]% c(TRUE, TRUE) [1] TRUE FALSE > c(TRUE, FALSE) %[]% c(FALSE, FALSE) [1] FALSE TRUE > c(TRUE, FALSE) %[]% c(TRUE, FALSE) [1] TRUE TRUE > c(TRUE, FALSE) %[]% c(FALSE, TRUE) [1] TRUE TRUE > > ## NA values > 1:5 %[]% c(NA,4) [1] NA NA NA NA NA > 1:5 %[]% c(2,NA) [1] NA NA NA NA NA > c(1:5, NA) %[]% c(2,4) [1] FALSE TRUE TRUE TRUE FALSE NA > NA %[]% c(1,2) [1] NA > NA %[]% c(NA,NA) [1] NA > > ## numeric > ((1:5)+0.5) %[]% (c(2,4)+0.5) [1] FALSE TRUE TRUE TRUE FALSE > > ## character > c('a','b','c','d','e') %[]% c('b','d') [1] FALSE TRUE TRUE TRUE FALSE > > ## ordered > as.ordered(c('a','b','c','d','e')) %[]% c('b','d') [1] FALSE TRUE TRUE TRUE FALSE > > ## factor -- leads to NA with warnings > as.factor(c('a','b','c','d','e')) %[]% c('b','d') [1] NA NA NA NA NA Warning messages: 1: In Ops.factor(x, ab$a) : '>=' not meaningful for factors 2: In Ops.factor(x, ab$b) : '<=' not meaningful for factors > > ## dates > as.Date(1:5,origin='2000-01-01') %[]% as.Date(c(2,4),origin='2000-01-01') [1] FALSE TRUE TRUE TRUE FALSE > > ## helper functions > intrval_types(plot=TRUE) > intrval_types(plot=FALSE) Expression Visual Condition %[]% x %[]% c(a, b) ---x===x--- x >= a & x <= b %)(% x %)(% c(a, b) ===o---o=== x < a | x > b %[<]% x %[<]% c(a, b) ===o---o--- x < a %[>]% x %[>]% c(a, b) ---o---o=== x > b %[)% x %[)% c(a, b) ---x===o--- x >= a & x < b %)[% x %)[% c(a, b) ===o---x=== x < a | x >= b %[<)% x %[<)% c(a, b) ===o---o--- x < a %[>)% x %[>)% c(a, b) ---o---x=== x >= b %(]% x %(]% c(a, b) ---o===x--- x > a & x <= b %](% x %](% c(a, b) ===x---o=== x <= a | x > b %(<]% x %(<]% c(a, b) ===x---o--- x <= a %(>]% x %(>]% c(a, b) ---o---o=== x > b %()% x %()% c(a, b) ---o===o--- x > a & x < b %][% x %][% c(a, b) ===x---x=== x <= a | x >= b %(<)% x %(<)% c(a, b) ===x---o--- x <= a %(>)% x %(>)% c(a, b) ---o---x=== x >= b > > ## recycling values > 1:10 %[]% list(1:5, 6) [1] TRUE TRUE TRUE TRUE TRUE TRUE FALSE FALSE FALSE FALSE > > ## overlap: simple interval comparisons > c(2:3) %[o]% c(0:1) [1] FALSE > c(2:3) %[o]% c(1:2) [1] TRUE > c(2:3) %[o]% c(2:3) [1] TRUE > c(2:3) %[o]% c(3:4) [1] TRUE > c(2:3) %[o]% c(4:5) [1] FALSE > c(0:1) %[o]% c(2:3) [1] FALSE > c(1:2) %[o]% c(2:3) [1] TRUE > c(2:3) %[o]% c(2:3) [1] TRUE > c(3:4) %[o]% c(2:3) [1] TRUE > c(4:5) %[o]% c(2:3) [1] FALSE > > ## overlap: vectorized versions > c(2:3) %[o]% list(0:4, 1:5) [1] FALSE TRUE TRUE TRUE FALSE > c(2:3) %[o]% cbind(0:4, 1:5) [1] FALSE TRUE TRUE TRUE FALSE > c(2:3) %[o]% data.frame(a=0:4, b=1:5) [1] FALSE TRUE TRUE TRUE FALSE > list(0:4, 1:5) %[o]% c(2:3) [1] FALSE TRUE TRUE TRUE FALSE > cbind(0:4, 1:5) %[o]% c(2:3) [1] FALSE TRUE TRUE TRUE FALSE > data.frame(a=0:4, b=1:5) %[o]% c(2:3) [1] FALSE TRUE TRUE TRUE FALSE > list(0:4, 1:5) %[o]% cbind(rep(2,5), rep(3,5)) [1] FALSE TRUE TRUE TRUE FALSE > cbind(rep(2,5), rep(3,5)) %[o]% list(0:4, 1:5) [1] FALSE TRUE TRUE TRUE FALSE > > ## directional relations > 1:4 %[]% c(2,3) [1] FALSE TRUE TRUE FALSE > 1:4 %[>]% c(2,3) [1] FALSE FALSE FALSE TRUE > 1:4 %[<]% c(2,3) [1] TRUE FALSE FALSE FALSE > 1:4 %[)% c(2,3) [1] FALSE TRUE FALSE FALSE > 1:4 %[>)% c(2,3) [1] FALSE FALSE TRUE TRUE > 1:4 %[<)% c(2,3) [1] TRUE FALSE FALSE FALSE > 1:4 %(]% c(2,3) [1] FALSE FALSE TRUE FALSE > 1:4 %(>]% c(2,3) [1] FALSE FALSE FALSE TRUE > 1:4 %(<]% c(2,3) [1] TRUE TRUE FALSE FALSE > 1:4 %()% c(2,3) [1] FALSE FALSE FALSE FALSE > 1:4 %(>)% c(2,3) [1] FALSE FALSE TRUE TRUE > 1:4 %(<)% c(2,3) [1] TRUE TRUE FALSE FALSE > > (ab1 <- cbind(rep(3,5),rep(4,5))) [,1] [,2] [1,] 3 4 [2,] 3 4 [3,] 3 4 [4,] 3 4 [5,] 3 4 > (ab2 <- cbind(1:5, 2:6)) [,1] [,2] [1,] 1 2 [2,] 2 3 [3,] 3 4 [4,] 4 5 [5,] 5 6 > ab1 %[o]% ab2 [1] FALSE TRUE TRUE TRUE FALSE > ab1 %)o(% ab2 [1] TRUE FALSE FALSE FALSE TRUE > ab1 %[ ab1 %[o>]% ab2 [1] TRUE FALSE FALSE FALSE FALSE > > ## timings > > set.seed(1) > n <- 10^6 > x <- runif(n) > a1 <- runif(n) > b1 <- runif(n) > a2 <- runif(n) > b2 <- runif(n) > > system.time(x %[]% list(a1, b1)) user system elapsed 0.02 0.02 0.03 > system.time(x %)(% list(a1, b1)) user system elapsed 0.03 0.02 0.05 > system.time(x %[<]% list(a1, b1)) user system elapsed 0.03 0.00 0.03 > system.time(x %[>]% list(a1, b1)) user system elapsed 0.00 0.01 0.02 > > system.time(x %[)% list(a1, b1)) user system elapsed 0.05 0.00 0.05 > system.time(x %)[% list(a1, b1)) user system elapsed 0.05 0.00 0.04 > system.time(x %[<)% list(a1, b1)) user system elapsed 0.03 0.00 0.03 > system.time(x %[>)% list(a1, b1)) user system elapsed 0.00 0.01 0.01 > > system.time(x %(]% list(a1, b1)) user system elapsed 0.05 0.00 0.04 > system.time(x %](% list(a1, b1)) user system elapsed 0.03 0.00 0.03 > system.time(x %(<]% list(a1, b1)) user system elapsed 0.03 0.00 0.03 > system.time(x %(>]% list(a1, b1)) user system elapsed 0.03 0.00 0.03 > > system.time(x %()% list(a1, b1)) user system elapsed 0.01 0.01 0.03 > system.time(x %][% list(a1, b1)) user system elapsed 0.01 0.04 0.05 > system.time(x %(<)% list(a1, b1)) user system elapsed 0.03 0.00 0.03 > system.time(x %(>)% list(a1, b1)) user system elapsed 0.04 0.00 0.04 > > system.time(tmp1 <- list(a2, b2) %[o]% list(a1, b1)) user system elapsed 0.04 0.03 0.07 > system.time(tmp2 <- list(a2, b2) %[]o[]% list(a1, b1)) user system elapsed 0.06 0.01 0.08 > stopifnot(all(tmp1==tmp2)) > system.time(list(a2, b2) %)o(% list(a1, b1)) user system elapsed 0.05 0.02 0.06 > system.time(list(a2, b2) %[ system.time(list(a2, b2) %[o>]% list(a1, b1)) user system elapsed 0.05 0.00 0.05 > > system.time(tmp1 <- list(a2, b2) %(o)% list(a1, b1)) user system elapsed 0.06 0.01 0.08 > system.time(tmp2 <- list(a2, b2) %()o()% list(a1, b1)) user system elapsed 0.07 0.04 0.10 > stopifnot(all(tmp1==tmp2)) > system.time(list(a2, b2) %]o[% list(a1, b1)) user system elapsed 0.06 0.01 0.07 > system.time(list(a2, b2) %( system.time(list(a2, b2) %(o>)% list(a1, b1)) user system elapsed 0.03 0.02 0.05 > > ## helper function > > intrval_types() # print Expression Visual Condition %[]% x %[]% c(a, b) ---x===x--- x >= a & x <= b %)(% x %)(% c(a, b) ===o---o=== x < a | x > b %[<]% x %[<]% c(a, b) ===o---o--- x < a %[>]% x %[>]% c(a, b) ---o---o=== x > b %[)% x %[)% c(a, b) ---x===o--- x >= a & x < b %)[% x %)[% c(a, b) ===o---x=== x < a | x >= b %[<)% x %[<)% c(a, b) ===o---o--- x < a %[>)% x %[>)% c(a, b) ---o---x=== x >= b %(]% x %(]% c(a, b) ---o===x--- x > a & x <= b %](% x %](% c(a, b) ===x---o=== x <= a | x > b %(<]% x %(<]% c(a, b) ===x---o--- x <= a %(>]% x %(>]% c(a, b) ---o---o=== x > b %()% x %()% c(a, b) ---o===o--- x > a & x < b %][% x %][% c(a, b) ===x---x=== x <= a | x >= b %(<)% x %(<)% c(a, b) ===x---o--- x <= a %(>)% x %(>)% c(a, b) ---o---x=== x >= b > intrval_types(1:4) # print Expression Visual Condition %[]% x %[]% c(a, b) ---x===x--- x >= a & x <= b %)(% x %)(% c(a, b) ===o---o=== x < a | x > b %[<]% x %[<]% c(a, b) ===o---o--- x < a %[>]% x %[>]% c(a, b) ---o---o=== x > b > > ## test for general 2-interval operators > > # n=no overlap > # o=overlap > # u=upper boundary of interval1 (lhs) > # l=upper boundary of interval1 (lhs) > m <- rbind( + "n"=c(1,2, 3,5), + "u"=c(1,3, 3,5), + "o"=c(1,4, 3,5), + "o"=c(2,4, 3,6), + "u"=c(2,4, 4,6), + "n"=c(2,4, 5,6), + "o"=c(1,5, 2,4), + + "n"=c(3,5, 1,2), + "l"=c(3,5, 1,3), + "o"=c(3,5, 1,4), + "o"=c(3,6, 2,4), + "l"=c(4,6, 2,4), + "n"=c(5,6, 2,4), + "o"=c(2,4, 1,5)) > > test_fun <- function(type1="[]", type2="[]") { + val <- sapply(1:nrow(m), function(i) + intrval:::.intrval3(m[i,1:2], m[i,3:4], type1, type2)) + expect <- rep(TRUE, length(val)) + expect[rownames(m) == "n"] <- FALSE + ## *]o[* + expect[rownames(m) == "u"] <- if (substr(type1, 2L, 2L) == "]" && + substr(type2, 1L, 1L) == "[") + TRUE else FALSE + ## [*o*] + expect[rownames(m) == "l"] <- if (substr(type1, 1L, 1L) == "[" && + substr(type2, 2L, 2L) == "]") + TRUE else FALSE + rbind(value=val, expect=expect, test=val==expect) + } > > tt <- expand.grid(iv1=c("[]", "[)", "(]", "()"), iv2=c("[]", "[)", "(]", "()")) > res <- lapply(1:nrow(tt), function(i) + test_fun(as.character(tt[i,1]), as.character(tt[i,2]))) > > tt[which(!sapply(res, function(z) all(z[3,]))),] [1] iv1 iv2 <0 rows> (or 0-length row.names) > stopifnot(all(sapply(res, function(z) all(z[3,])))) > > ## degenerate open interval should not overlap > stopifnot(!intrval:::.intrval3(c(3,3),c(3,3),"()","()")) > stopifnot(!intrval:::.intrval3(c(1,1),c(3,3),"()","()")) > stopifnot(!intrval:::.intrval3(c(1,1),c(1,1),"()","[]")) > stopifnot(!intrval:::.intrval3(c(1,1),c(3,3),"()","[]")) > stopifnot(!intrval:::.intrval3(c(1,1),c(3,3),"[]","()")) > > > proc.time() user system elapsed 5.26 0.42 5.65