매우 큰 데이터 프레임에서 루프를 최적화하는 방법

Question

행정 법정에서 완료된 개별 사례를 나타내는 590 만 개의 행과 4 개의 열 (idnumber/integer, compdate/integer 및 judge/character)이있는 데이터 프레임 "x"가 있습니다. 데이터는 stata 데이터 세트에서 가져오고 날짜 필드는 정수로 입력되었으므로 내 용도에는 적합합니다. 문제의 완료 날짜를 30 일 이내에 판사가 완료 한 사례 수를 계산하여 사례로드 변수를 작성하려고합니다. 여기

는 데이터의 첫 번째 34 행은 다음과 같습니다

idnumber compdate judge 
1 9615 JVC 
2 15316 BAN 
3 15887 WLA 
4 11968 WFN 
5 15001 CLR 
6 13914 IEB 
7 14760 HSD 
8 11063 RJD 
9 10948 PPL 
10 16502 BAN 
11 15391 WCP 
12 14587 LRD 
13 10672 RTG 
14 11864 JCW 
15 15071 GMR 
16 15082 PAM 
17 11697 DLK 
18 10660 ADP 
19 13284 ECC 
20 13052 JWR 
21 15987 MAK 
22 10105 HEA 
23 14298 CLR 
24 18154 MMT 
25 10392 HEA 
26 10157 ERH 
27 9188 RBR 
28 12173 JCW 
29 10234 PAR 
30 10437 ADP 
31 11347 RDW 
32 14032 JTZ 
33 11876 AMC 
34 11470 AMC 

가 여기에 내가 무엇을 최대 온입니다. 따라서 각 레코드에 대해 해당 특정 판사의 데이터 하위 집합을 가져온 다음 30 일 창에서 결정된 사례를 하위 집합으로 지정한 다음 하위 집합 된 데이터 프레임의 벡터 길이를 대상 사례의 사례로드 변수에 할당하면,

for(i in 1:length(x$idnumber)){ 
    e<-x$compdate[i] 
    f<-e-29 
    a<-x[x$judge==x$judge[i] & !is.na(x$compdate),] 
    b<-a[a$compdate<=e & a$compdate>=f,] 
    x$caseload[i]<-length(b$idnumber) 
} 

작동하지만 완료하는 데 너무 오래 걸립니다. 이것을 어떻게 최적화하거나 쉽게 할 수 있습니까? 죄송합니다. 프로그래밍에 익숙하지 않습니다. 법원 데이터를 분석하려는 법학 교수입니다 .... 귀하의 도움에 감사드립니다. 감사. Ken

Answer 1

나는 같은에 경우에 동일을 할 것이다이 별 일이 아닌 당 사건 (이후 ...

• 계산을 압연 계산에 많은 경험을 가지고 있지만하지 않습니다 일).
• 사례 수의 누적 합계를 계산하고이 합계의 현재 값과 합계 31 일 전의 값 (또는 사례가 매일 해결되지 않으므로 min{daysAgo:daysAgo>30})의 차이를 가져옵니다.

아마도 data.table을 사용하는 것이 가장 빠릅니다. 이것은 @nograpes 시뮬레이션 데이터를 사용하여 시도한 것입니다. 설명은 #으로 시작하십시오.

require(data.table) 
DT <- data.table(x) 
DT[,compdate:=as.integer(compdate)] 
setkey(DT,judge,compdate) 

# count cases for each day 
ldt <- DT[,.N,by='judge,compdate'] 
# cumulative sum of counts 
ldt[,nrun:=cumsum(N),by=judge] 
# see how far to look back 
ldt[,lookbk:=sapply(1:.N,function(i){ 
    z  <- compdate[i]-compdate[i:1] 
    older <- which(z>30) 
    if (length(older)) min(older)-1L else as(NA,'integer') 
}),by=judge] 
# compute cumsum(today) - cumsum(more than 30 days ago) 
ldt[,wload:=list(sapply(1:.N,function(i) 
    nrun[i]-ifelse(is.na(lookbk[i]),0,nrun[i-lookbk[i]]) 
))] 

내 랩톱에서이 작업은 1 분 이내에 완료됩니다. 이 명령을 실행하면 한 판사의 결과를 볼 수 있습니다.

print(ldt['XYZ'],nrow=120) 

Answer 2

모든 행을 반복 할 필요는 없습니다. 한 번에 전체 열에 대한 작업을 수행 할 수 있습니다. 먼저 몇 가지 데이터를 만듭니다.

# Create some data. 
n<-6e6 # cases 
judges<-apply(combn(LETTERS,3),2,paste0,collapse='') # About 2600 judges 
set.seed(1) 
x<-data.frame(idnumber=1:n,judge=sample(judges,n,replace=TRUE),compdate=Sys.Date()+round(runif(n,1,120))) 

이제 롤링 윈도우 기능을 만들어 각 판단에 따라 실행할 수 있습니다.

# Sort 
x<-x[order(x$judge,x$compdate),] 
# Create a little rolling window function. 
rolling.window<-function(y,window=30) seq_along(y) - findInterval(y-window,y) 
# Run the little function on each judge. 
x$workload<-unlist(by(x$compdate,x$judge,rolling.window)))