TTR: Technical Trading Rules

#
#   TTR: Technical Trading Rules
#
#   Copyright (C) 2007-2013  Joshua M. Ulrich
#
#   This program is free software: you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation, either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program.  If not, see <http://www.gnu.org/licenses/>.
#

#' Stochastic Oscillator / Stochastic Momentum Index
#'
#' The stochastic oscillator is a momentum indicator that relates the location
#' of each day's close relative to the high/low range over the past \code{n}
#' periods.  Developed by George C.  Lane in the late 1950s.  The SMI relates
#' the close to the midpoint of the high/low range.  Developed by William Blau
#' in 1993.
#'
#' If a High-Low-Close series is provided, the indicator is calculated using the
#' high/low values.  If a vector is provided, the calculation only uses that
#' series.  This allows stochastics to be calculated for: (1) series that have
#' no HLC definition (e.g. foreign exchange), and (2) stochastic indicators
#' (e.g. stochastic RSI - see examples).
#'
#' The \code{smooth} argument is the number of periods of internal smoothing to
#' apply to the differences in the high-low-close range before calculating Fast
#' K.  Thanks to Stanley Neo for the suggestion.
#'
#' @aliases stochastics stochastic stoch SMI %K %D
#' @param HLC Object that is coercible to xts or matrix and contains
#' High-Low-Close prices.  If only a univariate series is given, it will be
#' used.  See details.
#' @param n Number of periods to use.
#' @param nFastK Number of periods for fast \%K (i.e. the number of past periods
#' to use).
#' @param nFastD Number of periods for fast \%D (i.e. the number smoothing
#' periods to apply to fast \%K).
#' @param nSlowD Number of periods for slow \%D (i.e. the number smoothing
#' periods to apply to fast \%D).
#' @param smooth Number of internal smoothing periods to be applied before
#' calculating FastK. See Details.
#' @param nFast Number of periods for initial smoothing.
#' @param nSlow Number of periods for double smoothing.
#' @param nSig Number of periods for signal line.
#' @param maType Either:
#'  \enumerate{
#'    \item A function or a string naming the function to be called.
#'    \item A \emph{list} with the first component like (1) above, and
#'      additional parameters specified as \emph{named} components.
#'      See Examples.
#'  }
#' @param bounded Logical, should current period's values be used in the
#' calculation?
#' @param \dots Other arguments to be passed to the \code{maType} function in
#' case (1) above.
#' @return A object of the same class as \code{HLC} or a matrix (if
#' \code{try.xts} fails) containing the columns:
#'  \describe{
#'     \item{ fastK }{ Stochastic Fast \%K }
#'     \item{ fastD }{ Stochastic Fast \%D }
#'     \item{ slowD }{ Stochastic Slow \%D }
#'     \item{ SMI }{ Stochastic Momentum Index }
#'     \item{ signal }{ Stochastic Momentum Index signal line }
#'  }
#' @note The calculation for William's \%R is similar to that of stochastics'
#' fast \%K.
#'
#' The value for fast \%K will be 0.5 whenever the highest high and
#' lowest low are the same over the last \code{n} periods.
#'
#' The stochastic oscillator and SMI calculate relative value of the close
#' versus the high/low range and the midpoint of the high/low range,
#' respectively.
#'
#' The stochastic oscillator and the stochastic momentum index are interpreted
#' similarly.  Readings below 20 (above 80) are considered oversold
#' (overbought).  However, readings below 20 (above 80) are not necessarily
#' bearish (bullish).  Lane believed some of the best sell (buy) signals
#' occurred when the oscillator moved from overbought (oversold) back below 80
#' (above 20).
#'
#' For the stochastic oscillator, buy (sell) signals can also be given when \%K
#' crosses above (below) \%D.  Crossover signals are quite frequent however,
#' which may result in whipsaws.
#' @author Joshua Ulrich
#' @seealso See \code{\link{EMA}}, \code{\link{SMA}}, etc. for moving average
#' options; and note Warning section.  See \code{\link{WPR}} to compare it's
#' results to fast \%K.
#' @references The following site(s) were used to code/document these
#' indicators:
#' \cr Stochastic Oscillator:\cr
#' \url{https://www.fmlabs.com/reference/StochasticOscillator.htm}\cr
#' \url{https://www.metastock.com/Customer/Resources/TAAZ/?p=106}\cr
#' \url{https://www.linnsoft.com/techind/stochastics}\cr
#' \url{https://school.stockcharts.com/doku.php?id=technical_indicators:stochastic_oscillator_fast_slow_and_full}\cr
#' \cr SMI:\cr
#' \url{https://www.fmlabs.com/reference/default.htm?url=SMI.htm}\cr
#' @keywords ts
#' @examples
#'
#'  data(ttrc)
#'  stochOSC <- stoch(ttrc[,c("High","Low","Close")])
#'  stochWPR <- WPR(ttrc[,c("High","Low","Close")])
#'
#'  plot(tail(stochOSC[,"fastK"], 100), type="l",
#'      main="Fast %K and Williams %R", ylab="",
#'      ylim=range(cbind(stochOSC, stochWPR), na.rm=TRUE) )
#'  lines(tail(stochWPR, 100), col="blue")
#'  lines(tail(1-stochWPR, 100), col="red", lty="dashed")
#'
#'  stoch2MA <- stoch( ttrc[,c("High","Low","Close")],
#'      maType=list(list(SMA), list(EMA, wilder=TRUE), list(SMA)) )
#'
#'  SMI3MA <- SMI(ttrc[,c("High","Low","Close")],
#'      maType=list(list(SMA), list(EMA, wilder=TRUE), list(SMA)) )
#'
#'  stochRSI <- stoch( RSI(ttrc[,"Close"]) )
#' @rdname stochastics
"stoch" <-
function(HLC, nFastK=14, nFastD=3, nSlowD=3, maType, bounded=TRUE, smooth=1, ...) {

  # Stochastics

  HLC <- try.xts(HLC, error=as.matrix)

  # Calculation if HLC series is given
  if(NCOL(HLC)==3) {
    high  <- HLC[,1]
    low   <- HLC[,2]
    close <- HLC[,3]
  } else

  # Calculation if price vector is given
  if(NCOL(HLC)==1) {
    high  <- HLC
    low   <- HLC
    close <- HLC
  } else

  stop("Price series must be either High-Low-Close, or Close")

  if(bounded) {
    hmax <- runMax(high, nFastK)
    lmin <- runMin( low, nFastK)
  } else {
    hmax <- runMax(c(high[1],high[-NROW(HLC)]), nFastK)
    lmin <- runMin(c( low[1], low[-NROW(HLC)]), nFastK)
  }

  num <- close - lmin
  den <- hmax - lmin

  if(missing(maType)) {
    maType <- 'SMA'
  }

  # Case of two different 'maType's for both MAs.
  # e.g. stoch(price, 14, 3, 3,
  #           maType=list(maUp=list(EMA,ratio=1/5), maDown=list(WMA,wts=1:10)) )
  if( is.list(maType) ) {

    # Make sure maType is a list of lists
    maTypeInfo <- sapply(maType,is.list)
    if( !(all(maTypeInfo) && length(maTypeInfo) == 3) ) {
      stop("If \'maType\' is a list, you must specify\n ",
      "*three* MAs (see Examples section of ?stochastics)")
    }

    # If MA function has 'n' arg, see if it's populated in maType;
    # if it isn't, populate it with function's formal 'n'
    if( !is.null( formals(maType[[1]][[1]])$n ) && is.null( maType[[1]]$n ) ) {
      maType[[1]]$n <- nFastD
    }
    if( !is.null( formals(maType[[2]][[1]])$n ) && is.null( maType[[2]]$n ) ) {
      maType[[2]]$n <- nSlowD
    }
    if( !is.null( formals(maType[[3]][[1]])$n ) && is.null( maType[[3]]$n ) ) {
      maType[[3]]$n <- smooth
    }

    numMA <- do.call( maType[[3]][[1]], c( list(num), maType[[3]][-1] ) )
    denMA <- do.call( maType[[3]][[1]], c( list(den), maType[[3]][-1] ) )

    fastK <- numMA / denMA
    fastK[!is.finite(fastK) & !is.na(fastK)] <- 0.5
    fastD <- do.call( maType[[1]][[1]], c( list(fastK), maType[[1]][-1] ) )
    slowD <- do.call( maType[[2]][[1]], c( list(fastD), maType[[2]][-1] ) )
  }

  # Case of one 'maType' for both MAs.
  # e.g. stoch(price, 14, 3, 3, maType="WMA", wts=volume )
  else {

    numMA <- do.call( maType, c( list(num), list(n=smooth) ) )
    denMA <- do.call( maType, c( list(den), list(n=smooth) ) )

    fastK <- numMA / denMA
    fastK[!is.finite(fastK) & !is.na(fastK)] <- 0.5
    fastD <- do.call( maType, c( list(fastK), list(n=nFastD, ...) ) )
    slowD <- do.call( maType, c( list(fastD), list(n=nSlowD, ...) ) )

  }

  result <- cbind( fastK, fastD, slowD )
  colnames(result) <- c( "fastK", "fastD", "slowD" )

  reclass(result, HLC)
}

