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

结果应该是一个表（天数x类型），每个元素由给定日期的活动ID数量和类型的总和组成。

我希望对此代码进行矢量化，以便在应用更大的数据集时运行速度更快！请帮助，谢谢。

Answer 1

您的代码不按原样运行，因此我无法确切知道您要查找的内容。您的说明建议您希望Qty与Days之间StartDate的总和为EndDate，按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方法。请注意is.between(...)和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天），以及测试@ Arun的答案。

# 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

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

Answer 2

查看@ jihoward的代码，这似乎是重叠连接的情况，最近在data.table的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

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

2 个答案: