CODEWITHSUNDEEP
rzoo
alexeymosco
alexeymosco

Reputation: 311

r rolling custom function

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')

Upvotes: 3

Views: 2159

Answers (2)

alexeymosco
alexeymosco

Reputation: 311

jackStinger, thanks for acute eye. I indeed had mixed x-y and dataframe-vector. I updated the code and it seems to work just fine with rollapply: 

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 > z]) <= n
        & (min(c(1:length(x))[x > z]) < min(c(1:length(x))[x < -z])
           | is.infinite(min(c(1:length(x))[x < -z])) == T)){
        level <- 1

    }else if (min(c(1:length(x))[x < -z]) <= n
           & (min(c(1:length(x))[x < -z]) < min(c(1:length(x))[x > z])
              | is.infinite(min(c(1:length(x))[x > z])) == T)){
        level <- -1

    } else {
        level <- 0
    }
    return(level)
}

level_break(y, n = 1000, z = 21)

library(zoo)

yy <- rollapply(data = y$`x$cumul`, width = 100, align = 'left', function(x) level_break(x, n = 100, z = 1))

plot(yy, type = 'l')

I am now passing x to my function, and inside that function it is treated as vector. It seems to work just fine. The last line of code - plots the expected results. Thank you a lot!

Upvotes: 0

jackStinger
jackStinger

Reputation: 2055

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. :)

Upvotes: 6

Related Questions