Подтвердить что ты не робот

Найти время до ближайшего появления определенного значения для каждой строки

Скажем, у меня есть таблица данных:

dt <- data.table(
        datetime = seq(as.POSIXct("2016-01-01 00:00:00"),as.POSIXct("2016-01-01 10:00:00"), by = "1 hour"),
        ObType = c("A","A","B","B","B","B","A","A","B","A","A")
)

dt
                   datetime ObType
     1: 2016-01-01 00:00:00      A
     2: 2016-01-01 01:00:00      A
     3: 2016-01-01 02:00:00      B
     4: 2016-01-01 03:00:00      B
     5: 2016-01-01 04:00:00      B
     6: 2016-01-01 05:00:00      B
     7: 2016-01-01 06:00:00      A
     8: 2016-01-01 07:00:00      A
     9: 2016-01-01 08:00:00      B
    10: 2016-01-01 09:00:00      A
    11: 2016-01-01 10:00:00      A

Что мне нужно сделать, где ObType - это "B", мне нужно найти время до ближайшего ObType "A" с обеих сторон. Результат должен выглядеть (в часах):

               datetime ObType timeLag timeLead
 1: 2016-01-01 00:00:00      A      NA       NA
 2: 2016-01-01 01:00:00      A      NA       NA
 3: 2016-01-01 02:00:00      B       1        4
 4: 2016-01-01 03:00:00      B       2        3
 5: 2016-01-01 04:00:00      B       3        2
 6: 2016-01-01 05:00:00      B       4        1
 7: 2016-01-01 06:00:00      A      NA       NA
 8: 2016-01-01 07:00:00      A      NA       NA
 9: 2016-01-01 08:00:00      B       1        1
10: 2016-01-01 09:00:00      A      NA       NA
11: 2016-01-01 10:00:00      A      NA       NA

Я обычно использую data.table, но не data.table решения также прекрасны.

Спасибо!

Лисс

4b9b3361

ОТВЕТЫ

Ответ 1

Подход, который я намекнул на использование roll=:

X = dt[ObType=="A"]
X
              datetime ObType
1: 2016-01-01 00:00:00      A
2: 2016-01-01 01:00:00      A
3: 2016-01-01 06:00:00      A
4: 2016-01-01 07:00:00      A
5: 2016-01-01 09:00:00      A
6: 2016-01-01 10:00:00      A

dt[ObType=="B", Lag:=X[.SD,on="datetime",roll=Inf,i.datetime-x.datetime]]
dt[ObType=="B", Lead:=X[.SD,on="datetime",roll=-Inf,x.datetime-i.datetime]]
dt[ObType=="B", Nearest:=X[.SD,on="datetime",roll="nearest",x.datetime-i.datetime]]
dt
               datetime ObType      Lag     Lead     Nearest
 1: 2016-01-01 00:00:00      A NA hours NA hours    NA hours
 2: 2016-01-01 01:00:00      A NA hours NA hours    NA hours
 3: 2016-01-01 02:00:00      B  1 hours  4 hours    -1 hours
 4: 2016-01-01 03:00:00      B  2 hours  3 hours    -2 hours
 5: 2016-01-01 04:00:00      B  3 hours  2 hours     2 hours
 6: 2016-01-01 05:00:00      B  4 hours  1 hours     1 hours
 7: 2016-01-01 06:00:00      A NA hours NA hours    NA hours
 8: 2016-01-01 07:00:00      A NA hours NA hours    NA hours
 9: 2016-01-01 08:00:00      B  1 hours  1 hours    -1 hours
10: 2016-01-01 09:00:00      A NA hours NA hours    NA hours
11: 2016-01-01 10:00:00      A NA hours NA hours    NA hours

Одно из преимуществ roll= заключается в том, что вы можете применить ограничение на статичность, просто изменив Inf на ограничение времени, в которое вы хотите присоединиться. Это разница во времени, к которой применяется предел, а не количество строк. Inf просто средства не ограничивают. Знак roll= указывает, следует ли смотреть вперед или назад (свинец или лаг).

Другим преимуществом является то, что roll= работает быстро.

Ответ 2

Два подхода, один с использованием объединений, другой с использованием перестройки

Соединения

Вероятно, существует более подходящий подход, который использует скользящие объединения/неравновесные соединения, но здесь подход с грубой силой

dt2 <- dt[, key := 1][ 
    dt, 
    on = "key", 
    allow.cartesian = T
    ][
        ObType != i.ObType
        ][
            , `:=`(lag_min = datetime - i.datetime,
                         lag_max = i.datetime - datetime)
            ]


