대용량 데이터 테이블에 대해 R에서 루프를 최적화하는 방법

Question

대규모 데이터 테이블 (250 만 행)의 interbank loan으로 작업하고 있습니다. 여기에 첫 번째 (20)의 추출물 : clean 있습니다 issued, issued_radius 및 week에 대한 관심의

> dput(head(clean,20)) 
structure(list(time = c(4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 3L, 4L, 
4L, 4L, 1L, 2L, 3L, 4L, 3L, 4L, 4L, 4L), bal = structure(c(2L, 
4L, 4L, 4L, 4L, 4L, 3L, 3L, 9L, 4L, 2L, 3L, 3L, 3L, 3L, 2L, 4L, 
5L, 2L, 15L), .Label = c("32001", "32002", "32003", "32004", 
"32005", "32006", "32007", "32008", "32009", "32010", "32201", 
"32202", "32203", "32204", "32205", "32206", "32207", "32208", 
"32209", "32210"), class = "factor"), lender = c(2003L, 2547L, 
2547L, 574L, 574L, 574L, 2984L, 3015L, 812L, 3278L, 3124L, 3124L, 
41L, 354L, 3156L, 3156L, 735L, 735L, 1421L, 3319L), borrower = c(2285L, 
2285L, 2285L, 2285L, 2285L, 2285L, 2285L, 2285L, 269L, 2839L, 
2839L, 2839L, 2839L, 2897L, 2399L, 2399L, 1816L, 1816L, 2476L, 
3033L), obm = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
0, 0, 0, 0, 0), obd = c(1, 0.3, 0.2, 0.35, 0.7, 0.5, 0.4, 1.2, 
4, 0.16, 4, 4, 0.5, 0.1, 1.4, 1.4, 4, 1, 3.25, 0.4), obk = c(1, 
0, 0, 0, 0, 0, 0, 0.5, 0, 0, 0, 4, 0.5, 0.1, 0, 0, 0, 0, 3.25, 
0), oem = c(0, 0.3, 0.2, 0.35, 0.7, 0.5, 0.4, 0.7, 4, 0.16, 4, 
0, 0, 0, 1.4, 1.4, 4, 1, 0, 0.4), r = c(35, 63, 63, 63, 63, 63, 
60, 60, 3, 55, 25, 12, 34, 0, 5, 4, 60, 60, 60, 35), type = structure(c(1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 2L), .Label = c("loan", "deposit"), class = "factor"), 
    term = structure(c(2L, 4L, 4L, 4L, 4L, 4L, 3L, 3L, 9L, 4L, 
    2L, 3L, 3L, 3L, 3L, 2L, 4L, 5L, 2L, 5L), .Label = c("overdraft", 
    "<1d", "2-7d", "8-30d", "31-90d", "91-180d", "0.5-1y", "1-3y", 
    ">3y", "demand"), class = "factor"), reported = structure(c(10561, 
    10561, 10561, 10561, 10561, 10561, 10561, 10561, 10531, 10561, 
    10561, 10561, 10470, 10500, 10531, 10561, 10531, 10561, 10561, 
    10561), class = "Date"), issued = structure(c(10542, 10543.5, 
    10550, 10556.5, 10553.5, 10555.5, 10558, 10558, 10515, 10557.5, 
    10560, 10555, 10465, 10488, 10527, 10560, 10515.5, 10545.5, 
    10541, 10544), class = "Date"), issued_radius = c(0, 10.5, 
    10, 3.5, 6.5, 4.5, 2, 2, 15, 2.5, 0, 2, 2, 2, 2, 0, 10.5, 
    14.5, 0, 13), due = structure(c(10543, 10563, 10570, 10583, 
    10577, 10581, 10563, 10563, 11966, 10585, 10561, 10560, 10470, 
    10493, 10532, 10561, 10535, 10611, 10542, 10589), class = "Date"), 
    month = c(4, 4, 4, 4, 4, 4, 4, 4, 3, 4, 4, 4, 1, 2, 3, 4, 
    3, 4, 4, 4), week = c(14, 14, 15, 16, 16, 16, 17, 17, 10, 
    16, 17, 16, 3, 7, 12, 17, 10, 15, 14, 15)), .Names = c("time", 
"bal", "lender", "borrower", "obm", "obd", "obk", "oem", "r", 
"type", "term", "reported", "issued", "issued_radius", "due", 
"month", "week"), class = c("data.table", "data.frame"), row.names = c(NA, 
-20L), .internal.selfref = <pointer: 0x2960818>) 

