r - 根据具有回溯的其他列值更改 xts 中某些列的值

Question

我有以下 xts 对象（代表长/短条目（第 1 列和第 2 列）和退出（第 3 列和第 4 列）触发器，其中“聚合”信号列应该是 1（系统很长），-1（系统很短）或 0（系统是平坦的）。我无法为“聚合”信号列 5 进行这项工作...

数据：

         LongEntrySignal ShortEntrySignal LongExitSignal ShortExitSignal Signal
18.02.93               0                0              1               0      0
19.02.93               0                0              0               1      0
22.02.93               1                0              0               0      1
23.02.93               0                0              0               0      0
24.02.93               0                0              0               0      0
25.02.93               0                0              0               0      0
26.02.93               0                0              1               0      0
01.03.93               0                0              1               0      0
04.03.93               0                1              0               0     -1
05.03.93               0                0              0               0      0
11.03.93               0                0              0               1      0
12.03.93               0                0              1               0      0

我想以这种形式转换数据：

         LongEntrySignal ShortEntrySignal LongExitSignal ShortExitSignal Signal
18.02.93               0                0              1               0      0
19.02.93               0                0              0               1      0
22.02.93               1                0              0               0      1
23.02.93               0                0              0               0      1
24.02.93               0                0              0               0      1
25.02.93               0                0              0               0      1
26.02.93               0                0              1               0      1
01.03.93               0                0              1               0      0
04.03.93               0                1              0               0     -1
05.03.93               0                0              0               0     -1
11.03.93               0                0              0               1     -1
12.03.93               0                0              1               0      0

我尝试对如下函数进行编程（但 id 不起作用；注释掉的部分也不起作用并且非常慢 - 我知道在 R 中使用循环很慢，但这是我唯一的想法）：

padMinusPlusOnes<-function(signals, longEntryColumn=1, shortEntryColumn=2, signalsColumn=5) {   
    ret<-signals
#get all indexes between long entry equals 1 to long exit equals 1 and set signalsColumn for these rows to 1
    ret[(lag(ret)[, longEntryColumn] == 1) & (ret[, signalsColumn] == 0), signalsColumn]<-1
#get all indexes between short entry equals 1 to short exit equals 1 and set signalsColumn for these rows to -1
    ret[(lag(ret)[, shortEntryColumn] == -1) & (ret[, signalsColumn] == 0), signalsColumn]<--1

    return(ret)

#   ret<-signals
#   for (i in 2:NROW(ret)) {
#       if ((ret[i - 1, longEntryColumn] == 1) & (ret[, signalsColumn] == 0)) {
#           ret[i, signalsColumn]<-1
#       }
#       if ((ret[i - 1, shortEntryColumn] == -1) & (ret[, signalsColumn] == 0)) {
#           ret[i, signalsColumn]<--1
#       }
#   }
#   
#   return(ret)
}

感谢您在如何转换数据方面提供的帮助。

亲切的问候，萨摩。

编辑说明：在收到 Prasad Chalasani 和 J. Winchester 的两个非常有用且有见地的回答后，我意识到我遗漏了数据结构的重要信息。因此，我更改了上面的数据以更好地反映我的数据，并在下面复制了原始数据（基于这两个答案）：

数据：

         LongEntrySignal ShortEntrySignal LongExitSignal ShortExitSignal Signal
18.02.93               0                0              0               0      0
19.02.93               0                0              0               0      0
22.02.93               1                0              0               0      1
23.02.93               0                0              0               0      0
24.02.93               0                0              0               0      0
25.02.93               0                0              0               0      0
26.02.93               0                0              1               0      0
01.03.93               0                0              0               0      0
04.03.93               0                1              0               0     -1
05.03.93               0                0              0               0      0
11.03.93               0                0              0               1      0
12.03.93               0                0              0               0      0

我想以这种形式转换数据：

         LongEntrySignal ShortEntrySignal LongExitSignal ShortExitSignal Signal
