---
title: "fastRanges vs Bioconductor: Publication Benchmark"
subtitle: "Large-scale overlap workloads for GRanges and IRanges"
vignette: >
  %\VignetteIndexEntry{fastRanges vs Bioconductor: Publication Benchmark}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
format:
  html:
    toc: true
    number-sections: true
    code-fold: false
execute:
  echo: true
  warning: false
  message: false
params:
  seed: 42
  iterations: 4
  max_threads: 96
  thread_grid: [2, 8, 32, 64, 96]
  gr_subject_sizes: [2000000, 5000000, 8000000]
  gr_query_ratio: 0.20
  gr_scaling_subject_n: 5000000
  gr_scaling_query_n: 1000000
  gr_scaling_coord_span: 40000000
  repeated_queries: 8
  repeated_subject_n: 8000000
  repeated_query_n: 1000000
  ir_subject_n: 12000000
  ir_query_n: 3000000
  derived_subject_n: 5000000
  derived_query_n: 1200000
  derived_window_width: 5000
  derived_step_width: 2500
---

## Goal

This benchmark compares `fastRanges` against Bioconductor-native overlap engines on workloads large enough to be publication-relevant.

Compared engines:

-   `fastRanges::fast_find_overlaps()` (direct subject)
-   `fastRanges::fast_find_overlaps()` with `fast_build_index()` reuse
-   `GenomicRanges::findOverlaps()`
-   `GenomicRanges::findOverlaps()` with `GenomicRanges::GNCList()` pre-processing
-   `IRanges::findOverlaps(..., nthread = k)` for integer-range thread scaling (when supported by the installed IRanges version)

Derived API benchmarks are also included for grouped overlap counting, overlap aggregation, and sliding-window overlap counts.

## Reproducibility + Setup

```{r setup}
required_pkgs <- c(
  "fastRanges", "GenomicRanges", "IRanges", "S4Vectors",
  "ggplot2", "dplyr", "tidyr", "scales"
)
missing_pkgs <- required_pkgs[!vapply(required_pkgs, requireNamespace, logical(1), quietly = TRUE)]
if (length(missing_pkgs) > 0) {
  stop("Missing required packages: ", paste(missing_pkgs, collapse = ", "))
}

library(fastRanges)
library(GenomicRanges)
library(IRanges)
library(S4Vectors)
library(ggplot2)
library(dplyr)
library(tidyr)
library(scales)

set.seed(params$seed)

available_threads <- parallel::detectCores(logical = FALSE)
available_threads <- if (is.na(available_threads) || available_threads < 1L) 1L else available_threads
max_threads <- min(as.integer(params$max_threads), as.integer(available_threads))
max_threads <- max(1L, max_threads)

thread_grid <- as.integer(params$thread_grid)
thread_grid <- sort(unique(thread_grid[thread_grid >= 1L & thread_grid <= max_threads]))
if (!1L %in% thread_grid) thread_grid <- sort(unique(c(1L, thread_grid)))
if (!max_threads %in% thread_grid) thread_grid <- sort(unique(c(thread_grid, max_threads)))

input_file <- knitr::current_input(dir = TRUE)
output_root <- normalizePath(file.path(getwd(), "benchmark_result"), winslash = "/", mustWork = FALSE)
if (!dir.exists(output_root)) dir.create(output_root, recursive = TRUE)

fig_dir <- file.path(output_root, "figures")
if (!dir.exists(fig_dir)) dir.create(fig_dir, recursive = TRUE)
results_dir <- file.path(output_root, "results")
if (!dir.exists(results_dir)) dir.create(results_dir, recursive = TRUE)

write_result_table <- function(tbl, name) {
  path <- file.path(results_dir, paste0(name, ".csv"))
  utils::write.csv(as.data.frame(tbl), path, row.names = FALSE)
  path
}

simulate_granges <- function(
  n,
  seed,
  seqlevels = paste0("chr", 1:22),
  coord_span = 250000000L,
  width_max = 1000L,
  width_offset = 49L
) {
  set.seed(seed)
  starts <- sample.int(as.integer(coord_span), n, replace = TRUE)
  widths <- sample.int(as.integer(width_max), n, replace = TRUE) + as.integer(width_offset)
  GRanges(
    seqnames = sample(seqlevels, n, replace = TRUE),
    ranges = IRanges(start = starts, width = widths),
    strand = sample(c("+", "-", "*"), n, replace = TRUE, prob = c(0.45, 0.45, 0.10))
  )
}

simulate_iranges <- function(n, seed) {
  set.seed(seed)
  starts <- sample.int(50000000L, n, replace = TRUE)
  widths <- sample.int(1000L, n, replace = TRUE) + 49L
  IRanges(start = starts, width = widths)
}

time_engine <- function(engine, fn, iterations = 3L, size_fn = length) {
  out <- vector("list", iterations)
  for (i in seq_len(iterations)) {
    gc(verbose = FALSE)
    elapsed <- unname(system.time({
      h <- fn()
    })["elapsed"])

    out[[i]] <- data.frame(
      engine = engine,
      iteration = i,
      elapsed_sec = as.numeric(elapsed),
      hits = as.numeric(size_fn(h)),
      stringsAsFactors = FALSE
    )
  }
  dplyr::bind_rows(out)
}

time_task <- function(task, engine, fn, size_fn = length, iterations = 3L) {
  out <- vector("list", iterations)
  for (i in seq_len(iterations)) {
    gc(verbose = FALSE)
    elapsed <- unname(system.time({
      result <- fn()
    })["elapsed"])

    out[[i]] <- data.frame(
      task = task,
      engine = engine,
      iteration = i,
      elapsed_sec = as.numeric(elapsed),
      result_size = as.numeric(size_fn(result)),
      stringsAsFactors = FALSE
    )
  }
  dplyr::bind_rows(out)
}

normalize_hit_pairs <- function(h) {
  pairs <- cbind(
    query = S4Vectors::queryHits(h),
    subject = S4Vectors::subjectHits(h)
  )
  if (nrow(pairs) == 0L) {
    return(pairs)
  }
  pairs[order(pairs[, "query"], pairs[, "subject"]), , drop = FALSE]
}

theme_pub <- function() {
  theme_bw(base_size = 13) +
    theme(
      panel.grid.minor = element_blank(),
      plot.title.position = "plot",
      legend.position = "bottom"
    )
}

cat("Detected physical cores =", available_threads, "\n")
cat("Using benchmark max_threads =", max_threads, "\n")
cat("Thread grid =", paste(thread_grid, collapse = ", "), "\n")
cat("Input qmd =", input_file, "\n")
cat("Benchmark output root =", output_root, "\n")
cat("Results directory =", results_dir, "\n")
```

