※ 引述《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://webptt.com/m.aspx?n=bbs/R_Language/M.1486641897.A.7A2.html ※ 編輯: celestialgod (111.246.24.51), 02/09/2017 20:05:23