我在R中执行每个政策人寿保险估值。按照政策执行每月现金流量预测,并按以下格式返回数据框(例如):
Policy1 = data.frame(ProjM = 1:200,
Cashflow1 = rep(5,200),
Cashflow2 = rep(10,200))
我的模型返回一个列表(使用lapply和一个执行每个策略现金流预测的函数 - 基于各种策略细节,升级假设和生命突发事件)。我想通过ProjM
汇总所有政策的现金流量。以下代码执行我想要的,但寻找更高效的内存方式(即不使用rbindlist
函数)。示例数据:
Policy1 = data.frame(ProjM = 1:5,
Cashflow1 = rep(5,5),
Cashflow2 = rep(10,5))
Policy2 = data.frame(ProjM = 1:3,
Cashflow1 = rep(50,3),
Cashflow2 = rep(-45,3))
# this is the output containing 35000 data frames:
ListOfDataFrames = list(Policy1 = Policy1, Policy2 = Policy2)
我的代码:
library(data.table)
OneBigDataFrame <- rbindlist(ListOfDataFrames)
MyOutput <- aggregate(. ~ ProjM, data = OneBigDataFrame, FUN = sum)
需要输出:
ProjM Cashflow1 Cashflow2
1 55 -35
2 55 -35
3 55 -35
4 5 10
5 5 10
我查找过示例,R aggregate list of dataframe对所有数据帧执行聚合,但不将它们合并为1个数据帧。
答案 0 :(得分:1)
使用data.table
语法,一步法是先创建大数据。然后再进行聚合:
library(data.table)
OneBigDataFrame <- rbindlist(ListOfDataFrames)
OneBigDataFrame[, lapply(.SD, sum), by = ProjM]
或更简洁
rbindlist(ListOfDataFrames)[, lapply(.SD, sum), by = ProjM]
ProjM Cashflow1 Cashflow2 1: 1 55 -35 2: 2 55 -35 3: 3 55 -35 4: 4 5 10 5: 5 5 10
现在,OP已经要求首先避免创建大数据。为了节省内存。这需要一个两步法,为每个data.table计算聚合,然后在最后一步中汇总为总计:
rbindlist(
lapply(ListOfDataFrames,
function(x) setDT(x)[, lapply(.SD, sum), by = ProjM])
)[, lapply(.SD, sum), by = ProjM]
ProjM Cashflow1 Cashflow2 1: 1 55 -35 2: 2 55 -35 3: 3 55 -35 4: 4 5 10 5: 5 5 10
请注意,此处使用setDT()
通过引用将data.frames强制转换为data.table ,即不创建额外的副本以节省时间和内存。
使用基准数据of d.b(10000个data.frames列表,每行100行,总共28.5 Mb),到目前为止提供了所有答案:
mb <- microbenchmark::microbenchmark(
malan = {
OneBigDataFrame <- rbindlist(test)
malan <- aggregate(. ~ ProjM, data = OneBigDataFrame, FUN = sum)
},
d.b = d.b <- with(data = data.frame(do.call(dplyr::bind_rows, test)),
expr = aggregate(x = list(Cashflow1 = Cashflow1, Cashflow2 = Cashflow2),
by = list(ProjM = ProjM),
FUN = sum)),
a.gore = {
newagg <- function(dataset) {
dataset <- data.table(dataset)
dataset <- dataset[,lapply(.SD,sum),by=ProjM,.SDcols=c("Cashflow1","Cashflow2")]
return(dataset)
}
a.gore <- newagg(rbindlist(lapply(test,newagg)))
},
dt1 = dt1 <- rbindlist(test)[, lapply(.SD, sum), by = ProjM],
dt2 = dt2 <- rbindlist(
lapply(test,
function(x) setDT(x)[, lapply(.SD, sum), by = ProjM])
)[, lapply(.SD, sum), by = ProjM],
times = 5L
)
mb
Unit: milliseconds expr min lq mean median uq max neval cld malan 565.43967 583.08300 631.15898 600.45790 605.60237 801.2120 5 b d.b 707.50261 710.31127 719.25591 713.54526 721.26691 743.6535 5 b a.gore 14706.40442 14747.76305 14861.61641 14778.88547 14805.29412 15269.7350 5 d dt1 40.10061 40.92474 42.27034 41.55434 42.07951 46.6925 5 a dt2 8806.85039 8846.47519 9144.00399 9295.29432 9319.17251 9452.2275 5 c
最快的解决方案是使用data.table
的一步法,比第二快的快15倍。令人惊讶的是,两步data.table
方法比一步法更慢。
为确保所有解决方案都返回相同的结果,可以使用
进行检查all.equal(malan, d.b)
all.equal(malan, as.data.frame(a.gore))
all.equal(malan, as.data.frame(dt1))
all.equal(malan, as.data.frame(dt2))
在所有情况下都返回TRUE
。
答案 1 :(得分:0)
我认为这个解决方案可能有效。试一试,让我知道
require(data.table)
newagg <- function(dataset) { dataset <- data.table(dataset);dataset <- dataset[,lapply(.SD,sum),by=ProjM,.SDcols=c("Cashflow1","Cashflow2")]; return(dataset)}
newagg(rbindlist(lapply(ListOfDataFrames,newagg)))
# ProjM Cashflow1 Cashflow2
# 1: 1 55 -35
# 2: 2 55 -35
# 3: 3 55 -35
# 4: 4 5 10
# 5: 5 5 10