## Choosing the Right fastRanges Mode

Use this decision rule before benchmarking or production runs:

1. Single overlap call: use direct subject (`fast_find_overlaps(query, subject, ...)`).
2. Repeated queries on one subject: build once with `fast_build_index(subject)` and pass the index.
3. If output order stability matters across thread counts, keep `deterministic = TRUE`.
4. For throughput-only timing, use `deterministic = FALSE` to remove sorting overhead.
5. Tune `threads` empirically; saturation often occurs before maximum core count.

## 96-Core Server Profile and Rationale

This benchmark profile is tuned for high-core Linux servers and targets up to `96` threads.

Why these defaults are large:

-   `GRanges` scenarios from `2M` to `8M` subjects expose index build cost and query throughput under high concurrency.
-   repeated-query workload (`8` query batches against one `8M` subject) captures the practical value of index reuse.
-   `IRanges` scaling (`12M` subjects, `3M` queries) pushes thread scaling where object overhead is lower and compute dominates.
-   thread grid for a 96-core server is `{2, 8, 32, 64, 96}`; the script automatically adds `1` for baseline speedup normalization.

On a 96-core server, run:

```{bash render-96-threads, eval=FALSE}
quarto render inst/benchmarks/benchmark_bioc.qmd -P max_threads:96
```

## GRanges End-to-End Runtime

```{r granges-benchmark}
gr_subject_sizes <- as.integer(params$gr_subject_sizes)
gr_query_sizes <- pmax(50000L, as.integer(gr_subject_sizes * as.numeric(params$gr_query_ratio)))

gr_bench_list <- vector("list", length(gr_subject_sizes))

for (i in seq_along(gr_subject_sizes)) {
  subject_n <- gr_subject_sizes[i]
  query_n <- gr_query_sizes[i]

  subject <- simulate_granges(subject_n, seed = params$seed + i * 10L)
  query <- simulate_granges(query_n, seed = params$seed + i * 10L + 1L)

  fast_idx <- fastRanges::fast_build_index(subject)
  gnc_idx <- GenomicRanges::GNCList(subject)

  local <- dplyr::bind_rows(
    time_engine("fastRanges_indexed", function() fastRanges::fast_find_overlaps(query, fast_idx, threads = max_threads), params$iterations),
    time_engine("fastRanges_direct", function() fastRanges::fast_find_overlaps(query, subject, threads = max_threads), params$iterations),
    time_engine("GenomicRanges_findOverlaps", function() GenomicRanges::findOverlaps(query, subject, ignore.strand = FALSE), params$iterations),
    time_engine("GenomicRanges_GNCList", function() GenomicRanges::findOverlaps(query, gnc_idx, ignore.strand = FALSE), params$iterations)
  )

  ref_hits <- unique(local$hits[local$engine == "GenomicRanges_findOverlaps"])
  if (length(ref_hits) != 1L || any(local$hits != ref_hits[1])) {
    stop("Hit count mismatch between engines at scenario ", i)
  }

  local$subject_n <- subject_n
  local$query_n <- query_n
  local$scenario <- paste0("Q", format(query_n, big.mark = ","), " vs S", format(subject_n, big.mark = ","))
  gr_bench_list[[i]] <- local
}

gr_bench <- dplyr::bind_rows(gr_bench_list)

gr_summary <- gr_bench %>%
  dplyr::group_by(scenario, query_n, subject_n, engine) %>%
  dplyr::summarise(
    median_sec = median(elapsed_sec),
    min_sec = min(elapsed_sec),
    max_sec = max(elapsed_sec),
    .groups = "drop"
  )

gr_summary
```

```{r granges-runtime-plot, fig.width=12, fig.height=5}
p_gr_runtime <- ggplot(gr_summary, aes(x = engine, y = median_sec, fill = engine)) +
  geom_col(width = 0.75) +
  facet_wrap(~scenario, scales = "free_y") +
  scale_y_continuous(labels = label_number(accuracy = 0.1)) +
  labs(
    title = "GRanges overlap runtime by engine",
    x = NULL,
    y = "Median elapsed time (sec)",
    fill = "Engine"
  ) +
  theme_pub() +
  theme(axis.text.x = element_text(angle = 30, hjust = 1))

p_gr_runtime

ggsave(file.path(fig_dir, "granges_runtime_bar.png"), p_gr_runtime, width = 12, height = 5, dpi = 300)
```

