Znajdź pierwszą sekwencję o długości N na R

Question

Powiedzmy mam taką data.frame

df <- data.frame(signal = c(0, 0, 1, 0, 1, 1, 0, 1, 1, 1)) 

Jaki jest najlepszy sposób na znalezienie pierwszego sygnału przez te numerycznych, które wykraczają z rzędu n razy. Na przykład, jeśli n = 1 wtedy mój sygnał będzie trzeci element i chciałabym uzyskać odpowiedź tak:

c(0, 0, 1, 0, 0, 0, 0, 0, 0, 0) 

Dla n = 2 odpowiedzią byłoby:

c(0, 0, 0, 0, 0, 1, 0, 0, 0, 0) 

I dla n = 3 ostatni element jest sygnał po 3 te z rzędu:

c(0, 0, 0, 0, 0, 0, 0, 0, 0, 1) 

Answer 1

fun <- function(signal, n) { 
    r <- rle(signal == 1) 
    replace(numeric(length(signal)), sum(r$l[seq.int(head(which(r$l * r$v == n), 1))]), 1) 
} 
fun(df$signal, 1) 
# [1] 0 0 1 0 0 0 0 0 0 0 
fun(df$signal, 2) 
# [1] 0 0 0 0 0 1 0 0 0 0 
fun(df$signal, 3) 
# [1] 0 0 0 0 0 0 0 0 0 1 
fun(df$signal, 4) 
# [1] 0 0 0 0 0 0 0 0 0 0 

Answer 2

x <- c(0, 0, 1, 0, 1, 1, 0, 1, 1, 1) 

y <- rle(x) 
y$values <- y$lengths * y$values 
(y <- inverse.rle(y)) 
# [1] 0 0 1 0 2 2 0 3 3 3 

f <- function(n) {z <- rep(0, length(y)); z[which.max(cumsum(y == n))] <- 1; z} 
f(1) 
# [1] 0 0 1 0 0 0 0 0 0 0 

f(2) 
# [1] 0 0 0 0 0 1 0 0 0 0 

f(3) 
# [1] 0 0 0 0 0 0 0 0 0 1 

Pełne funkcja będzie

g <- function(x, n) { 
    y <- rle(x) 
    y$values <- y$lengths * y$values 
    y <- inverse.rle(y) 
    z <- rep_len(0, length(x)) 
    z[which.max(cumsum(y == n))] <- 1 
    z 
} 
g(x, 1) 
g(x, 2) 
g(x, 3) 

edycja wersja 2

g <- function(x, n, ties = c('first','random','last')) { 
    ties <- match.arg(ties) 
    FUN <- switch(ties, first = min, last = max, 
       random = function(x) x[sample.int(length(x), 1)]) 
    y <- rle(x) 
    y$values <- y$lengths * y$values 
    y <- inverse.rle(y) 
    z <- rep_len(0, length(x)) 
    if (!length(wh <- which(y == n))) 
    return(z) 
    wh <- wh[seq_along(wh) %% n == 0] 
    z[FUN(wh)] <- 1 
    z 
} 

x <- c(0, 0, 1, 0, 1, 0, 1, 1, 0, 1, 1, 0, 1, 1, 1) 

g(x, 1, 'first') 
# [1] 0 0 1 0 0 0 0 0 0 0 0 0 0 0 0 

g(x, 1, 'last') 
# [1] 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 

g(x, 1, 'random') 
# [1] 0 0 0 0 1 0 0 0 0 0 0 0 0 0 0 

g(x, 4) 
# [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 

Answer 3

The 1st 1 do walcowania produktów o signal z rozmiarem okna = n jest początkiem sygnału, tak

f <- function(x, n){ 
    y <- numeric(length(x)) 
    k <- RcppRoll::roll_prod(x, n) 
    y[which(k==1)[1] + n-1] <- 1 
    y 
} 

> f(df$signal, 1) 
[1] 0 0 1 0 0 0 0 0 0 0 
> f(df$signal, 2) 
[1] 0 0 0 0 0 1 0 0 0 0 
> f(df$signal, 3) 
[1] 0 0 0 0 0 0 0 0 0 1 

Sanity Check

set.seed(1) 
signal <- sample(0:1, 10, TRUE) 
signal 
# [1] 0 0 1 1 0 1 1 1 1 0 
f(signal, 3) 
# [1] 0 0 0 0 0 0 0 1 0 0 
g(signal, 3) 
# [1] 1 0 0 0 0 0 0 0 0 0 
fun(signal, 3) 
Error in 1:which(r$len * r$val == n)[1] : NA/NaN argument