计算数据中的连续条纹

时间:2011-01-11 09:03:05

标签: r

我正在尝试计算数据集中的最大输赢(即连续正值或负值的最大数量)。我在StackOverflow上找到了a somewhat related question,尽管这给了我一些很好的建议,但问题的角度是不同的,而且我还没有足够的经验来翻译并将这些信息应用于这个问题。所以我希望你能帮助我,即使是一个建议也会很棒。

我的数据集如下所示:

> 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的最大(获胜)条纹为4(即264,284,69和283连续阳性结果),对于KFT,该值为3(107,107,56)。

我的目标是创建一个函数,该函数给出每个乐器的最大连胜条件(即JPM:4,KFT:3)。为此:

R需要将当前结果与之前的结果进行比较,如果它更高,则存在至少2个连续正结果的条纹。然后R需要查看下一个值,如果这个值也更高:在已经找到的值2上加1,如果这个值不高,R需要继续下一个值,同时记住2为中间最大值。

我已根据条件求和(例如cumsum)尝试了cummaxcumsum(c(TRUE, diff(subRes[,2]) > 0)),但没有成功。同样rle符合lapply(如lapply(rle(subRes$TradeResult.Currency.), function(x) diff(x) > 0))也不起作用。

我该如何做到这一点?

编辑2011年1月19日

计算条纹的大小 除了条纹的长度,我还想在我的分析中加入条纹的大小。通过下面提供的答案,我认为我能够自己做到这一点,遗憾的是我错了并遇到以下问题:

使用以下数据框:

> 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函数让我感到困惑,因为它似乎是函数的显而易见的一部分,但不会导致任何变化。我错过了什么明显的观点?

3 个答案:

答案 0 :(得分:11)

这将有效:

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不是必需的,您可以在此处使用其他子系数和应用函数函数(tapplyaggregate等) :

> 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'参数来交换测试的含义。如果我们想获胜,我们会将TRUEFALSE保留在$values中。如果我们想要亏损,我们会交换TRUEFALSE。然后,我们可以使用此$values组件仅选择与wins(negate = TRUE)对应的运行或与损失(negate = FALSE)对应的运行。

答案 1 :(得分:3)

没有Gavin的解决方案那么光滑,但是这里有。我的函数返回最长条纹的实际序列。

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

FOR NEGATIVE VALUES

请注意,KFT有很长的连败纪录。我已经为JPM(摩根大通?)留下了价值。

> 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

答案 2 :(得分:1)

我已经编写了一个循环来计算任何长度数据的获胜和失败条纹的长度(在本例中,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

道歉,因为它看起来很麻烦,我不是全职程序员,但我认为你会发现这很有效。