Расчет последовательной полосы данных

Question

Я пытаюсь рассчитать максимальную серию выигрышей и проигрышей в наборе данных (т.е. наибольшее количество последовательных положительных или отрицательных значений).Я нашел несколько связанный вопрос здесь, в StackOverflow, и, хотя это дало мне несколько хороших советов, этот вопрос был другим, и я (пока) не достаточно опытен, чтобы перевести и применить этот вопрос.информация к этой проблеме.Поэтому я надеялся, что вы мне поможете, даже предложение было бы замечательно.

Мой набор данных выглядит следующим образом:

> subRes
   Instrument TradeResult.Currency.
1         JPM                    -3
2         JPM                   264
3         JPM                   284
4         JPM                    69
5         JPM                   283
6         JPM                  -219
7         JPM                   -91
8         JPM                   165
9         JPM                   -35
10        JPM                  -294
11        KFT                    -8
12        KFT                   -48
13        KFT                   125
14        KFT                  -150
15        KFT                  -206
16        KFT                   107
17        KFT                   107
18        KFT                    56
19        KFT                   -26
20        KFT                   189
> split(subRes[,2],subRes[,1])
$JPM
 [1]   -3  264  284   69  283 -219  -91  165  -35 -294
$KFT
 [1]   -8  -48  125 -150 -206  107  107   56  -26  189

В этом случае максимальная (выигрышная) полоса дляJPM равен четырем (а именно 264, 284, 69 и 283 последовательных положительных результатов), а для KFT это значение равно 3 (107, 107, 56).

Моя цель - создать функцию, которая выдает максимальные полосы выигрыша на инструмент (т. Е. JPM: 4, KFT: 3).Чтобы достичь этого:

R необходимо сравнить текущий результат с предыдущим результатом, и если он выше, то наблюдается серия из как минимум 2 последовательных положительных результатов.Тогда R нужно посмотреть на следующее значение, и если оно также выше: добавьте 1 к уже найденному значению 2. Если это значение не выше, R нужно перейти к следующему значению, помня 2 какпромежуточный максимум.

Я пробовал cumsum и cummax в соответствии с условным суммированием (например, cumsum(c(TRUE, diff(subRes[,2]) > 0))), которое не сработало.Также rle в соответствии с lapply (например, lapply(rle(subRes$TradeResult.Currency.), function(x) diff(x) > 0)) не работает.

Как мне сделать эту работу?

Редактировать 19 января 2011

Расчет размера полосы Помимо длины полосы, я также хотел бы включить размер полосы в мой анализ.С ответами, представленными ниже, я подумал, что смог сделать это сам, к сожалению, я ошибаюсь и столкнулся со следующими проблемами:

Со следующим фреймом данных:

> subRes
   Instrument TradeResult.Currency.
1         JPM                    -3
2         JPM                   264
3         JPM                   284
4         JPM                    69
5         JPM                   283
6         JPM                  -219
7         JPM                   -91
8         JPM                   165
9         JPM                   -35
10        JPM                  -294
11        KFT                    -8
12        KFT                   -48
13        KFT                   125
14        KFT                  -150
15        KFT                  -206
16        KFT                   107
17        KFT                   107
18        KFT                    56
19        KFT                   -26
20        KFT                   189
> lapply(split(subRes[,2], subRes[,1]), function(x) {
+             df.rle <- ifelse(x > 0, 1, 0)
+             df.rle <- rle(df.rle)
+ 
+             wh <- which(df.rle$lengths == max(df.rle$lengths))
+             mx <- df.rle$lengths[wh]
+             suma <- df.rle$lengths[1:wh]
+             out <- x[(sum(suma) - (suma[length(suma)] - 1)):sum(suma)]
+             return(out)
+         })
$JPM
[1] 264 284  69 283

$KFT
[1] 107 107  56

Этот результат верный, и изменив последнюю строку на return(sum(out)) Я могу получить общий размер полосы:

$JPM
[1] 900

$KFT
[1] 270

Однако функция, похоже, не учитывает проигрышные полосы при измененииусловие ifelse:

lapply(split(subRes[,2], subRes[,1]), function(x) {
            df.rle <- ifelse(x < 0, 1, 0)
            df.rle <- rle(df.rle)

            wh <- which(df.rle$lengths == max(df.rle$lengths))
            mx <- df.rle$lengths[wh]
            suma <- df.rle$lengths[1:wh]
            out <- x[(sum(suma) - (suma[length(suma)] - 1)):sum(suma)]
            return(out)
        })
$JPM
[1] 264 284  69 283

$KFT
[1] 107 107  56

Я не вижу, что мне нужно изменить в этой функции, чтобы в конечном итоге прийти к общей сумме проигрышной серии.Однако я настраиваю / меняю функцию, получаю тот же результат или ошибку.Функция ifelse сбивает меня с толку, потому что она кажется очевидной частью изменения функции, но не приводит к каким-либо изменениям.Какой очевидный момент я упускаю?

Answer 1

Это будет работать:

