R/calculate_sl.R

In rengelke/tradr:

#' Calculate Gradual Stop Loss from Price Data
#'
#' @param price asset price
#' @param sl1 number indicating drawdown at which to initiate gradual stop loss
#' @param sl2 number indicating drawdown to which to extend gradual stop loss
#' @param ma moving average type (SMA, EMA, ALMA or DEMA) to use for drawdown calculation
#' @param n number of periods to use for moving average calculation
#'
#' @return xts object indicating proportion of portfolio to be invested (1.0 = fully invested; 0.8 = 20% cash, etc.)
#' @importFrom magrittr %>% %<>%
#' @export
#'
#' @examples calculate_sl(xts_price, sl1 = -0.18, sl2 = -0.28, ma = c("ALMA"), n = 5)
calculate_sl <- function (price, sl1 = -0.18, sl2 = -0.28, ma = c("ALMA"), n = 5) {

    ma <- match.arg(ma, c("ALMA", "DEMA", "EMA", "SMA"), several.ok = FALSE)

    if (ma == "DEMA") {
        n_add <- 2*n
    } else {
        n_add <- n
    }

    index_ext <- rep(index(price)[1], n_add) - rev(seq_len(n_add))
    price_ext <- as.data.frame(rep(price[1], length(index_ext))) %>%
        xts(order.by = index_ext, dateFormat = "Date")
    price_fixed <- rbind(price_ext, price)

    if (!"Close" %in% colnames(price_fixed)) {
        price_fixed %<>% `colnames<-`(c("Close"))
    }

    sl_seq <- seq(sl1, sl2, by=(sl2-sl1)/7)

    if (ma == "ALMA") {
        ma_val <- price_fixed %>% Cl() %>% TTR::ALMA(., n=n, offest = 0.95, sigma = 2)
    }
    if (ma == "DEMA") {
        ma_val <- price_fixed %>% Cl() %>% TTR::DEMA(., n=n)
    }
    if (ma == "EMA") {
        ma_val <- price_fixed %>% Cl() %>% TTR::EMA(., n=n)
    }
    if (ma == "SMA") {
        ma_val <- price_fixed %>% Cl() %>% TTR::SMA(., n=n)
    }

    ma_dd <- ma_val %>%
        .[!is.na(.), ] %>%
        quantmod::dailyReturn() %>%
        PerformanceAnalytics::Drawdowns(geometric = TRUE)

    ma_dd_sl <- tradr::align_xts(
        ifelse(ma_dd < sl_seq[1], 0.9, 1),     #0.9
        ifelse(ma_dd < sl_seq[2], 0.8/0.9, 1)  #0.8
    )
    ma_dd_sl[[3]] <- tradr::align_xts(
        ma_dd_sl[[1]],
        ifelse(ma_dd < sl_seq[3], 0.7/0.8, 1)  #0.7
    )[[2]]
    ma_dd_sl[[4]] <- tradr::align_xts(
        ma_dd_sl[[1]],
        ifelse(ma_dd < sl_seq[4], 0.6/0.7, 1)  #0.6
    )[[2]]
    ma_dd_sl[[5]] <- tradr::align_xts(
        ma_dd_sl[[1]],
        ifelse(ma_dd < sl_seq[5], 0.5/0.6, 1)  #0.5
    )[[2]]
    ma_dd_sl[[6]] <- tradr::align_xts(
        ma_dd_sl[[1]],
        ifelse(ma_dd < sl_seq[6], 0.4/0.5, 1)  #0.4
    )[[2]]
    ma_dd_sl[[7]] <- tradr::align_xts(
        ma_dd_sl[[1]],
        ifelse(ma_dd < sl_seq[7], 0.3/0.4, 1)  #0.3
    )[[2]]
    ma_dd_sl[[8]] <- tradr::align_xts(
        ma_dd_sl[[1]],
        ifelse(ma_dd < sl_seq[8], 0.2/0.3, 1)  #0.2
    )[[2]]
    ma_dd_sl %<>% Reduce("*", .)
    ma_dd_sl %<>%
        .[index(price), ] %>%
        `colnames<-`(c("StopLoss"))

    return(ma_dd_sl)
}