```{r granges-speedup-plot, fig.width=10, fig.height=5}
gr_speedup <- gr_summary %>%
  dplyr::left_join(
    gr_summary %>%
      dplyr::filter(engine == "GenomicRanges_findOverlaps") %>%
      dplyr::select(scenario, baseline_sec = median_sec),
    by = "scenario"
  ) %>%
  dplyr::mutate(speedup_vs_genomicranges = baseline_sec / median_sec)

p_gr_speedup <- ggplot(
  dplyr::filter(gr_speedup, engine != "GenomicRanges_findOverlaps"),
  aes(x = scenario, y = speedup_vs_genomicranges, color = engine, group = engine)
) +
  geom_hline(yintercept = 1, linetype = "dashed", color = "grey40") +
  geom_point(size = 3) +
  geom_line(linewidth = 0.9) +
  labs(
    title = "Speedup vs GenomicRanges::findOverlaps",
    x = "Scenario",
    y = "Speedup (x)",
    color = "Engine"
  ) +
  theme_pub() +
  theme(axis.text.x = element_text(angle = 25, hjust = 1))

p_gr_speedup

ggsave(file.path(fig_dir, "granges_speedup_line.png"), p_gr_speedup, width = 10, height = 5, dpi = 300)
```

## GRanges Thread Scaling on a Denser Workload

```{r granges-scaling}
gr_scaling_subject <- simulate_granges(
  as.integer(params$gr_scaling_subject_n),
  seed = params$seed + 1500L,
  seqlevels = paste0("chr", 1:6),
  coord_span = as.integer(params$gr_scaling_coord_span),
  width_max = 1500L
)
gr_scaling_query <- simulate_granges(
  as.integer(params$gr_scaling_query_n),
  seed = params$seed + 1501L,
  seqlevels = paste0("chr", 1:6),
  coord_span = as.integer(params$gr_scaling_coord_span),
  width_max = 1500L
)

gr_scaling_fast_idx <- fastRanges::fast_build_index(gr_scaling_subject)
gr_scaling_gnc_idx <- GenomicRanges::GNCList(gr_scaling_subject)

gr_scaling_ref_direct <- GenomicRanges::findOverlaps(
  gr_scaling_query,
  gr_scaling_subject,
  ignore.strand = FALSE
)
gr_scaling_ref_gnc <- GenomicRanges::findOverlaps(
  gr_scaling_query,
  gr_scaling_gnc_idx,
  ignore.strand = FALSE
)

stopifnot(identical(
  normalize_hit_pairs(gr_scaling_ref_direct),
  normalize_hit_pairs(gr_scaling_ref_gnc)
))

gr_scaling_ref_hits <- length(gr_scaling_ref_direct)

gr_scaling_list <- list()
for (i in seq_along(thread_grid)) {
  th <- thread_grid[i]

  direct_local <- time_engine(
    "fastRanges_direct_GRanges",
    function() fastRanges::fast_find_overlaps(
      gr_scaling_query,
      gr_scaling_subject,
      threads = th,
      deterministic = FALSE
    ),
    params$iterations
  )
  if (any(direct_local$hits != gr_scaling_ref_hits)) {
    stop("Hit count mismatch for direct fastRanges in GRanges scaling benchmark")
  }
  direct_local$threads <- th
  gr_scaling_list[[length(gr_scaling_list) + 1L]] <- direct_local

  indexed_local <- time_engine(
    "fastRanges_indexed_GRanges",
    function() fastRanges::fast_find_overlaps(
      gr_scaling_query,
      gr_scaling_fast_idx,
      threads = th,
      deterministic = FALSE
    ),
    params$iterations
  )
  if (any(indexed_local$hits != gr_scaling_ref_hits)) {
    stop("Hit count mismatch for indexed fastRanges in GRanges scaling benchmark")
  }
  indexed_local$threads <- th
  gr_scaling_list[[length(gr_scaling_list) + 1L]] <- indexed_local
}

gr_scaling_baseline <- dplyr::bind_rows(
  time_engine(
    "GenomicRanges_findOverlaps",
    function() GenomicRanges::findOverlaps(
      gr_scaling_query,
      gr_scaling_subject,
      ignore.strand = FALSE
    ),
    params$iterations
  ),
  time_engine(
    "GenomicRanges_GNCList",
    function() GenomicRanges::findOverlaps(
      gr_scaling_query,
      gr_scaling_gnc_idx,
      ignore.strand = FALSE
    ),
    params$iterations
  )
)
if (any(gr_scaling_baseline$hits != gr_scaling_ref_hits)) {
  stop("Hit count mismatch for GenomicRanges baseline in GRanges scaling benchmark")
}
gr_scaling_baseline$threads <- 1L

gr_scaling <- dplyr::bind_rows(gr_scaling_list, gr_scaling_baseline)

gr_scaling_summary <- gr_scaling %>%
  dplyr::group_by(engine, threads) %>%
  dplyr::summarise(
    median_sec = median(elapsed_sec),
    min_sec = min(elapsed_sec),
    max_sec = max(elapsed_sec),
    .groups = "drop"
  )

gr_scaling_baseline_sec <- gr_scaling_summary$median_sec[
  gr_scaling_summary$engine == "GenomicRanges_findOverlaps" & gr_scaling_summary$threads == 1L
]

gr_scaling_summary <- gr_scaling_summary %>%
  dplyr::group_by(engine) %>%
  dplyr::arrange(threads, .by_group = TRUE) %>%
  dplyr::mutate(speedup_vs_1_thread = first(median_sec) / median_sec) %>%
  dplyr::ungroup() %>%
  dplyr::mutate(speedup_vs_genomicranges = as.numeric(gr_scaling_baseline_sec) / median_sec)

gr_scaling_summary %>% dplyr::arrange(engine, threads)
```

This section uses a denser chromosome layout (`chr1`-`chr6` over a smaller
coordinate span) so overlap density is higher than in the broad end-to-end
stress test above. The goal is to expose scaling behavior when traversal work,
not just object size, becomes a stronger part of runtime.

