dplyr suppress next n occurrences of a value in a group - r

Question

I have recently looked for advice on how to suppress all but the first occurrences of a value within a group using dplyr (dplyr override all but the first occurrences of a value within a group).
The solution was a really clever one and now I am struggling with finding something equally efficient in case I need to suppress only n next values.
For example, in the code below I create a new "tag" column:
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
# .. ... ... ... ... ... ...
In the setosa group rows: 4, 6, 7, ... are tagged as "1"s. I am trying to suppress "1"s (i.e. convert them to "0"s) in the next two rows after any occurrence of a "1". In other words, rows #5 and #6 should be set to "0" but #7 should remain unaffected. In this case, row #7 happens to be a "1", so rows #8 and #9 should be set to "0"s and so on...
Any hint on how to do this in dplyr? This package is really powerful but for a reason it is a mental challenge for me to master all the subtleties...
Some more examples:
in case of: 0 0 1 1, the output should be 0 0 1 0
in case of: 0 0 1 1 1 1 1, the output should be 0 0 1 0 0 1 0

Answer 1

I can't think of any better way to do this than a loop:
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
.. ... ... ... ... ... ...
For a possible speedup, you could switch the loop to if (keep[i]) keep[i+seq_len(nf)][match(w[i]+seq_len(nf), w[i+seq_len(nf)])] = FALSE so that match only searches the next nf elements of w. I'm sure Rcpp would be faster still, if that's a serious concern.

Answer 2

To me this is semantically clearer if you use an accumulating reduce to keep track of the refraction period.
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)
}
Example
suppress(c(0,0,1,1,1,1,1), 2)
#> [1] 0 0 1 0 0 1 0

Answer 3

Kinda clumsy but it seems like you have to walk down the vector regardless
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
And your example
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
And you can replace with whatever you want
(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