dplyr：在分组中抑制下一个值的n个出现次数

Question

我最近在寻求关于如何使用dplyr抑制同一组中除第一个外的所有值的建议（dplyr override all but the first occurrences of a value within a group）。解决方案非常巧妙，但如果我需要抑制接下来的n个值，我就会遇到困难。

例如，在下面的代码中，我创建了一个新的“tag”列：

library('dplyr')
data(iris)
set.seed(1)
iris$tag <- sample(c(0,1), 150, replace=TRUE, prob = c(0.7, 0.3))
giris <- iris %>% group_by(Species)

# Source: local data frame [150 x 6]
# Groups: Species [3]
# 
#    Sepal.Length Sepal.Width Petal.Length Petal.Width Species   tag
#           (dbl)       (dbl)        (dbl)       (dbl)  (fctr) (dbl)
# 1           5.1         3.5          1.4         0.2  setosa     0
# 2           4.9         3.0          1.4         0.2  setosa     0
# 3           4.7         3.2          1.3         0.2  setosa     0
# 4           4.6         3.1          1.5         0.2  setosa     1
# 5           5.0         3.6          1.4         0.2  setosa     0
# 6           5.4         3.9          1.7         0.4  setosa     1
# 7           4.6         3.4          1.4         0.3  setosa     1
# 8           5.0         3.4          1.5         0.2  setosa     0
# 9           4.4         2.9          1.4         0.2  setosa     0
# 10          4.9         3.1          1.5         0.1  setosa     0
# ..          ...         ...          ...         ...     ...   ...

在setosa组的行中，第4、6、7等被标记为“1”。我想在任何出现“1”之后的下两行中抑制“1”（即将它们转换为“0”）。换句话说，第5行和第6行应设置为“0”，但第7行应保持不变。在这种情况下，第7行碰巧是“1”，因此第8行和第9行应设为“0”，以此类推...

有没有关于如何在dplyr中实现这一点的提示？这个包非常强大，但是由于我要掌握所有的微妙差别，所以对我来说是一个心理挑战...

更多例子： 如果是：0 0 1 1，则输出应为0 0 1 0 如果是：0 0 1 1 1 1 1，则输出应为0 0 1 0 0 1 0

- rpl

---

所以，如果有一个序列0 0 1 1 1 1 1，它应该变成0 0 1 0 0 1 0？ - Frank

@ Frank 没错，这就是预期的输出。 - rpl

Answer 1

我想不出比循环更好的方法来实现这个：

flip_followers = function(tag, nf = 2L){
    w    = which(tag==1L)
    keep = rep(TRUE, length(w))
    for (i in seq_along(w)) if (keep[i]) keep[match(w[i]+seq_len(nf), w)] = FALSE
    tag[w[!keep]] = 0L
    tag
}

giris %>% mutate(tag = flip_followers(tag))



Source: local data frame [150 x 6]
Groups: Species [3]

   Sepal.Length Sepal.Width Petal.Length Petal.Width Species   tag
          (dbl)       (dbl)        (dbl)       (dbl)  (fctr) (dbl)
1           5.1         3.5          1.4         0.2  setosa     0
2           4.9         3.0          1.4         0.2  setosa     0
3           4.7         3.2          1.3         0.2  setosa     0
4           4.6         3.1          1.5         0.2  setosa     1
5           5.0         3.6          1.4         0.2  setosa     0
6           5.4         3.9          1.7         0.4  setosa     0
7           4.6         3.4          1.4         0.3  setosa     1
8           5.0         3.4          1.5         0.2  setosa     0
9           4.4         2.9          1.4         0.2  setosa     0
10          4.9         3.1          1.5         0.1  setosa     0
..          ...         ...          ...         ...     ...   ...

为了可能的加速，您可以将循环切换到if (keep[i]) keep[i+seq_len(nf)][match(w[i]+seq_len(nf), w[i+seq_len(nf)])] = FALSE，这样match只会搜索w的下一个nf元素。如果这是一个严重的问题，我相信Rcpp仍然会更快。

- Frank

---

谢谢你，@Frank。我点赞了，因为这是一个解决方案。同时，我仍然很好奇是否有人能够提出一个可行的dplyr想法。 - rpl

@rpl 感谢您的反馈。Dplyr 是一个经过精心策划的命令集，旨在涵盖最常见的数据操作任务（与 tidyr 一起）。我不认为这个操作属于它的范畴，但我可能是错的。 - Frank

Answer 2

有些笨拙，但似乎你不得不沿着向量走下去。

f <- function(x, repl = c(1,0,0)) {
  sx <- seq(x)
  for (ii in seq_along(x))
    if (x[ii] == repl[1L])  ## thanks to @Frank for catching
      x[ii:(ii + length(repl) - 1)] <- repl
  x[sx]
}

(x <- c(0,0,1,1,1,1,1)); f(x)
# [1] 0 0 1 1 1 1 1
# [1] 0 0 1 0 0 1 0

(x <- c(0,0,1,0,1,0,1,1)); f(x)
# [1] 0 0 1 0 1 0 1 1
# [1] 0 0 1 0 0 0 1 0

并且这是你的例子

set.seed(1)
head(n = 10,
  cbind(tag <- sample(c(0,1), 150, replace=TRUE, prob = c(0.7, 0.3)),
        tag2 = f(tag)))

#  [1,] 0    0
#  [2,] 0    0
#  [3,] 0    0
#  [4,] 1    1
#  [5,] 0    0
#  [6,] 1    0
#  [7,] 1    1
#  [8,] 0    0
#  [9,] 0    0
# [10,] 0    0

你可以将其替换为任何你想要的内容。

(x <- c(0,0,1,1,1,1,1)); f(x, c(1,0,0,0))
# [1] 0 0 1 1 1 1 1
# [1] 0 0 1 0 0 0 1

(x <- c(0,0,1,1,1,1,1)); f(x, 1:3)
# [1] 0 0 1 1 1 1 1
# [1] 0 0 1 2 3 1 2


## courtesy of @Frank this would also work
(x <- c(0,0,1,1,0,0,1)); f(x, 0:2)
# [1] 0 0 1 1 0 0 1
# [1] 0 1 2 1 0 1 2

- rawr

---

谢谢@rawr - 这是一个可行的解决方案，我已经点赞了。 - rpl

Answer 3

对我来说，如果你使用累加的reduce来跟踪折射周期，这在语义上更清晰。

suppress <- function(x, w) {
  r <- Reduce(function(d,i) if(i&!d) w else max(0,d-1), x, init=0, acc=TRUE)[-1] 
  x * (r==w)
}

示例

suppress(c(0,0,1,1,1,1,1), 2)
#>     [1] 0 0 1 0 0 1 0

- A. Webb

---

极速！ - rpl