세 개의 열이 있지만,이 루프의 성능에 영향을 미칠 수 있기 때문에 나는 모든 열을 포함했다.

모든 행은 내가 매주 해상도와 에 대한 발행 Date을 추정 할 대출을 의미합니다. 이 발급일은 [issued - issued_radius, issued + issued_radius] 사이에 있습니다. 이 간격은 1 일 또는 수 주일 (최대 1 개월 또는 최대 5 주) 일 수 있습니다. 코드는이 간격을 생성하고 간격 띄우기 날짜로부터 몇 주가 간격에 포함되는지 계산합니다. 각 주에는 겹침과 일치하는 가중치가 지정됩니다. 예를 들어, 간격에서 파생 된 17 주와 18 주에 발행 될 수있는 clean의 대출 중 하나가 patch에서 두 개의 대출로 확장되고 대출 금액 (열 oem, obd 등)이이 가중치로 조정됩니다.

library(data.table) 

START_DATE = as.Date("1998-8-1") 

elapsed_weeks <- function(t, start_date) { 
    as.numeric(floor(difftime(t, start_date, units="weeks"))) 
} 

#load("clean.Rda") 

# One-day intervals can be added to our result immediately 
patch = clean[issued_radius==0] 
clean = clean[issued_radius!=0] 

N = nrow(clean) 
write_index = nrow(patch)+1 

# Allocate space in patch. 
dummy = data.table(time = rep(0, N*5)) 
patch = rbindlist(list(patch, dummy), use.names = TRUE, fill= TRUE) 

for (k in 1:N) { 
    entry = clean[k] 

    # Recover Date interval [i, j]. 
    i = entry$issued - entry$issued_radius 
    j = entry$issued + entry$issued_radius 

    # Generate sequence of days in the interval and 
    # map each day to a weeknumber, counting the frequencies. 
    x = seq.Date(i, j, by="day") 
    T = table(elapsed_weeks(x, START_DATE)) 

    for (name in names(T)) { # can this be vectorized? 
    week_number = as.numeric(name) 
    week_weight = as.numeric(T[name])/length(x) 

    new_entry = entry 

    new_entry$week = week_number 
    new_entry$obm = entry$obm * week_weight 
    new_entry$obd = entry$obd * week_weight 
    new_entry$obk = entry$obk * week_weight 
    new_entry$oem = entry$oem * week_weight 

    patch[write_index] = new_entry 

    write_index = write_index + 1 
    } 
} 

# Delete unused allocated rows. 
patch = patch[!is.na(type)] 

print(nrow(patch)/nrow(clean)) # < 5 

편집 2 : 다른 예를 들어서. 이 대출

> clean[2] 
    time bal lender borrower obm obd obk oem r type term reported  issued issued_radius  due 
1: 4 32004 2547  2285 0 0.3 0 0.3 63 loan 8-30d 1998-12-01 1998-11-13   10.5 1998-12-03 
    month week 
1:  4 14 

, 그것은 [1998-11-24, 1998-11-3]의 모든 일에 발행 할 수있다. 이 간격의 모든 날이 START_DATE에서 오프셋 주 수에 매핑 :