18.02.93               0                0              0               0      0
19.02.93               0                0              0               0      0
22.02.93               1                0              0               0      1
23.02.93               0                0              0               0      1
24.02.93               0                0              0               0      1
25.02.93               0                0              0               0      1
26.02.93               0                0              1               0      1
01.03.93               0                0              0               0      0
04.03.93               0                1              0               0     -1
05.03.93               0                0              0               0     -1
11.03.93               0                0              0               1     -1
12.03.93               0                0              0               0      0

score 4 · Accepted Answer

您不需要使用循环，也不需要“回溯”。您可以使用矢量化函数cumsum来获得所需的内容。假设您的长进/出和短进/出周期不重叠，您可以这样做：首先组成虚拟信号：

n <- 15
zeros <- rep(0,n)
LongEnt <- replace(zeros, c(1, 12), 1)
LongEx <- replace(zeros, c(4, 14), 1)
ShortEnt <- replace(zeros, 6, 1)
ShortEx <- replace(zeros, 10, 1)

现在做一些cumsum魔术来获得正确的“聚合”信号列：

SigLong <- cumsum(LongEnt) - cumsum(LongEx) + LongEx
SigShort <- -cumsum(ShortEnt) + cumsum(ShortEx) - ShortEx
> cbind(LongEnt, LongEx, ShortEnt, ShortEx, Signal = SigLong + SigShort)
      LongEnt LongEx ShortEnt ShortEx Signal
 [1,]       1      0        0       0      1
 [2,]       0      0        0       0      1
 [3,]       0      0        0       0      1
 [4,]       0      1        0       0      1
 [5,]       0      0        0       0      0
 [6,]       0      0        1       0     -1
 [7,]       0      0        0       0     -1
 [8,]       0      0        0       0     -1
 [9,]       0      0        0       0     -1
[10,]       0      0        0       1     -1
[11,]       0      0        0       0      0
[12,]       1      0        0       0      1
[13,]       0      0        0       0      1
[14,]       0      1        0       0      1
[15,]       0      0        0       0      0

更新。根据OP修改后的问题，我们需要处理任意进/出信号序列的情况，并找到第一个进入和对应的第一个退出之间的周期。这是一种通过非常简单的算术运算（即没有昂贵的回顾或 if/else 检查）来做到这一点的方法。cumsum我们只需要对我将调用的函数进行一个小的修改cumplus——这就像cumsum，除了在取每个总和后，它会根据它是否为正数将其替换为 1 或 0：

cumplus <- function(y) Reduce(function(a,b) a + b > 0, y, 0, accum=TRUE)[-1]

（顺便说一句，Reduce这是一种无需显式写出for循环即可紧凑定义累积函数的好方法——详情请参阅?Reduce）。

现在以进入/退出信号为例：

LongEnt <- c(1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 
0, 1, 0, 0)
LongEx <- c(0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, 
1, 0, 0, 1)

x <- LongEnt - LongEx  
z <- cumplus(x)

这几乎就是我们想要的……我们只需要在每个块的末尾插入 1。

z <- z - c(0,pmin(0,diff(z)))

> cbind(LongEnt, LongEx, signal = z)
      LongEnt LongEx signal
 [1,]       1      0      1
 [2,]       0      0      1
 [3,]       0      0      1
 [4,]       1      0      1
 [5,]       0      0      1
 [6,]       0      0      1
 [7,]       1      0      1
 [8,]       0      0      1
 [9,]       0      1      1
[10,]       0      0      0
[11,]       0      0      0
[12,]       0      1      0
[13,]       1      0      1
[14,]       0      0      1
[15,]       0      0      1
[16,]       1      0      1
[17,]       0      0      1
[18,]       0      0      1
[19,]       0      1      1
[20,]       0      0      0
[21,]       0      1      0
[22,]       1      0      1
[23,]       0      0      1
[24,]       0      1      1

处理空头进/出当然是类似的。

score 0 · Accepted Answer

我做了几个逻辑假设，即：系统从中性状态（即零）开始；如果系统通过任一类型（多头/空头）的“进入”信号离开“零状态”，则下一个信号必须是相同类型的“退出”信号。如果我将您的数据读入一个名为的矩阵sigmat，我可以执行以下操作。

