r - 使用触发器在滚动基础上提取累积唯一值(第 2 部分)

Question

这个问题是this one的延续.

给定一个 data.table，我想提取累积的唯一元素，直到它达到三个唯一值，或者当由 t 触发时，然后重置并恢复:

y <- data.table(  a = c (1, 2, 2, 3, 3, 4, 3, 2, 2, 5, 6, 7, 9, 8)
                , t = c (F, F, F, F, F, F, F, T, F, F, F, F, F, F))

导出的输出是:

a     t output
1 FALSE      1
2 FALSE    1 2
2 FALSE    1 2
3 FALSE  1 2 3
3 FALSE  1 2 3
4 FALSE      4    # 4 is the forth element, so it resets and start again
3 FALSE    3 4
2  TRUE      2    # because `t` is `TRUE` it resets and start again 
2 FALSE      2
5 FALSE    2 5
6 FALSE  2 5 6
7 FALSE      7   # 7 is the forth element, so it resets and start again
9 FALSE    7 8
8 FALSE  7 8 9

基于链接中的“thelatemail”解决方案，我尝试了以下功能:

unionlim_trigger <- function(x,y,n=4, trigger = FALSE) {
  u <- union(x,y)
  if(length(u) == n | trigger == TRUE) y else u
}

但是，当我通过以下方式申请时:

y[, out := sapply(Reduce(function(x,y,trigger) unionlim_trigger(x=x, y = y, trigger = t), a, accumulate=TRUE), paste, collapse=" ")]

我收到警告:

In if (length(u) == n | trigger == T) y else u :
the condition has length > 1 and only the first element will be used

我知道发生这种情况是因为我传递的是整个向量，而不是传递 t 的第 i 个元素。

我该如何解决这个问题？我尝试使用 mapply 和下面的说明，但没有成功:

y[, out := sapply(Reduce(function(x,y,trigger) unionlim_trigger(x=x, y = y, trigger = t[.I]), a, accumulate=TRUE), paste, collapse=" ")]

Answer 1

这是一种方法:

library(data.table)

#Create a group column for every reset

y[, group := cumsum(t)]

#Function
unionlim_trigger <- function(x,y,n=4) {
  u <- union(x,y)
  if(length(u) >= n) y else sort(u)
}

#appply it for each group
y[, output := sapply(Reduce(unionlim_trigger, a, accumulate = TRUE), 
              paste0, collapse = ' '), group]
y

#    a     t group output
# 1: 1 FALSE     0      1
# 2: 2 FALSE     0    1 2
# 3: 2 FALSE     0    1 2
# 4: 3 FALSE     0  1 2 3
# 5: 3 FALSE     0  1 2 3
# 6: 4 FALSE     0      4
# 7: 3 FALSE     0    3 4
# 8: 2  TRUE     1      2
# 9: 2 FALSE     1      2
#10: 5 FALSE     1    2 5
#11: 6 FALSE     1  2 5 6
#12: 7 FALSE     1      7
#13: 9 FALSE     1    7 9
#14: 8 FALSE     1  7 8 9