#-------------------------------------------------------------------------#

#' @rdname stochastics
"SMI" <-
function(HLC, n=13, nFast=2, nSlow=25, nSig=9, maType, bounded=TRUE, ...) {

  # Stochastic Momentum Index
  # Not Validated

  # http://www.fmlabs.com/reference/default.htm?url=SMI.htm
  # The median in the SMI formula on the above site is incorrect.

  # Calculation if HLC series is given
  if(ncol(HLC)==3) {
    high  <- HLC[,1]
    low   <- HLC[,2]
    close <- HLC[,3]
  } else

  # Calculation if price vector is given
  if(ncol(HLC)==1) {
    high  <- HLC
    low   <- HLC
    close <- HLC
  } else

  stop("Price series must be either High-Low-Close, or Close")

  if(bounded) {
    hmax <- runMax(high, n)
    lmin <- runMin( low, n)
  } else {
    hmax <- runMax(c(high[1],high[-NROW(HLC)]), n)
    lmin <- runMax(c( low[1], low[-NROW(HLC)]), n)
  }
  hmax <- ifelse( is.na(hmax), high, hmax )
  lmin <- ifelse( is.na(lmin),  low, lmin )

  HLdiff <- hmax - lmin
  Cdiff  <- close - ( hmax + lmin ) / 2

  if(missing(maType)) {
    maType <- 'EMA'
  }

  # Case of two different 'maType's for both MAs.
  # e.g. SMI(price, 13, 2, 25, 9,
  #           maType=list(maUp=list(EMA,ratio=1/5), maDown=list(WMA,wts=1:10)) )
  if( is.list(maType) ) {

    # Make sure maType is a list of lists
    maTypeInfo <- sapply(maType,is.list)
    if( !(all(maTypeInfo) && length(maTypeInfo) == 3) ) {
      stop("If \'maType\' is a list, you must specify\n ",
      "*three* MAs (see Examples section of ?SMI)")
    }

    # If MA function has 'n' arg, see if it's populated in maType;
    # if it isn't, populate it with function's formal 'n'
    if( !is.null( formals(maType[[1]][[1]])$n ) && is.null( maType[[1]]$n ) ) {
      maType[[1]]$n <- nFast
    }
    if( !is.null( formals(maType[[2]][[1]])$n ) && is.null( maType[[2]]$n ) ) {
      maType[[2]]$n <- nSlow
    }
    if( !is.null( formals(maType[[3]][[1]])$n ) && is.null( maType[[3]]$n ) ) {
      maType[[3]]$n <- nSig
    }

    num1 <- do.call( maType[[1]][[1]], c( list(Cdiff ), maType[[1]][-1] ) )
    den1 <- do.call( maType[[1]][[1]], c( list(HLdiff), maType[[1]][-1] ) )
    num2 <- do.call( maType[[2]][[1]], c( list( num1 ), maType[[2]][-1] ) )
    den2 <- do.call( maType[[2]][[1]], c( list( den1 ), maType[[2]][-1] ) )

    SMI <- 100 * ( num2 / ( den2 / 2 ) )
    signal <- do.call( maType[[3]][[1]], c( list(SMI), maType[[3]][-1] ) )

  }

  # Case of one 'maType' for both MAs.
  # e.g. SMI(price, 13, 2, 25, 9, maType="WMA", wts=volume )
  else {

    num1 <- do.call( maType, c( list(Cdiff ), list(n=nSlow, ... ) ) )
    den1 <- do.call( maType, c( list(HLdiff), list(n=nSlow, ... ) ) )
    num2 <- do.call( maType, c( list( num1 ), list(n=nFast, ... ) ) )
    den2 <- do.call( maType, c( list( den1 ), list(n=nFast, ... ) ) )

    SMI <- 100 * ( num2 / ( den2 / 2 ) )
    signal <- do.call( maType, c( list(SMI), list(n=nSig, ... ) ) )

  }

  result <- cbind( SMI, signal )
  colnames(result) <- c( "SMI", "signal" )

  reclass( result, HLC )
}