推 Edster: 改好了，在原文s 02/09 21:49
※ 引述《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