# Benchmarking immutables Collections

## Method

This article measures individual operation times for each collection type provided by `immutables`. Each recorded repetition rebuilds the fixture for size n, then uses `microbenchmark(..., times = 1)` to time one operation on that fresh state.

The numbers shown below are loaded from cached results shipped with the package; re-running `data-raw/generate_publication_results.R` regenerates them. See the script’s header for runtime and options.

Comparisons use base R implementations and select structures from `rstackdeque` and `IRanges`:

- Sequences and queue operations:
  - immutables: `flexseq()`
  - base R: `list()`
  - `rstackdeque`: `rpqueue()`
- Priority operations:
  - immutables: `priority_queue()`
  - base R: parallel value and priority vectors with `which.min()` / `which.max()`
- Interval operations:
  - immutables: `interval_index()`
  - base R: `data.frame` with start/end columns, filtered with vectorized comparisons
  - `IRanges`: `IRanges()`

## Sequence operations

Seven operations on sequences of 1,024 to 131,072 elements. Append, prepend, concatenate, and split exploit the finger tree’s O(log n) structural sharing; get, replace, and remove at the middle exercise index-based splitting.

    repeats <- 6L

    sequence_sizes <- 2^(10 + 0:6)
    rows <- flexseq()

    for(n in sequence_sizes) {
      cat("Sequence ops, size ", n, "\n")
      vals <- function() as.list(sprintf("v_%06d", seq_len(n)))
      mid <- as.integer(n / 2)
      flex_setup <- function() list(s = as_flexseq(vals()), mid = mid)
      list_setup <- function() list(s = vals(), mid = mid)
      pair_flex  <- function() list(a = as_flexseq(vals()), b = as_flexseq(vals()))
      pair_list  <- function() list(a = vals(), b = vals())

      rows <- bench_one(rows, "flexseq", "append",  n, repeats, flex_setup,
        function(st) push_back(st$s, "z"))
      rows <- bench_one(rows, "flexseq", "prepend", n, repeats, flex_setup,
        function(st) push_front(st$s, "z"))
      rows <- bench_one(rows, "flexseq", "get middle", n, repeats, flex_setup,
        function(st) st$s[[st$mid]])
      rows <- bench_one(rows, "flexseq", "replace middle", n, repeats, flex_setup,
        function(st) { s <- st$s; s[[st$mid]] <- "y"; s })
      rows <- bench_one(rows, "flexseq", "remove middle", n, repeats, flex_setup,
        function(st) pop_at(st$s, st$mid)$remaining)
      rows <- bench_one(rows, "flexseq", "concatenate", n, repeats, pair_flex,
        function(st) c(st$a, st$b))
      rows <- bench_one(rows, "flexseq", "split at middle", n, repeats, flex_setup,
        function(st) split_at(st$s, st$mid))

      rows <- bench_one(rows, "base R list", "append",  n, repeats, list_setup,
        function(st) c(st$s, list("z")))
      rows <- bench_one(rows, "base R list", "prepend", n, repeats, list_setup,
        function(st) c(list("z"), st$s))
      rows <- bench_one(rows, "base R list", "get middle", n, repeats, list_setup,
        function(st) st$s[[st$mid]])
      rows <- bench_one(rows, "base R list", "replace middle", n, repeats, list_setup,
        function(st) { s <- st$s; s[[st$mid]] <- "y"; s })
      rows <- bench_one(rows, "base R list", "remove middle", n, repeats, list_setup,
        function(st) st$s[-st$mid])
      rows <- bench_one(rows, "base R list", "concatenate", n, repeats, pair_list,
        function(st) c(st$a, st$b))
      rows <- bench_one(rows, "base R list", "split at middle", n, repeats, list_setup,
        function(st) list(
          left = st$s[seq_len(st$mid - 1L)],
          value = st$s[[st$mid]],
          right = st$s[(st$mid + 1L):n]
        ))
    }

    results_list$sequence <- do.call(rbind, as.list(rows))

    if(!is.null(results_list$sequence)) {
      seq_results <- results_list$sequence
      seq_results$time_ms <- seq_results$time_us / 1000
      sorted_sizes <- sort(unique(seq_results$n))
      pow_labels <- lapply(sorted_sizes, function(s) bquote(2^.(log2(s)))) |> as.character()
      seq_results$n_cat <- factor(seq_results$n, levels = sorted_sizes)

      p_sequence <- ggplot(seq_results, aes(x = n_cat, y = time_ms, color = impl)) +
        geom_point(position = position_jitter(width = 0.15, height = 0)) +
        facet_wrap(~ op, scales = "free_y") +
        scale_x_discrete(labels = pow_labels) +
        labs(
          title = "Sequence Operations",
          x = "Number of elements",
          y = "Time (ms)",
          color = "Implementation"
        ) +
        theme_bw() +
        theme(plot.title = element_text(hjust = 0.5), legend.position = "bottom")
      print(p_sequence)
    } else {
      knitr::asis_output("*Benchmark results not yet generated. Run `data-raw/generate_publication_results.R` to populate.*")
    }

