Ben*_*Ben 11 r data.table
dt <- data.table(x=c(1, .9, .8, .75, .5, .1))
dt
x
1: 1.00
2: 0.90
3: 0.80
4: 0.75
5: 0.50
6: 0.10
Run Code Online (Sandbox Code Playgroud)
对于每一行,如何获取该行和接下来两行的x乘积?
x Prod.3
1: 1.00 0.7200
2: 0.90 0.5400
3: 0.80 0.3000
4: 0.75 0.0375
5: 0.50 NA
6: 0.10 NA
Run Code Online (Sandbox Code Playgroud)
更一般地说,对于每一行,如何获得该行和接下来的n行的x乘积?
Dav*_*urg 15
这是另一个可能的版本使用data.table::shift
结合Reduce
(根据@Aruns评论)
library(data.table) #v1.9.6+
N <- 3L
dt[, Prod3 := Reduce(`*`, shift(x, 0L:(N - 1L), type = "lead"))]
Run Code Online (Sandbox Code Playgroud)
shift
是矢量化的,这意味着它可以一次创建几个新列,具体取决于传递给n
参数的向量.然后,Reduce
基本上是*
元素一次适用于所有向量.
Aru*_*run 14
这有两种方式......虽然不是最有效的实现方式:
require(data.table)
N = 3L
dt[, prod := prod(dt$x[.I:(.I+N-1L)]), by=1:nrow(dt)]
Run Code Online (Sandbox Code Playgroud)
另一个使用embed()
:
tmp = apply(embed(dt$x, N), 1, prod)
dt[seq_along(tmp), prod := tmp]
Run Code Online (Sandbox Code Playgroud)
基准:
set.seed(1L)
dt = data.table(x=runif(1e6))
zoo_fun <- function(dt, N) {
rollapply(dt$x, N, FUN=prod, fill=NA, align='left')
}
dt1_fun <- function(dt, N) {
dt[, prod := prod(dt$x[.I:(.I+N-1L)]), by=1:nrow(dt)]
dt$prod
}
dt2_fun <- function(dt, N) {
tmp = apply(embed(dt$x, N), 1L, prod)
tmp[1:nrow(dt)]
}
david_fun <- function(dt, N) {
Reduce(`*`, shift(dt$x, 0:(N-1L), type="lead"))
}
system.time(ans1 <- zoo_fun(dt, 3L))
# user system elapsed
# 8.879 0.264 9.221
system.time(ans2 <- dt1_fun(dt, 3L))
# user system elapsed
# 10.660 0.133 10.959
system.time(ans3 <- dt2_fun(dt, 3L))
# user system elapsed
# 1.725 0.058 1.819
system.time(ans4 <- david_fun(dt, 3L))
# user system elapsed
# 0.009 0.002 0.011
all.equal(ans1, ans2) # [1] TRUE
all.equal(ans1, ans3) # [1] TRUE
all.equal(ans1, ans4) # [1] TRUE
Run Code Online (Sandbox Code Playgroud)
你可以试试
library(zoo)
rollapply(dt, 3, FUN = prod)
x
[1,] 0.7200
[2,] 0.5400
[3,] 0.3000
[4,] 0.0375
Run Code Online (Sandbox Code Playgroud)
匹配预期的输出
dt[, Prod.3 :=rollapply(x, 3, FUN=prod, fill=NA, align='left')]
Run Code Online (Sandbox Code Playgroud)