> x 
[1] "1998-11-03" "1998-11-04" "1998-11-05" "1998-11-06" "1998-11-07" "1998-11-08" "1998-11-09" "1998-11-10" 
[9] "1998-11-11" "1998-11-12" "1998-11-13" "1998-11-14" "1998-11-15" "1998-11-16" "1998-11-17" "1998-11-18" 
[17] "1998-11-19" "1998-11-20" "1998-11-21" "1998-11-22" "1998-11-23" "1998-11-24" 
> elapsed_weeks(x, START_DATE) 
[1] 13 13 13 13 14 14 14 14 14 14 14 15 15 15 15 15 15 15 16 16 16 16 

이제 우리는 대출에 대한 발행 가능한 각 주에 무게를 추론 할 주파수 테이블을 확인합니다.

> table(elapsed_weeks(x, START_DATE)) 

13 14 15 16 
4 7 7 4 

그래서이 대출은 week 열 {13, 14, 15, 16}와 대출로 확장 될 것입니다. 이 대출 금액은 가능한 주간 오프셋 집합의 빈도로 조정됩니다.

> patch 
    time bal lender borrower obm  obd obk  oem r type term reported  issued 
1: 4 32004 2547  2285 0 0.05454545 0 0.05454545 63 loan 8-30d 1998-12-01 1998-11-13 
2: 4 32004 2547  2285 0 0.09545455 0 0.09545455 63 loan 8-30d 1998-12-01 1998-11-13 
3: 4 32004 2547  2285 0 0.09545455 0 0.09545455 63 loan 8-30d 1998-12-01 1998-11-13 
4: 4 32004 2547  2285 0 0.05454545 0 0.05454545 63 loan 8-30d 1998-12-01 1998-11-13 
    issued_radius  due month week 
1:   10.5 1998-12-03  4 13 
2:   10.5 1998-12-03  4 14 
3:   10.5 1998-12-03  4 15 
4:   10.5 1998-12-03  4 16 

내가 이미 @ 데이비드 (How to speed up rbind?)에 일부 최적화 감사를했지만 결과는 여전히 매우 느립니다 :

> table(elapsed_weeks(x, START_DATE))/length(x) 

     13  14  15  16 
0.1818182 0.3181818 0.3181818 0.1818182 

따라서 우리는이처럼 보이는 patch와 끝까지. 야간 계산을 10 시간 수행 한 후 clean 데이터 테이블의 4 %를 처리했습니다.

그래서 내 질문는 다음과 같습니다. 어떻게이 루프를 대형 data.table로 스케일 할 수 있습니까?

감사합니다.

편집 : R 버전 3.3.1 (2016-06-21).

Answer 1

설명을 올바르게 이해했다면 data.table에서 중복 조인을 사용해야합니다.

#define start and end dates, 
#fractional days could be an issue here, but I have not checked that further 
DT[, c("start", "end") := .(issued - issued_radius, issued + issued_radius)] 
#create an ID 
DT[, id := .I] 

#create a data.table with start of week and end of week for whole year 
weeks <- data.table(date = seq(as.Date("1998-01-01"), as.Date("1998-12-31"), by = "1 day")) 
weeks[, week := week(date)] 
weeks <- weeks[, .(start = min(date), end = max(date)), by = week] 
setkey(weeks, start, end) 

#now an overlaps join 
DT1 <- foverlaps(DT, weeks) 
#calculate number of days in each week, 
#special handling of last and first week of year might be necessary here 
DT1[, overlap := 7 - (i.start > start) * (i.start - start) - (i.end < end) * (end - i.end)] 
#calculate weights 
DT1[, weight := as.numeric(overlap)/sum(as.numeric(overlap)), by = id] 
#apply weights 
DT1[, c("obm_w", "obd_w", "obk_w", "oem_w") := lapply(.SD, function(x) x * DT1[["weight"]]), 
    .SDcols = c("obm", "obd", "obk", "oem")] 

필요에 따라 조정하고 필요에 따라 조정하십시오.