cumsum_cut.R

# https://fosstodon.org/@josi/113391735804937128
cumsum_cut_rlang <- function(x, cuts) {
  x[cuts-1] <- 0
  res <- lapply(split(x, cumsum(x == 0)), \(.x) {
    cumsum(.x)
  }) |> 
    unlist() |>
    unname()
  n <- length(res)
  to_fill <- numeric(n)
  rlang::vec_poke_range(to_fill, 2, res, to = n -1)
  to_fill
}

# https://fosstodon.org/@yjunechoe/113390873585173089
cumsum_cut_findInterval <- function(x, cut) {
  cut <- sort.int(c(1, cut))
  lagged_cumsum <- c(0, cumsum(x)[-length(x)])
  offsets <- lagged_cumsum[cut]
  offset_vec <- offsets[findInterval(seq_along(x), cut)]
  lagged_cumsum - offset_vec
}

set.seed(1)
vec <- sample(1e4)
reset_at <- sample(1e4, 1e3)
bench::mark(
  findInterval = cumsum_cut_findInterval(vec, reset_at),
  rlang = cumsum_cut_rlang(vec, reset_at)
) |>
  summary()
#> # A tibble: 2 × 6
#>   expression        min   median `itr/sec` mem_alloc `gc/sec`
#>   <bch:expr>   <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl>
#> 1 findInterval  194.9µs  369.3µs     2342.     595KB    24.5 
#> 2 rlang          2.36ms   2.87ms      321.     839KB     6.55