累積ルックバックローリング結合

Question

私は2つのデータテーブルを持っています。私はローリングジョイントをしたいのですが、 "カミング的なもの"です。 例えば、ここでは2つのテーブル今

d1 <- data.table(starttime = c("2011-01-01 15:29:50", "2011-01-01 15:30:03", "2011-01-01 15:40:20", "2011-01-01 15:50:20" ,"2011-01-01 16:30:00", "2011-01-01 16:40:00"), 
       endtime = c("2011-01-01 15:30:00", "2011-01-01 15:30:15", "2011-01-01 15:40:28", "2011-01-01 15:50:25", "2011-01-01 16:31:00", "2011-01-01 16:41:00"), v = c("A", "B", "B", "A", "B", "A"), m = c(2,3,5,8,9,9), dur = c(10,12,8,5,60,11)) 

starttime    endtime   v m dur 
2011-01-01 15:29:50 2011-01-01 15:30:00 A 2 10 
2011-01-01 15:30:03 2011-01-01 15:30:15 B 3 12 
2011-01-01 15:40:20 2011-01-01 15:40:28 B 5  8 
2011-01-01 15:50:20 2011-01-01 15:50:25 A 8  5 
2011-01-01 16:30:00 2011-01-01 16:31:00 B 9 60 
2011-01-01 16:40:00 2011-01-01 16:41:00 A 9 11 

d2 <- data.table(time = c("2011-01-01 16:39:50", "2011-01-01 16:00:03", "2011-01-01 16:50:50"), 
          v = c("A", "B", "A"), mk = rnorm(3)) 

       time v   mk 
2011-01-01 16:00:03 B -0.2385093 
2011-01-01 16:39:50 A -0.4966836 
2011-01-01 16:50:50 A -0.4566836 

D2の最初の行のために、最初の行のD2 $時間から振り返ってみる考慮

があり、私はD1の行の同じD2ます$ Vまで与えられたmの合計を取得したいです期間の合計（endtime-starttime）> 15

15秒を超えて追加した行の数をカウントする方法もありますか？

ので、基本的に 私はこの

   time v  mk  m  rowsUsed 
2011-01-01 16:00:03 B -0.2385093 8   2 
2011-01-01 16:39:50 A -0.4966836 10   2 
2011-01-01 16:50:50 A -0.4566836 17   2 

に似て取得する必要のために誰もが、このようなローリングを構築することができるの参加方法を私を助けることができますか？私は速度が心配であるようにたくさんの行を持っています。 XTSで柔軟に対応しようとしています。

Answer 1

これを試してください。私はコメントを説明し、それが不明瞭であるか遅すぎるかを教えてください。

library(data.table) 
library(pbapply) 

d1 <- data.table(starttime = c("2011-01-01 15:29:50", "2011-01-01 15:30:03", "2011-01-01 15:40:20", "2011-01-01 15:50:20" ,"2011-01-01 16:30:00", "2011-01-01 16:40:00"), 
        endtime = c("2011-01-01 15:30:00", "2011-01-01 15:30:15", "2011-01-01 15:40:28", "2011-01-01 15:50:25", "2011-01-01 16:31:00", "2011-01-01 16:41:00"), v = c("A", "B", "B", "A", "B", "A"), m = c(2,3,5,8,9,9), dur = c(10,12,8,5,60,11)) 

d2 <- data.table(time = c("2011-01-01 16:39:50", "2011-01-01 16:00:03", "2011-01-01 16:50:50"), 
        v = c("A", "B", "A"), mk = rnorm(3)) 

d1$endtime <- as.POSIXct(d1$endtime) 
d2$time <- as.POSIXct(d2$time) 
d1 <- d1[order(d1$endtime,decreasing=TRUE),] # I want the more recent on top 

output_list <- pbapply(d2,1,function(row){ 
    sub_d1 <- subset(d1,endtime <= row["time"] & v == row["v"]) # keep only relevant rows timewise and with correct v 
    sub_d1$cumdur <- cumsum(sub_d1$dur) # sum the time to be able to limit ti be able to test this 15 sec limit 
    rowsUsed <- nrow(sub_d1) - nrow(subset(sub_d1,cumdur >= 15)) + 1 # check the number of rows I need 
    m <- sum(sub_d1$m[1:rowsUsed]) # sum the relevant m 
    return(list(m,rowsUsed)) # return as list 
    }) 

d2 <- cbind(d2, matrix(unlist(output_list),ncol=2,byrow=TRUE,dimnames = list(NULL,c("m","rowsUsed")))) 

# time v   mk m rowsUsed 
# 1: 2011-01-01 16:39:50 A -0.01884752 10  2 
# 2: 2011-01-01 16:00:03 B 0.08545874 8  2 
# 3: 2011-01-01 16:50:50 A 1.62738391 17  2 

Answer 2

私のバージョンです。しかし、あなたはこれを変更することができます。それが役に立つと分かったら教えてください。

library("lubridate") 
library("data.table") 

d1 <- data.table(starttime = parse_date_time(c("2011-01-01 15:29:50", "2011-01-01 15:30:03", "2011-01-01 15:40:20", "2011-01-01 15:50:20" ,"2011-01-01 16:30:00", "2011-01-01 16:40:00"), orders="ymd HMS"), 
        endtime = parse_date_time(c("2011-01-01 15:30:00", "2011-01-01 15:30:15", "2011-01-01 15:40:28", "2011-01-01 15:50:25", "2011-01-01 16:31:00", "2011-01-01 16:41:00"), orders="ymd HMS"), v = c("A", "B", "B", "A", "B", "A"), m = c(2,3,5,8,9,9), dur = c(10,12,8,5,60,11)) 

d2 <- data.table(time = parse_date_time(c("2011-01-01 16:39:50", "2011-01-01 16:00:03", "2011-01-01 16:50:50"), orders="ymd HMS"), 
        v = c("A", "B", "A"), mk = rnorm(3)) 

get_m_rows <- function(value,timeValue,threshold){ 
    d3 <- d1[v==value] 
    d3 <- d3[order(endtime,decreasing = TRUE)] 
    d3[endtime<timeValue,totalTime:=cumsum(dur)] 
    eligibleRows <- d3[endtime<timeValue,.N] 
    ifelse(d3[totalTime<=threshold&!is.na(totalTime),.N]>0,rowIndex <- d3[,.I[totalTime<=threshold&!is.na(totalTime)]],rowIndex <- 0) 
    ifelse(rowIndex==0,rowIndex<-1,ifelse(length(rowIndex)<eligibleRows,rowIndex<-c(rowIndex,rowIndex[length(rowIndex)]+1),0)) 
    return(d3[rowIndex,.(m=sum(m),.N)]) 
} 

d2[,c("m","rowUsed"):=(get_m_rows(v,time,15)),by=.(v,time)] 

# time v   mk m rowUsed 
# 1: 2011-01-01 16:39:50 A -0.2025446 10  2 
# 2: 2011-01-01 16:00:03 B 1.2363660 8  2 
# 3: 2011-01-01 16:50:50 A 1.0222815 17  2