R 基于日期时间差或窗口的子集数据

我有一个带有日期时间戳的位置数据。这些地点本应定期收集，但并不总是这样。我需要提取时间窗口内的位置。例如，相隔12小时的地点。如果我从位置1的日期时间开始，找到12小时后的下一个位置。如果没有一个精确的12小时，则下一个最接近新指定时间的时间。然后在12小时内找到下一个位置。我必须为每个唯一的ID执行此操作

COLLAR_ID                    dt
2159    2006-01-27 13:02:55
2159    2006-01-27 14:01:12
2159    2006-01-27 15:01:04
2159    2006-01-27 16:01:09

是数据的样子，这里是一个简短的数据子集，您可以剪切和粘贴。注意，它都是相同的ID，我有5个不同的ID，具有不同的开始日期/时间

structure(list(COLLAR_ID = c(2159L, 2159L, 2159L, 2159L, 2159L, 
2159L, 2159L, 2159L, 2159L, 2159L, 2159L, 2159L, 2159L, 2159L, 
2159L, 2159L, 2159L, 2159L, 2159L, 2159L), dt = structure(c(1138366975, 
1138370472, 1138374064, 1138377669, 1138381264, 1138384873, 1138388503, 
1138399312, 1138402842, 1138406507, 1138413700, 1138417261, 1138420848, 
1138424444, 1138428071, 1138431695, 1138435287, 1138438938, 1138442428, 
1138446098), class = c("POSIXct", "POSIXt"), tzone = "GMT")), .Names = c("COLLAR_ID", 
"dt"), class = "data.frame", row.names = c(NA, 20L))

因此，我认为从示例数据来看，如果我的开始日期是2006-01-27 00:00:00，那么它应该记录的下一个位置是12:00:00-但是这个位置不存在，所以它应该记录13:02:55。但即便如此，这也超出了严格的1小时缓冲时间2分钟的范围

我曾想过将日期时间转换为朱利安十进制数，以便于使用，但我不知道如何做到这一点。将日期/时间四舍五入到几个小时是可以的，但有时在一个小时的时间间隔内会有2到3个位置，因此我需要从这1个位置中选择最接近原始开始的位置

因此，添加新的细节可能会让事情变得更加混乱——一些数据最初是每隔1小时收集一次的，然后在3周后改为12小时。但是，我不知道每个开关的设定时间。其他人从12小时开始，从00:00:00开始，但改为1小时间隔，几天后又改为12小时，但又不知道是在哪一个时间切换。所以，它可以从下午2点开始切换到12小时

我想看看，但看不出这是怎么回事。所以，这是我在下面的尝试，我已经从最初的问题帖子中更新了。它不起作用。我仍在努力…它的代码似乎仍然相当笨拙

 test2 = test2[order(test2$COLLAR_ID,test2$dt),]
test2$dt <- as.POSIXct(strptime((test2$dt), "%Y-%m-%d %H:%M:%S"), tz="GMT")
MinInterval = 12 #minimum time interval (in hours) between consecutive locations
row = 0           # Keeps track of row within alldata
Endtest2 = 2                  #keeps track of row within individual within all data
SubData1 = test2[1,]
IDNames = levels(as.factor(test2$COLLAR_ID))
test22 = data.frame()

for (n in 1:length(IDNames)){
  IndivData = test2[test2$COLLAR_ID==IDNames[n],]
  row = row+1               #Continues to track next row between individuals
  Endtest2 = 2               #restarts counting the rows for NEXT individual
  SubData1[row,]=IndivData[1,]

  while (Endtest2<nrow(IndivData) ){
    timediff = difftime(IndivData$dt[Endtest2],SubData1$dt[row],units = "hours")

    if (timediff>MinInterval){          #If time difference is greater than 47 hours then do
      row = row+1
      SubData1=rbind(SubData1,IndivData[Endtest2,])
      Endtest2 = Endtest2+1                
    } else{
      Endtest2 = Endtest2+1
    }
  } #end while loop

} #end loop through individuals
test22 =SubData1
} #end conditional to subset data

---

很抱歉，我很不好意思地说，我完全忘记了我很久以前使用过类似的代码，但从来没有得到任何解决方案。我已经放弃了所有的努力，但现在我用新的数据、更混乱的数据和新的需求重新审视它。脚本没有过滤出正确的数据。

使用您提供的数据集，我从您的结构中创建了一个名为temp的对象，这就是我想到的。此代码将为每个观察创建12小时戳记，最后在每个12小时窗口中拾取第一个观察，方法是在第一个观察完成后删除所有观察

# create an xts object, I just find them easier to work with
xts_object<-xts(temp$COLLAR_ID, order.by=temp$dt)

# extract time and floor to 12 hours
time<-temp$dt
time_numeric<-as.numeric(time)
# 43200 is the number of seconds in 12 hours
floored_time<-c(floor(time_numeric/43200)*43200)
floored_time<-as.POSIXct(floored_time, origin="1970-01-01 00:00:00")

# create a new xts object with the floored index
floored_xts_object<-xts(xts_object, order.by=floored_time)

# drop double time stamps, leaving just the first observation in those 12 hours
unique_xts_object<-make.index.unique(floored_xts_object, drop=T)

可以试试天花板或圆形。希望这有帮助

我已经添加了一些代码来选择唯一的12小时内具有最小时差的时间戳，保留原始时间戳，将具有最小时差的时间戳的POSIXct对象返回到您的12小时

# make floored times unique
unique_time<-unique(floored_time)

# use difftime in lapply to get time differences for each unique time to all time stamps
time_diffrences<-lapply(unique_time, difftime, time)
small<-lapply(time_diffrences, abs)
small<-as.data.frame(small)
names(small)<-NULL