```{r granges-scaling-runtime-plot, fig.width=10, fig.height=5}
gr_scaling_fast <- dplyr::filter(gr_scaling_summary, grepl("^fastRanges", engine))
gr_scaling_serial <- dplyr::filter(gr_scaling_summary, grepl("^GenomicRanges", engine))

p_gr_scaling_runtime <- ggplot(gr_scaling_fast, aes(x = threads, y = median_sec, color = engine)) +
  geom_line(linewidth = 1) +
  geom_point(size = 3) +
  geom_hline(
    data = gr_scaling_serial,
    aes(yintercept = median_sec, color = engine),
    linetype = "dashed",
    linewidth = 0.9
  ) +
  geom_point(
    data = gr_scaling_serial,
    aes(x = threads, y = median_sec, color = engine),
    size = 3
  ) +
  scale_x_continuous(breaks = thread_grid) +
  scale_y_continuous(labels = label_number(accuracy = 0.1)) +
  labs(
    title = "GRanges thread scaling on a denser workload",
    x = "Threads",
    y = "Median elapsed time (sec)",
    color = "Engine"
  ) +
  theme_pub()

p_gr_scaling_runtime

ggsave(file.path(fig_dir, "granges_scaling_runtime.png"), p_gr_scaling_runtime, width = 10, height = 5, dpi = 300)
```

```{r granges-scaling-speedup-plot, fig.width=10, fig.height=5}
p_gr_scaling_speedup <- ggplot(
  dplyr::filter(gr_scaling_summary, grepl("^fastRanges", engine)),
  aes(x = threads, y = speedup_vs_1_thread, color = engine)
) +
  geom_hline(yintercept = 1, linetype = "dashed", color = "grey40") +
  geom_line(linewidth = 1) +
  geom_point(size = 3) +
  scale_x_continuous(breaks = thread_grid) +
  labs(
    title = "GRanges speedup vs 1 thread",
    x = "Threads",
    y = "Speedup vs 1 thread",
    color = "Engine"
  ) +
  theme_pub()

p_gr_scaling_speedup

ggsave(file.path(fig_dir, "granges_scaling_speedup.png"), p_gr_scaling_speedup, width = 10, height = 5, dpi = 300)
```

## Thread Scaling: IRanges vs fastRanges (Fair Indexed Comparison)

```{r iranges-scaling}
subject_ir <- simulate_iranges(as.integer(params$ir_subject_n), seed = params$seed + 1000L)
query_ir <- simulate_iranges(as.integer(params$ir_query_n), seed = params$seed + 1001L)
subject_ir_index <- fastRanges::fast_build_index(subject_ir)

iranges_nthread_probe <- try(
  {
    probe_q <- IRanges::IRanges(start = c(1L, 10L), width = c(3L, 4L))
    probe_s <- IRanges::IRanges(start = c(2L, 9L), width = c(3L, 4L))
    IRanges::findOverlaps(probe_q, probe_s, nthread = 1L)
    TRUE
  },
  silent = TRUE
)
iranges_supports_nthread <- isTRUE(iranges_nthread_probe)

if (!iranges_supports_nthread) {
  message(
    "Installed IRanges::findOverlaps() does not accept `nthread` for this method; ",
    "using serial IRanges baseline."
  )
} else {
  message("IRanges nthread support detected; running threaded IRanges benchmark.")
}

ref_hits_ir <- length(IRanges::findOverlaps(query_ir, subject_ir))

ir_scale_list <- list()
for (i in seq_along(thread_grid)) {
  th <- thread_grid[i]

  fast_local <- time_engine(
    "fastRanges_indexed_IRanges",
    function() fastRanges::fast_find_overlaps(
      query_ir,
      subject_ir_index,
      threads = th,
      deterministic = FALSE
    ),
    params$iterations
  )
  if (any(fast_local$hits != ref_hits_ir)) {
    stop("Hit count mismatch for fastRanges in IRanges scaling benchmark")
  }
  fast_local$threads <- th
  ir_scale_list[[length(ir_scale_list) + 1L]] <- fast_local

  if (iranges_supports_nthread) {
    ir_local <- time_engine(
      "IRanges_nthread",
      function() IRanges::findOverlaps(query_ir, subject_ir, nthread = th),
      params$iterations
    )
    if (any(ir_local$hits != ref_hits_ir)) {
      stop("Hit count mismatch for IRanges in IRanges scaling benchmark")
    }
    ir_local$threads <- th
    ir_scale_list[[length(ir_scale_list) + 1L]] <- ir_local
  }
}

if (!iranges_supports_nthread) {
  ir_serial <- time_engine(
    "IRanges_serial",
    function() IRanges::findOverlaps(query_ir, subject_ir),
    params$iterations
  )
  if (any(ir_serial$hits != ref_hits_ir)) {
    stop("Hit count mismatch for serial IRanges baseline")
  }
  ir_serial$threads <- 1L
  ir_scale_list[[length(ir_scale_list) + 1L]] <- ir_serial
}

ir_scaling <- dplyr::bind_rows(ir_scale_list)
ir_scaling_summary <- ir_scaling %>%
  dplyr::group_by(engine, threads) %>%
  dplyr::summarise(median_sec = median(elapsed_sec), .groups = "drop") %>%
  dplyr::group_by(engine) %>%
  dplyr::mutate(speedup_vs_1_thread = first(median_sec) / median_sec) %>%
  dplyr::ungroup()

ir_scaling_summary %>% dplyr::arrange(engine, threads)
```

This scaling panel uses pre-indexed `fastRanges` (`fast_build_index(subject_ir)` once, then reused) to avoid counting index construction time in every iteration. This makes the comparison closer to repeated-query production workloads. When `IRanges` does not support `nthread`, the report shows a single `IRanges_serial` point at `threads = 1`.

