如何按行中的时间间隔对时间序列进行子集化和提取

时间:2015-04-27 19:08:44

标签: r time-series lubridate

我正在对动物位置进行分析,要求每只动物的位置相隔60分钟或更长时间。动物之间位置的时间差异无关紧要。数据集包含动物ID列表以及每个位置的日期和时间,如下所示。

例如,对于下面的动物6,从16:19位置开始,代码将遍历位置,直到找到距离16:19 60分钟的位置。在这种情况下,它将是17:36的位置。然后,代码将从17:36位置开始查找下一个位置(18:52)60+分钟,依此类推。然后,彼此相距60分钟以上的每个位置将被提取到单独的数据帧中。

我在R中编写了一个循环来对数据进行子集化,但是在计算位置是否为60分钟或更长时间时,代码中没有考虑日期变化的问题。

我一直在探索lubridate包,看起来它可能有一种更简单的方法来解决我的数据子集。但是,我还没有找到使用此软件包将数据子集化到我的规范的解决方案。任何有关使用润滑剂或替代方法的建议都将不胜感激。

提前感谢您的考虑。

>data(locdata);
>view(locdata);
id  date    time
6   30-Jun-09   16:19
6   30-Jun-09   16:31
6   30-Jun-09   17:36
6   30-Jun-09   17:45
6   30-Jun-09   18:00
6   30-Jun-09   18:52
6   7-Aug-10    5:30
6   7-Aug-10    5:45
6   7-Aug-10    6:00
6   7-Aug-10    6:45
23  30-Jun-09   17:15
23  30-Jun-09   17:38
23  30-Jun-09   17:56
23  30-Jun-09   20:00
23  30-Jun-09   22:19
23  18-Jul-11   16:22
23  18-Jul-11   17:50
23  18-Jul-11   18:15

上面示例数据的输出如下所示:

id  date    time
6   30-Jun-09   16:19
6   30-Jun-09   17:36
6   30-Jun-09   18:52
6   7-Aug-10    5:30
6   7-Aug-10    6:45
23  30-Jun-09   17:15
23  30-Jun-09   20:00
23  30-Jun-09   22:19
23  18-Jul-11   16:22
23  18-Jul-11   17:50

2 个答案:

答案 0 :(得分:2)

如果我理解正确,我认为你正在寻找这些方面的东西:

library(dplyr)
library(lubridate)

locdata %>% 
    mutate(timestamp = dmy_hm(paste(date, time))) %>%
    group_by(id, date) %>%
    mutate(delta = timestamp - lag(timestamp))

如果您之前未使用过dplyrmagrittr,则上述语法可能不清楚。 %>%运算符将每个计算的结果传递给下一个函数,因此上面的代码执行以下操作:

  1. 使用lubridate
  2. 将日期和时间解析为R理解的时间戳
  3. id和唯一date s
  4. 对数据进行分组
  5. 在每组中,计算观察之间的持续时间
  6. 如果要保存输出,请将第一行更改为results <- locdata %>%

    根据您更新的问题和修订数据,我相信这有效:

    locdata %>% 
        mutate(timestamp = dmy_hm(paste(date, time))) %>%
        group_by(id, date) %>%
        mutate(delta = timestamp - first(timestamp),
               steps = as.numeric(floor(delta / 3600)), 
               change = ifelse(is.na(steps - lag(steps)), 1, steps - lag(steps))) %>%
        filter(change > 0) %>%
        select(id, date, timestamp)
    

    输出:

    Source: local data frame [10 x 3]
    Groups: id, date
    
       id      date           timestamp
    1   6 30-Jun-09 2009-06-30 16:19:00
    2   6 30-Jun-09 2009-06-30 17:36:00
    3   6 30-Jun-09 2009-06-30 18:52:00
    4   6  7-Aug-10 2010-08-07 05:30:00
    5   6  7-Aug-10 2010-08-07 06:45:00
    6  23 30-Jun-09 2009-06-30 17:15:00
    7  23 30-Jun-09 2009-06-30 20:00:00
    8  23 30-Jun-09 2009-06-30 22:19:00
    9  23 18-Jul-11 2011-07-18 16:22:00
    10 23 18-Jul-11 2011-07-18 17:50:00
    

    工作原理:

    1. 像以前一样创建timestamp
    2. iddate
    3. 对数据进行分组
    4. 计算每组中第一个时间戳(即给定日期中一只动物的第一次观察)与该组中每个后续观察之间的增量(以秒为单位),将其存储在新列中delta
    5. 确定哪个观测值(如果有的话)距离第一个观测值超过3600秒,增量为3600秒;将其存储在新列steps
    6. 确定哪个观察结果是第一次观察中的一个或多个step(并保留第一个观察结果);将其存储在新列change
    7. 仅保留change为1或更多的观察结果 - 即观察距前一次观察一小时或同一小时的观察时间
    8. 仅保留感兴趣的列
    9. 为了熟悉它的工作原理,请从最后删除filterselect并检查输出:

      Source: local data frame [18 x 7]
      Groups: id, date
      
         id      date  time           timestamp      delta steps change
      1   6 30-Jun-09 16:19 2009-06-30 16:19:00     0 secs     0      1
      2   6 30-Jun-09 16:31 2009-06-30 16:31:00   720 secs     0      0
      3   6 30-Jun-09 17:36 2009-06-30 17:36:00  4620 secs     1      1
      4   6 30-Jun-09 17:45 2009-06-30 17:45:00  5160 secs     1      0
      5   6 30-Jun-09 18:00 2009-06-30 18:00:00  6060 secs     1      0
      6   6 30-Jun-09 18:52 2009-06-30 18:52:00  9180 secs     2      1
      7   6  7-Aug-10  5:30 2010-08-07 05:30:00     0 secs     0      1
      8   6  7-Aug-10  5:45 2010-08-07 05:45:00   900 secs     0      0
      9   6  7-Aug-10  6:00 2010-08-07 06:00:00  1800 secs     0      0
      10  6  7-Aug-10  6:45 2010-08-07 06:45:00  4500 secs     1      1
      11 23 30-Jun-09 17:15 2009-06-30 17:15:00     0 secs     0      1
      12 23 30-Jun-09 17:38 2009-06-30 17:38:00  1380 secs     0      0
      13 23 30-Jun-09 17:56 2009-06-30 17:56:00  2460 secs     0      0
      14 23 30-Jun-09 20:00 2009-06-30 20:00:00  9900 secs     2      2
      15 23 30-Jun-09 22:19 2009-06-30 22:19:00 18240 secs     5      3
      16 23 18-Jul-11 16:22 2011-07-18 16:22:00     0 secs     0      1
      17 23 18-Jul-11 17:50 2011-07-18 17:50:00  5280 secs     1      1
      18 23 18-Jul-11 18:15 2011-07-18 18:15:00  6780 secs     1      0
      

