Для первой функции вы ищете совокупное число периодов, в течение которых серия x ниже / выше, чем y. Для этого вы можете использовать эту удобную функцию CumCount(), построенную из cummax. Сначала некоторые примеры данных:
set.seed(1)
x <- sample(1:5,20,T)
y <- sample(1:5,20,T)
CumCount <- function(x) {
z <- cumsum(x)
z - cummax(z*(!x))
}
CumLow = CumCount(x<y)
CumHigh = CumCount(x>y)
Для второго вычисления вы пытаетесь найти совокупный минимум x значение в течение каждого периода , в течение которого x < y. Для этого очень полезна функция rle («кодирование длин серий»).
# runs equals the length of each phase (x < y or x > y)
runs <- rle(CumLow > 0)$lengths
# starts is the number of periods prior to each phase...
starts <- c(0,cumsum(runs)[-length(runs)])
#... which we use to build "blocks", a list of indices of each phase.
blocks <- mapply( function(x,y) x+y, starts, lapply(runs,seq))
# now apply the cummin function within each block:
# (remember to mask it by CumLow > 0 --
# we only want to do this within the x<y phase)
BlockCumMin <- unlist(sapply(blocks, function(blk) cummin(x[blk]))) * (CumLow > 0)
Теперь мы собрали все вместе:
> cbind(x,y, CumLow, CumHigh, BlockCumMin)
x y CumLow CumHigh BlockCumMin
[1,] 3 4 1 0 3
[2,] 4 2 0 1 0
[3,] 2 2 0 0 0
[4,] 2 5 1 0 2
[5,] 4 4 0 0 0
[6,] 2 2 0 0 0
[7,] 4 1 0 1 0
[8,] 1 3 1 0 1
[9,] 2 5 2 0 1
[10,] 1 3 3 0 1
[11,] 2 5 4 0 1
[12,] 1 4 5 0 1
[13,] 4 2 0 1 0
[14,] 5 3 0 2 0
[15,] 4 1 0 3 0
[16,] 4 1 0 4 0
[17,] 3 4 1 0 3
[18,] 3 1 0 1 0
[19,] 5 3 0 2 0
[20,] 4 4 0 0 0
Обратите внимание, что эта проблема связана с этим вопросом
Обновление. Для более общего случая, когда у вас есть вектор series, вектор lengths (такой же длины, что и series), и вы хотите получить результат с именем BlockMins, где BlockMins[i] - это минимум блока lengths[i] из series, заканчивающегося в позиции i, вы можете сделать следующее. Поскольку длины произвольны, это больше не кумулятивный минимум; за каждый i вы должны взять минимум length[i] элементов series, заканчивающихся в позиции i:
set.seed(1)
series <- sample(1:5,20,T)
lengths <- sample(3:5,20,T)
BlockMins <- sapply(seq_along(lengths),
function(i) min( series[ i : max(1, (i - lengths[i]+1)) ]) )
> cbind(series, lengths, BlockMins)
series lengths BlockMins
[1,] 1 5 1
[2,] 1 4 1
[3,] 3 3 1
[4,] 4 4 1
[5,] 5 3 3
[6,] 1 4 1
[7,] 1 5 1
[8,] 4 3 1
[9,] 2 5 1
[10,] 2 4 1
[11,] 1 5 1
[12,] 2 5 1
[13,] 2 3 1
[14,] 2 4 1
[15,] 4 5 1
[16,] 3 5 2
[17,] 5 3 3
[18,] 1 4 1
[19,] 5 3 1
[20,] 3 3 1