Question

我有两个数据框，ord，行数为15行

         uniq.id prev.ord.dt cur.ord.dt
           <chr>      <date>     <date>
1  4892267119791  2016-04-28 2016-06-09
2  7174853145105  2016-04-26 2016-05-10
3  9600318129252  2016-07-07 2016-07-11
4  7150993150290  2016-03-30 2016-04-13
5  3121040102603  2016-05-01 2016-05-18
6  4899102101891  2016-04-29 2016-05-08
7  7174853112259  2016-05-10 2016-05-24
8  4648283132540  2016-04-25 2016-05-09
9  9600318144830  2016-05-12 2016-05-19
10 9600318134838  2016-05-23 2016-06-06
...

和dlvrd。有39k行

uniq.id   dlvrd.dt dlvrd.qty
           <chr>     <date>     <int>
1  9600318114229 2016-02-24        10
2  2594775116151 2016-04-07        22
3  4935357145929 2016-05-26         6
4  4127487134929 2016-05-18         9
5  4935357144169 2016-05-10        62
6  1180975135573 2016-03-16        11
7  3121040102604 2016-06-17        22
8  1580171115586 2016-01-12       240
9  3011291147292 2016-03-25        12
10 4892267115584 2016-05-16        21
...

编辑：uniq.id总共约有2k，每个都有多个交付周期（为简单起见，假设交付期由cur.ord.dt表示）。我需要汇总每个交付期间每个uniq.id的总交付量，但我目前使用的方法需要大约35分钟才能运行。我定义了一个自定义函数

add.dlvrd <- function(uniq, prev, cur) {
  require(dplyr)
  dlvrd <- get("dlv.data", envir = .GlobalEnv)

  dlvrd <- dlvrd %>% filter(uniq.id==uniq,
                            dlvrd.dt >= prev, 
                            dlvrd.dt < cur) %$% sum(dlvrd.qty) %>% return()
}

然后运行mapply

ord$dlvrd.qty <- ord %$% mapply(add.dlvrd, uniq.id, prev.ord.dt, cur.ord.dt)

有更优雅的方式吗？

旁注：我意识到它的使用形式不好＆＃34;。＆＃34;在变量和函数名称而不是＆＃34; _＆＃34;，但我没有时间立即改变它。

Answer 1

在SQL中，您需要一个看似如下的相关聚合子查询（这可能在sqldf包中可行）

SELECT ord.uniqid, ord.prevorddt, ord.curorddt, 
       (SELECT SUM(dlvrd.dlvrqty) 
        FROM dlvrd.dlvrqty
        WHERE dlvrd.uniqid = ord.uniqid
        AND dlvrd.dlvrddt >= ord.prevorddt
        AND dlvrd.dlvrddt <= ord.curorddt) AS dlvrqty
FROM ord

基数R中的对应物将是sapply()条件，相关和：

ord$dlvr.qty <- sapply(1:nrow(ord), function(i) {
                     tempdf <- dlvrd[dlvrd$dlvrd.dt >= ord$prev.ord.dt[i] &
                                     dlvrd$dlvrd.dt < ord$cur.ord.dt[i] &
                                     dlvrd$uniq.id == ord$uniq.id[i],]
                     sum(tempdf$dlvrd.qty)
})

虽然上面的解决方案类似于你原来的解决方案。根据您发布的数据，以下各项之间会出现明显差异：1）mapply和dplyr以及2）sapply和base：

library(microbenchmark)
microbenchmark(ord$dlvrd.qty <- with(ord, 
                                     mapply(add.dlvrd, uniq.id, prev.ord.dt, cur.ord.dt)))
#      min       lq     mean  median       uq      max neval
# 23.40284 24.21174 25.98971 25.6515 27.22191 32.95809   100

microbenchmark(ord$dlvr.qty <- sapply(1:nrow(ord), function(i) {
                               tempdf <- dlvrd[dlvrd$dlvrd.dt >= ord$prev.ord.dt[i] &
                                               dlvrd$dlvrd.dt < ord$cur.ord.dt[i] &
                                               dlvrd$uniq.id == ord$uniq.id[i],]
                                sum(tempdf$dlvrd.qty)
                            }))    
#      min       lq     mean   median       uq      max neval
# 6.426951 6.592485 7.157509 6.779431 7.124455 11.30587   100

并且vapply()略快，但可以在较长时间内保存：

microbenchmark(ord$dlvr.qty <- vapply(1:nrow(ord), function(i) {
                               tempdf <- dlvrd[dlvrd$dlvrd.dt >=  ord$prev.ord.dt[i] &
                                               dlvrd$dlvrd.dt < ord$cur.ord.dt[i] &
                                               dlvrd$uniq.id == ord$uniq.id[i],]
                                        sum(tempdf$dlvrd.qty)
                             }, numeric(1)))
#      min       lq     mean   median       uq      max neval
# 6.395672 6.525357 6.912836 6.592966 6.865086 9.737148   100

执行函数的速度比R中的mapply更快

1 个答案: