在某些值的连续运行中创建计数器答案

【问题标题】：Create counter within consecutive runs of certain values在某些值的连续运行中创建计数器
【发布时间】：2011-02-16 04:22:52
【问题描述】：

我有一个小时值。我想计算自上次不为零以来该值连续多少小时为零。对于电子表格或 for 循环来说，这是一项简单的工作，但我希望有一个活泼的矢量化单线来完成这项任务。

x <- c(1, 0, 1, 0, 0, 0, 1, 1, 0, 0)
df <- data.frame(x, zcount = NA)

df$zcount[1] <- ifelse(df$x[1] == 0, 1, 0)
for(i in 2:nrow(df)) 
  df$zcount[i] <- ifelse(df$x[i] == 0, df$zcount[i - 1] + 1, 0)

期望的输出：

R> df
   x zcount
1  1      0
2  0      1
3  1      0
4  0      1
5  0      2
6  0      3
7  1      0
8  1      0
9  0      1
10 0      2

【问题讨论】：

标签： r

【解决方案1】：

William Dunlap 在 R-help 上的帖子是查找与运行长度相关的所有内容的地方。他来自this post的f7是

f7 <- function(x){ tmp<-cumsum(x);tmp-cummax((!x)*tmp)}

在当前情况下f7(!x)。在性能方面有

> x <- sample(0:1, 1000000, TRUE)
> system.time(res7 <- f7(!x))
   user  system elapsed 
  0.076   0.000   0.077 
> system.time(res0 <- cumul_zeros(x))
   user  system elapsed 
  0.345   0.003   0.349 
> identical(res7, res0)
[1] TRUE

【讨论】：

【解决方案2】：

这是一种基于 Joshua 的 rle 方法的方法：（根据 Marek 的建议编辑为使用 seq_len 和 lapply）

> (!x) * unlist(lapply(rle(x)$lengths, seq_len))
 [1] 0 1 0 1 2 3 0 0 1 2

更新。只是为了好玩，这是另一种方法，大约快 5 倍：

cumul_zeros <- function(x)  {
  x <- !x
  rl <- rle(x)
  len <- rl$lengths
  v <- rl$values
  cumLen <- cumsum(len)
  z <- x
  # replace the 0 at the end of each zero-block in z by the 
  # negative of the length of the preceding 1-block....
  iDrops <- c(0, diff(v)) < 0
  z[ cumLen[ iDrops ] ] <- -len[ c(iDrops[-1],FALSE) ]
  # ... to ensure that the cumsum below does the right thing.
  # We zap the cumsum with x so only the cumsums for the 1-blocks survive:
  x*cumsum(z)
}

试一试：

> cumul_zeros(c(1,1,1,0,0,0,0,0,1,1,1,0,0,1,1))
 [1] 0 0 0 1 2 3 4 5 0 0 0 1 2 0 0

现在比较一百万长度向量的时间：

> x <- sample(0:1, 1000000,T)
> system.time( z <- cumul_zeros(x))
   user  system elapsed 
   0.15    0.00    0.14 
> system.time( z <- (!x) * unlist( lapply( rle(x)$lengths, seq_len)))
   user  system elapsed 
   0.75    0.00    0.75

故事的寓意：单行文字更好更容易理解，但并不总是最快的！

【讨论】：

+1 出色的单线。小代码分析：(!x) * unlist(lapply(rle(x)$lengths, seq_len))（lapply 更安全、更快，seq_len 是seq 的简化版），大约快 2 倍。
谢谢@Marek。有几件事对我来说是新的：seq_len 更快，很高兴知道；为什么lapply 更安全？另外rle 也不是特别快；我有一种烦人的感觉，有一种方法可以使用纯算术运算更快地完成此操作，而无需分解数组并重新组装等（例如涉及 cumsum 的事情）。
lapply 总是给你列表，sapply 有时不会，例如试试你的代码x <- c(0,0,1,1,0,0,1,1)。除了lapply 这里就足够了，为什么要使用基于它的函数。
vapply 是sapply 的更安全版本，因为你告诉它输出类型应该是什么

【解决方案3】：

rle 将“计算自上次不为零以来该值连续多少小时为零”，但不是以您的“所需输出”的格式。

注意对应值为零的元素的长度：

rle(x)
# Run Length Encoding
#   lengths: int [1:6] 1 1 1 3 2 2
#   values : num [1:6] 1 0 1 0 1 0

【讨论】：

很方便，但如果不做一些不雅的事情，我就无法从 rle 得到我需要的东西。

【解决方案4】：

一个简单的baseR 方法：

ave(!x, cumsum(x), FUN = cumsum)

#[1] 0 1 0 1 2 3 0 0 1 2

【讨论】：

【解决方案5】：

单线，不是超级优雅：

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

 unlist(lapply(split(x, c(0, cumsum(abs(diff(!x == 0))))), function(x) (x[1] == 0) * seq(length(x))))

【讨论】：

【解决方案6】：

使用purr::accumulate() 非常简单，所以这个 tidyverse 解决方案可能会在这里增加一些价值。我必须承认它绝对不是最快的，因为它调用了相同的函数length(x)times。

library(purrr)

accumulate(x==0, ~ifelse(.y!=0, .x+1, 0))

 [1] 0 1 0 1 2 3 0 0 1 2

【讨论】：