I am trying to build a rolling take-profit / stop-loss detection function in R using zoo package.
x <- as.data.frame(rnorm(10000, 0, 1))
x$cumul <- cumsum(x[, 1])
plot(x$cumul, type = 'l')
y <- as.data.frame(x$cumul)
level_break <- function(x, n, z){
if (min(c(1:nrow(x))[x[, 1] > z]) <= n
& (min(c(1:nrow(x))[x[, 1] > z]) < min(c(1:nrow(x))[x[, 1] < -z])
| min(c(1:nrow(x))[x[, 1] < -z]) > n)){
level <- 1
}else if (min(c(1:nrow(x))[x[, 1] < -z]) <= n
& (min(c(1:nrow(x))[x[, 1] < -z]) < min(c(1:nrow(x))[x[, 1] > z])
| min(c(1:nrow(x))[x[, 1] > z]) > n)){
level <- -1
} else {
level <- 0
}
return(level)
}
library(zoo)
yy <- rollapply(data = y$`x$cumul`, width = 1000, align = 'left', function(x) level_break(y, n = 1000, z = 1))
I am sure I am making something wrong. Could you please help me understand how to make it work. Or otherwise I would be happy to learn that there is a dedicated function in some package that does exactly what I am doing.
After all clarifications: An ultimate take-profit/stop-loss function:
#################### sl-tp
x <- as.data.frame(rnorm(10000, 0, 1))
x$cumul <- cumsum(x[, 1])
plot(x$cumul, type = 'l')
y <- as.data.frame(x$cumul)
level_break <- function(x, n, tp, sl) {
if (min(c(1:length(x))[x > tp]) <= n
& (min(c(1:length(x))[x > tp]) < min(c(1:length(x))[x < sl])
| is.infinite(min(c(1:length(x))[x < sl])) == T)) {
level <- 1
}else if (min(c(1:length(x))[x < sl]) <= n
& (min(c(1:length(x))[x < sl]) < min(c(1:length(x))[x > tp])
| is.infinite(min(c(1:length(x))[x > tp])) == T)) {
level <- -1
} else {
level <- 0
}
return(level)
}
library(zoo)
level <- 10
window <- 1000
start <- Sys.time()
yy <- rollapply(data = y$`x$cumul`
, width = window
, align = 'left'
, function(x) level_break(x = x, n = window, tp = head(x + level, 1), sl = head(x - level, 1)))
Sys.time() - start
plot(yy, type = 'l')
Your Orchestration logic is fine. I wrote a simplified version of rollapply to demonstrate it.
x = sample(1:1000,100,replace = T)
stop_loss = function(vec){
if(vec[10]< 0.75*mean(vec)) return(TRUE)
return(FALSE)
}
rollapply(x,width = 10,FUN = stop_loss)
The Output looks like:
[1] TRUE FALSE TRUE FALSE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE TRUE FALSE FALSE
[16] FALSE FALSE FALSE TRUE TRUE FALSE FALSE FALSE FALSE FALSE FALSE TRUE FALSE FALSE TRUE
[31] TRUE FALSE FALSE FALSE FALSE TRUE TRUE TRUE TRUE FALSE FALSE TRUE TRUE FALSE FALSE
[46] TRUE TRUE TRUE FALSE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE
[61] FALSE TRUE TRUE FALSE TRUE FALSE TRUE FALSE FALSE FALSE FALSE FALSE FALSE FALSE TRUE
[76] FALSE TRUE FALSE FALSE TRUE FALSE TRUE TRUE TRUE FALSE TRUE TRUE FALSE TRUE FALSE
[91] FALSE
91 outputs on an input of 100 with a width of 10- perfect. That leaves your logic to be tested.
Looking at what you wrote, your input has a prob. You are passing the dataframe y into the level_break function. It's got to be x.
Now, you've written your function to take x as a dataframe, it goes in as a vector.
Here is what I changed your code to:
x <- as.data.frame(rnorm(10000, 0, 1))
x$cumul <- cumsum(x[, 1])
plot(x$cumul, type = 'l')
y <- as.data.frame(x$cumul)
level_break <- function(x, n, z){
if (min(c(1:length(x))[x[1] > z]) <= n
& (min(c(1:length(x))[x[1] > z]) < min(c(1:length(x))[x[1] < -z])
| min(c(1:length(x))[x[1] < -z]) > n)){
level <- 1
}else if (min(c(1:length(x))[x[1] < -z]) <= n
& (min(c(1:length(x))[x[1] < -z]) < min(c(1:length(x))[x[1] > z])
| min(c(1:length(x))[x[1] > z]) > n)){
level <- -1
} else {
level <- 0
}
return(level)
}
library(zoo)
yy <- rollapply(data = y$`x$cumul`, width = 1000, align = 'left', function(x) level_break(x, n = 1000, z = 1))
You'll need to check the min condition- It throws warnings. :)