```{r iranges-scaling-plot, fig.width=10, fig.height=5}
p_ir_scaling <- ggplot(ir_scaling_summary, aes(x = threads, y = speedup_vs_1_thread, color = engine)) +
  geom_line(linewidth = 1) +
  geom_point(size = 3) +
  scale_x_continuous(breaks = thread_grid) +
  labs(
    title = "Thread scaling on IRanges workloads (indexed fastRanges)",
    x = "Threads",
    y = "Speedup vs 1 thread",
    color = "Engine"
  ) +
  theme_pub()

p_ir_scaling

ggsave(file.path(fig_dir, "iranges_thread_scaling.png"), p_ir_scaling, width = 10, height = 5, dpi = 300)
```

```{r iranges-absolute-winner, fig.width=10, fig.height=5}
ir_absolute_winner <- ir_scaling_summary %>%
  dplyr::arrange(threads, median_sec, engine) %>%
  dplyr::group_by(threads) %>%
  dplyr::slice_head(n = 1L) %>%
  dplyr::ungroup()

p_ir_winner <- ggplot(
  ir_absolute_winner,
  aes(x = factor(threads), y = median_sec, fill = engine)
) +
  geom_col(width = 0.72) +
  geom_text(aes(label = sprintf("%.1f", median_sec)), vjust = -0.35, size = 3.6) +
  labs(
    title = "Absolute winner at each thread count (lower is better)",
    x = "Threads",
    y = "Median elapsed time (sec)",
    fill = "Winning engine"
  ) +
  theme_pub()

p_ir_winner

ggsave(file.path(fig_dir, "iranges_absolute_winner_bar.png"), p_ir_winner, width = 10, height = 5, dpi = 300)
```

## Repeated-Query Workload (Index Reuse)

```{r repeated-query-benchmark}
subject_rep <- simulate_granges(as.integer(params$repeated_subject_n), seed = params$seed + 2000L)
query_list <- lapply(
  seq_len(as.integer(params$repeated_queries)),
  function(i) simulate_granges(as.integer(params$repeated_query_n), seed = params$seed + 2000L + i)
)

run_repeated_fast_indexed <- function() {
  idx <- fastRanges::fast_build_index(subject_rep)
  total_hits <- 0L
  for (q in query_list) {
    total_hits <- total_hits + length(fastRanges::fast_find_overlaps(q, idx, threads = max_threads))
  }
  total_hits
}

run_repeated_fast_direct <- function() {
  total_hits <- 0L
  for (q in query_list) {
    total_hits <- total_hits + length(fastRanges::fast_find_overlaps(q, subject_rep, threads = max_threads))
  }
  total_hits
}

run_repeated_gr_direct <- function() {
  total_hits <- 0L
  for (q in query_list) {
    total_hits <- total_hits + length(GenomicRanges::findOverlaps(q, subject_rep, ignore.strand = FALSE))
  }
  total_hits
}

run_repeated_gr_gnclist <- function() {
  idx <- GenomicRanges::GNCList(subject_rep)
  total_hits <- 0L
  for (q in query_list) {
    total_hits <- total_hits + length(GenomicRanges::findOverlaps(q, idx, ignore.strand = FALSE))
  }
  total_hits
}

repeat_bench <- dplyr::bind_rows(
  time_engine("fastRanges_index_reuse", run_repeated_fast_indexed, params$iterations, size_fn = identity),
  time_engine("fastRanges_direct", run_repeated_fast_direct, params$iterations, size_fn = identity),
  time_engine("GenomicRanges_findOverlaps", run_repeated_gr_direct, params$iterations, size_fn = identity),
  time_engine("GenomicRanges_GNCList", run_repeated_gr_gnclist, params$iterations, size_fn = identity)
)

ref_repeat_hits <- unique(repeat_bench$hits[repeat_bench$engine == "GenomicRanges_findOverlaps"])
if (length(ref_repeat_hits) != 1L || any(repeat_bench$hits != ref_repeat_hits[1])) {
  stop("Total hit mismatch between engines in repeated-query benchmark")
}

repeat_bench_summary <- repeat_bench %>%
  dplyr::group_by(engine) %>%
  dplyr::summarise(median_sec = median(elapsed_sec), .groups = "drop") %>%
  dplyr::left_join(
    repeat_bench %>%
      dplyr::filter(engine == "GenomicRanges_findOverlaps") %>%
      dplyr::summarise(baseline_sec = median(elapsed_sec)),
    by = character()
  ) %>%
  dplyr::mutate(speedup_vs_genomicranges = baseline_sec / median_sec)

repeat_bench_summary
```

```{r repeated-query-plot, fig.width=10, fig.height=5}
p_repeat <- ggplot(repeat_bench_summary, aes(x = reorder(engine, median_sec), y = median_sec, fill = engine)) +
  geom_col(width = 0.7) +
  coord_flip() +
  scale_y_continuous(labels = label_number(accuracy = 0.1)) +
  labs(
    title = "Repeated-query total runtime (index reuse scenario)",
    x = NULL,
    y = "Median elapsed time (sec)",
    fill = "Engine"
  ) +
  theme_pub()

p_repeat

ggsave(file.path(fig_dir, "repeated_query_runtime_bar.png"), p_repeat, width = 10, height = 5, dpi = 300)
```

## Derived Function Benchmark (New API)