# get back into an xts object of time differences
small<-xts(small, order.by=time)
# using apply on the xts object, find the minimum for each unique time, selecting with
# with which, and just extracting the index instead of the entire array
smallest<-index(small[arrayInd(which(as.array(small)%in% apply(small, 2, min), arr.ind=T), dim(small))[,1]])

这允许您从xts数据中选择这些时间戳

# select from your original xts_object those line
selected<-xts_object[smallest]

最好的， Ben

使用data.table中的漂亮滚动功能，您可以获得最接近午夜/中午的时间戳：

# Make data (hourly time stamps +- random noise with 30 min standard dev)

len <- 30  # Days
stamps <- seq(as.POSIXct("2013-12-01"), by="-1 hour", length.out=len*12) + rnorm(len*12, 0, 1800)
stamps.target <- seq(as.POSIXct("2013-12-01"), by="-12 hour", length.out=len)

# Use data table to join stamps.target (midnight/noon) to stamps (hourly w/ noise)

library(data.table)
dt.data <- data.table(stamps, closest.match=stamps, key="stamps")
dt.target <- data.table(stamps.target)
dt.data[dt.target, roll="nearest"]

#                    stamps       closest.match
#    1: 2013-12-01 00:00:00 2013-12-01 00:24:20
#    2: 2013-11-30 12:00:00 2013-11-30 11:57:10
#    3: 2013-11-30 00:00:00 2013-11-29 23:41:29
#    4: 2013-11-29 12:00:00 2013-11-29 11:39:32
#    5: 2013-11-29 00:00:00 2013-11-28 23:31:32
#   ....

编辑：具有多个套环的解决方案

虽然下面是一段相当多的代码，但大部分代码都在生成数据。实际工作实际上只是最后三行：

# Make data (hourly time stamps +- random noise with 30 min standard dev)

len <- 30  # number of 12 hour intervals
pets <- c("fido", "rosie", "felix")
start.date <- as.POSIXct("2013-12-01")

# Create random roughly 1 hour apart time stamps for
# our pets and store in data table.  

library(data.table)
stamps.data <- 
  do.call(
    rbind,
    lapply(
      pets,
      function(x) {
        data.table(
          pet=rep(x, len * 12), 
          stamp.join=seq(
            start.date, 
            by="-1 hour", 
            length.out=len*12
          ) + rnorm(len*12, 0, 1800)
  ) } ) )
# The above looks complicated, but just creates our
# data, a 3 column data table with roughly hourly time
# stamps for each pet: 
#         pet          stamp.join
#    1: rosie 2013-11-16 01:16:32
#    2:  fido 2013-11-16 01:24:28
#    3: felix 2013-11-16 01:24:40
#    4:  fido 2013-11-16 01:50:54
#    5: rosie 2013-11-16 02:33:49
#   ---                          
# 1076: felix 2013-11-30 22:50:22
# 1077: rosie 2013-11-30 23:10:52
# 1078: felix 2013-11-30 23:52:32
# 1079:  fido 2013-12-01 00:24:01
# 1080: rosie 2013-12-01 00:34:36   

# Now add a copy of stamp.join to the data table; necessary
# because we will lose the stamp.join column in the join

stamps.data[, closest.match:=stamp.join]

# Now, for each pet, create a data.table with the target
# times (CJ does a cartesian join of our pets and our target
# times vectors and returns a data table, this is necessary
# because we are doing a rolling join, if it was an exact
# join we wouldn't need to CJ with pets, could just use
# target stamps)

stamps.target <- CJ(pets, seq(as.POSIXct("2013-12-01"), by="-12 hour", length.out=len))
setkey(stamps.data, pet, stamp.join)  # join on pet and stamp.join

# Use data table to join stamps.target (midnight/noon) to stamps (hourly w/ noise)

stamps.data[stamps.target, roll="nearest"][order(stamp.join)]

#       pet          stamp.join       closest.match
#  1: felix 2013-11-16 12:00:00 2013-11-16 12:03:31
#  2:  fido 2013-11-16 12:00:00 2013-11-16 12:20:55
#  3: rosie 2013-11-16 12:00:00 2013-11-16 11:36:37
#  4: felix 2013-11-17 00:00:00 2013-11-17 00:01:48
#  5:  fido 2013-11-17 00:00:00 2013-11-17 00:12:11
#  6: rosie 2013-11-17 00:00:00 2013-11-16 23:47:56
#  ----

---

非常好的特性滚动，您刚刚简化了我的一半代码，我一直在尝试让它工作，但问题是，在我的示例中，我使用00:00:作为原始目标，好像我实际上知道目标时间一样。每个人的目标时间是不同的，并且会发生变化。我将尝试在示例中进行解释。@BrodieG您能告诉我如何将独特的个体合并到您的代码中吗？我认为你的代码是可行的，但它没有考虑到有多个人有相同的日期-它仍然只需要最接近的时间。我试过了：dt。test@BrodieG还有一件事，我不太明白为什么我需要最接近的.match=stamps列。那是怎么用的？它似乎只是复制了数据。@Kerry，看看更新的答案。by修改不起作用，因为by只影响结果的聚合，而不影响表之间的连接。此外，还需要添加最近的.match列，因为原始stamps列在联接中丢失。通常这不是问题，因为您仍然有外部表列，并且在联接中，它通常与刚才丢失的列相同，但由于我们使用滚动联接，它们实际上不相同，因此您需要额外的副本，以便在联接后查看。答案对您有用吗？看来是的。如果是，请将其标记为已回答。