最有效的方法是使用collapse。
首先创建一个GRP对象。

library(collapse)
library(data.table)
setDT(t)
g <- GRP(t, by = "q")

然后使用GRP对象进行分组滞后和累积求和。

t[, result := fcumsum(flag(p, g = g, fill = 0), g = g)][]
     p q  r result
 1:  1 a  0      0
 2:  2 a  1      1
 3:  3 a  3      3
 4:  4 b  0      0
 5:  5 b  4      4
 6:  6 c  0      0
 7:  7 c  6      6
 8:  8 c 13     13
 9:  9 c 21     21
10: 10 c 30     30

collapse对比data.table基准测试

3组

mark(e1 = {
  g <- GRP(t, by = "q")
  t[, result := fcumsum(flag(p, g = g, fill = 0), g = g)][]
},
e2 = {
  t[, result := cumsum(shift(p, type = "lag", fill = 0)), by = q][]
}
)
# A tibble: 2 x 13
  expression    min median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory     time       gc      
  <bch:expr> <bch:> <bch:>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list> <list>     <list>     <list>  
1 e1          434us  484us     1905.    36.7KB     0      953     0      500ms <dt>   <Rprofmem> <bench_tm> <tibble>
2 e2          511us  548us     1646.    32.5KB     2.27   725     1      440ms <dt>   <Rprofmem> <bench_tm> <tibble>

10^7行，约10^6组

t <- t[sample.int(.N, 10^7, T)]
t[, q := sample.int(10^6, 10^7, T)]

mark(e1 = {
  g <- GRP(t, by = "q")
  t[, result := fcumsum(flag(p, g = g, fill = 0), g = g)][]
},
e2 = {
  t[, result := cumsum(shift(p, type = "lag", fill = 0)), by = q][]
}
)
# A tibble: 2 x 13
  expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time result memory     time          
  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm> <list> <list>     <list>        
1 e1          694.9ms  694.9ms    1.44       244MB     0        1     0    694.9ms <dt>   <Rprofmem> <bench_tm [1]>
2 e2            21.3s    21.3s    0.0469      71MB     1.50     1    32      21.3s <dt>   <Rprofmem> <bench_tm [1]>

**1）**这是使用ave和cumsum的基础R解决方案。

ave(p, q, FUN = cumsum) - p
##  [1]  0  1  3  0  4  0  6 13 21 30

**2）**此变体也适用：

ave(p, q, FUN = function(x) c(0, head(cumsum(x), -1)))

**3）**同样的思路也可以用在折叠包上

library(collapse)

fcumsum(p, q) - p
##  [1]  0  1  3  0  4  0  6 13 21 30

这将是相当快的：

library(dplyr)
t |>
  mutate(result = cumsum(lag(p, default = 0)), .by = q)
#     p q  r result
# 1   1 a  0      0
# 2   2 a  1      1
# 3   3 a  3      3
# 4   4 b  0      0
# 5   5 b  4      4
# 6   6 c  0      0
# 7   7 c  6      6
# 8   8 c 13     13
# 9   9 c 21     21
# 10 10 c 30     30

这样会更快：

library(data.table)
setDT(t)[, result := cumsum(shift(p, type = "lag", fill = 0)), by = q]

如果我们需要良好的性能，同时保持在dplyr内，我们可以使用dtplyr。dtplyr是dplyr的一个数据表前端。它使用data.table运行大部分代码。并非所有的dplyr动词和操作都可以翻译，但是对于像这样的简单用例，它工作得很好。

library(dtplyr)

t <- lazy_dt(t)
t |> 
    group_by(q) |>
    mutate(result = cumsum(lag(p, default = 0))) |>
    as_tibble()

# A tibble: 10 × 4
       p q         r result
   <dbl> <chr> <dbl>  <dbl>
 1     1 a         0      0
 2     2 a         1      1
 3     3 a         3      3
 4     4 b         0      0
 5     5 b         4      4
 6     6 c         0      0
 7     7 c         6      6
 8     8 c        13     13
 9     9 c        21     21
10    10 c        30     30

data.table可以尝试

> setDT(t)[, rr := shift(cumsum(p), fill = 0), q][]
     p q  r rr
 1:  1 a  0  0
 2:  2 a  1  1
 3:  3 a  3  3
 4:  4 b  0  0
 5:  5 b  4  4
 6:  6 c  0  0
 7:  7 c  6  6
 8:  8 c 13 13
 9:  9 c 21 21
10: 10 c 30 30

正如问题中所述，可以假设向量 * 已经排序 *，您可以在q发生变化的地方取索引，并在这些位置减去cumsum。

n <- length(q)
i <- 1 + which(q[-1] != q[-n])
r <- cumsum(p) - p
r <- r - rep(c(0, r[i]), diff(c(1, i, n+1)))
r
# [1]  0  1  3  0  4  0  6 13 21 30

问题可能是，由于cumsum是在整个向量上构建的，因此其结果可能不像分组时那样准确。另一个变体是对向量进行子集化。

n <- length(q)
i <- which(q[-1] != q[-n])
unlist(Map(\(i,j) {. <- p[i:j]; cumsum(.) -.}, c(1, i+1), c(i,n)), FALSE, FALSE)
# [1]  0  1  3  0  4  0  6 13 21 30

基准

set.seed(42)
q <- rep(letters, sample(1e5:1e6, length(letters), TRUE))
length(q)
#[1] 13535111
p <- sample(as.numeric(1:10), length(q), TRUE)

library(collapse)
library(data.table)
t <- data.frame(p,q)

bench::mark(min_iterations = 7L,
collapse = {g <- GRP(t, by = "q")
 as.data.table(t)[, result := fcumsum(flag(p, g = g, fill = 0), g = g)][]$result},
Map = {n <- length(q)
 i <- which(q[-1] != q[-n])
 unlist(Map(\(i,j) {. <- p[i:j]; cumsum(.) -.}, c(1, i+1), c(i,n)), FALSE, FALSE)},
rep = {n <- length(q)
 i <- 1 + which(q[-1] != q[-n])
 r <- cumsum(p) - p
 r - rep(c(0, r[i]), diff(c(1, i, n+1)))},
ave = {ave(p, q, FUN = cumsum) - p} ) # @G. Grothendieck

结果

expression      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc
  <bch:expr> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>
1 collapse   196.59ms 248.53ms     4.17      518MB     5.36     7     9
2 Map         539.4ms    568ms     1.78      981MB     3.80     7    15
3 rep        442.83ms 481.89ms     2.03      826MB     3.77     7    13
4 ave           1.18s    1.23s     0.801    1006MB     1.37     7    12

在这种情况下，使用 collapse 和 * data.table * 比 base Map和rev快2倍，比ave快5倍。