我有一个大型数据框(大约300万行),其中包含ID,一年和三个日期:lookupdate
,date1
和date2
。 data.frame
按ID
和date1
排序。我想搜索整个数据集并找到记录i
:
financial_year == 2013
和ID
包含相同的j
,以便date1[j] < lookupdate[i] < date2[j]
我在下面实现了这个逻辑,但它的速度非常慢。你知道如何加速这段代码吗?
calc_hits_bruteforce <- function(d){
N <- nrow(d)
hits <- rep(FALSE, N)
for (i in 2:N) {
if(d[i,"financial_year"]!=2013) next
for (j in i:1) {
if (d[i,"ID"]!=d[j,"ID"]) {
break
}
else {
if (d[j,"date1"] < d[i,"lookupdate"] & d[j, "date2"] > d[i, "lookupdate"]) {
hits[i] <- TRUE
break
}
}
}
}
hits
}
我不知道每个ID
有多少条记录,但我知道每条记录的lookupdate
位于date1
和date2
之前,即所有lookupdate[i] < date1[i] < date2[i]
都是i
。
以下是数据框和输出的示例:
> d.ex
ID lookupdate date1 date2 financial_year
1 C143896B 2011-02-24 2011-11-09 2011-11-21 2011
2 C143896G 2010-11-23 2011-10-29 2011-11-21 2011
3 C143896G 2011-11-11 2012-10-12 2012-11-05 2012
4 C143896G 2012-06-17 2013-01-30 2013-02-11 2013
5 C143896G 2012-10-31 2013-09-15 2013-09-29 2013
> calc_hits_bruteforce(d.ex)
[1] FALSE FALSE FALSE FALSE TRUE
自2012-10-12以来,最后一行为TRUE&lt; 2012-10-31&lt; 2012年11月5日。
答案 0 :(得分:2)
从您提出问题的方式来看,听起来您对长度等于d
中的行数的逻辑向量感兴趣,因此预先分配 < / p>
hits = logical(nrow(d)) ## initialized to 'FALSE'
您对特定财政年度的行子集感兴趣,因此 vectorize 选择
i_idx <- which(d$financial_year == 2013)
对于其中的每一个,如果任何其他行满足某些复杂条件,您将更新hits
为真;如何避免外部循环并不明显(尽管数据的特定功能(例如,只有少数ID)可能会提出不同的策略),但内部循环可以矢量化为
for (i in i_idx)
hits[i] <- any(d[, date1] < d[i, lookupdate] &
d[, date2] > d[i, lookupdate] &
d[, ID] == d[i, ID] &
seq_len(nrow(d)) < i)
}
结合并进行一点优化
calc_hits_bruteforce <- function(d) {
hits <- logical(nrow(d))
i_idx <- which(d$financial_year == 2013)
for (i in i_idx) {
lkup <- d[i, lookupdate]
hits[i] <- any((d$date1 < lkup) & (d$date2 > lkup) &
(d$ID == d[i, ID]) & (seq_len(nrow(d)) < i))
}
hits
}
这将比原始版本更快,但不会利用数据的排序特性,并且会大致按照数据框中的行数进行缩放(而不是使用行数的平方来缩放,就像在原始行中一样算法)。
一种可能的改进是使用Bioconductor IRanges包。安装并附上
source("http://bioconductor.org/biocLite.R")
biocLite("IRanges")
library(IRanges)
IRanges是整数值,因此日期的表示变得很重要。我把你的数据读作
txt <- "ID lookupdate date1 date2 financial_year
C143896B 2011-02-24 2011-11-09 2011-11-21 2011
C143896G 2010-11-23 2011-10-29 2011-11-21 2011
C143896G 2011-11-11 2012-10-12 2012-11-05 2012
C143896G 2012-06-17 2013-01-30 2013-02-11 2013
C143896G 2012-10-31 2013-09-15 2013-09-29 2013"
d <- read.delim(textConnection(txt),
colClasses=c("factor", "Date", "Date", "Date", "integer"),
sep="")
然后将日期和查找表示为IRanges(范围表示包括端点,但您对此不感兴趣)。
dates = with(d, IRanges(as.integer(date1) + 1, as.integer(date2) - 1))
lkup = with(d, IRanges(as.integer(lookupdate), width=1))
查找重叠范围(这会找到所有重叠的范围;我们稍后会清除不需要的值;比较有效,如帮助页面上所述?IntervalTree)
olaps = findOverlaps(query=dates, subject=lkup)
并微调
q_hits = queryHits(olaps); s_hits = subjectHits(olaps)
keep = (d[s_hits, "financial_year"] == 2013) &
(d[s_hits, "ID"] == d[q_hits, "ID"]) & (q_hits < s_hits)
tabulate(s_hits[keep], length(lkup)) != 0
这会很快,但我可能会遇到边缘情况错误。
答案 1 :(得分:0)
test <- structure(list(ID = c("C143896B", "C143896G", "C143896G", "C143896G",
"C143896G"), lookupdate = structure(c(15029, 14936, 15289, 15508,
15644), class = "Date"), date1 = structure(c(15287, 15276, 15625,
15735, 15963), class = "Date"), date2 = structure(c(15299, 15299,
15649, 15747, 15977), class = "Date"), financial_year = c(2011,
2011, 2012, 2013, 2013)), .Names = c("ID", "lookupdate", "date1",
"date2", "financial_year"), row.names = c(NA, -5L), class = "data.frame")
我会建议这样做,但我担心我无法测试它的表现:
calc_hits_bruteforce2 <- function(db){
a <- sapply(test[,2],FUN=function(x)(test[,3] < x & x < test[,4] ))
b <- sapply(test[,1],FUN=function(x)(x==test[,1]))
c <- matrix(sapply(test[,5], FUN=function(x)(x==2013)),nrow(a),nrow(a), byrow=T)
d <- a==TRUE & a==b & a==c
rows <- round(which(d==TRUE)/nrow(a))
test[rows,]
}
## ID lookupdate date1 date2 financial_year
## 5 C143896G 2012-10-31 2013-09-15 2013-09-29 2013