```{r derived-benchmark}
subject_drv <- simulate_granges(as.integer(params$derived_subject_n), seed = params$seed + 3000L)
query_drv <- simulate_granges(as.integer(params$derived_query_n), seed = params$seed + 3001L)

group_levels <- c("promoter", "exon", "intron", "intergenic", "enhancer")
S4Vectors::mcols(subject_drv)$feature_group <- sample(group_levels, length(subject_drv), replace = TRUE)
S4Vectors::mcols(subject_drv)$score <- rexp(length(subject_drv), rate = 1 / 8)

baseline_count_overlaps_by_group <- function(query, subject, group_col) {
  h <- GenomicRanges::findOverlaps(query, subject, ignore.strand = FALSE)
  qh <- S4Vectors::queryHits(h)
  sh <- S4Vectors::subjectHits(h)
  groups <- as.character(S4Vectors::mcols(subject)[[group_col]][sh])
  levels <- sort(unique(as.character(S4Vectors::mcols(subject)[[group_col]])))
  out <- matrix(0L, nrow = length(query), ncol = length(levels), dimnames = list(NULL, levels))
  if (length(qh) == 0L) {
    return(out)
  }
  tab <- table(qh, factor(groups, levels = levels))
  out[as.integer(rownames(tab)), ] <- tab
  out
}

baseline_overlap_aggregate_sum <- function(query, subject, value_col) {
  h <- GenomicRanges::findOverlaps(query, subject, ignore.strand = FALSE)
  qh <- S4Vectors::queryHits(h)
  sh <- S4Vectors::subjectHits(h)
  values <- as.numeric(S4Vectors::mcols(subject)[[value_col]][sh])
  out <- rep(NA_real_, length(query))
  if (length(values) == 0L) {
    return(out)
  }
  split_vals <- split(values, qh)
  out[as.integer(names(split_vals))] <- vapply(split_vals, sum, numeric(1))
  out
}

baseline_window_count_overlaps <- function(query, subject, window_width, step_width) {
  seq_chr <- as.character(GenomicRanges::seqnames(query))
  split_idx <- split(seq_len(length(query)), seq_chr)

  pieces <- vector("list", length(split_idx))
  for (i in seq_along(split_idx)) {
    idx <- split_idx[[i]]
    s <- min(IRanges::start(query[idx]))
    e <- max(IRanges::end(query[idx]))
    starts <- seq.int(s, e, by = as.integer(step_width))
    pieces[[i]] <- GenomicRanges::GRanges(
      seqnames = names(split_idx)[i],
      ranges = IRanges::IRanges(start = starts, width = as.integer(window_width)),
      strand = "*"
    )
  }

  windows <- do.call(c, pieces)
  counts <- GenomicRanges::countOverlaps(windows, subject, ignore.strand = FALSE)
  data.frame(
    seqnames = as.character(GenomicRanges::seqnames(windows)),
    start = IRanges::start(windows),
    end = IRanges::end(windows),
    overlap_count = as.integer(counts),
    stringsAsFactors = FALSE
  )
}

ref_group <- baseline_count_overlaps_by_group(query_drv, subject_drv, "feature_group")
ref_agg <- baseline_overlap_aggregate_sum(query_drv, subject_drv, "score")
ref_window <- baseline_window_count_overlaps(
  query_drv,
  subject_drv,
  window_width = as.integer(params$derived_window_width),
  step_width = as.integer(params$derived_step_width)
)
ref_self_all <- GenomicRanges::findOverlaps(query_drv, query_drv)
ref_self_q <- S4Vectors::queryHits(ref_self_all)
ref_self_s <- S4Vectors::subjectHits(ref_self_all)
ref_self_keep <- ref_self_q != ref_self_s & ref_self_q < ref_self_s
ref_self <- S4Vectors::Hits(
  from = ref_self_q[ref_self_keep],
  to = ref_self_s[ref_self_keep],
  nLnode = length(query_drv),
  nRnode = length(query_drv)
)

got_group <- fastRanges::fast_count_overlaps_by_group(
  query_drv,
  subject_drv,
  group_col = "feature_group",
  threads = max_threads,
  deterministic = FALSE
)
got_agg <- fastRanges::fast_overlap_aggregate(
  query_drv,
  subject_drv,
  value_col = "score",
  fun = "sum",
  threads = max_threads,
  deterministic = FALSE
)
got_window <- fastRanges::fast_window_count_overlaps(
  query_drv,
  subject_drv,
  window_width = as.integer(params$derived_window_width),
  step_width = as.integer(params$derived_step_width),
  threads = max_threads,
  deterministic = FALSE
)
got_self <- fastRanges::fast_self_overlaps(
  query_drv,
  threads = max_threads,
  deterministic = FALSE
)

stopifnot(identical(unname(got_group[, colnames(ref_group), drop = FALSE]), unname(ref_group)))
stopifnot(isTRUE(all.equal(got_agg, ref_agg, tolerance = 1e-10, check.attributes = FALSE)))
stopifnot(identical(got_window$overlap_count, ref_window$overlap_count))
stopifnot(identical(normalize_hit_pairs(got_self), normalize_hit_pairs(ref_self)))

drv_bench <- dplyr::bind_rows(
  time_task(
    task = "count_by_group",
    engine = "fastRanges",
    fn = function() fastRanges::fast_count_overlaps_by_group(
      query_drv,
      subject_drv,
      group_col = "feature_group",
      threads = max_threads,
      deterministic = FALSE
    ),
    size_fn = function(x) sum(x),
    iterations = params$iterations
  ),
  time_task(
    task = "count_by_group",
    engine = "Bioconductor_baseline",
    fn = function() baseline_count_overlaps_by_group(query_drv, subject_drv, group_col = "feature_group"),
    size_fn = function(x) sum(x),
    iterations = params$iterations
  ),
  time_task(
    task = "aggregate_sum",
    engine = "fastRanges",
    fn = function() fastRanges::fast_overlap_aggregate(
      query_drv,
      subject_drv,
      value_col = "score",
      fun = "sum",
      threads = max_threads,
      deterministic = FALSE
    ),
    size_fn = function(x) sum(x, na.rm = TRUE),
    iterations = params$iterations
  ),
  time_task(
    task = "aggregate_sum",
    engine = "Bioconductor_baseline",
    fn = function() baseline_overlap_aggregate_sum(query_drv, subject_drv, value_col = "score"),
    size_fn = function(x) sum(x, na.rm = TRUE),
    iterations = params$iterations
  ),
  time_task(
    task = "window_count",
    engine = "fastRanges",
    fn = function() fastRanges::fast_window_count_overlaps(
      query_drv,
      subject_drv,
      window_width = as.integer(params$derived_window_width),
      step_width = as.integer(params$derived_step_width),
      threads = max_threads,
      deterministic = FALSE
    ),
    size_fn = function(x) sum(x$overlap_count),
    iterations = params$iterations
  ),
  time_task(
    task = "window_count",
    engine = "Bioconductor_baseline",
    fn = function() baseline_window_count_overlaps(
      query_drv,
      subject_drv,
      window_width = as.integer(params$derived_window_width),
      step_width = as.integer(params$derived_step_width)
    ),
    size_fn = function(x) sum(x$overlap_count),
    iterations = params$iterations
  ),
  time_task(
    task = "self_overlaps",
    engine = "fastRanges",
    fn = function() fastRanges::fast_self_overlaps(
      query_drv,
      threads = max_threads,
      deterministic = FALSE
    ),
    size_fn = length,
    iterations = params$iterations
  ),
  time_task(
    task = "self_overlaps",
    engine = "Bioconductor_baseline",
    fn = function() {
      h <- GenomicRanges::findOverlaps(query_drv, query_drv)
      qh <- S4Vectors::queryHits(h)
      sh <- S4Vectors::subjectHits(h)
      keep <- qh != sh & qh < sh
      S4Vectors::Hits(
        from = qh[keep],
        to = sh[keep],
        nLnode = length(query_drv),
        nRnode = length(query_drv)
      )
    },
    size_fn = length,
    iterations = params$iterations
  )
)

drv_summary <- drv_bench %>%
  dplyr::group_by(task, engine) %>%
  dplyr::summarise(median_sec = median(elapsed_sec), .groups = "drop") %>%
  dplyr::left_join(
    drv_bench %>%
      dplyr::filter(engine == "Bioconductor_baseline") %>%
      dplyr::group_by(task) %>%
      dplyr::summarise(baseline_sec = median(elapsed_sec), .groups = "drop"),
    by = "task"
  ) %>%
  dplyr::mutate(speedup_vs_baseline = baseline_sec / median_sec)

drv_summary
```

