作者celestialgod (天)
看板R_Language
標題Re: [問題] 資料整理的問題
時間Wed Dec 7 18:36:31 2016
※ 引述《ppp1987 (ppp)》之銘言：
: [問題類型]:
: 程式諮詢(我想用R 做某件事情，但是我不知道要怎麼用R 寫出來)
: [軟體熟悉度]:
: 入門(寫過其他程式，只是對語法不熟悉)
: [問題敘述]:
: 資料形式
: ID Day X
: 1 1 0.5
: 1 3 0.1
: 1 4 0.3
: 1 7 0.5
: 1 9 0.5
: 1 11 0.2
: 1 14 0.5
: 2 1 0.1
: 2 2 0.4
: 2 5 0.8
: 2 9 0.7
: 2 11 0.1
: 2 13 0.2
: 現在我的資料每個ID(有100多個ID)每天有一筆觀測值（但不一定每天有）
: 我現在想要算每個ID當天的前七天有觀測值的平均
: 例如
: (ID=1,Day=9) Xhat=(0.5+0.3+0.1)/3
: (ID=2,Day=11) Xhat=(0.7+0.8)/2
: 現在已經用for迴圈跑出結果（但是很慢 2萬多筆約30分鐘）
: 想請教各位大大有沒有比較快的方法
: 謝謝
我後來想到好像其實不用這樣轉換
直接算其實會是最快的，用rollapply反而很慢
library(data.table)
library(pipeR)
DT <- fread('ID Day X
1 1 0.5
1 3 0.1
1 4 0.3
1 7 0.5
1 9 0.5
1 11 0.2
1 14 0.5
2 1 0.1
2 2 0.4
2 5 0.8
2 9 0.7
2 11 0.1
2 13 0.2')
mvAvg_f <- function(val, day, span = 7) {
sapply(day, function(y){
tmp <- day - y
mean(val[which(tmp < 0 & tmp >= -span)])
})
}
DT[ , x_mean := mvAvg_f(X, Day), by = .(ID)]
# ID Day X x_mean
# 1: 1 1 0.5 NaN
# 2: 1 3 0.1 0.5000000
# 3: 1 4 0.3 0.3000000
# 4: 1 7 0.5 0.3000000
# 5: 1 9 0.5 0.3000000
# 6: 1 11 0.2 0.4333333
# 7: 1 14 0.5 0.4000000
# 8: 2 1 0.1 NaN
# 9: 2 2 0.4 0.1000000
# 10: 2 5 0.8 0.2500000
# 11: 2 9 0.7 0.6000000
# 12: 2 11 0.1 0.7500000
# 13: 2 13 0.2 0.4000000
benchmark:
http://pastebin.com/Msib1dEh
Unit: milliseconds
expr min lq mean median uq max neval
me_1 4630.6863 4675.9866 4760.6722 4724.280 4873.9444 4902.0621 10
cywhale 3923.2040 3946.4697 3980.4697 3964.108 4030.4913 4063.7901 10
me_2 301.1468 307.6433 313.9698 309.936 314.3256 349.7625 10
me_1是用melt.data.table + rollapply的程式
me_2是這個方法，只需要0.3秒就可以算完了
根本不需要去用CJ 或是 melt.data.table 再配上rollapply去處理
直接算是最簡單省事的，想複雜反而增加運算複雜度
QQ... 這也教了我一課
12/07 18:55補充：
可以直接簡化成下面這樣：
DT[ , x_mean := sapply(Day, function(s) mean(X[between(Day, s-7, s-1)])),
by = .(ID)]
但是會比較慢，請看benchmark... 我也不懂why
12/07 19:07補充：
between效果不彰，如果換成下面這樣就會很快了
DT[ , x_mean := sapply(Day, function(s) mean(X[Day >= s-7 & Day < s])),
by = .(ID)]
請看benchmark，三萬列只要0.15秒就搞定了
--
R資料整理套件系列文：
magrittr #1LhSWhpH (R_Language) https://goo.gl/72l1m9
data.table #1LhW7Tvj (R_Language) https://goo.gl/PZa6Ue
dplyr(上.下) #1LhpJCfB,#1Lhw8b-s (R_Language) https://goo.gl/I5xX9b
tidyr #1Liqls1R (R_Language) https://goo.gl/i7yzAz
pipeR #1NXESRm5 (R_Language) https://goo.gl/zRUISx
--
※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 111.246.24.125
※ 文章網址: https://webptt.com/m.aspx?n=bbs/R_Language/M.1481106994.A.8CD.html
※ 編輯: celestialgod (111.246.24.125), 12/07/2016 19:10:37
1F：推 cywhale: 本來也想day-7這種方式但沒試出來，沒想到sapply~so good 12/07 19:47