set next n values to zero when this value equal one - r

Question

Given a 0/1 vector and a k value
x <- c(0, 1, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1)
k <- 3
I need to define a function f so that
f(x, k)
[1] 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0
That is: if any value of x = 1 set the next k = 3 values of x to zero
I have solved the problem with this terrible solution
f <- function(x, k){
.f <- function(x, i, k){
s <- seq(i+1, i+k)
if (x[[i]] == 1) x[s] <- 0
x
}
n <- length(x)
for ( i in seq(1, n-1)) {
#for ( i in seq(1, n-k-1)) {
x <- .f(x, i , k)
}
length(x) <- n
x
}
Can anyone provide a more elegant (functional) solution ?
Thanks for any help

Answer 1

This takes some steps out:
foo <- function(x, k) {
n <- length(x)
for (i in seq_along(x)) {
if (x[i] == 1) x[seq(i+1L, min(i+k, n))] <- 0
}
x
}
foo(x, k)
# [1] 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0
This takes bigger steps when it encounters a 1, should be more efficient at least for big k.
foo2 <- function(x, k) {
n <- length(x)
i <- 1L
while (i < n) {
if (x[i] == 1) {
x[seq(i+1L, min(i+k, n))] <- 0
i <- i+k
} else {
i <- i+1L
}
}
x
}

Answer 2

A simple counter will also do the job :
fnew <- function(x, k){
counter <- 0L
for (i in 1:length(x)){
if (x[i] & !counter) {
counter <- k
next
}
if (!!counter) {
x[i] <- 0
counter <- counter - 1L
}
}
x
}
fnew(x,3)
[1] 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0
Advantage of a simple loop is that it can easily be converted to C++:
Rcpp::cppFunction('
NumericVector fcpp(NumericVector x, int k) {
int n = x.size();
int i;
int counter = 0;
NumericVector xout(n);
xout = x;
for (i = 0;i<n;i++){
if ((x[i]==1) & (counter==0)) {
counter = k;
} else
if (counter > 0) {
xout[i] = 0;
counter += -1;
}
}
return xout;
}')
I found interesting to compare performance of the different options proposed until now, which shows that a simple loop still has its word to say :
x <- rnorm(1e3)>0
microbenchmark::microbenchmark(f(x,3),gen_vec(x,3),foo(x,3),onePeriodic(x,3),fnew(x,3),fA5C1(x,3),fcpp(x,3))
Unit: microseconds
expr min lq mean median uq max neval cld
f(x, 3) 7783.375 8205.9390 9340.76417 8559.7845 8868.092 33439.139 100 e
gen_vec(x, 3) 2821.330 3086.5605 3683.71671 3176.2015 3490.867 25794.430 100 d
foo(x, 3) 1396.922 1495.1775 1689.60223 1532.5110 1640.818 5901.121 100 c
onePeriodic(x, 3) 879.178 994.0510 1090.42763 1049.4345 1103.793 2109.536 100 bc
fnew(x, 3) 413.538 452.7175 492.22530 473.6405 494.564 1142.563 100 ab
fA5C1(x, 3) 160.000 178.4620 274.42453 188.7180 213.949 7361.222 100 a
fcpp(x, 3) 6.154 16.4100 21.46069 20.5130 24.206 94.359 100 a

Answer 3

Waldi's fcpp function is great, but if you want to stick with base R, you can try this for loop.
f <- function(x, y) {
l <- length(x)
x <- as.integer(x)
ind <- which(as.logical(x))
for (i in seq_along(ind)) {
if (x[ind[i]] == 1L) {
x[ind[i] + seq.int(y)] <- 0L
}
}
x[1:l]
}
f(x, 3)
# [1] 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0

Answer 4

Here is another base R option:
onePeriodic <- function(x, k) {
w <- which(x==1L)
idx <- unlist(lapply(split(w, c(0L, cumsum(diff(w) > k+1L))), function(v) {
seq(v[1L], v[length(v)], by=k+1L)
}))
replace(integer(length(x)), idx, 1L)
}
k <- 3
(x <- c(0, 1, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1))
(o <- onePeriodic(x, k))
output:
x: [1] 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1 0 0 0 0 0 1 0 0 1 1
o: [1] 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0 0 0 0 0 0 1 0 0 0 1

Answer 5

I don't know why you are specifically looking for a functional programming solution, but, without claiming anything regarding the quality of the solution, this does the job:
x <- c(0, 1, 1, 0, 0, 1, 1, 0, 1, 1, 1, 1, 1, 1, 1)
gen_vec <- function(x,k){
x2 <- x
purrr::walk(1:length(x2), function(n,k){
ifelse(x2[n]==1, x2[(n+1):min(n+k, length(x2))] <<- 0, x2[n])
}, k=k)
x2
}
Output
> gen_vec(x, 3)
[1] 0 1 0 0 0 1 0 0 0 1 0 0 0 1 0
Original x is unmodified:
> x
[1] 0 1 1 0 0 1 1 0 1 1 1 1 1 1 1