Как установить и извлечь временные ряды по временному интервалу в строке
Я работаю над анализом местоположения животных, которое требует, чтобы местоположения для каждого животного были на расстоянии 60 минут или больше друг от друга. Разница во времени среди животных не имеет значения. Набор данных содержит список идентификаторов животных, а также дату и время каждого местоположения, пример ниже.
Например, для животного 6 ниже, начиная с местоположения 16:19, код будет перебирать местоположения, пока не найдет местоположение, которое находится в 60+ минутах от 16:19. В этом случае это будет место 17:36. Затем код будет начинаться с местоположения 17:36, чтобы найти следующее местоположение (18:52) через 60 минут и так далее. Каждое из местоположений в 60+ минутах друг от друга будет затем извлечено в отдельный кадр данных.
Я написал цикл в R для подмножества данных, но у меня была проблема с кодом, не учитывающим изменение даты при расчете, если местоположения составляют 60 минут или больше.
Я изучал пакет lubridate, который, кажется, может иметь более простой способ решения проблемы подмножества моих данных. Тем не менее, я еще не нашел решения для подстановки данных в мои спецификации с помощью этого пакета. Будем весьма благодарны за любые предложения по использованию 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 ответа
Если я вас правильно понял, я думаю, что вы ищете что-то вроде этого:
library(dplyr)
library(lubridate)
locdata %>%
mutate(timestamp = dmy_hm(paste(date, time))) %>%
group_by(id, date) %>%
mutate(delta = timestamp - lag(timestamp))
Если вы не использовали dplyr или же magrittr ранее, синтаксис выше может быть неясным. %>% Оператор передает результаты каждого вычисления следующей функции, поэтому приведенный выше код выполняет следующее:
- Разобрать дату и время в метку времени, которую R понимает, используя
lubridate - Сгруппировать данные по
idи уникальныйdates - Внутри каждой группы рассчитайте продолжительность между наблюдениями
Если вы хотите сохранить вывод, измените первую строку на что-то вроде 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 - Определить, какие наблюдения (если таковые имеются) находятся на расстоянии более 3600 секунд от первого с шагом 3600 секунд; сохранить это в новом столбце
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
Мне удалось построить функцию, используя 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