ivx_sizes <- 2^(12 + 0:6)
rows <- flexseq()
set.seed(123)
max_ivx <- max(ivx_sizes)
all_starts <- sort(sample.int(max_ivx * 10L, max_ivx))
all_widths <- sample.int(100L, max_ivx, replace = TRUE)
all_ends <- all_starts + all_widths
all_vals <- sprintf("interval_%06d", seq_len(max_ivx))
has_iranges <- requireNamespace("IRanges", quietly = TRUE) &&
requireNamespace("S4Vectors", quietly = TRUE)
for(n in ivx_sizes) {
cat("Interval ops, size ", n, "\n")
starts <- all_starts[seq_len(n)]
ends <- all_ends[seq_len(n)]
vals <- all_vals[seq_len(n)]
# Query and insertion points are derived from the size-n subset so they fall
# inside the indexed coordinate range at every size, and the overlap window
# spans a fixed number of starts so result-set size k stays constant
# (~50 matches) as n grows. (Fixed global points computed from the largest
# size would fall beyond the data for smaller n, timing only the
# empty-result path.)
qpt <- starts[n %/% 2L] + 10L
qlo <- starts[n %/% 2L]
qhi <- starts[n %/% 2L + 50L]
ins_s <- starts[n %/% 2L]
ins_e <- ins_s + 50L
ivx_setup <- function() list(ix = as_interval_index(as.list(vals), start = starts, end = ends, default_query_bounds = "[]"))
# Endpoints in a data.frame (the natural interval table); payloads in a
# parallel list, as the interval_index stores arbitrary value objects.
df_setup <- function() list(df = data.frame(start = starts, end = ends), value = as.list(vals))
rows <- bench_one(rows, "interval_index", "insert", n, repeats, ivx_setup,
function(st) insert(st$ix, "interval_new", ins_s, ins_e))
rows <- bench_one(rows, "interval_index", "point query", n, repeats, ivx_setup,
function(st) peek_point(st$ix, qpt, bounds = "[]"))
rows <- bench_one(rows, "interval_index", "all point matches", n, repeats, ivx_setup,
function(st) peek_all_point(st$ix, qpt, bounds = "[]", as_list = TRUE))
rows <- bench_one(rows, "interval_index", "overlap query", n, repeats, ivx_setup,
function(st) peek_all_overlaps(st$ix, qlo, qhi, bounds = "[]", as_list = TRUE))
rows <- bench_one(rows, "interval_index", "within query", n, repeats, ivx_setup,
function(st) peek_all_within(st$ix, qlo, qhi, bounds = "[]", as_list = TRUE))
rows <- bench_one(rows, "interval_index", "remove by overlap", n, repeats, ivx_setup,
function(st) pop_all_overlaps(st$ix, qlo, qhi, bounds = "[]")$remaining)
rows <- bench_one(rows, "base R", "insert", n, repeats, df_setup,
function(st) list(
df = rbind(st$df, data.frame(start = ins_s, end = ins_e)),
value = c(st$value, list("interval_new"))
))
rows <- bench_one(rows, "base R", "point query", n, repeats, df_setup,
function(st) {
hits <- which(st$df$start <= qpt & qpt <= st$df$end)
if(length(hits)) st$value[[hits[1L]]] else NULL
})
rows <- bench_one(rows, "base R", "all point matches", n, repeats, df_setup,
function(st) st$value[st$df$start <= qpt & qpt <= st$df$end])
rows <- bench_one(rows, "base R", "overlap query", n, repeats, df_setup,
function(st) st$value[st$df$start <= qhi & st$df$end >= qlo])
rows <- bench_one(rows, "base R", "within query", n, repeats, df_setup,
function(st) st$value[st$df$start >= qlo & st$df$end <= qhi])
rows <- bench_one(rows, "base R", "remove by overlap", n, repeats, df_setup,
function(st) { keep <- !(st$df$start <= qhi & st$df$end >= qlo)
list(df = st$df[keep, , drop = FALSE], value = st$value[keep]) })
if(has_iranges) {
ir_setup <- function() list(
ir = IRanges::IRanges(start = starts, end = ends),
v = as.list(vals)
)
rows <- bench_one(rows, "IRanges", "insert", n, repeats, ir_setup,
function(st) list(
ir = c(st$ir, IRanges::IRanges(start = ins_s, end = ins_e)),
v = c(st$v, list("interval_new"))
))
rows <- bench_one(rows, "IRanges", "point query", n, repeats, ir_setup,
function(st) {
hits <- S4Vectors::subjectHits(IRanges::findOverlaps(IRanges::IRanges(start = qpt, width = 1L), st$ir))
if(length(hits)) st$v[[hits[1L]]] else NULL
})
rows <- bench_one(rows, "IRanges", "all point matches", n, repeats, ir_setup,
function(st) {
st$v[S4Vectors::subjectHits(IRanges::findOverlaps(IRanges::IRanges(start = qpt, width = 1L), st$ir))]
})
rows <- bench_one(rows, "IRanges", "overlap query", n, repeats, ir_setup,
function(st) {
st$v[S4Vectors::subjectHits(IRanges::findOverlaps(IRanges::IRanges(start = qlo, end = qhi), st$ir))]
})
rows <- bench_one(rows, "IRanges", "within query", n, repeats, ir_setup,
function(st) {
st$v[S4Vectors::queryHits(IRanges::findOverlaps(st$ir, IRanges::IRanges(start = qlo, end = qhi), type = "within"))]
})
rows <- bench_one(rows, "IRanges", "remove by overlap", n, repeats, ir_setup,
function(st) {
hits <- S4Vectors::subjectHits(IRanges::findOverlaps(IRanges::IRanges(start = qlo, end = qhi), st$ir))
keep <- setdiff(seq_along(st$v), hits)
list(ir = st$ir[keep], v = st$v[keep])
})
}
}
results_list$ivx <- do.call(rbind, as.list(rows))
save_batch("ivx")
