2013-10-06 35 views
0

我有一個數據幀「x」,包含590萬行和4列:idnumber/integer,compdate/integer和judge/character,代表在行政法庭中完成的個別案例。數據是從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) 
} 

它正在工作,但它需要非常長的時間來完成。我怎樣才能優化這個或更容易做到這一點。對不起,我對r和編程非常陌生 - 我是一位試圖分析法庭數據的法學教授....您的幫助表示感謝。謝謝。 Ken

+1

您就這一問題一個很好的開始,但如果你提供一個樣本'data.frame'只有幾行,將是非常有益的(如10)。這樣,我們就可以運行你的代碼,並用新的代碼對'data.frame'進行驗證,並確認它是一樣的。 – nograpes

+0

「過去30天」的業務可能有點奇怪,因爲前30天(實際)工作日的數量在一週之內會有所不同。也許你應該每週都這樣做?順便說一下,我不知道「窗口」自動意味着「前30天」,而不是「後續30天」或「任何一方15次」。你不要在數學之外指定。 – Frank

回答

2

我沒有與滾動計算了豐富的經驗,但是......

  • 計算這每一天,而不是每個情況下(因爲這將是同爲同一案件天)。
  • 計算案例數量的累計總和,然後計算此金額的當前值與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]]) 
))] 

在我的筆記本電腦上,這需要一分鐘時間。運行這個命令來查看輸出的一個判斷:

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

您不必遍歷每一行。您可以一次對整個列執行操作。首先,創建一些數據:

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