答案 1 :(得分:1)

我设法使用tapply构建一个函数,选择正确的时间并将它解压缩到几个不同的版本中,尽管我还没有以符合您建议输出的形式组装它。考虑一下我想知道使用lapply-split来获取正确的表单是否更容易:

 tapply(dat$d_time, list(dat$id, dat$date), 
                    function(dt) {
        Reduce( function(x,y) {
                   if( as.numeric(y)-as.numeric(tail(x,1)) < 60*60){
                      x } else {
                     (x,y)} } , 
              dt, 
              init=dt[1]))
 #------------
   18-Jul-11 30-Jun-09 7-Aug-10 
6  NULL      Numeric,3 Numeric,2
23 Numeric,2 Numeric,3 NULL    

# c( ) removes the dimensions and unfortunately the INDEX items
c(tapply(dat$d_time, list(dat$id, dat$date), function(dt) Reduce( function(x,y) if(as.numeric(y)-as.numeric(tail(x,1)) < 60*60){ x } else {c(x,y)} , dt, init=dt[1])))
[[1]]
NULL

[[2]]
[1] "2011-07-18 16:22:00 PDT" "2011-07-18 17:50:00 PDT"

[[3]]
[1] "2009-06-30 16:19:00 PDT" "2009-06-30 17:36:00 PDT"
[3] "2009-06-30 18:52:00 PDT"

[[4]]
[1] "2009-06-30 17:15:00 PDT" "2009-06-30 20:00:00 PDT"
[3] "2009-06-30 22:19:00 PDT"

[[5]]
[1] "2010-08-07 05:30:00 PDT" "2010-08-07 06:45:00 PDT"

[[6]]
NULL

# unlist does something similar
unlist(tapply(dat$d_time, list(dat$id, dat$date), function(dt) Reduce( function(x,y) if(as.numeric(y)-as.numeric(tail(x,1)) < 60*60){ x } else {c(x,y)} , dt, init=dt[1])))
 [1] 1311031320 1311036600 1246403940 1246408560 1246413120 1246407300
 [7] 1246417200 1246425540 1281184200 1281188700

# It's possible to restore the date-time class.
 > as.POSIXct(unlist(tapply(dat$d_time, 
                            list(dat$id, dat$date), 
                            function(dt) Reduce( function(x,y) if(as.numeric(y)-as.numeric(tail(x,1)) < 60*60){ x } else {c(x,y)} , dt, init=dt[1]))) , origin="1970-01-01")

 [1] "2011-07-18 16:22:00 PDT" "2011-07-18 17:50:00 PDT"
 [3] "2009-06-30 16:19:00 PDT" "2009-06-30 17:36:00 PDT"
 [5] "2009-06-30 18:52:00 PDT" "2009-06-30 17:15:00 PDT"
 [7] "2009-06-30 20:00:00 PDT" "2009-06-30 22:19:00 PDT"
 [9] "2010-08-07 05:30:00 PDT" "2010-08-07 06:45:00 PDT"

 # This keeps the INDEX values as row and column names
 as.data.frame( tapply(dat$d_time, list(dat$id, dat$date), function(dt) Reduce( function(x,y) if(as.numeric(y)-as.numeric(tail(x,1)) < 60*60){ x } else {c(x,y)} , dt, init=dt[1])) )
                18-Jul-11                          30-Jun-09
6                    NULL 1246403940, 1246408560, 1246413120
23 1311031320, 1311036600 1246407300, 1246417200, 1246425540
                 7-Aug-10
6  1281184200, 1281188700
23                   NULL