使用行向迭代在 mapply 上实现 data.table 函数
Implementing data.table functions on mapply with rowwise iteration
我有一个数据框
df<-data.frame(var1=c(1:10),var2=c(rep(c(0,0.1),each=5)),BYGROUP_OBSNUM=c(0:4))
我想使用按行伪公式计算列
df$VAR1_NEW <-(ifelse (var2!=0 & BYGROUP_OBSNUM !=0),
var1[i]+lag(var1,1)*var2^1+lag(var1,2)*var2^2 +....lag(var1,BYGROUP_OBSNUM)*var2^BYGROUP_OBSNUM)
当前方法-
my.func <- function(x){mapply(function(v1,v2,v3,n) {
if(v2==0 | v3==0){
as.numeric(v1)
} else {
sum(v1, x[rev(seq(1:(n-1))),1][1:v3] * v2 ^ seq(1:(n-1))[1:v3])
}
}, x[,"var1"], x[,"var2"], x[,"BYGROUP_OBSNUM"],seq(1:nrow(x)))
}
df1 <- df %>%
do(data.frame(., my.func(.))) %>%
mutate(VAR1_NEW = my.func...)%>%
select(-my.func...)
#结果-
df1
var1 var2 BYGROUP_OBSNUM VAR1_NEW
1 0.0 0 1.0000
2 0.0 1 2.0000
3 0.0 2 3.0000
4 0.0 3 4.0000
5 0.0 4 5.0000
6 0.1 0 6.0000
7 0.1 1 7.6000
8 0.1 2 8.7600
9 0.1 3 9.8760
10 0.1 4 10.9876
对于 140 万行的数据帧,此方法需要 6 分钟。因此,我想将方法更改为 data.table,因为不会创建副本,这应该花费更少的时间。
到目前为止,这是我取得的成就-
DT<-as.data.table(df)
DT<-DT[, c("New_Var1") := my.func(DT)]
但这会引发很多警告,例如-
>warnings()
10: In if (v2 == 0 | v3 == 0) { ... :
the condition has length > 1 and only the first element will be used
11: In `[.data.table`(DT, , `:=`(c("New.Var1"), my.func(DT))) :
10 column matrix RHS of := will be treated as one vector
12: In `[.data.table`(DT, , `:=`(c("New.Var1"), my.func(DT))) :
Supplied 100 items to be assigned to 10 items of column 'New.Var1' (90 unused)
并且只将 var1 列复制到 new_var1 中,因为只使用了第一个元素。
我是 data.table 用法的新手,无法找到解决方法。
这是一个使用data.table
的选项
library(data.table)
setDT(df)[, grp := cumsum(BYGROUP_OBSNUM==0)
][, VAR1_NEW := Reduce(`+`, Map(`*`, shift(var1, 1:.N, fill = 0),
var2^(seq_len(.N)))) + var1, grp][, grp := NULL][]
# var1 var2 BYGROUP_OBSNUM VAR1_NEW
# 1: 1 0.0 0 1.0000
# 2: 2 0.0 1 2.0000
# 3: 3 0.0 2 3.0000
# 4: 4 0.0 3 4.0000
# 5: 5 0.0 4 5.0000
# 6: 6 0.1 0 6.0000
# 7: 7 0.1 1 7.6000
# 8: 8 0.1 2 8.7600
# 9: 9 0.1 3 9.8760
#10: 10 0.1 4 10.9876
我有一个数据框
df<-data.frame(var1=c(1:10),var2=c(rep(c(0,0.1),each=5)),BYGROUP_OBSNUM=c(0:4))
我想使用按行伪公式计算列
df$VAR1_NEW <-(ifelse (var2!=0 & BYGROUP_OBSNUM !=0),
var1[i]+lag(var1,1)*var2^1+lag(var1,2)*var2^2 +....lag(var1,BYGROUP_OBSNUM)*var2^BYGROUP_OBSNUM)
当前方法-
my.func <- function(x){mapply(function(v1,v2,v3,n) {
if(v2==0 | v3==0){
as.numeric(v1)
} else {
sum(v1, x[rev(seq(1:(n-1))),1][1:v3] * v2 ^ seq(1:(n-1))[1:v3])
}
}, x[,"var1"], x[,"var2"], x[,"BYGROUP_OBSNUM"],seq(1:nrow(x)))
}
df1 <- df %>%
do(data.frame(., my.func(.))) %>%
mutate(VAR1_NEW = my.func...)%>%
select(-my.func...)
#结果-
df1
var1 var2 BYGROUP_OBSNUM VAR1_NEW
1 0.0 0 1.0000
2 0.0 1 2.0000
3 0.0 2 3.0000
4 0.0 3 4.0000
5 0.0 4 5.0000
6 0.1 0 6.0000
7 0.1 1 7.6000
8 0.1 2 8.7600
9 0.1 3 9.8760
10 0.1 4 10.9876
对于 140 万行的数据帧,此方法需要 6 分钟。因此,我想将方法更改为 data.table,因为不会创建副本,这应该花费更少的时间。
到目前为止,这是我取得的成就-
DT<-as.data.table(df)
DT<-DT[, c("New_Var1") := my.func(DT)]
但这会引发很多警告,例如-
>warnings()
10: In if (v2 == 0 | v3 == 0) { ... :
the condition has length > 1 and only the first element will be used
11: In `[.data.table`(DT, , `:=`(c("New.Var1"), my.func(DT))) :
10 column matrix RHS of := will be treated as one vector
12: In `[.data.table`(DT, , `:=`(c("New.Var1"), my.func(DT))) :
Supplied 100 items to be assigned to 10 items of column 'New.Var1' (90 unused)
并且只将 var1 列复制到 new_var1 中,因为只使用了第一个元素。
我是 data.table 用法的新手,无法找到解决方法。
这是一个使用data.table
library(data.table)
setDT(df)[, grp := cumsum(BYGROUP_OBSNUM==0)
][, VAR1_NEW := Reduce(`+`, Map(`*`, shift(var1, 1:.N, fill = 0),
var2^(seq_len(.N)))) + var1, grp][, grp := NULL][]
# var1 var2 BYGROUP_OBSNUM VAR1_NEW
# 1: 1 0.0 0 1.0000
# 2: 2 0.0 1 2.0000
# 3: 3 0.0 2 3.0000
# 4: 4 0.0 3 4.0000
# 5: 5 0.0 4 5.0000
# 6: 6 0.1 0 6.0000
# 7: 7 0.1 1 7.6000
# 8: 8 0.1 2 8.7600
# 9: 9 0.1 3 9.8760
#10: 10 0.1 4 10.9876