我有小时价值.我想计算自上一次非零以来该值连续多少小时.对于电子表格或循环来说,这是一项简单的工作,但我希望有一个快速的矢量化单行程来完成任务.
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)
Run Code Online (Sandbox Code Playgroud)
期望的输出:
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
Run Code Online (Sandbox Code Playgroud)
Mar*_*gan 23
William Dunlap关于R-help的帖子是寻找与跑步长度相关的所有事情的地方.他在这篇文章中的f7 是
f7 <- function(x){ tmp<-cumsum(x);tmp-cummax((!x)*tmp)}
Run Code Online (Sandbox Code Playgroud)
在目前的情况下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
Run Code Online (Sandbox Code Playgroud)
Pra*_*ani 22
这里有一个方法,建立在约书亚的rle
方法:(编辑以使用seq_len
和lapply
按马立克的建议)
> (!x) * unlist(lapply(rle(x)$lengths, seq_len))
[1] 0 1 0 1 2 3 0 0 1 2
Run Code Online (Sandbox Code Playgroud)
更新.只是为了踢,这是另一种方法,大约快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)
}
Run Code Online (Sandbox Code Playgroud)
试试一个例子:
> 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
Run Code Online (Sandbox Code Playgroud)
现在比较百万长度向量的时间:
> 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
Run Code Online (Sandbox Code Playgroud)
故事的道德:单行更好,更容易理解,但并不总是最快!
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
Run Code Online (Sandbox Code Playgroud)
一个简单的base
R 方法:
ave(!x, cumsum(x), FUN = cumsum)
#[1] 0 1 0 1 2 3 0 0 1 2
Run Code Online (Sandbox Code Playgroud)