R/supertrend.R

In rengelke/tradr:

#' SuperTrend
#'
#' @param HLC xts object that contains High-Low-Close prices
#' @param n period of days
#' @param f Average True Range factor
#'
#' @import xts
#' @import quantmod
#'
#' @return
#' @export
#'
#' @examples supertrend(price_data, n = 10, f = 3)
supertrend <- function(HLC, n = 10, f = 3) {

    atr <- TTR::ATR(HLC, n = n)

    upperbasic <- (HLC[, 1] + HLC[, 2])/2 + (f * atr$atr)
    upperfinal <- upperbasic
    close <- HLC[, 3]
    for (i in seq_len(nrow(upperbasic))[-1]) {
        if (isTRUE(close[i-1] < upperfinal[i-1])) {
            upperfinal[i] <- min(upperbasic[i], upperfinal[i-1], na.rm = TRUE)
        } else {
            upperfinal[i] <- upperbasic[i]
        }
    }

    lowerbasic <- (HLC[, 1] + HLC[, 2])/2 - (f * atr$atr)
    lowerfinal <- lowerbasic
    close <- HLC[, 3]
    for (i in seq_len(nrow(lowerbasic))[-1]) {
        if (isTRUE(close[i-1] > lowerfinal[i-1])) {
            lowerfinal[i] <- max(lowerbasic[i], lowerfinal[i-1], na.rm = TRUE)
        } else {
            lowerfinal[i] <- lowerbasic[i]
        }
    }

    supertrend <- cbind(upperfinal, lowerfinal)
    supertrend$supertrend <- NA
    st <- supertrend$supertrend

    cl_greater_upper <- close > upperfinal
    cl_greater_lower <- close > lowerfinal
    cl_less_upper <- close < upperfinal
    cl_less_lower <- close < lowerfinal

    for (i in seq_len(nrow(supertrend))[-1]) {
        if ( isTRUE(st[i-1] == upperfinal[i-1]) &
             isTRUE(cl_less_upper[i]) ) {
            st[i] <- upperfinal[i]
        } else if ( isTRUE(st[i-1] == upperfinal[i-1]) &
                    isTRUE(cl_greater_upper[i]) ) {
            st[i] <- lowerfinal[i]
        } else if ( isTRUE(st[i-1] == lowerfinal[i-1]) &
                    isTRUE(cl_greater_lower[i]) ) {
            st[i] <- lowerfinal[i]
        } else if ( isTRUE(st[i-1] == lowerfinal[i-1]) &
                    isTRUE(cl_less_lower[i]) ) {
            st[i] <- upperfinal[i]
        } else if ( isTRUE(cl_less_upper[i]) ) {
            st[i] <- upperfinal[i]
        } else if ( isTRUE(cl_greater_lower[i]) ) {
            st[i] <- lowerfinal[i]
        }
    }
    st
}