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