streamLong <- with(sigmat, LongEntrySignal == 1 | LongExitSignal == 1)
switches <- which(streamLong)
mat <- cbind(c(1, switches), c(switches, length(streamLong) + 1), 0:1)
stateLong <- do.call("c", apply(mat, 1, function(ro)rep(ro[3], ro[2] - ro[1])))

streamShort <- with(sigmat, ShortEntrySignal == 1 | ShortExitSignal == 1)
switches <- which(streamShort)
mat <- cbind(c(1, switches), c(switches, length(streamShort) + 1), 0:1)
stateShort <- do.call("c", apply(mat, 1, function(ro)rep(ro[3], ro[2] - ro[1])))

# EDIT: The entry signal stays "on" until end of the exit day 
# so add one to the on sequences, and subtract one from the off sequences
sigRLE <- rle(stateLong - stateShort)
sigRLE$lengths[-1] <- sigRLE$lengths[-1] + 1:0 + 0:-1
sigmat$signal <- rep(sigRLE$values, sigRLE$lengths)

这是输出。

R> sigmat
       date LongEntrySignal ShortEntrySignal LongExitSignal ShortExitSignal Signal signal
1  18.02.93               0                0              0               0      0      0
2  19.02.93               0                0              0               0      0      0
3  22.02.93               1                0              0               0      1      1
4  23.02.93               0                0              0               0      0      1
5  24.02.93               0                0              0               0      0      1
6  25.02.93               0                0              0               0      0      1
7  26.02.93               0                0              1               0      0      1
8  01.03.93               0                0              0               0      0      0
9  04.03.93               0                1              0               0     -1     -1
10 05.03.93               0                0              0               0      0     -1
11 11.03.93               0                0              0               1      0     -1
12 12.03.93               0                0              0               0      0      0

score 0 · Accepted Answer

我确信有一种“神奇的”（即矢量化）方法可以做到这一点，但现在，这是一个可行的循环解决方案。

# your example data
sigmat <- structure(list(
  date = structure(c(6L, 7L, 8L, 9L, 10L, 11L, 12L, 1L, 2L, 3L, 4L, 5L), 
  .Label = c("01.03.93", "04.03.93", "05.03.93", "11.03.93", "12.03.93", 
    "18.02.93", "19.02.93", "22.02.93", "23.02.93", "24.02.93", 
    "25.02.93", "26.02.93"), class = "factor"), 
  LongEntrySignal = c(0L, 0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L), 
  ShortEntrySignal = c(0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L, 0L, 0L), 
  LongExitSignal = c(1L, 0L, 0L, 0L, 0L, 0L, 1L, 1L, 0L, 0L, 0L, 1L), 
  ShortExitSignal = c(0L, 1L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 0L, 1L, 0L), 
  Signal = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), 
  .Names = c("date", "LongEntrySignal", "ShortEntrySignal", 
    "LongExitSignal", "ShortExitSignal", "Signal"), 
  row.names = c(NA, -12L), class = "data.frame")

# if there is an entry/exit signal, turn on/off
# otherwise keep the same state as the day before
sigShort <- sigmat$ShortEntrySignal - sigmat$ShortExitSignal
sigLong  <- sigmat$LongEntrySignal -  sigmat$LongExitSignal
for(i in 2:nrow(sigmat)) {
  if(sigShort[i] == 0) sigShort[i] <- sigShort[i-1]
  if(sigLong[i]  == 0) sigLong[i]  <- sigLong[i-1]
}

# The entry signal stays "on" until end of the exit day 
# so extend the on sequences by one day, and shorten the off sequences
sigRLE <- rle((sigLong > 0) * 1 - (sigShort > 0) * 1)
sigRLE$lengths[-1] <- sigRLE$lengths[-1] + 1:0 + 0:-1
sigmat$Signal <- rep(sigRLE$values, sigRLE$lengths)

r - 根据具有回溯的其他列值更改 xts 中某些列的值

3 回答 3

Related

Reference