提高R的效率（矢量化？）

Question

我有R的脚本，需要8分钟的运行，基本上比较了多年期间800个记录的日期范围。这太长了。我是R新手，很确定它与我的嵌入式循环有关。另外，当我试图将我的数据转换为玩具问题时，它似乎不起作用。我一直在处理从excel中读取的数组类型。

# data vectors 
ID <- c("1e", "1f", "1g") 
StartDate <- c(1, 2, 4) 
EndDate <- c(3, 4, 5) 
Type <- c("A", "B", "B") 
Qty <- c(.5, 2.5, 1) 

# table rows and headers 
Days <- c(1, 2, 3, 4, 5) 
setOfTypes <- c("A", "B") 

# get subset of active IDs for each day in table 
ActiveID <- data.frame() 
for(d in 1:length(Days)){ 
    check <- StartDate<=Days[d] & EndDate>=Days[d] 
    subsetID <- subset(ID, check) 
    strSubsetID <- c() 
    for(i in 1:length(subsetID)){ 
    strSubsetID <- paste(ID, subsetID[i], sep=",") 
} 
ActiveID[d,1] <- strSubsetID 
} 

# calculate quantity counts by day and type 
Count <- matrix(,length(Days),length(setOfTypes)) 
for(d in 1:length(Days)){ 
    for(t in 1:length(setOfTypes)) 
    check <- Type == setOfTypes[t] & sapply(ID, grepl, x=ActiveID[d,1]) 
    tempCount <- subset(Types, check) 
    Count[t,d] <- sum(tempCount) 
    } 
} 

结果应该是一个表（天×类型）具有由数量的用于在给定的一天和型有源ID的总和的每个元素。

我正在寻找矢量化这段代码，所以它适用于更大的数据集时运行得更快！请帮忙，谢谢。

Answer 1

你的代码不能按原样运行，所以我无法准确知道你在找什么。您的描述建议您需要Days之间StartDate和EndDate之间的Qty的总和，按Type分组。这将产生这样一个矩阵：

df <- data.frame(ID,StartDate,EndDate,Type,Qty,stringsAsFactors=FALSE) 
Days <- min(StartDate):max(EndDate) 

is.between <- function(x,df) with(df,x>=StartDate & x<=EndDate) 
get.sums <- function(df) sapply(Days,function(d,df) sum(df[is.between(d,df),"Qty"]),df) 
do.call(rbind,lapply(split(df,df$Type), get.sums)) 
# [,1] [,2] [,3] [,4] [,5] 
# A 0.5 0.5 0.5 0.0 0 
# B 0.0 2.5 2.5 3.5 1 

这是一个data.table方法，可能会更快。请注意0​​和get.sums(...)的不同定义。

DT <- data.table(df,key="Type") 
is.between <- function(x,a,b) x>=a & x <= b 
get.sums <- function(day) DT[,list(day,Qty=sum(Qty[is.between(day,StartDate,EndDate)])),by=Type] 
long  <- rbindlist(lapply(Days,get.sums)) 
result  <- dcast.data.table(long,Type~day,value.var="Qty") 
result 
# Type 1 2 3 4 5 
# 1: A 0.5 0.5 0.5 0.0 0 
# 2: B 0.0 2.5 2.5 3.5 1 

---

这里有一些基准测试与希望比较有代表性的例子的数据集（800行，500个开始日期，总日期范围>900天），也测试@阿伦的回答。

# more representative example 
set.seed(1) # for reproducibility 
StartDate <- sample(1:500,800,replace=TRUE) 
EndDate <- StartDate + rpois(800,400) 
Type  <- sample(LETTERS[1:20],800,replace=TRUE) 
Qty  <- rnorm(800,10,2) 
Days  <- min(StartDate):max(EndDate) 
df  <- data.frame(StartDate,EndDate,Type,Qty, stringsAsFactors=FALSE) 

比较数据帧方法和两种数据表方法。

library(data.table) 
library(reshape2) 
DT <- data.table(df,key="Type") 
f.df <- function() { 
    is.between <- function(x,df) with(df,x>=StartDate & x<=EndDate) 
    get.sums <- function(df) sapply(Days,function(d,df) sum(df[is.between(d,df),"Qty"]),df) 
    do.call(rbind,lapply(split(df,df$Type), get.sums)) 
} 
f.dt1 <- function() { 
    is.between <- function(x,a,b) x>=a & x <= b 
    get.sums <- function(day) DT[,list(day,Qty=sum(Qty[is.between(day,StartDate,EndDate)])),by=Type] 
    long  <- rbindlist(lapply(Days,get.sums)) 
    dcast.data.table(long,Type~day,value.var="Qty") 
} 
f.dt2 <- function() { 
    lookup <- data.table(StartDate=Days, EndDate=Days) 
    setkey(lookup) 
    j_olaps <- foverlaps(DT, lookup, by.x=c("StartDate", "EndDate"), type="any") 
    dcast.data.table(j_olaps, Type ~ StartDate, value.var="Qty", fun.agg=sum, na.rm=TRUE) 
} 
identical(f.dt1(),f.dt2()) # same result? YES! 
# [1] TRUE 
library(microbenchmark) 
microbenchmark(f.df(),f.dt1(),f.dt2(),times=10) 
# Unit: milliseconds 
#  expr  min   lq median  uq  max neval 
# f.df() 1199.76370 1212.03787 1222.6558 1243.8743 1275.5526 10 
# f.dt1() 1634.92675 1664.98885 1689.7812 1714.2662 1798.9121 10 
# f.dt2() 91.53245 95.19545 129.2789 158.0789 208.1818 10 

So @ Arun的方法比df方法快10倍，比上面dt方法快17倍。

Answer 2

查看@ jihoward的代码，这似乎是重叠连接的一种情况，它最近在0123.的v1.9.4中实现。该功能被称为foverlaps()。以下是我们如何使用它的方法：

首先，我们创建一个查找表，其中包含我们希望重叠连接的日期范围。这是使用@ jihoward代码中的变量Days构建的。你的情况开始和结束日期是相同的。

require(data.table) ## 1.9.4 
lookup <- data.table(StartDate=Days, EndDate=Days) 
setkey(lookup) 

然后我们使用foverlaps()来计算重叠连接。这里的重叠类型被指定为any。看看?foverlaps来找出这意味着什么，以及其他类型的重叠可以做。

j_olaps = foverlaps(DT, lookup, by.x=c("StartDate", "EndDate"), type="any") 

现在，我们的重叠，我们可以简单地将它转换为：

dcast.data.table(j_olaps, Type ~ StartDate, value.var="Qty", fun.agg=sum, na.rm=TRUE) 

# Type 1 2 3 4 5 
# 1: A 0.5 0.5 0.5 0.0 0 
# 2: B 0.0 2.5 2.5 3.5 1 

我相信这应该是速度远远超过不必做一个矢量扫描基于子集中的每个元素在Days。如果有的话，知道你获得了多少加速会很棒！

HTH