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

看板R_Language作者celestialgod (天)時間8年前 (2017/02/09 20:04)推噓1(1推 0噓 0→)

留言1則, 1人參與討論串7/8 (看更多)

※ 引述《Edster (Edster)》之銘言： : 想了一陣子，覺得還是C版的 abs(difftime)>6 這個最漂亮。 : 我沒做什麼動作，就改成一個老人看得懂的版本 : library(magrittr) : CriInterval = function(x, criteria){ : i=1 : names(x) = 1:length(x) : while(i <= length(x)){ : x = x[x[length(x)>i]-x[i]>criteria] : i=i+1 : } : return(as.integer(names(x))) : } : TS = seq(ISOdatetime(2005,02,08,18,20,00), : ISOdatetime(2017,02,08,18,20,00), "min") : system.time( : ci <- lapply(1:500, function(i) CriInterval(TS %>% sample(1e4) : %>% sort, criteria=6*60*60))) : ## speed test : user system elapsed : 29.77 0.19 30.11 : TS_sampled = TS[ci[[1]]] : 其實也沒有比較慢，我放了 500 * 10000 筆資料 library(magrittr) TS <- seq(ISOdatetime(2005,02,08,18,20,00), ISOdatetime(2017,02,08,18,20,00), "min") (x <- sort(sample(TS, 1e1, TRUE))) # [1] "2007-01-19 13:35:00 CST" "2008-09-03 01:13:00 CST" # [3] "2009-02-28 01:16:00 CST" "2010-07-28 11:02:00 CST" # [5] "2011-03-23 05:31:00 CST" "2011-12-03 10:35:00 CST" # [7] "2013-03-17 12:21:00 CST" "2013-11-09 19:40:00 CST" # [9] "2015-03-31 16:01:00 CST" "2015-04-11 14:39:00 CST" 如果條件是間隔6小時，照理來說應該要全部都留下，也就是E大的函數回傳的是1:10 CriInterval(x, 6*60*60) # integer(0) 但是回傳是空向量，我細看了一下函數 x = x[x[length(x)>i]-x[i]>criteria] 這行讓我覺得滿疑惑的 length(x) > i 這樣應該全部都會留下，這是第一個問題這樣就會發生自己減自己 = 0的情況出現，然後第一筆就被刪掉了照理來說，第一筆一定會留下... 如果改成1:length(x)或seq_along(x)，則會出現邏輯值判斷只有N-i的情況出現，這樣也是有問題的這裡可能要再細想一下怎麼改才對第二個問題是時間減法，單位不會一定是秒 Ex: ISOdatetime(2005,02,08,18,20,00) - ISOdatetime(2005,02,07,11,20,00) # Time difference of 1.291667 days ISOdatetime(2005,02,08,18,20,00) - ISOdatetime(2005,02,08,11,20,00) # Time difference of 7 hours ISOdatetime(2005,02,08,18,20,00) - ISOdatetime(2005,02,08,18,19,00) # Time difference of 1 mins ISOdatetime(2005,02,08,18,20,00) - ISOdatetime(2005,02,08,18,19,55) # Time difference of 5 secs 這裡真的要很小心處理時間減法，務必要使用difftime + units參數控制 Ex: difftime(ISOdatetime(2005,02,08,18,20,00), ISOdatetime(2005,02,08,18,19,00), units = "secs") # Time difference of 60 secs : ※ 引述《celestialgod (天)》之銘言： : : 我用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), 來自: 111.246.24.51 ※ 文章網址: https://www.ptt.cc/bbs/R_Language/M.1486641897.A.7A2.html ※ 編輯: celestialgod (111.246.24.51), 02/09/2017 20:05:23