Re: [問題] 以時間間隔為條件，抽取資料

看板R_Language作者Edster (Edster)時間8年前 (2017/02/08 18:55)推噓0(0推 0噓 4→)

留言4則, 2人參與討論串5/8 (看更多)

想了一陣子，覺得還是C版的 abs(difftime)>6 這個最漂亮。我沒做什麼動作，就改成一個老人看得懂的版本 library(magrittr) CriInterval = function(x, criteria){ names(x) = 1:length(x) i=1 while(i<length(x)){ j=1 while(x[i+j] - x[i] < criteria & i+j <= length(x)){ x[i+j]<-NA j=j+1 } i=i+j } return(names(na.omit(x))) } CriInterval2 = function(x, criteria){ i=1 j=1 while(!is.na(i[j]) & i[j]<length(x)){ i = c(i, match(FALSE,x[i[j]:length(x)]-x[i[j]] < criteria) + i[j]-1) j=j+1 } return(i) } TS = seq(ISOdatetime(2016,02,08,18,20,00), ISOdatetime(2017,02,08,18,20,00), "min") X=TS %>% sample(1e4) %>% sort %>% as.numeric() system.time(ci <- CriInterval(X,6*60*60)) system.time(ci <- CriInterval2(X,6*60*60)) match(FALSE,X-X[1]<6*60*60) %in% ci system.time(ci <- lapply(1:500, function(i) CriInterval(TS %>% sample(1e4) %>% sort %>% as.numeric(), criteria=6*60*60))) str(ci) user system elapsed 26.25 0.05 26.29 其實也沒有比較慢，我放了 500 * 10000 筆資料 ps: 其實一開始想的是match, 後來執行太慢，就放棄繼續，直到看到C版的寫法又覺得abs這動作有點多餘，然後沒有檢查，-.-。感謝幫忙抓錯 ※ 引述《celestialgod (天)》之銘言： : ※ 引述《anakinyen (我在台北天氣晴)》之銘言： : : [問題類型]: : : 程式諮詢(我想用R 做某件事情，但是我不知道要怎麼用R 寫出來) : : [軟體熟悉度]: : : 新手，只會套用package : : [問題敘述]: : : 我有一批動物研究的資料 : : 資料大致長這個樣子，共有12隻個體一萬多筆 : : 個體A 2012/10/11 20:00 實驗資料OOXX : : 個體A 2012/10/11 23:00 實驗資料OOXX : : 個體A 2012/10/12 03:00 實驗資料OOXX : : 個體B 2012/12/11 05:00 實驗資料OOXX : : 個體B 2012/12/11 11:05 實驗資料OOXX : : 個體B 2012/12/11 13:00 實驗資料OOXX : : 個體B 2012/12/11 18:00 實驗資料OOXX : : 個體B 2012/12/11 20:00 實驗資料OOXX : : 由於時間間隔過短的話，資料之間可能有相關性 : : 因此我現在想要設定6小時的閥值，間隔超過6小時的資料才會保留 : : 以上面資料為例 : : A個體保留第一、第三筆資料 : : B個體保留第一、第二、第四筆資料 : : 我的程度是新手，偶爾會拿一些package來套用 : : 請教是否有相關套件或現成code可以用在這個案例 : : 非常感謝~~ : 我用while + data.table做，若用data.frame會複製很多次，效率會不彰 : library(data.table) : # 產生資料 : numObs <- 50 : numInd <- 5 : DT <- data.table(ind = paste0("A", sample(numInd, numObs, TRUE)), : time = strptime("2012/12/11", "%Y/%m/%d") + : sample(86400, numObs, TRUE), : obs = rnorm(numObs)) : # 排序 : setorder(DT, ind, time, obs) : # 移除掉時間差小於六小時的 : k <- 1 : while ( TRUE ) { : # 計算時間差，以小時表示 : DT[ , diffTime := difftime(time, time[min(k, .N)], units="hours"), by = ind] : # 留下自己那一組 : set(DT, which(DT$diffTime == 0), which(names(DT) == "diffTime"), 1e6) : # 留下時間差超過六小時的 : DT <- DT[abs(diffTime) > 6, ] : # 下一組 : k <- k + 1 : # 如果k大於某組的觀測值數目就跳離迴圈 : if (k > max(DT[ , .(numObsGroup = .N), by = ind]$numObsGroup)) : break : } : DT[ , diffTime := NULL] : 五萬筆觀測值，一千個個體，耗時0.23秒 (平均一個個體50個觀測值) : 五十萬筆觀測值，一千個個體，耗時0.39秒 (平均一個個體500個觀測值) : 我覺得這個速度應該可以接受 : 不過我的區間只有24小時，所以可能都很快就篩選完了 : 有人可以試試看更長時間的表現 : 有問題或任何人有更好解法，歡迎提供，感謝 : Note: 間隔一百天，五十萬筆觀測值，一千個個體，耗時18.33秒 -- ※ 發信站: 批踢踢實業坊(ptt.cc), 來自: 140.112.4.209 ※ 文章網址: https://www.ptt.cc/bbs/R_Language/M.1486551342.A.2DB.html ※ 編輯: Edster (140.112.4.209), 02/08/2017 19:07:23