作者Edster (Edster)
看板R_Language
标题Re: [问题] 以时间间隔为条件，抽取资料
时间Wed Feb 8 18:55:39 2017
想了一阵子，觉得还是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://webptt.com/cn.aspx?n=bbs/R_Language/M.1486551342.A.2DB.html
※ 编辑: Edster (140.112.4.209), 02/08/2017 19:07:23
1F：→ celestialgod: 这样的坏处是每一个个体都要跑一个CriInterval? 02/08 19:41
2F：→ celestialgod: 如果我个体数超多，应该会超久QQ 02/08 19:41
3F：→ anakinyen: 问题已解决，没用到这个方法，还是多谢了 02/08 23:47
※ 编辑: Edster (140.112.64.48), 02/09/2017 17:38:43
4F：→ celestialgod: 结果怪怪的，已回文 02/09 20:05
※ 编辑: Edster (140.112.64.48), 02/09/2017 21:48:44
※ 编辑: Edster (140.112.64.48), 02/09/2017 21:51:28