R/strategy2.R

In Chen-Chaozong/extraquantstrat: extra functions of Quantitative Strategy Model Framework

#' 
#' apply the strategy to arbitrary market data
#' This function is different from \code{applyStrategy}, add stop loss signal and rules in
#' This function is the wrapper that holds together the execution of a strategy.
#' 
#' After the straetgy object has been created, it may be applied to any 
#' combination of symbols and parameters.
#' 
#' The symbols to be utilized will be defined in one of two ways, either by
#' specifying a name of a portfolio that has already been initialized 
#' with the \code{portfolios} argument, or be specifying a 
#' \code{symbols} argument in  addition to setting \code{initStrat=TRUE}.
#' 
#' \code{applyStrategy} will use the \R core function \code{\link{get}} 
#' to load market data for each symbol during stategy evaluation unless 
#' the user passes \code{mktdata} in the call to \code{applyStrategy}
#'
#'  
#' @param strategy an object of type 'strategy' to add the indicator to
#' @param portfolios a list of portfolios to apply the strategy to
#' @param mktdata an xts object containing market data.  depending on indicators, may need to be in OHLCV or BBO formats, default NULL
#' @param parameters named list of parameters to be applied during evaluation of the strategy, default NULL
#' @param ... any other passthru parameters
#' @param debug if TRUE, return output list
#' @param symbols character vector identifying symbols to initialize a portfolio for, default NULL
#' @param initStrat whether to use (experimental) initialization code, default FALSE
#' @param updateStrat whether to use (experimental) wrapup code, default FALSE
#' @param initBySymbol whether to load and initialize each instrument within the \code{Symbols} loop. See \code{initSymbol} for details on how
#'                     to run a custom function. Moreover, if the argument \code{Interval} is available (as passthrough to \code{updatePortf} via \code{updateStrat}),
#'                     each instrument is downsampled to the frequency specified by \code{Interval} for the purpose of marking the Portfolio.
#'                     Notice that this happenes only after the strategy has been applied.
#' @param gc if TRUE, call \code{\link{gc}} after each symbol run, default FALSE (experimental)
#' @param delorders if TRUE, delete the order book for a symbol at the end of the symbols loop, will cause issues with rebalancing, default FALSE (experimental)
#' @export
apply_Strategy <- function(strategy, 
                           portfolios, 
                           mktdata=NULL, 
                           parameters=NULL, 
                           ..., 
                           debug=FALSE, 
                           symbols=NULL, 
                           initStrat=FALSE, 
                           updateStrat=FALSE,
                           initBySymbol=FALSE,
                           gc=FALSE,
                           delorders=FALSE) {
  
  #TODO add saving of modified market data
  
  if(isTRUE(debug)) ret<-list()
  
  if (!is.strategy(strategy)) {
    strategy<-try(getStrategy(strategy))
    if(inherits(strategy,"try-error"))
      stop ("You must supply an object of type 'strategy'.")
  } 
  
  if (missing(mktdata) || is.null(mktdata)) load.mktdata=TRUE else load.mktdata=FALSE
  
  for (portfolio in portfolios) {
    
    # call initStrategy
    if(isTRUE(initStrat)) initStrategy(strategy=strategy, portfolio, symbols, ...=...)
    
    if(isTRUE(debug)) ret[[portfolio]]<-list() # this is slot [[i]] which we will use later
    pobj<-.getPortfolio(portfolio)
    symbols<- ls(pobj$symbols)
    sret<-new.env(hash=TRUE)
    
    for (symbol in symbols){
      if(isTRUE(load.mktdata)){
        if(isTRUE(initBySymbol)) initSymbol(strategy, symbol, ... = ...)
        mktdata <- get(symbol)
      }
      
      # loop over indicators
      sret$indicators <- applyIndicators(strategy=strategy, mktdata=mktdata , parameters=parameters, ... )
      
      if(inherits(sret$indicators,"xts") & nrow(mktdata)==nrow(sret$indicators)){
        mktdata<-sret$indicators
        sret$indicators <- NULL
      }
      
      # loop over signal generators
      sret$signals <- applySignals(strategy=strategy, mktdata=mktdata, parameters=parameters, ... )
      
      if(inherits(sret$signals,"xts") & nrow(mktdata)==nrow(sret$signals)){
        mktdata<-sret$signals
        sret$signals<-NULL
      }
      
      if(!is.null(strategy$stoploss)) mktdata<- applyStoplossSig(strategy=strategy, mktdata=mktdata, parameters=parameters, ... )
      
      # 
      #loop over rules  
      sret$rules<-list()
      
      # only fire nonpath/pathdep when true
      # TODO make this more elegant
      pd <- FALSE
      for(i in 1:length(strategy$rules)){  
        if(length(strategy$rules[[i]])!=0){z <- strategy$rules[[i]]; if(z[[1]]$path.dep==TRUE){pd <- TRUE}}
      }
      
      sret$rules$nonpath<-applyRules(portfolio=portfolio, 
                                     symbol=symbol, 
                                     strategy=strategy, 
                                     mktdata=mktdata, 
                                     Dates=NULL, 
                                     indicators=sret$indicators, 
                                     signals=sret$signals, 
                                     parameters=parameters,  
                                     ..., 
                                     path.dep=FALSE,
                                     debug=debug)
      
      # Check for open orders
      rem.orders <- suppressWarnings(getOrders(portfolio=portfolio, symbol=symbol, status="open")) #, timespan=timespan, ordertype=ordertype,which.i=TRUE)
      if(NROW(rem.orders)>0){pd <- TRUE}
      if(pd==TRUE){sret$rules$pathdep<-applyRules(portfolio=portfolio, 
                                                  symbol=symbol, 
                                                  strategy=strategy, 
                                                  mktdata=mktdata, 
                                                  Dates=NULL, 
                                                  indicators=sret$indicators, 
                                                  signals=sret$signals, 
                                                  parameters=parameters,  
                                                  ..., 
                                                  path.dep=TRUE,
                                                  debug=debug)}
      
      if(isTRUE(initBySymbol)) {
        if(hasArg(Interval)){
          Interval <- match.call(expand.dots=TRUE)$Interval
          if(!is.null(Interval)){
            temp.symbol <- get(symbol) 
            ep_args     <- blotter:::.parse_interval(Interval)
            temp.symbol <- temp.symbol[endpoints(temp.symbol, on = ep_args$on, k = ep_args$k)]
            if(hasArg(prefer)){
              prefer      <- match.call(expand.dots=TRUE)$prefer
              temp.symbol <- getPrice(temp.symbol, prefer=prefer)[,1]
            }
            assign(symbol, temp.symbol, envir = .GlobalEnv)
          }
        } else {
          rm(list = symbol)
          gc()
        }
      }
      
      if(isTRUE(debug)) ret[[portfolio]][[symbol]]<-sret
      
      if(isTRUE(delorders)) .strategy[[paste("order_book",portfolio,sep='.')]][[symbol]]<-NULL #WARNING: This is VERY DESTRUCTIVE  
      
      if(isTRUE(gc)) gc()
    }
    
    # call updateStrategy
    if(isTRUE(updateStrat)) updateStrategy(strategy, portfolio, Symbols=symbols, ...=...)
    
  }
  
  if(isTRUE(debug)) return(ret)
}

