次のデータを見てみましょう。
dt <- data.table(TICKER=c(rep("ABC",10),"DEF"),
PERIOD=c(rep(as.Date("2010-12-31"),10),as.Date("2011-12-31")),
DATE=as.Date(c("2010-01-05","2010-01-07","2010-01-08","2010-01-09","2010-01-10","2010-01-11","2010-01-13","2010-04-01","2010-04-02","2010-08-03","2011-02-05")),
ID=c(1,2,1,3,1,2,1,1,2,2,1),VALUE=c(1.5,1.3,1.4,1.6,1.4,1.2,1.5,1.7,1.8,1.7,2.3))
setkey(dt,TICKER,PERIOD,ID,DATE)
ティッカー/ピリオドの組み合わせごとに、新しい列に次のものが必要です。
PRIORAVG
:現在のIDを除く、各IDの最新のVALUEの平均。ただし、180日以内である必要があります。PREV
:同じIDからの前の値。結果は次のようになります。
TICKER PERIOD DATE ID VALUE PRIORAVG PREV
[1,] ABC 2010-12-31 2010-01-05 1 1.5 NA NA
[2,] ABC 2010-12-31 2010-01-08 1 1.4 1.30 1.5
[3,] ABC 2010-12-31 2010-01-10 1 1.4 1.45 1.4
[4,] ABC 2010-12-31 2010-01-13 1 1.5 1.40 1.4
[5,] ABC 2010-12-31 2010-04-01 1 1.7 1.40 1.5
[6,] ABC 2010-12-31 2010-01-07 2 1.3 1.50 NA
[7,] ABC 2010-12-31 2010-01-11 2 1.2 1.50 1.3
[8,] ABC 2010-12-31 2010-04-02 2 1.8 1.65 1.2
[9,] ABC 2010-12-31 2010-08-03 2 1.7 1.70 1.8
[10,] ABC 2010-12-31 2010-01-09 3 1.6 1.35 NA
[11,] DEF 2011-12-31 2011-02-05 1 2.3 NA NA
行9のPRIORAVG
は1.7に等しいことに注意してください(これは、行5のVALUE
に等しいです。これは、別のID
による過去180日間の唯一の以前の観測です。 )
data.table
パッケージを発見しましたが、:=
関数を完全に理解していないようです。シンプルにするとうまくいくようです。各IDの以前の値を取得するには(私はこれを この質問 の解決策に基づいています):
dt[,PREV:=dt[J(TICKER,PERIOD,ID,DATE-1),roll=TRUE,mult="last"][,VALUE]]
これはうまく機能し、約25万行のデータセットに対してこの操作を実行するのに0.13秒しかかかりません。私のベクトルスキャン関数は同じ結果を取得しますが、約30,000倍遅くなります。
さて、最初の要件があります。 2番目のより複雑な要件に取り掛かりましょう。今のところ、私にとってこれまでの断食方法は、いくつかのベクトルスキャンを使用し、関数をplyr
関数adply
にスローして、各行の結果を取得することです。
calc <- function(df,ticker,period,id,date) {
df <- df[df$TICKER == ticker & df$PERIOD == period
& df$ID != id & df$DATE < date & df$DATE > date-180, ]
df <- df[order(df$DATE),]
mean(df[!duplicated(df$ID, fromLast = TRUE),"VALUE"])
}
df <- data.frame(dt)
adply(df,1,function(x) calc(df,x$TICKER,x$PERIOD,x$ID,x$DATE))
data.frame
の関数を作成しましたが、data.table
では機能しないようです。 5000行のサブセットの場合、これには約44秒かかりますが、私のデータは100万行を超えています。 :=
を使用することで、これをより効率的にすることができるのだろうか。
dt[J("ABC"),last(VALUE),by=ID][,mean(V1)]
これは、ABCの各IDの最新の値の平均を選択するために機能します。
dt[,PRIORAVG:=dt[J(TICKER,PERIOD),last(VALUE),by=ID][,mean(V1)]]
ただし、これは、現在のティッカー/期間だけでなく、すべてのティッカー/期間の最後のすべての値の平均を取るため、期待どおりに機能しません。したがって、すべての行が同じ平均値を取得することになります。私は何か間違ったことをしていますか、それともこれは:=
の制限ですか?
素晴らしい質問です。これを試して :
_dt
TICKER PERIOD DATE ID VALUE
[1,] ABC 2010-12-31 2010-01-05 1 1.5
[2,] ABC 2010-12-31 2010-01-08 1 1.4
[3,] ABC 2010-12-31 2010-01-10 1 1.4
[4,] ABC 2010-12-31 2010-01-13 1 1.5
[5,] ABC 2010-12-31 2010-01-07 2 1.3
[6,] ABC 2010-12-31 2010-01-11 2 1.2
[7,] ABC 2010-12-31 2010-01-09 3 1.6
[8,] DEF 2011-12-31 2011-02-05 1 2.3
ids = unique(dt$ID)
dt[,PRIORAVG:=NA_real_]
for (i in 1:nrow(dt))
dt[i,PRIORAVG:=dt[J(TICKER[i],PERIOD[i],setdiff(ids,ID[i]),DATE[i]),
mean(VALUE,na.rm=TRUE),roll=TRUE,mult="last"]]
dt
TICKER PERIOD DATE ID VALUE PRIORAVG
[1,] ABC 2010-12-31 2010-01-05 1 1.5 NA
[2,] ABC 2010-12-31 2010-01-08 1 1.4 1.30
[3,] ABC 2010-12-31 2010-01-10 1 1.4 1.45
[4,] ABC 2010-12-31 2010-01-13 1 1.5 1.40
[5,] ABC 2010-12-31 2010-01-07 2 1.3 1.50
[6,] ABC 2010-12-31 2010-01-11 2 1.2 1.50
[7,] ABC 2010-12-31 2010-01-09 3 1.6 1.35
[8,] DEF 2011-12-31 2011-02-05 1 2.3 NA
_
次に、少し単純化してすでに持っていたもの...
_dt[,PREV:=dt[J(TICKER,PERIOD,ID,DATE-1),VALUE,roll=TRUE,mult="last"]]
TICKER PERIOD DATE ID VALUE PRIORAVG PREV
[1,] ABC 2010-12-31 2010-01-05 1 1.5 NA NA
[2,] ABC 2010-12-31 2010-01-08 1 1.4 1.30 1.5
[3,] ABC 2010-12-31 2010-01-10 1 1.4 1.45 1.4
[4,] ABC 2010-12-31 2010-01-13 1 1.5 1.40 1.4
[5,] ABC 2010-12-31 2010-01-07 2 1.3 1.50 NA
[6,] ABC 2010-12-31 2010-01-11 2 1.2 1.50 1.3
[7,] ABC 2010-12-31 2010-01-09 3 1.6 1.35 NA
[8,] DEF 2011-12-31 2011-02-05 1 2.3 NA NA
_
これがプロトタイプとして問題ない場合、速度を大幅に向上させるには、ループを維持しますが、オーバーヘッドを減らすために、_:=
_の代わりにset()
を使用します。
_for (i in 1:nrow(dt))
set(dt,i,6L,dt[J(TICKER[i],PERIOD[i],setdiff(ids,ID[i]),DATE[i]),
mean(VALUE,na.rm=TRUE),roll=TRUE,mult="last"])
dt
TICKER PERIOD DATE ID VALUE PRIORAVG PREV
[1,] ABC 2010-12-31 2010-01-05 1 1.5 NA NA
[2,] ABC 2010-12-31 2010-01-08 1 1.4 1.30 1.5
[3,] ABC 2010-12-31 2010-01-10 1 1.4 1.45 1.4
[4,] ABC 2010-12-31 2010-01-13 1 1.5 1.40 1.4
[5,] ABC 2010-12-31 2010-01-07 2 1.3 1.50 NA
[6,] ABC 2010-12-31 2010-01-11 2 1.2 1.50 1.3
[7,] ABC 2010-12-31 2010-01-09 3 1.6 1.35 NA
[8,] DEF 2011-12-31 2011-02-05 1 2.3 NA NA
_
これは、質問に示されている繰り返しのベクトルスキャンよりもはるかに高速であるはずです。
または、操作をベクトル化することもできます。ただし、このタスクの機能により、書き込みと読み取りは簡単ではありません。
ところで、180日の要件をテストする質問のデータはありません。いくつか追加して期待される出力を再度表示する場合は、コメントで述べた結合継承スコープを使用した年齢の計算を追加します。
data.table
の新しいバージョンを使用する別の可能なアプローチ:
library(data.table) #data.table_1.12.6 as of Nov 20, 2019
cols <- copy(names(DT))
DT[, c("MIN_DATE", "MAX_DATE") := .(DATE - 180L, DATE)]
DT[, PRIORAVG :=
.SD[.SD, on=.(TICKER, PERIOD, DATE>=MIN_DATE, DATE<=MAX_DATE),
by=.EACHI, {
subdat <- .SD[x.ID!=i.ID]
pavg <- if (subdat[, .N > 0L])
mean(subdat[, last(VALUE), ID]$V1, na.rm=TRUE)
else
NA_real_
c(setNames(mget(paste0("i.", cols)), cols), .(PRIORAVG=pavg))
}]$PRIORAVG
]
DT[, PREV := shift(VALUE), .(TICKER, PERIOD, ID)]
出力:
TICKER PERIOD DATE ID VALUE MIN_DATE MAX_DATE PRIORAVG PREV
1: ABC 2010-12-31 2010-01-05 1 1.5 2009-07-09 2010-01-05 NA NA
2: ABC 2010-12-31 2010-01-08 1 1.4 2009-07-12 2010-01-08 1.30 1.5
3: ABC 2010-12-31 2010-01-10 1 1.4 2009-07-14 2010-01-10 1.45 1.4
4: ABC 2010-12-31 2010-01-13 1 1.5 2009-07-17 2010-01-13 1.40 1.4
5: ABC 2010-12-31 2010-04-01 1 1.7 2009-10-03 2010-04-01 1.40 1.5
6: ABC 2010-12-31 2010-01-07 2 1.3 2009-07-11 2010-01-07 1.50 NA
7: ABC 2010-12-31 2010-01-11 2 1.2 2009-07-15 2010-01-11 1.50 1.3
8: ABC 2010-12-31 2010-04-02 2 1.8 2009-10-04 2010-04-02 1.65 1.2
9: ABC 2010-12-31 2010-08-03 2 1.7 2010-02-04 2010-08-03 1.70 1.8
10: ABC 2010-12-31 2010-01-09 3 1.6 2009-07-13 2010-01-09 1.35 NA
11: DEF 2011-12-31 2011-02-05 1 2.3 2010-08-09 2011-02-05 NA NA