dt_min <- dt2[ObType == "B" & lag_min > 0, .(timeLag = min(lag_min)), by = .(datetime, ObType)]
dt_max <- dt2[ObType == "B" & lag_max > 0, .(timeLead = min(lag_max)), by = .(datetime, ObType)]


dt_max[ dt_min[ dt, on = c("datetime", "ObType"), nomatch = NA], on = c("datetime", "ObType"), nomatch = NA]

#                datetime ObType  lag_max  lag_min key
#  1: 2016-01-01 00:00:00      A NA hours NA hours   1
#  2: 2016-01-01 01:00:00      A NA hours NA hours   1
#  3: 2016-01-01 02:00:00      B  4 hours  1 hours   1
#  4: 2016-01-01 03:00:00      B  3 hours  2 hours   1
#  5: 2016-01-01 04:00:00      B  2 hours  3 hours   1
#  6: 2016-01-01 05:00:00      B  1 hours  4 hours   1
#  7: 2016-01-01 06:00:00      A NA hours NA hours   1
#  8: 2016-01-01 07:00:00      A NA hours NA hours   1
#  9: 2016-01-01 08:00:00      B  1 hours  1 hours   1
# 10: 2016-01-01 09:00:00      A NA hours NA hours   1
# 11: 2016-01-01 10:00:00      A NA hours NA hours   1

Перепрофилирование

Это довольно сложно, и некоторые из шагов, очевидно, могут быть упрощены, но я все равно бросаю все это, чтобы вы могли видеть процесс

dt[, group := rleid(ObType)]
dt_cast <- dcast(dt, formula = datetime + group ~ ObType, value.var = "ObType")

dt_cast[, `:=`(group_before = group - 1,
                             group_after = group + 1)]


dt_min <- dt_cast[ !is.na(B) ][dt_cast[!is.na(A), .(datetime, group)] , on = c(group_before = "group")  , allow.cartesian = T][, max(i.datetime), by = group]
dt_max <- dt_cast[ !is.na(B) ][dt_cast[!is.na(A), .(datetime, group)] , on = c(group_after = "group")  , allow.cartesian = T][, min(i.datetime), by = group]


dt_cast <- rbindlist(list(
    dt_cast[ dt_min, on = c("group"), nomatch = 0],
    dt_cast[ dt_max, on = c("group"), nomatch = 0]
))

dt <- dt_cast[ dt, on = c("datetime", "group"), nomatch = NA][, .(datetime, ObType, lag = V1)]

dt[ObType == "B" , lag_type := c("lag", "lead"), by = .(datetime, ObType)]
dt <- dcast(dt, formula = datetime + ObType ~ lag_type, value.var = "lag")

dt[, `:=`(timeLag = difftime(datetime, lag),
                    timeLead = difftime(lead, datetime),
                    `NA` = NULL)]

dt
#                datetime ObType                 lag                lead  timeLag timeLead
#  1: 2016-01-01 00:00:00      A                <NA>                <NA> NA hours NA hours
#  2: 2016-01-01 01:00:00      A                <NA>                <NA> NA hours NA hours
#  3: 2016-01-01 02:00:00      B 2016-01-01 01:00:00 2016-01-01 06:00:00  1 hours  4 hours
#  4: 2016-01-01 03:00:00      B 2016-01-01 01:00:00 2016-01-01 06:00:00  2 hours  3 hours
#  5: 2016-01-01 04:00:00      B 2016-01-01 01:00:00 2016-01-01 06:00:00  3 hours  2 hours
#  6: 2016-01-01 05:00:00      B 2016-01-01 01:00:00 2016-01-01 06:00:00  4 hours  1 hours
#  7: 2016-01-01 06:00:00      A                <NA>                <NA> NA hours NA hours
#  8: 2016-01-01 07:00:00      A                <NA>                <NA> NA hours NA hours
#  9: 2016-01-01 08:00:00      B 2016-01-01 07:00:00 2016-01-01 09:00:00  1 hours  1 hours
# 10: 2016-01-01 09:00:00      A                <NA>                <NA> NA hours NA hours
# 11: 2016-01-01 10:00:00      A                <NA>                <NA> NA hours NA hours

Ответ 3

dt$timelag = NA
dt$timelead = NA

A = split(dt, dt$ObType)$A
B = split(dt, dt$ObType)$B

A_time_up = sort(A$datetime)
A_time_dn = sort(A$datetime, decreasing = TRUE)

B$timelag = apply(B, 1, function(x) 
    A_time_up[which(x[1] < A_time_up)[1]]
)

B$timelead = apply(B, 1, function(x) 
    A_time_dn[which(x[1] > A_time_dn)[1]]
)

B$timelag = (B$timelag - as.numeric(B$datetime))/(3600)
B$timelead = (as.numeric(B$datetime) - B$timelead)/(3600)

rbind(A,B)