R/make_mltimer.R

In jeanmarcgp/xtsanalytics: A library of functions to do advanced analytics of time series data (xts matrices).

####################################################################################
# FILE make_mltimer.R
#
#
####################################################################################
# FUNCTION make_mltimer
#
#' Converts the output list of a machine learning predictor into a timer
#'
#'
#' @param mlresults The output list generated by a wfo machine learning
#'                  asset price predictor.
#'
#' @param prices    An xts matrix containing the price of the asset being
#'                  timed using the predictions of the machine learner. This
#'                  should be a one column xts matrix.
#'
#' @param rules     A list of equity curves to generate from the timer.  Each list
#'                  object consist of a named list which names the equity curve and
#'                  contains the rules to construct that equity curve.  The first
#'                  item on each named list must be the name of the ruleset to follow,
#'                  and other items are its arguments, which may be optional. For
#'                  details on the supported rules, see function
#'                  \code{\link{make_equitycurve}}.
#'
#'
#' @param trade_day Specified when the timer trade is executed. trade_day = 1 means
#'                  the trade is executed at the close of day when the timer is
#'                  calculated.  trade_day = 2 means at the next close, and so on.
#'
#' @return Returns a list containing the folloring xts matrices:
#' \describe{
#'   \item{\preformatted{$long}}{
#'      An xts matrix containing the equity curves associated with each timer method,
#'      computed daily, and long when the post-processed timer is positive, or
#'      in cash otherwise (without earning any interest). The normalized asset
#'      price equity curve is also included to enable an easy comparison.
#'   }
#'   \item{\preformatted{$timers}}{
#'      An xts matrix containing the binary timers associated with each timer method,
#'      computed daily, indicating one when the post-processed timer is positive, or
#'      zero otherwise.
#'   }
#' }
#'
#' @export
#-----------------------------------------------------------------------------------
make_mltimer <- function(mlresults, prices, rules, trade_day = 1) {

  #------------------------------------------------------
  # Extract the predictions and convert to a timer
  #------------------------------------------------------
  startdate       <- index(mlresults$pred[1, ])
  lastdate        <- index(mlresults$pred[nrow(mlresults$pred), ])
  timeframe       <- paste0(startdate, "/", lastdate)

  data            <- prices[timeframe, 1]
  data$rets       <- ROC(data[, 1], type = "discrete")
  data$y          <- mlresults$pred[, "y"]
  data$yhat       <- mlresults$pred[, "yhat"]

  #------------------------------------------------------
  # Lag yhat to align with trade day.  Lag = 1 means
  # trading happens at close of same day as features
  # are caculated.  Lag = 2 is next day's close.
  #------------------------------------------------------
  data$yhattrade  <- lag(data$yhat, k = trade_day)
  #data$timer      <- ifelse(data$yhattrade >= 0, 1, 0)
  data$timer      <- ifelse(sign(data$yhattrade) > 0, 1, 0) # propagates NAs

  data$ytrade     <- lag(data$y, k = trade_day)
  #data$perfect    <- ifelse(data$ytrade >= 0, 1, 0)
  data$perfect    <- ifelse(sign(data$ytrade) > 0, 1, 0) # propagates NAs

  #---------------------------------------------------------
  # Make the timer series and timed equity curves
  #---------------------------------------------------------
  cnames    <- c(colnames(data)[1], "perfect")
  yrules    <- list(perfect    = list(type = "endpoints", on = "days"))
  ycurve    <- make_equitycurve(data[, cnames], rules = yrules, Nlag = 0)

  cnames    <- c(colnames(data)[1], "timer")
  x         <- make_equitycurve(data[, cnames], rules = rules, Nlag = 0)

  #sprint("column names:")
  #sprint(colnames(ycurve$long))

  #sprint("number of columns: %s", ncol(ycurve$long))

  long      <- cbind(x$long, ycurve$long[, "timer_perfect"])
  GC        <- make_bench(prices, retval = c("timedec", "timerlag"))
  long$GC   <- GC[timeframe, 1] / rep(GC[1,1], nrow(GC[timeframe,]))  # normalize
  long      <- long[complete.cases(long), ]

  timers    <- cbind(x$timers, ycurve$timers[, "timer_perfect"])
  timers$GC <- GC[timeframe, 2]

  #--------------------------------------------------------
  # Build list to return
  #--------------------------------------------------------
  retlist  <- list(long = long, timers = timers)

  return(retlist)

}