Это можно сделать итеративно.Идея состоит в том, чтобы идентифицировать точки, которые должны быть включены, используйте их, чтобы удалить точки, которые не могут быть включены, и повторять до тех пор, пока они не будут сделаны.
Вот некоторые простые данныене временные метки, а целые числа (временные метки легко конвертируются в целое число через as.integer()), предполагая, что нас интересует «ширина» в 10 - начинаются менее чем через 10 единиц.
set.seed(123)
start <- sort(sample(100, 10))
width <- 10
Мы пишем функцию для определения начала и ширины
filter1 <- function(start, width) {
Построим интервалы для каждого начала
end <- start + width - 1L # closed interval
выясним, как привести начало и конец в порядок, и запомнимкакое начальное событие соответствует порядку
o <- order(c(start, end))
is_start <- rep(c(TRUE, FALSE), each = length(start))[o]
, закодируйте начальные события как 1, конечные события как -1 и вычислите «охват», количество открытых событий
event <- rep(c(1, -1), each = length(start))[o] # 1 == open, -1 == close
cvg <- cumsum(event) # number of open intervals
Мы точно знаем, что хотим сохранить стартовые события, когда покрытие увеличивается до 1, поэтому сохраните эти
must <- (event == 1 & cvg == 1)[is_start]
open <- start[must] # non-overlapping events
и найдите событие, которое НЕ находится в этих интервалах
close <- end[must] + 1L
might <- findInterval(start, sort(c(open, close))) %% 2 == 0
вернуть значения, которые мы знаемчтобы быть хорошим, и что мы еще не исключили
must | might # best guess, so far
}
Полная функция:
filter1 <- function(start, width) {
end <- start + width - 1L # closed interval
o <- order(c(start, end))
is_start <- rep(c(TRUE, FALSE), each = length(start))[o]
event <- rep(c(1, -1), each = length(start))[o] # 1 == open, -1 == close
cvg <- cumsum(event) # number of open intervals
must <- (event == 1 & cvg == 1)[is_start]
open <- start[must] # non-overlapping events
close <- end[must] + 1L
might <- findInterval(start, sort(c(open, close))) %% 2 == 0
must | might
}
Теперь у нас есть сокращенный вектор возможных кандидатов;мы повторяем до тех пор, пока длина кандидатов не изменится
filter_all <- function(start, width) {
idx <- !logical(length(start))
repeat {
idx0 <- filter1(start[idx], width)
if (sum(idx0) == sum(idx))
break
idx[idx] <- idx0
}
idx
}
в действии:
> set.seed(123)
> (start <- sort(sample(100, 10)))
[1] 5 29 41 42 50 51 79 83 86 91
> keep <- filter_all(start, 10)
> start[keep]
[1] 5 29 41 51 79 91
Это может быть неверно (но может быть сделано так) в случае, когда интервалы заканчиваются иначать в том же месте.В худшем случае производительность будет линейной по количеству запусков (когда конец одного интервала точно перекрывает начало другого, по ширине на единицу длины), но кажется, что он часто будет приблизительно логарифмическим.
Это может бытьприменяется к группам с использованием data.table или базовых функций R, таких как ave().