FUN <- function(x, negate = FALSE, na.rm = FALSE) {
    rles <- rle(x > 0)
    if(negate) {
        max(rles$lengths[!rles$values], na.rm = na.rm)
    } else {
        max(rles$lengths[rles$values], na.rm = na.rm)
    }
}
wins <- lapply(split(subRes[,2],subRes[,1]), FUN)
loses <- lapply(split(subRes[,2],subRes[,1]), FUN, negate = TRUE)

Предоставление этого:

> wins
$JPM
[1] 4

$KFT
[1] 3
> loses
$JPM
[1] 2

$KFT
[1] 2

или

> sapply(split(subRes[,2],subRes[,1]), FUN)
JPM KFT 
  4   3
> sapply(split(subRes[,2],subRes[,1]), FUN, negate = TRUE)
JPM KFT 
  2   2 

Вы были близки, но вам нужно было применить rle() к каждому элементу вашего списка в отдельности, а также преобразовать TradeResult.Currency. в логический вектор, в зависимости от того, указано выше 0 или нет. Наша функция FUN возвращает только компонент lengths объекта, возвращаемого rle, и мы применяем max() к этому вектору длин, чтобы найти самый длинный выигрышный прогон.

Обратите внимание, что здесь split не требуется, и вы можете использовать другие функции поднабора по факторам и применять функции (tapply, aggregate и т. Д.) Здесь:

> with(subRes, aggregate(`TradeResult.Currency.`, 
+                        by = list(Instrument = Instrument), FUN))
  Instrument x
1        JPM 4
2        KFT 3
> with(subRes, tapply(`TradeResult.Currency.`, Instrument, FUN))
JPM KFT 
  4   3

---

Причина, по которой предыдущая версия была неправильной, заключалась в том, что если у вас был более длинный ряд потерь, чем выигрыши (более длинный ряд отрицательных значений), это привело бы к выбору длины ряда потерь.

Измененная функция добавляет аргумент 'negate', чтобы поменять значение теста. Если мы хотим выиграть, мы оставляем TRUE и FALSE в $values как они есть. Если мы хотим потерь, мы меняем местами TRUE и FALSE. Затем мы можем использовать этот компонент $values для выбора только прогонов, которые соответствуют выигрышам (negate = TRUE) или прогонов, которые соответствуют потерям (negate = FALSE).

Answer 2

Нигде почти так гладко, как решение Гэвина, но здесь идет.Моя функция возвращает фактическую последовательность самой длинной полосы.

inst.split <- split(inst[, 2], inst[, 1])

inst <- lapply(inst.split, function(x) {
            df.rle <- ifelse(x > 0, 1, 0)
            df.rle <- rle(df.rle)

            wh <- which(df.rle$lengths == max(df.rle$lengths))
            mx <- df.rle$lengths[wh]
            suma <- df.rle$lengths[1:wh]
            out <- x[(sum(suma) - (suma[length(suma)] - 1)):sum(suma)]
            return(out)
        })

$JPM
[1] 264 284  69 283

$KFT
[1] 107 107  56

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

lapply(inst, length)

$JPM
[1] 4

$KFT
[1] 3

ДЛЯ ОТРИЦАТЕЛЬНЫХ ЗНАЧЕНИЙ

Обратите внимание, что у KFT длинная полоса неудач.Я оставил значения только для JPM (JP Morgan?).

> inst
   Instrument TradeResult.Currency.
1         JPM                    -3
2         JPM                   264
3         JPM                   284
4         JPM                    69
5         JPM                   283
6         JPM                  -219
7         JPM                   -91
8         JPM                   165
9         JPM                   -35
10        JPM                  -294
11        KFT                    -8
12        KFT                   -48
13        KFT                  -125
14        KFT                  -150
15        KFT                  -206
16        KFT                  -107
17        KFT                  -107
18        KFT                    56
19        KFT                   -26
20        KFT                   189

И это результат выполнения разбиения data.frame через вышеуказанную функцию.

$JPM
[1] 264 284  69 283

$KFT
[1]   -8  -48 -125 -150 -206 -107 -107

Answer 3

Я написал цикл для расчета длины выигрышных и проигрышных полос для любой длины данных (в этом примере x - это вектор чисел, который вас интересует).Проблема с этой проблемой заключается в том, что максимальная серия выигрышей или проигрышей может не совпадать с самой длинной длиной серии выигрышей.Поэтому требуется отдельный / независимый расчет:

rout <- rle (x>=0) # In this calculation, 0 is considered a "win"

losel <- max(rout$lengths[!rout$values]) # Length of max losing streak
winl <- max(rout$lengths[rout$values]) # Length of max winning streak

xpostemp <- cumsum(rout$lengths)
xpos <- c(0,xpostemp)
looplength <- length(xpos)-1
tot <- rep (0,looplength)

for(j in 1:looplength){
    start <- xpos[j]+1
    end <- xpos[j+1]
    tot[j] <- sum(x[start:end])                
}
winmax <- max(tot) # Sum of largest winning steak
losemax <- min(tot) # Sum of largest losing streak

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