## Queue operations

FIFO enqueue (push to back) and dequeue (pop from front) compared across `flexseq`, `rstackdeque`, and base R lists. Both `flexseq` and `rstackdeque` provide O(log n) or amortized O(1) queue operations; base R’s `c()` and `[-1]` are O(n).

    queue_sizes <- 2^(10 + 0:7)
    rows <- flexseq()

    for(n in queue_sizes) {
      items <- function() as.list(rep("queue_item", n))
      flex_setup <- function() list(q = as_flexseq(items()))
      rsd_setup  <- function() list(q = rstackdeque::as.rpqueue(items()))
      list_setup <- function() list(q = items())

      rows <- bench_one(rows, "flexseq",     "enqueue", n, repeats, flex_setup,
        function(st) push_back(st$q, "d"))
      rows <- bench_one(rows, "flexseq",     "dequeue", n, repeats, flex_setup,
        function(st) pop_front(st$q)$remaining)
      rows <- bench_one(rows, "rstackdeque", "enqueue", n, repeats, rsd_setup,
        function(st) rstackdeque::insert_back(st$q, "d"))
      rows <- bench_one(rows, "rstackdeque", "dequeue", n, repeats, rsd_setup,
        function(st) rstackdeque::without_front(st$q))
      rows <- bench_one(rows, "base R list", "enqueue", n, repeats, list_setup,
        function(st) c(st$q, list("d")))
      rows <- bench_one(rows, "base R list", "dequeue", n, repeats, list_setup,
        function(st) st$q[-1L])
    }

    results_list$queue <- do.call(rbind, as.list(rows))

    if(!is.null(results_list$queue)) {
      queue_results <- results_list$queue
      queue_results$time_ms <- queue_results$time_us / 1000
      queue_results$n_cat <- factor(queue_results$n, levels = sort(unique(queue_results$n)))

      p_queue <- ggplot(queue_results, aes(x = n_cat, y = time_ms, color = impl)) +
        geom_boxplot() +
        facet_wrap(~ op, scales = "free_y") +
        labs(
          title = "Queue Operations",
          x = "Number of elements",
          y = "Time (ms)",
          color = "Implementation"
        ) +
        theme_bw() +
        theme(plot.title = element_text(hjust = 0.5), legend.position = "bottom")
      print(p_queue)
    } else {
      knitr::asis_output("*Benchmark results not yet generated.*")
    }

## Priority queue operations

Insert, peek, and pop operations for min and max priority. The base R baseline stores values and priorities as parallel vectors and uses `which.min()` / `which.max()` for queries, so those reads are O(n) per call. `priority_queue` maintains a sorted finger tree with cached min/max monoids, giving O(log n) insert and pop.

    pq_sizes <- c(100, 500, 1000, 5000, 10000, 50000)
    rows <- flexseq()

    set.seed(42)
    max_pq <- max(pq_sizes)
    all_pq_vals <- sprintf("val_%06d", seq_len(max_pq))
    all_pq_pri  <- runif(max_pq)

    for(n in pq_sizes) {
      pv <- as.list(all_pq_vals[seq_len(n)])
      pw <- all_pq_pri[seq_len(n)]
      pq_setup   <- function() list(pq = as_priority_queue(pv, priorities = pw))
      base_setup <- function() list(v = all_pq_vals[seq_len(n)], p = pw)

      rows <- bench_one(rows, "priority_queue", "insert",   n, repeats, pq_setup,
        function(st) insert(st$pq, "val_new", 0.5))
      rows <- bench_one(rows, "priority_queue", "peek min", n, repeats, pq_setup,
        function(st) peek_min(st$pq))
      rows <- bench_one(rows, "priority_queue", "pop min",  n, repeats, pq_setup,
        function(st) pop_min(st$pq)$remaining)
      rows <- bench_one(rows, "priority_queue", "peek max", n, repeats, pq_setup,
        function(st) peek_max(st$pq))
      rows <- bench_one(rows, "priority_queue", "pop max",  n, repeats, pq_setup,
        function(st) pop_max(st$pq)$remaining)

      rows <- bench_one(rows, "base R", "insert",   n, repeats, base_setup,
        function(st) list(values = c(st$v, "val_new"), priorities = c(st$p, 0.5)))
      rows <- bench_one(rows, "base R", "peek min", n, repeats, base_setup,
        function(st) st$v[which.min(st$p)])
      rows <- bench_one(rows, "base R", "pop min",  n, repeats, base_setup,
        function(st) { i <- which.min(st$p); list(values = st$v[-i], priorities = st$p[-i]) })
      rows <- bench_one(rows, "base R", "peek max", n, repeats, base_setup,
        function(st) st$v[which.max(st$p)])
      rows <- bench_one(rows, "base R", "pop max",  n, repeats, base_setup,
        function(st) { i <- which.max(st$p); list(values = st$v[-i], priorities = st$p[-i]) })
    }

    results_list$pq <- do.call(rbind, as.list(rows))

    if(!is.null(results_list$pq)) {
      pq_results <- results_list$pq
      pq_results$time_ms <- pq_results$time_us / 1000
      pq_medians <- aggregate(time_us ~ impl + op + n, data = pq_results, FUN = median)
      pq_medians$time_ms <- pq_medians$time_us / 1000

      p_pq <- ggplot(pq_results, aes(x = n, y = time_ms, color = impl)) +
        geom_point(alpha = 0.25, size = 1.2, position = position_jitter(width = 0.03)) +
        geom_line(data = pq_medians, linewidth = 0.6) +
        geom_point(data = pq_medians, size = 1.8) +
        facet_wrap(~ op, scales = "free_y") +
        scale_x_log10(labels = scales::label_comma()) +
        scale_y_log10(labels = scales::label_comma()) +
        labs(
          title = "Priority Queue Operations",
          x = "Number of elements",
          y = "Time (ms)",
          color = "Implementation"
        ) +
        theme_bw() +
        theme(plot.title = element_text(hjust = 0.5), legend.position = "bottom")
      print(p_pq)
    } else {
      knitr::asis_output("*Benchmark results not yet generated.*")
    }

