Найти все подпоследовательности с определенной длиной в последовательности чисел в R

Question

Я хочу найти все подпоследовательности в последовательности с (минимальной) длиной n. Предположим, у меня есть эта последовательность

sequence <- c(1,2,3,2,5,3,2,6,7,9)

и я хочу найти увеличивающиеся подпоследовательности с минимальной длиной 3. Выходной результат должен быть кадром данных с начальной и конечной позицией для каждой найденной подпоследовательности.

df =data.frame(c(1,7),c(3,10))
colnames(df) <- c("start", "end")

Может кто-нибудь подсказать, как решить мою проблему?

Заранее спасибо!

Answer 1

Вот еще одно решение с использованием базы R. Я попытался прокомментировать это, но все еще может быть трудно следовать.Кажется, вы хотели получить направление / учиться, а не просто ответ, так что обязательно задавайте вопросы, если что-то неясно (или не работает для вашего реального применения).

Кроме того, для ваших данных я добавил 12 в конце, чтобы убедиться, что он возвращает правильную позицию для повторных увеличений, превышающих n (в данном случае 3):

# Data (I added 11 on the end)
sequence <- c(1,2,3,2,5,3,2,6,7,9, 12)

# Create indices for whether or not the numbers in the sequence increased
indices <- c(1, diff(sequence) >= 1)
indices
[1] 1 1 1 0 1 0 0 1 1 1 1

Теперь, когда у нас есть индексы, нам нужно получить начальную и конечную позиции для повторов> = 3

# Finding increasing sequences of n length using rle
n <- 3
n <- n - 1

# Examples 
rle(indices)$lengths
[1] 3 1 1 2 4

rle(indices)$values
[1] 1 0 1 0 1

# Finding repeated TRUE (1) in our indices vector
reps <- rle(indices)$lengths >= n & rle(indices)$values == 1
reps
[1]  TRUE FALSE FALSE FALSE  TRUE

# Creating a vector of positions for the end of a sequence
# Because our indices are true false, we can use cumsum along
# with rle to create the positions of the end of the sequences
rle_positions <- cumsum(rle(indices)$lengths)
rle_positions
[1]  3  4  5  7 11

# Creating start sequence vector and subsetting start / end using reps
start <- c(1, head(rle_positions, -1))[reps]

end <- rle_positions[reps]

data.frame(start, end)
  start end
1     1   3
2     7  11

Или, кратко:

n <- 3
n <- n-1
indices <- c(1, diff(sequence) >= 1)
reps <- rle(indices)$lengths >= n & rle(indices)$values == 1
rle_positions <- cumsum(rle(indices)$lengths)
data.frame(start = c(1, head(rle_positions, -1))[reps], 
           end = rle_positions[reps])
  start end
1     1   3
2     7  11

РЕДАКТИРОВАТЬ: @ Ronak's updateзаставил меня понять, что я должен использовать diff вместо sapply с анонимной функцией для моего первого шага.Обновлен ответ, поскольку он не улавливал увеличение в конце вектора (например, sequence <- c(1,2,3,2,5,3,2,6,7,9,12, 11, 11, 20, 100), также необходимо добавить еще одну строку в поле n <- 3. Теперь это должно работать так, как задумано.

Answer 2

В одну сторону, используя только базу R

n <- 3

do.call(rbind, sapply(split(1:length(sequence), cumsum(c(0, diff(sequence)) < 1)), 
        function(x) if (length(x) >= n) c(start = x[1], end = x[length(x)])))

#  start end
#1    1    3
#4    7   10

split индекс sequence, основанный на непрерывных инкрементальных подпоследовательностях, если length каждой группы больше, чем равно n, возвращает начальный и конечный индексы этой группы.

---

Чтобы понять, давайте разберем это и поймем это шаг за шагом

Используя diff, мы можем найти разницу между последовательными элементами

diff(sequence)
#[1]  0  1  1 -1  3 -2 -1  4  1  2

Проверяем, какие из них не имеют возрастающих подпоследовательностей

diff(sequence) < 1
#[1] FALSE FALSE  TRUE FALSE  TRUE  TRUE FALSE FALSE FALSE

и возьмите кумулятивную сумму на них, чтобы создать группы

cumsum(c(0, diff(sequence)) < 1)
#[1] 1 1 1 2 2 3 4 4 4 4

Исходя из этой группы, мы split индекс от 1:length(sequence)

split(1:length(sequence), cumsum(c(0, diff(sequence)) < 1))
#$`1`
#[1] 1 2 3

#$`2`
#[1] 4 5

#$`3`
#[1] 6

#$`4`
#[1]  7  8  9 10

Используя sapply, мы перебираем этот список и возвращаем начальный и конечный индексы списка if length списка составляет >= n (в нашем случае 3)

sapply(split(1:length(sequence), cumsum(c(0, diff(sequence)) < 1)), 
       function(x) if (length(x) >= n) c(start = x[1], end = x[length(x)]))

#$`1`
#start   end 
#    1     3 

#$`2`
# NULL

#$`3`
#NULL

#$`4`
#start   end 
#    7    10 

Наконец, rbind все вместе, используя do.call. NULL элементы автоматически игнорируются.

do.call(rbind, sapply(split(1:length(sequence), cumsum(c(0, diff(sequence)) < 1)), 
       function(x) if (length(x) >= n) c(start = x[1], end = x[length(x)])))

#  start end
#1     1   3
#4     7  10