如何在上次运行中计算连续的零？

Question

如果原子向量的上次运行为零，我只想计算上次运行的连续零个数。

例如：

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

因此，上次运行的连续零数为3。

如果上一次运行不为零，则答案必须为零。例如

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

因此，答案为零，因为在上一次运行中，答案为零，而不是零。

我不想使用任何外部软件包。我设法编写了一个使用循环的函数。但是我认为必须存在更有效的方法。

    czero <- function(a) {
      k = 0
      for(i in 1:length(a)){
        if(a[i] == 0) {
          k = k + 1 
        } else k = 0
      }
      return(k)
    }

Answer 1

反转a，然后计算其累计和。前导0将是剩下的唯一0，并且！其中每个元素均为TRUE，其他元素为FALSE。其总和就是所需的数字。

sum(!cumsum(rev(a)))

Answer 2

最简单的改进是从向量的末端开始循环并向后工作，而不是从前端开始。然后，您可以通过在第一个非零元素处退出循环而不是遍历整个向量来节省时间。

我已经根据给定的向量和一个更长的向量（在结尾处带有少量零）进行了检查，以显示从头开始循环需要很多时间的情况。

a <- c(1, 0, 0, 0)
b <- c(0, 1, 1, 0, 0, 1)
long <- rep(c(0, 1, 0, 1, 0), c(4, 6, 5, 10000, 3))

[czero是原始函数，f1是akrun使用rle的解决方案，fczero从结尾开始循环，revczero反转向量，然后从前面开始。

czero <- function(a) {
  k = 0
  for(i in 1:length(a)){
    if(a[i] == 0) {
      k = k + 1 
    } else k = 0
  }
  return(k)
}

f1 <- function(vec){
  pmax(0, with(rle(vec), lengths[values == 0 &
            seq_along(values) == length(values)])[1], na.rm = TRUE)
}

fczero <- function(vec) {
  k <- 0L
  for (i in length(vec):1) {
    if (vec[i] != 0) break
    k <- k + 1L
  }
  return(k)
}

revczero <- function(vec) {
  revd <- rev(vec)
  k <- 0L
  for (i in 1:length(vec)) {
    if (revd[i] != 0) break
    k <- k + 1L
  }
  return(k)
}

时间基准如下。编辑：我还添加了格洛腾迪克的版本。

microbenchmark::microbenchmark(czero(a), f1(a), fczero(a), revczero(a), sum(!cumsum(rev(a))), times = 1000)

#  Unit: nanoseconds
#                 expr   min    lq      mean median    uq     max neval
#             czero(a)     0   514   621.035    514   515   21076  1000
#                f1(a) 21590 23133 34455.218  27245 30843 3211826  1000
#            fczero(a)     0   514   688.892    514   515   28274  1000
#          revczero(a)  2570  3085  4626.047   3599  4626  112064  1000
# sum(!cumsum(rev(a)))  2056  2571  3879.630   3085  3599   62201  1000

microbenchmark::microbenchmark(czero(b), f1(b), fczero(b), revczero(b), sum(!cumsum(rev(b))), times = 1000)

# Unit: nanoseconds
#                   expr   min    lq      mean median    uq     max neval
#             czero(b)       0   514   809.691    514   515     29815  1000
#                f1(b)   22104 23647 29372.227  24675 26217   1319583  1000
#            fczero(b)       0     0   400.502      0   514     26217  1000
#          revczero(b)    2056  2571  3844.176   3085  3599     99727  1000
# sum(!cumsum(rev(b)))    2056  2570  3592.281   3084  3598.5  107952  1000

microbenchmark::microbenchmark(czero(long), f1(long), fczero(long), revczero(long), sum(!cumsum(rev(long))), times = 1000)

# Unit: nanoseconds
#                  expr    min     lq       mean median       uq     max neval
#             czero(long) 353156 354699 422077.536 383486 443631.0 1106250  1000
#                f1(long) 112579 119775 168408.616 132627 165269.5 2068050  1000
#            fczero(long)      0    514    855.444    514   1028.0   43695  1000
#          revczero(long)  24161  27245  35890.991  29301  36498.0  149591  1000
# sum(!cumsum(rev(long)))  49350  53462  71035.486  56546    71454 2006363  1000

Answer 3

我们可以使用rle

f1 <- function(vec){
    pmax(0, with(rle(vec), lengths[values == 0 & 
                 seq_along(values) == length(values)])[1], na.rm = TRUE)

  }

f1(a)
#[1] 3

在第二种情况下，

b <- c(0, 1, 1, 0, 0, 1)
f1(b)
#[1] 0

---

或者另一个选择是使用which和cumsum创建函数>

f2 <- function(vec) {
  i1 <- which(!vec)
  if(i1[length(i1)] != length(vec)) 0 else {
     sum(!cumsum(rev(c(TRUE, diff(i1) != 1)))) + 1
    }

 }

f2(a)
f2(b)

Answer 4

带有data.table：