####################################################################################
# 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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.