For derived-task throughput benchmarking, `fastRanges` calls are run with
`deterministic = FALSE` because result ordering is not part of the measured
task objective (counts/aggregates). Equality checks above still validate
numerical equivalence against Bioconductor baselines.

```{r derived-runtime-plot, fig.width=10, fig.height=5}
p_drv_runtime <- ggplot(drv_summary, aes(x = task, y = median_sec, fill = engine)) +
  geom_col(position = position_dodge(width = 0.75), width = 0.7) +
  scale_y_continuous(labels = label_number(accuracy = 0.1)) +
  labs(
    title = "Runtime for newly added fastRanges functions",
    x = "Task",
    y = "Median elapsed time (sec)",
    fill = "Engine"
  ) +
  theme_pub()

p_drv_runtime

ggsave(file.path(fig_dir, "derived_runtime_bar.png"), p_drv_runtime, width = 10, height = 5, dpi = 300)
```

```{r derived-speedup-plot, fig.width=10, fig.height=5}
p_drv_speedup <- ggplot(
  dplyr::filter(drv_summary, engine == "fastRanges"),
  aes(x = task, y = speedup_vs_baseline)
) +
  geom_hline(yintercept = 1, linetype = "dashed", color = "grey40") +
  geom_point(size = 3, color = "#1b9e77") +
  geom_segment(
    aes(xend = task, y = 1, yend = speedup_vs_baseline),
    linewidth = 0.8,
    color = "#1b9e77"
  ) +
  labs(
    title = "Speedup of new fastRanges APIs vs Bioconductor baselines",
    x = "Task",
    y = "Speedup (x)"
  ) +
  theme_pub()

p_drv_speedup

ggsave(file.path(fig_dir, "derived_speedup_dot.png"), p_drv_speedup, width = 10, height = 5, dpi = 300)
```

## Publication Reporting Block

```{r publication-table}
pub_table <- gr_speedup %>%
  dplyr::select(scenario, engine, median_sec, speedup_vs_genomicranges) %>%
  dplyr::arrange(scenario, engine)

pub_table
```

## Export Benchmark Tables

```{r export-benchmark-tables}
benchmark_run_metadata <- data.frame(
  run_timestamp = as.character(Sys.time()),
  seed = as.integer(params$seed),
  iterations = as.integer(params$iterations),
  max_threads_requested = as.integer(params$max_threads),
  max_threads_used = as.integer(max_threads),
  thread_grid = paste(thread_grid, collapse = ","),
  available_physical_cores = as.integer(available_threads),
  r_version = R.version.string,
  platform = R.version$platform,
  sysname = Sys.info()[["sysname"]],
  release = Sys.info()[["release"]],
  machine = Sys.info()[["machine"]],
  stringsAsFactors = FALSE
)

package_versions <- data.frame(
  package = c("fastRanges", "GenomicRanges", "IRanges", "S4Vectors", "ggplot2", "dplyr", "tidyr"),
  version = vapply(
    c("fastRanges", "GenomicRanges", "IRanges", "S4Vectors", "ggplot2", "dplyr", "tidyr"),
    function(pkg) as.character(utils::packageVersion(pkg)),
    character(1)
  ),
  stringsAsFactors = FALSE
)

benchmark_tables <- list(
  benchmark_run_metadata = benchmark_run_metadata,
  package_versions = package_versions,
  gr_bench_raw = gr_bench,
  gr_summary = gr_summary,
  gr_speedup = gr_speedup,
  gr_scaling_raw = gr_scaling,
  gr_scaling_summary = gr_scaling_summary,
  ir_scaling_raw = ir_scaling,
  ir_scaling_summary = ir_scaling_summary,
  ir_absolute_winner = ir_absolute_winner,
  repeat_bench_raw = repeat_bench,
  repeat_bench_summary = repeat_bench_summary,
  derived_bench_raw = drv_bench,
  derived_summary = drv_summary,
  publication_table = pub_table
)

benchmark_manifest <- data.frame(
  table_name = names(benchmark_tables),
  file = vapply(
    names(benchmark_tables),
    function(nm) write_result_table(benchmark_tables[[nm]], nm),
    character(1)
  ),
  stringsAsFactors = FALSE
)

manifest_path <- write_result_table(benchmark_manifest, "benchmark_table_manifest")
cat("Saved benchmark tables manifest to:", manifest_path, "\n")

benchmark_manifest
```

