Найти время до ближайшего появления определенного значения для каждой строки
Скажем, у меня есть таблица данных:
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 решения также прекрасны.
Спасибо!
Лисс
Ответы
Ответ 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)