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

[Edster (Edster)]

想了一陣子，覺得還是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
→ celestialgod: 這樣的壞處是每一個個體都要跑一個CriInterval?
→ celestialgod: 如果我個體數超多，應該會超久QQ
→ anakinyen: 問題已解決，沒用到這個方法，還是多謝了
※ 編輯: Edster (140.112.64.48), 02/09/2017 17:38:43
→ celestialgod: 結果怪怪的，已回文
※ 編輯: Edster (140.112.64.48), 02/09/2017 21:48:44
※ 編輯: Edster (140.112.64.48), 02/09/2017 21:51:28