Векторизация для цикла: доступ к предыдущим строкам data.frame

Question

Я пытаюсь преобразовать цикл в векторию. В моем приложении у меня более 2 миллионов строк, и цикл слишком медленный. Я прочитал этот пост, который является очень полезным: Speed up the loop operation in R

Вот пример того, что выглядит мои данные, как:

m <- data.frame(time = 1:10, level = c(0,0,60,100,0,0,100,100,0,0)) 

>m 
    time level 
1  1  0 
2  2  0 
3  3 60 
4  4 100 
5  5  0 
6  6  0 
7  7 100 
8  8 100 
9  9  0 
10 10  0 

То, что я хочу, это столбец machine, что либо «на» или «выключено» в зависимости от уровня.

если уровень! = 0, то машина = "на"

если уровень переходит в 0, то machine выключится, после произвольного периода lag. В этом примере, скажем, lag = 2 тогда результат будет:

time level machine 
1  1  0  off 
2  2  0  off 
3  3 60  on 
4  4 100  on 
5  5  0  on 
6  6  0  off 
7  7 100  on 
8  8 100  on 
9  9  0  on 
10 10 0  off 

Любые предложения, как, как векторизации эту операцию? Я изучил использование lag от dplyr, но не нашел способа заставить его работать.

Я написал цикл, который работает для этого примера, в качестве иллюстрации.

m$machine <- ifelse(m$level!=0, "on", 0) 

tlag <- 2 
# check to see if timeout period has elapsed 
for (i in seq_along(m$machine)){ 
    if(m$machine[i]!="on") { 
     nback <- i - tout 
     if (nback <=0) nback <- 1 
     if (sum(m$level[nback:i]) == 0){ #light should be off 
      m$machine[i] <- "off" 
     } 
    } 
} 

for (i in seq_along(m$machine)){ 
    if(m$machine[i]==0) m$machine[i] <- "on" 
} 

Answer 1

Вот одно решение с использованием lag оператора dplyr пакета ':

library(dplyr) 
m %>% mutate(machine = ifelse((level != 0 | 
           (level == 0 & 
           lag(level, 1, default = 0) != 0)), 
           'on', 'off')) 

Выход следующим образом:

time level machine 
1  1  0  off 
2  2  0  off 
3  3 60  on 
4  4 100  on 
5  5  0  on 
6  6  0  off 
7  7 100  on 
8  8 100  on 
9  9  0  on 
10 10  0  off 

Answer 2

Вы можете сделать это с data.table:

library(data.table) 
m <- data.table(time = 1:10, level = c(0,0,60,100,0,0,100,100,0,0)) 
m[, machine := {lag.level = shift(level, 1, fill = 0); 
       ifelse(level != 0 | lag.level != 0, "on", "off") },]