Trova prima sequenza di lunghezza n in R

Question

Diciamo che ho una tale data.frame

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

Qual è il modo migliore per trovare primo segnale dai numeri uno che vanno in successione n volte. Per esempio, se n = 1, allora il mio segnale sarebbe terzo elemento e mi piacerebbe avere una risposta come questa:

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

Per n = 2 risposta sarebbe:

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

E per n = 3 ultimo elemento è il segnale dopo 3 quelli consecutive:

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 

La funzione completa sarebbe

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) 

modificare la versione 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

Il 1 ° 1 nel prodotto di laminazione di signal con dimensione della finestra = n è l'inizio del segnale, in modo

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