#' constructor for objects of type 'strategy'
#' 
#' variables passed in dots will be added to the strategy object, and may 
#' be used by initialization and wrapup functions, as well as
#' indicators, signals, stoploss and rules.
#' 
#' different from \code{\link{strategy}} in quantstrat
#' 
#' @param name character string naming the strategy
#' @param ... any other passthru parameters
#' @param assets optional list of assets to apply the strategy to, should normally be defined in the portfolio, not here
#' @param constraints optional portfolio constraints object matching assets
#' @param store TRUE/FALSE whether to store the strategy in the .strategy environment, or return it.  default FALSE
#' @export
#' @seealso \code{\link{apply_Strategy}}
strategy2 <- function(name, ..., assets=NULL, constraints=NULL ,store=FALSE)
{ # originally modeled on framework code in GPL R-Forge pkg roi by Stefan Thuessel,Kurt Hornik,David Meyer
  
  if(!is.null(assets)){
    if(is.numeric(assets)){
      if (length(assets) == 1) {
        nassets=assets
        #we passed in a number of assets, so we need to create the vector
        message("assuming equal weighted seed portfolio")
        assets<-rep(1/nassets,nassets)
      } else {
        nassets = length(assets)
      }
      # and now we may need to name them
      if (is.null(names(assets))) {
        for(i in 1:length(assets)){
          names(assets)[i]<-paste("Asset",i,sep=".")
        }
      }
    }
    if(is.character(assets)){
      nassets=length(assets)
      assetnames=assets
      message("assuming equal weighted seed portfolio")
      assets<-rep(1/nassets,nassets)
      names(assets)<-assetnames  # set names, so that other code can access it,
      # and doesn't have to know about the character vector
    }
    # if assets is a named vector, we'll assume it is current weights
  }
  rules<-list()
  rules$order<-list()
  ## now structure and return
  strat<-structure(
    list(
      name= name,
      assets = assets,
      indicators = list(),
      signals = list(),
      stoploss = list(),
      rules = rules,
      constraints = NULL,
      init =list(),
      wrapup = list(),
      call = match.call()
    ),
    class=c("strategy")
  )
  
  arg<-list(...)        
  if(length(arg)>=1) {
    strat <- c(strat,arg)  
    #the c() function loses our class attribute, annoyingly
    class(strat)<-'strategy'
  }
  
  if(store) assign(strat$name,strat,envir=as.environment(.strategy))
  else return(strat)
}