我正在对动物位置进行分析,要求每只动物的位置相隔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
答案 0 :(得分:2)
如果我理解正确,我认为你正在寻找这些方面的东西:
library(dplyr)
library(lubridate)
locdata %>%
mutate(timestamp = dmy_hm(paste(date, time))) %>%
group_by(id, date) %>%
mutate(delta = timestamp - lag(timestamp))
如果您之前未使用过dplyr
或magrittr
,则上述语法可能不清楚。 %>%
运算符将每个计算的结果传递给下一个函数,因此上面的代码执行以下操作:
lubridate
id
和唯一date
s 如果要保存输出,请将第一行更改为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
工作原理:
timestamp
id
和date
delta
steps
step
(并保留第一个观察结果);将其存储在新列change
change
为1或更多的观察结果 - 即观察距前一次观察一小时或同一小时的观察时间为了熟悉它的工作原理,请从最后删除filter
和select
并检查输出:
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