## Interval queries

Insert and three query types (single-point lookup, all-point matches, and range overlap) on a collection of intervals with integer endpoints. The base R baseline stores intervals in a `data.frame` and filters with vectorized comparisons, which is simple and fast for small n but O(n) per query. `interval_index` uses an augmented finger tree for O(log n + k) queries, where k is the number of matches.

    ivx_sizes <- c(100, 500, 1000, 5000, 10000, 50000)
    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))

    qpt   <- all_starts[as.integer(max_ivx / 2)] + 10L
    qlo   <- all_starts[as.integer(max_ivx * 0.4)]
    qhi   <- all_starts[as.integer(max_ivx * 0.5)]
    ins_s <- all_starts[as.integer(max_ivx / 2)]
    ins_e <- ins_s + 50L

    has_iranges <- requireNamespace("IRanges", quietly = TRUE) &&
      requireNamespace("S4Vectors", quietly = TRUE)

    for(n in ivx_sizes) {
      starts <- all_starts[seq_len(n)]
      ends   <- all_ends[seq_len(n)]
      vals   <- all_vals[seq_len(n)]

      ivx_setup  <- function() list(ix = as_interval_index(as.list(vals), start = starts, end = ends, default_query_bounds = "[]"))
      df_setup   <- function() list(df = data.frame(start = starts, end = ends, value = vals, stringsAsFactors = FALSE))

      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 = "[]"))
      rows <- bench_one(rows, "interval_index", "overlap query", n, repeats, ivx_setup,
        function(st) peek_all_overlaps(st$ix, qlo, qhi, bounds = "[]"))

      rows <- bench_one(rows, "base R", "insert", n, repeats, df_setup,
        function(st) rbind(st$df, data.frame(start = ins_s, end = ins_e, value = "interval_new", stringsAsFactors = FALSE)))
      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$df$value[hits[1L]] else NULL
        })
      rows <- bench_one(rows, "base R", "all point matches", n, repeats, df_setup,
        function(st) st$df[st$df$start <= qpt & qpt <= st$df$end, , drop = FALSE])
      rows <- bench_one(rows, "base R", "overlap query", n, repeats, df_setup,
        function(st) st$df[st$df$start <= qhi & st$df$end >= qlo, , drop = FALSE])

      if(has_iranges) {
        ir_setup <- function() list(
          ir = IRanges::IRanges(start = starts, end = ends),
          v  = 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, "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))]
          })
      }
    }

    results_list$ivx <- do.call(rbind, as.list(rows))

    if(!is.null(results_list$ivx)) {
      ivx_results <- results_list$ivx
      ivx_results$time_ms <- ivx_results$time_us / 1000
      ivx_medians <- aggregate(time_us ~ impl + op + n, data = ivx_results, FUN = median)
      ivx_medians$time_ms <- ivx_medians$time_us / 1000

      p_ivx <- ggplot(ivx_results, aes(x = n, y = time_ms, color = impl)) +
        geom_point(alpha = 0.25, size = 1.2, position = position_jitter(width = 0.03)) +
        geom_line(data = ivx_medians, linewidth = 0.6) +
        geom_point(data = ivx_medians, size = 1.8) +
        facet_wrap(~ op, scales = "free_y") +
        scale_x_log10(labels = scales::label_comma()) +
        scale_y_log10(labels = scales::label_comma()) +
        labs(
          title = "Interval Index Queries",
          x = "Number of elements",
          y = "Time (ms)",
          color = "Implementation"
        ) +
        theme_bw() +
        theme(plot.title = element_text(hjust = 0.5), legend.position = "bottom")
      print(p_ivx)
    } else {
      knitr::asis_output("*Benchmark results not yet generated.*")
    }