r滾動自定義函數

Question

我想在R中使用動物園包建立滾動的獲利/止損檢測功能。

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

我確定自己做錯了什麼。你能幫我理解如何使它工作。否則，我會很高興得知在某些軟件包中有一個專門的功能，它完全符合我所做的。

全部澄清之後：終極取利潤/止損功能：

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

Answer 1

你編排邏輯是罰款。我寫了一個簡化版的rollapply來演示它。

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) 

的輸出如下所示：

[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輸出上的100 10-完美的寬度的輸入。這讓你的邏輯被測試。

看看你寫的是什麼，你的輸入有一個概率。您正在將dataframe y傳遞給level_break函數。它必須是x。

現在，你已經編寫了你的​​函數x作爲dataframe，它作爲vector進入。

這是我改變了你的代碼：

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

你需要檢查分條件 - 它拋出警告。 :)

Answer 2

jackStinger，謝謝你的急性眼睛。我確實混合了x-y和dataframe-vector。我更新的代碼，它似乎只是正常工作與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') 

我現在路過x到我的功能，並且該函數內部它被當作載體。它似乎工作得很好。最後一行代碼 - 繪製預期結果。萬分感謝！