## Interpretation

```{r interpretation, results='asis'}
gr_indexed <- gr_summary %>%
  dplyr::filter(engine == "fastRanges_indexed") %>%
  dplyr::select(scenario, indexed_sec = median_sec)

gr_direct <- gr_summary %>%
  dplyr::filter(engine == "fastRanges_direct") %>%
  dplyr::select(scenario, direct_sec = median_sec)

gr_baseline <- gr_summary %>%
  dplyr::filter(engine == "GenomicRanges_findOverlaps") %>%
  dplyr::select(scenario, baseline_sec = median_sec)

gr_interp <- gr_indexed %>%
  dplyr::left_join(gr_direct, by = "scenario") %>%
  dplyr::left_join(gr_baseline, by = "scenario") %>%
  dplyr::mutate(
    speedup_vs_baseline = baseline_sec / indexed_sec,
    speedup_vs_direct = direct_sec / indexed_sec
  )

gr_speedup_median <- median(gr_interp$speedup_vs_baseline, na.rm = TRUE)
gr_direct_gain_median <- median(gr_interp$speedup_vs_direct, na.rm = TRUE)

repeat_index_sec <- repeat_bench_summary$median_sec[repeat_bench_summary$engine == "fastRanges_index_reuse"]
repeat_direct_sec <- repeat_bench_summary$median_sec[repeat_bench_summary$engine == "fastRanges_direct"]
repeat_gr_speedup <- repeat_bench_summary$speedup_vs_genomicranges[repeat_bench_summary$engine == "fastRanges_index_reuse"]
repeat_direct_gain <- repeat_direct_sec / repeat_index_sec

ir_fast <- ir_scaling_summary %>%
  dplyr::filter(engine == "fastRanges_indexed_IRanges")
ir_fast_best <- ir_fast[which.max(ir_fast$speedup_vs_1_thread), , drop = FALSE]

gr_scale_fast <- gr_scaling_summary %>%
  dplyr::filter(engine == "fastRanges_indexed_GRanges")
gr_scale_fast_best <- gr_scale_fast[which.max(gr_scale_fast$speedup_vs_1_thread), , drop = FALSE]

drv_fast <- drv_summary %>%
  dplyr::filter(engine == "fastRanges")
drv_median_speedup <- median(drv_fast$speedup_vs_baseline, na.rm = TRUE)

cat("### Key Findings\n\n")
cat(sprintf(
  "- For GRanges overlap detection, indexed `fastRanges` achieved a median **%.2fx** speedup versus `GenomicRanges::findOverlaps` across tested scenarios.\n",
  gr_speedup_median
))
cat(sprintf(
  "- Reusing a pre-built index reduced runtime by **%.2fx** versus direct `fastRanges` overlap calls in repeated-query workloads (and **%.2fx** versus `GenomicRanges::findOverlaps`).\n",
  repeat_direct_gain,
  repeat_gr_speedup
))
cat(sprintf(
  "- On the denser GRanges scaling workload, indexed `fastRanges` reached **%.2fx** speedup versus its own 1-thread baseline at **%d threads**.\n",
  gr_scale_fast_best$speedup_vs_1_thread,
  gr_scale_fast_best$threads
))
cat(sprintf(
  "- Pre-indexed `fastRanges` on IRanges workloads peaked at **%.2fx** speedup versus 1 thread at **%d threads**.\n",
  ir_fast_best$speedup_vs_1_thread,
  ir_fast_best$threads
))
cat(sprintf(
  "- Across new derived APIs (`count_by_group`, `aggregate_sum`, `window_count`, `self_overlaps`), median speedup was **%.2fx** versus Bioconductor baseline implementations.\n",
  drv_median_speedup
))
```

## Conclusion

This benchmark indicates that `fastRanges` delivers its largest gains when:

-   the subject set is reused across many queries (index amortization),
-   high thread counts are available (especially for `IRanges`-style workloads), and
-   workflow steps combine overlap detection with derived summaries.

For a 96-core server, the recommended production pattern is:

1.  Build a `fast_ranges_index` once per subject cohort.
2.  Reuse the index for all query batches.
3.  Benchmark with the provided thread grid to identify the local saturation point.
4.  Set package-level default threads to the best-performing point for your hardware.

## Session Info

```{r session-info}
sessionInfo()
```

## Notes

-   Default parameters are intentionally large to expose differences in algorithmic and indexing behavior.
-   Use chunk caching or higher-memory machines for full publication runs.
-   All figures are exported to `./benchmark_result/figures/` for manuscript use, including derived-function runtime and speedup panels.
-   Raw and summary benchmark tables are exported as CSV files in `./benchmark_result/results/` with a manifest file (`benchmark_table_manifest.csv`) for downstream plotting workflows.
