在R中找到长度为n的第一个序列

Question

可以说我有这样的data.frame

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

什么是通过连续n次的数字信号找到第一个信号的最佳方法.例如,如果n = 1,那么我的信号将是第三个元素,我想得到这样的答案:

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

对于n = 2,答案是:

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

并且对于n = 3,最后一个元素是连续3个之后的信号:

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

Answer 1

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

完整的功能将是

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)

编辑版本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 2

窗口尺寸= n 1的轧制产品中的第1 signal个是信号的开始,所以

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

完整性检查

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

Answer 3

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