Использование кодирования длин серий с отметками времени

Моя цель — использовать функцию rle(), чтобы узнать, как долго велосипедные станции были пусты. Используя приведенные ниже данные test, rle(test$bikes) вернет длины повторяющихся значений в test$bikes.

> rle(test$bikes)
Run Length Encoding
  lengths: int [1:9] 3 2 3 1 5 1 7 1 1
  values : num [1:9] 0 1 2 1 0 1 0 1 0



> test
   station_id                time bikes
1           1 2017-12-25 00:00:02     0
2           1 2017-12-25 00:01:02     0
3           1 2017-12-25 00:02:02     0
4           1 2017-12-25 00:03:02     1
5           2 2017-12-25 00:04:02     1
6           2 2017-12-25 00:05:02     2
7           2 2017-12-25 00:06:02     2
8           2 2017-12-25 00:07:02     2
9           2 2017-12-25 00:08:02     1
10          3 2017-12-25 00:09:02     0
11          3 2017-12-25 00:10:02     0
12          3 2017-12-25 00:11:02     0
13          3 2017-12-25 00:12:02     0
14          3 2017-12-25 00:13:02     0
15          4 2017-12-25 00:14:03     1
16          4 2017-12-25 00:15:02     0
17          4 2017-12-25 00:16:02     0
18          4 2017-12-25 00:17:02     0
19          4 2017-12-25 00:18:02     0
20          5 2017-12-25 00:19:02     0
21          5 2017-12-25 00:20:02     0
22          5 2017-12-25 00:21:02     0
23          5 2017-12-25 00:22:02     1
24          5 2017-12-25 00:23:02     0

Моя цель состоит в том, чтобы сделать еще один шаг и создать выходные данные, которые группируются по staiton_id и возвращают разницу во времени (в минутах) только тогда, когда test$bikes имеет повторяющиеся нули. Это может происходить несколько раз для каждой станции (например, для станции 5 в данных test). В конце концов, приведенный выше набор данных выдаст следующий результат:

> output
  station_id diff_time      interval
1          1         2 00:00 - 00:02
2          3         4 00:09 - 00:13
3          4         3 00:15 - 00:18
4          5         2 00:19 -00:21
5          5         0 00:23 - 00:23

Будем признательны за любые предложения о том, как это сделать с dplyr и rle!

Вот тестовые данные:

> dput(test)
structure(list(station_id = c(1, 1, 1, 1, 2, 2, 2, 2, 2, 3, 3, 
3, 3, 3, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5), time = structure(c(1514178002.88487, 
1514178062.99145, 1514178122.88463, 1514178182.63461, 1514178242.71401, 
1514178302.20358, 1514178362.13263, 1514178422.88907, 1514178482.6502, 
1514178542.59171, 1514178602.51222, 1514178662.23203, 1514178722.04015, 
1514178782.87382, 1514178843.02124, 1514178902.71852, 1514178962.6987, 
1514179022.42077, 1514179082.19535, 1514179142.97175, 1514179202.81556, 
1514179262.85187, 1514179322.66264, 1514179382.50223), class = c("POSIXct", 
"POSIXt"), tzone = ""), bikes = c(0, 0, 0, 1, 1, 2, 2, 2, 1, 
0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0)), .Names = c("station_id", 
"time", "bikes"), row.names = c(NA, 24L), class = "data.frame")

r data.table dplyr difftime run-length-encoding
person the_darkside    schedule 26.12.2017    source источник

Ответы (2)


arrow_upward
4
arrow_downward

Мы можем использовать rleid из data.table. Создайте группирующую переменную («grp») на основе идентификатора длины цикла «велосипедов», затем сгруппируйте по «station_id» и «grp», укажите i, где «велосипеды» равны 0, суммируйте выходные данные, взяв difftime последнего и первого наблюдения «времени», а также paste formatотмеченных соответствующих элементов «времени»

library(data.table)
setDT(test)[, grp:= rleid(bikes)][bikes==0, 
 .(diff_time = as.numeric(round(difftime(time[.N], time[1], unit = "min"))), 
  interval = paste(format(time[1], "%M:%S"), format(time[.N], "%M:%S"), sep=" - ")),
          .(station_id, grp)]
person akrun    schedule 26.12.2017
comment
@the_darkside Я добавил некоторые пояснения. Это просто создать столбец группировки - person akrun; 26.12.2017

arrow_upward
1
arrow_downward

В dplyr нет аналогичной функции 'rleid'

поэтому здесь создана еще одна дополнительная функция

rle_dplyr <- function(x){
  x = rle(x)$lengths
  rep(seq_along(x),times = x)
}



> head(test1)

  station_id                time bikes
1          1 2017-12-25 10:30:02     0
2          1 2017-12-25 10:31:02     0
3          1 2017-12-25 10:32:02     0
4          1 2017-12-25 10:33:02     1
5          2 2017-12-25 10:34:02     1
6          2 2017-12-25 10:35:02     2


library(tidyverse)

test1%>%
     mutate(idrle = rle_dplyr(bikes))%>%
     filter(bikes == 0)%>%
     group_by(station_id,idrle)%>%
     summarise(diff_time = last(minute(time)) - first(minute(time)),
          interval = paste(format(first(time),"%M:%S"),format(last(time),"%M:%S"),sep = "-"))%>%
     select(-idrle)

Выход

# A tibble: 5 x 3
# Groups:   station_id [4]
  station_id diff_time    interval
       <dbl>     <int>       <chr>
1          1         2 30:02-32:02
2          3         4 39:02-43:02
3          4         3 45:02-48:02
4          5         2 49:02-51:02
5          5         0 53:02-53:02
person dondapati    schedule 26.12.2017