Fill in all entries between the two indicated values

Question

I have a long vector, thousands of records, which has elements 0, 1, 2 in it sporadically. 0 means no signal, 1 means signal on, and 2 means signal off. I try to find runs from 1 to the next occurrence of 2 and fill in the gap for 1 second. I also need to do the same between 2 and the next occurrence of 1, but fill in the blank 0s.

I currently have a solution to this problem using loops, but it is slow and incredibly inefficient:

Vector example: exp = c(1,1,1,0,0,1,2,0,2,0,1,0,2)

desired result: 1,1,1,1,1,1,2,0,0,0,1,1,2

thank

Answer 1

rle shift data.table - :

library(data.table)

# create the run-length object
rl <- rle(x)

# create indexes of the spots in the run-length object that need to be replaced
idx1 <- rl$values == 0 & shift(rl$values, fill = 0) == 1 & shift(rl$values, fill = 0, type = 'lead') %in% 1:2
idx0 <- rl$values == 2 & shift(rl$values, fill = 0) == 0 & shift(rl$values, fill = 2, type = 'lead') %in% 0:1

# replace these values
rl$values[idx1] <- 1
rl$values[idx0] <- 0

, inverse.rle:

> inverse.rle(rl)
 [1] 1 1 1 1 1 1 2 0 0 0 1 1 2

shift - lag lead dplyr.

---

, microbenchmark - - . 3 , :

# create functions for both approaches
jaap <- function(x) {
  rl <- rle(x)

  idx1 <- rl$values == 0 & shift(rl$values, fill = 0) == 1 & shift(rl$values, fill = 0, type = 'lead') %in% 1:2
  idx0 <- rl$values == 2 & shift(rl$values, fill = 0) == 0 & shift(rl$values, fill = 2, type = 'lead') %in% 0:1

  rl$values[idx1] <- 1
  rl$values[idx0] <- 0

  inverse.rle(rl)
}

john <- function(x) {
  Reduce(f, x, 0, accumulate = TRUE)[-1]
}

:

# benchmark on the original data

> microbenchmark(jaap(x), john(x), times = 100)
Unit: microseconds
    expr    min      lq     mean  median     uq     max neval cld
 jaap(x) 58.766 61.2355 67.99861 63.8755 72.147 143.841   100   b
 john(x) 13.684 14.3175 18.71585 15.7580 23.902  50.705   100  a 

# benchmark on a somewhat larger vector

> x2 <- rep(x, 10)
> microbenchmark(jaap(x2), john(x2), times = 100)
Unit: microseconds
     expr     min      lq      mean   median       uq     max neval cld
 jaap(x2)  69.778  72.802  84.46945  76.9675  87.3015 184.666   100  a 
 john(x2) 116.858 121.058 127.64275 126.1615 130.4515 223.303   100   b

# benchmark on a very larger vector

> x3 <- rep(x, 1e6)
> microbenchmark(jaap(x3), john(x3), times = 20)
Unit: seconds
     expr      min        lq      mean    median        uq       max neval cld
 jaap(x3)  1.30326  1.337878  1.389187  1.391279  1.425186  1.556887    20  a 
 john(x3) 10.51349 10.616632 10.689535 10.670808 10.761191 10.918953    20   b

, rle-Approach , 100 (, , ).

Answer 2

Reduce :

f <- function(x,y){
  if(x == 1){
    if(y == 2) 2 else 1
  }else{
    if(y == 1) 1 else 0
  }
}

:

> x <- c(1,1,1,0,0,1,2,0,2,0,1,0,2)
> Reduce(f, x, 0, accumulate = TRUE)[-1]
 [1] 1 1 1 1 1 1 2 0 0 0 1 1 2