比R中的mapply执行函数更快的方法

我有两个数据帧，ord有15k行

         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
...

编辑：uniq.id总共大约有2k个，每个uniq.id下都有多个交付周期。为简单起见，假设一个交付周期由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()
}

有没有更优雅的方法

---

旁注：我知道这是一种不好的使用形式。在变量和函数名中，而不是在x中，但我现在没有时间更改它

在SQL语言中，您需要一个相关的聚合子查询，该子查询在包中可能是可行的，如下所示

选择ord.uniqid、ord.prevorddt、ord.curorddt、， 选择SUMdlvrd.dlvrqty 来自dlvrd.dlvrqty 其中dlvrd.uniqid=ord.uniqid 和dlvrd.dlvrddt>=ord.prevordt

---

你能举一个小的可重复的例子吗？data.table包有一些用于间隔联接的工具，例如，在这里：尽管该链接有点old@Frankfoverlaps函数可能对我有用，但在y中可能会找到多个条目，我希望对这些值求和，而不是简单地返回它们。是的，我认为它不太合适。不过，最新的间隔联接工具确实允许求和：通过我上一个链接中的链接找到。不过，在使用data.table之前，您可能需要学习一些data.table语法。另外，制作一个可复制示例的最快方法是什么？关于最后的旁注：对于变量名和函数名中点的使用，有不同的观点。一般来说，蛇壳不是首选，使用圆点也不被认为是不好的风格。相反，一些风格指南明确建议使用名字的方式，并考虑蛇案坏作风。这是一个激烈且几乎不必要的争论话题…第一次合并中的order.dv是什么？当我在实际数据上尝试此方法时，dlvrd.qty返回为每个uniq.id的相同值。当然，您的目标是：在上一个日期和当前日期之间，每个uniq.id的总数量。并且uniq.id在ord中以不同的顺序重复每个订单。我已经对上述目标进行了澄清。我已经完成了这项工作，谢谢！我最终访问了dlvrd数据字段中带有订单日期的一个额外字段，使得匹配更加简单。你也帮助我提高了将来如何做这类事情的知识。

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()
}

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

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)
})

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

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