根据标题，我希望与一个表进行交叉连接，该表执行聚合函数并对表中的几个变量进行过滤。
我有与以下内容类似的数据：
library(dplyr)
library(data.table)
library(sqldf)
sales <- data.frame(salesx = c(3000, 2250,850,1800,1700,560,58,200,965,1525)
,week = seq(from = 1, to = 10, by = 1)
,uplift = c(0.04)
,slope = c(100)
,carryover = c(.35))
spend <- data.frame(spend = seq(from = 1, to = 50000, by = 1))
tempdata <- merge(spend,sales,all=TRUE)
tempdata$singledata <- as.numeric(1)
以下是我试图通过基于 sql 的解决方案完成的示例：
newdata <- sqldf("select a.spend, a.week,
sum(case when b.week > a.week
then b.salesx*(b.uplift*(1-exp(-(power(b.singledata,b.week-a.week)/b.slope))))/b.spend
else 0.0 end) as calc3
from tempdata a, tempdata b
where a.spend = b.spend
group by a.spend,a.week")
这提供了我想要的结果，但它有点慢，特别是对于我大约 100 万条记录的真实数据集。如果能就 a( 如何加速 sqldf 函数提供一些建议，那就太好了;或者b(使用更有效的data.table/dplyr方法(我无法解决交叉连接/聚合/过滤器三重问题(。
下面明确了非等连接解决方案：
我对非等值连接解决方案有几个问题——输出很好而且非常快。为了理解代码是如何工作的，我把它分解成这样：
breakdown <- setDT(tempdata)[tempdata, .(spend, uplift, slope,carryover,salesx, singledata, week, i.week,x.week, i.salesx,x.salesx, x.spend, i.spend), on=.(spend, week > week)]
根据细分，为了与原始计算保持一致，它应该是：
x.salesx*(uplift*(1.0-exp(-(`^`(singledata,x.week-week)/slope))))/i.spend
这不明显的原因是因为在示例中，我使用了等式的"功率"部分并没有真正做任何事情(总是 1(。实际使用的计算方法是(向数据添加结转变量(：
.SQL
b.salesx*(b.uplift*(1-exp(-(power((b.singledata*b.carryover),b.week-a.week)/b.slope))))/b.spend (sql)
我的数据表解决方案
sum(salesx.y*(uplift.y*(1-exp(-((singledata.y*adstock.y)^(week.y-week.x)/slope.y))))/spend), by=list(spend, week.x)
但是，在添加"结转"变量时，我无法使用非 equi 连接解决方案来使用它。
x.salesx*(uplift*(1.0-exp(-(`^`((singledata*carryover),x.week-week)/slope))))/i.spend
在版本1.9.8(CRAN 2016 年 11 月 25 日(中引入了data.table非等联接，这有助于避免占用内存的交叉联接：
library(data.table)
newdata4 <-
# coerce to data.table
setDT(tempdata)[
# non-equi self-join
tempdata, on = .(spend, week > week),
# compute result
.(calc3 = sum(salesx*(uplift*(1.0-exp(-(`^`(singledata,week-i.week)/slope))))/i.spend)),
# grouped by join parameters
by = .EACHI][
# replace NA
is.na(calc3), calc3 := 0.0][]
# check that results are equal
all.equal(newdata, as.data.frame(newdata4[order(spend, week)]))
[1] TRUE
基准
OP提供了三种不同的解决方案，两种sqldf变体和一种使用交叉连接的data.table方法。这些与非等连接进行比较。
下面的代码
dt_tempdata <- data.table(tempdata)
microbenchmark::microbenchmark(
sqldf = {
newdata <- sqldf("select a.spend, a.week,
sum(case when b.week > a.week
then b.salesx*(b.uplift*(1-exp(-(power(b.singledata,b.week-a.week)/b.slope))))/b.spend
else 0.0 end) as calc3
from tempdata a, tempdata b
where a.spend = b.spend
group by a.spend,a.week")
},
sqldf_idx = {
newdata2 <- sqldf(c('create index newindex on tempdata(spend)',
'select a.spend, a.week,
sum(case when b.week > a.week
then b.salesx*(b.uplift*(1-exp(-(power(b.singledata,b.week-a.week)/b.slope))))/b.spend
else 0.0 end) as calc3
from main.tempdata a left join main.tempdata b
on a.spend = b.spend
group by a.spend,a.week'), dbname = tempfile())
},
dt_merge = {
newdata3 <- merge(dt_tempdata, dt_tempdata, by="spend", all=TRUE, allow.cartesian=TRUE)[
week.y > week.x,
.(calc3 = sum(salesx.y*(uplift.y*(1-exp(-(singledata.y^(week.y-week.x)/slope.y)))))),
by=.(spend, week.x)]
},
dt_nonequi = {
newdata4 <- dt_tempdata[
dt_tempdata, on = .(spend, week > week),
.(calc3 = sum(salesx*(uplift*(1.0-exp(-(`^`(singledata,week-i.week)/slope))))/i.spend)),
by = .EACHI][is.na(calc3), calc3 := 0.0]
},
times = 3L
)
返回这些计时：
Unit: seconds expr min lq mean median uq max neval cld sqldf 9.456110 10.081704 10.647193 10.707299 11.242735 11.778171 3 b sqldf_idx 10.980590 11.477774 11.734239 11.974958 12.111064 12.247170 3 b dt_merge 3.037857 3.147274 3.192227 3.256692 3.269412 3.282131 3 a dt_nonequi 1.768764 1.776581 1.792359 1.784397 1.804156 1.823916 3 a
对于给定的问题大小，非 equi 连接速度最快，几乎是合并/交叉连接data.table方法的两倍，比sqldf代码快 6 倍。有趣的是，索引创建和/或临时文件使用在我的系统上似乎相当昂贵。
请注意，我已经简化了OP的data.table解决方案。
最后，除了合并/交叉连接(我没有修复此版本(之外的所有版本都返回相同的结果。
all.equal(newdata, newdata2) # TRUE
all.equal(newdata, as.data.frame(newdata3[order(spend, week.x)])) # FALSE (last week missing)
all.equal(newdata, as.data.frame(newdata4[order(spend, week)])) # TRUE
更大的问题大小
OP 报告说，合并/交叉联接data.table解决方案的内存不足，用于其 1 M 行的生产数据集。为了验证非 equi 连接方法消耗的内存更少，我用 5 M 行 (nrow(tempdata)( 的问题大小对其进行了测试，这比之前的基准测试运行大十倍。在我拥有 8 GB 内存的 PC 上，运行在大约 18 秒内顺利完成。
Unit: seconds expr min lq mean median uq max neval dt_nonequi 18.12387 18.12657 18.23454 18.12927 18.28987 18.45047 3
终于有时间再次调查这个问题：
我最初的解决方案：
system.time(newdata <- sqldf("select a.spend, a.week,
sum(case when b.week > a.week
then b.salesx*(b.uplift*(1-exp(-(power(b.singledata,b.week-a.week)/b.slope))))/b.spend
else 0.0 end) as calc3
from tempdata a, tempdata b
where a.spend = b.spend
group by a.spend,a.week"))
user system elapsed
11.99 3.77 16.11
使用索引(尽管有些东西告诉我这无法正常工作(：
system.time(newdata2 <- sqldf(c('create index newindex on tempdata(spend)',
'select a.spend, a.week,
sum(case when b.week > a.week
then b.salesx*(b.uplift*(1-exp(-(power(b.singledata,b.week-a.week)/b.slope))))/b.spend
else 0.0 end) as calc3
from main.tempdata a left join main.tempdata b
on a.spend = b.spend
group by a.spend,a.week'), dbname = tempfile()))
user system elapsed
12.73 2.93 15.76
数据表解决方案(不从 sql 中的 ifelse 语句返回 0(：
datatablefunc <- function(g){
tempdata2 <- as.data.table(g)
setkey(tempdata2, spend)
tempdata3 <- merge(tempdata2, tempdata2, by="spend", all=TRUE, allow.cartesian=TRUE)
tempdata4 <- tempdata3[week.y > week.x, sum(salesx.y*(uplift.y*(1-exp(-(singledata.y^(week.y-week.x)/slope.y))))/spend), by=list(spend, week.x)]
return(tempdata4)
}
system.time(newdata3 <- datatablefunc(tempdata))
user system elapsed
2.36 0.25 2.62
基于 sql的解决方案的美妙之处在于，由于临时输出存储在 sql 服务器中而不是内存中，所以我不会遇到讨厌的"无法分配矢量"问题，这发生在 data.table/dplyr 解决方案中(当我添加更多数据时(......缺点是运行需要更长的时间。