I have the following xts object (representing long/short entries (column 1 and 2) and exit (columns 3 and 4) triggers with "aggregate" signal column which should be 1 (system is long), -1 (system is short) or 0 (system is flat). I can not make this work for "aggregate" signal column5...
The data:
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
I would like to transform the data in this form:
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
I tried uprogramming a function like below (but id does not work; the commented out part also does not work and is terribly slow - I am aware of using loops in R is slow but that was the only idea that I had):
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)
}
Thanks for your kind help in how to transform the data.
Kind regards, Samo.
Edit note: After receving two very helpful and insightful answers from Prasad Chalasani and J. Winchester I realized I left out important information from how my data is structured. So I changed the data above to better reflect my data and copied original (based on which two answers were based) below:
The data:
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
I would like to transform the data in this form:
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
You don't need to use loops, nor do you need to "lookback". You can use the vectorized function cumsum to get what you want. Assuming your long entry/exit and short entry/exit periods are non-overlapping, you can do this: First make up dummy signals:
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)
Now do some cumsum magic to get the right "aggregate" signal column:
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
Update. According to the OP's modified question, we need to handle the case of arbitrary sequence of entry/exit signals, and find the periods between the first entry and the corresponding first exit. Here's a way to do this with very simple arihtmetic operations (i.e. no expensive lookbacks or if/else checking). We just need a small modification of the cumsum function that I will call cumplus -- this is like cumsum, except that after taking each sum, it replaces it with 1 or 0 depending on whether it's positive or not:
cumplus <- function(y) Reduce(function(a,b) a + b > 0, y, 0, accum=TRUE)[-1]
(Incidentally, Reduce is a nice way to compactly define a cumulative function without explicitly writing out the for loop -- see ?Reduce for details).
Now take an example of Entry/exit signals:
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)
This is almost what we want... we just need to insert the 1s at the end of each ones-block.
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
Dealing with the short entry/exits would of course be similar.
I have made a couple logical assumptions, namely: the system starts in neutral state (ie zero); if the system leaves "zero state" by an "entry" signal of either type (long/short), the next signal must be an "exit" signal of the same type. If I read your data into a matrix named sigmat I can do the following.
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)
Here is the output.
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
I'm sure there's a "magical" (ie vectorized) way to do this, but for now, here's a workable loop solution.
# 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)
来源：https://stackoverflow.com/questions/5135087/change-value-of-some-column-in-xts-based-on-other-columns-values-with-lookback