R/ruleOrderProc.R

In cloudcello/quantstrat: Quantitative Strategy Model Framework

#' process open orders at time \emph{t}, generating transactions or new orders
#' 
#' The ruleOrderProc function is effectively the default fill simulator for quantstrat. 
#' This function is meant to be sufficient for backtesting most strategies, 
#' but would need to be replaced for production use.  It provides the interface 
#' for taking the order book and determining when orders become trades.
#'  
#' In this version, in contrast with an earlier version, 
#' this function will allow a transaction to cross your current 
#' position through zero.  The accounting rules for realizing gains in such cases 
#' are quite complicated, so blotter will split this transaction into two transactions.  
#' Many brokers will break, revise, or split such transactions for the same reason.
#' 
#' This function would need to be revised or replaced for connection to a live trading infrastructure.
#' In a production mode, you would replace the \code{\link{addOrder}} function 
#' with a custom function to connect to your market infrastructure.  
#' In that case, you might need to add additional code to your strategy, 
#' or overload functions for checking position.  
#'   
#' Note that this function is called by default in the 'orders' slot of the 
#' \code{\link{applyRules}} processing.  If you have defined another order 
#' processing rule, it will \emph{replace} this function.  If you want your 
#' custom order rule and ruleOrderProc to both be called, you will need
#' explicitly add a rule to call ruleOrderProc either before or after your 
#' custom order processing function. 
#' 
#' We would like to model slippage here via \code{slippageFUN}.  Code contributions, suggestions, 
#' and requests appreciated. 
#'
#' @concept fill simulator
#' @concept orders  
#' @concept backtest
#' @concept fills
#' 
#' This function is meant to be sufficient for backtesting many/most strategies, 
#' but would need to be replaced for production use.  It provides the interface 
#' for taking the order book and determining when orders become trades.
#'  
#' @param portfolio text name of the portfolio to associate the order book with
#' @param symbol identfier of the instrument to find orders for.  The name of any associated price objects (xts prices, usually OHLC or BBO) should match these
#' @param mktdata an xts object containing market data.  depending on indicators, may need to be in OHLCV or BBO formats, default NULL
#' @param timestamp timestamp coercible to POSIXct that will be the time the order will be processed on 
#' @param ordertype one of NULL, "market","limit","stoplimit", or "stoptrailing" default NULL
#' @param ... any other passthru parameters
#' @param slippageFUN default  NULL, not yet implemented
#' @seealso add.rule
#' @seealso applyRules
#' @seealso getOrderBook
#' @seealso addOrder
#' @seealso updateOrders
#' @export
ruleOrderProc <- function(portfolio, symbol, mktdata, timestamp=NULL, ordertype=NULL, ..., slippageFUN=NULL)
{
  if(is.null(timestamp)) return()
  # Get row index of timestamp for faster subsetting
  if(hasArg(curIndex))
      curIndex <- eval(match.call(expand.dots=TRUE)$curIndex, parent.frame())
  else
      curIndex <- mktdata[timestamp,which.i=TRUE]
  
  orderbook <- getOrderBook(portfolio)
  ordersubset <- orderbook[[portfolio]][[symbol]]
  
  ### retrieve open orders
  OpenOrders.i<-getOrders(portfolio=portfolio, symbol=symbol, status="open", timespan=timespan, ordertype=ordertype, which.i=TRUE)

  #extract time in force for open orders
  tif.xts <- ordersubset[OpenOrders.i, 'Time.In.Force']
  if(any(!tif.xts==''))
  {
    if (any(indexClass(ordersubset)=='Date'))
        tif <- as.Date(coredata(tif.xts))
    else
    {
        tif <- strptime(coredata(tif.xts), format='%Y-%m-%d %H:%M:%OS')
        tif.na <- is.na(tif)
        if(any(tif.na))
            tif[tif.na] <- strptime(coredata(tif.xts[tif.na]), format='%Y-%m-%d %H:%M:%S')
    }

    #check which ones should be expired
    ExpiredOrders.i<-which(tif<timestamp)

    ordersubset[OpenOrders.i[ExpiredOrders.i], "Order.Status"] = 'expired'  
    ordersubset[OpenOrders.i[ExpiredOrders.i], "Order.StatusTime"]<-ordersubset[OpenOrders.i[ExpiredOrders.i], "Time.In.Force"]
  }
      
  if(hasArg(prefer)) prefer=match.call(expand.dots=TRUE)$prefer
  else prefer = NULL
  
  # check for open orders
  if (!(length(OpenOrders.i)>=1)){
    return(NULL)  
  } else {

    mktdataTimestamp <- mktdata[curIndex]
    # only keep the last observation per time stamp
    if( NROW(mktdataTimestamp) > 1 ) mktdataTimestamp <- last(mktdataTimestamp)
    isOHLCmktdata <- is.OHLC(mktdata)
    isBBOmktdata  <- is.BBO(mktdata)
    
    for (ii in OpenOrders.i )
    {
      if(ordersubset[ii, "Order.Status"] != "open")   # need to check this bc side effects may have changed order.status in this loop
        next()
      
      txnprice=NULL
      
      txnfees=ordersubset[ii,"Txn.Fees"]
      
      orderPrefer=ordersubset[ii, "Prefer"]
      if(!orderPrefer=="") prefer=orderPrefer
      
      orderPrice <- as.numeric(ordersubset[ii,"Order.Price"])
      
      orderQty <- ordersubset[ii,"Order.Qty"]
      if(orderQty %in% c('all','trigger'))
      {
        # this has to be an exit or risk order, so: 
        orderQty=-1*getPosQty(Portfolio=portfolio,Symbol=symbol,Date=timestamp)
        orderside<-ordersubset[ii, "Order.Side"]
        if(((orderQty>0 && orderside=='long') || (orderQty<0 && orderside=='short')))
        {
          # this condition may occur if (for example) a signal triggers an 'increase LONG pos' and 'close all SHORT pos' simultaneously
          # hence this is legal condition, and we must 0 the orderQty to reject the order
          
          orderQty = 0
        }
      }
      orderQty<-as.numeric(orderQty)
      
      orderThreshold <- as.numeric(ordersubset[ii,"Order.Threshold"])
      # mktdataTimestamp <- mktdata[timestamp]
      #FIXME Should we only keep the last observation per time stamp?
      #if( NROW(mktdataTimestamp) > 1 ) mktdataTimestamp <- last(mktdataTimestamp)
      
      orderType <- ordersubset[ii,"Order.Type"]
      
      if(hasArg(allowMagicalThinking)) allowMagicalThinking=match.call(expand.dots=TRUE)$allowMagicalThinking
      else allowMagicalThinking = FALSE
      
      # Get cached frequency, if it's available
      if(hasArg(periodicity))
          freq <- eval(match.call(expand.dots=TRUE)$periodicity, envir=parent.frame())
      else
          freq <- periodicity(mktdata)
      #switch on frequency
      switch(orderType,
             market = {
               switch(freq$scale,
                      yearly = ,
                      quarterly = ,
                      monthly = {
                        txntime=as.character(index(ordersubset[ii,])) # transacts on this bar, e.g. in the intraday cross, or leading into the end of month, quarter, etc.
                        # txntime=as.character(timestamp) # use this if you wanted to transact on the close of the next bar
                        # txnprice=as.numeric(getPrice(mktdataTimestamp, prefer=prefer)[,1])
                        txnprice = orderPrice
                      },
                      daily = {
                        if(isTRUE(allowMagicalThinking)){
                          txntime=as.character(index(ordersubset[ii,])) # transacts on this bar, e.g. in the intraday cross, or leading into the end of month, quarter, etc.
                          #txnprice=as.numeric(getPrice(mktdataTimestamp, prefer=prefer)[,1])
                          txnprice = orderPrice
                        } else {
                          txntime = timestamp
                          txnprice = as.numeric(getPrice(mktdataTimestamp, prefer=prefer)[,1]) #filled at now-prevailing 'price'
                        }
                      }, #end daily
                      { 
                        txntime = timestamp
                        if (isBBOmktdata) {
                          #An ordertype of market will *almost* trump pricemethod here. orderPrice was determined using pricemethod.
                          #but, for buy orders you'll be filled at either orderPrice or the current mkt ask -- whichever is worse.
                          #and, for sell orders you'll be filled at either orderPrice or the current mkt bid -- whichever is worse.
                          if(orderQty > 0){ # positive quantity 'buy'
                            #fill at max(orderPrice,newMktAsk price) 
                            txnprice = max(orderPrice, as.numeric(getPrice(mktdataTimestamp,prefer='ask')[,1]))
                          } else { # negative quantity 'sell'
                            txnprice = min(orderPrice, as.numeric(getPrice(mktdataTimestamp,prefer='bid')[,1])) #presumes unique timestamp
                          }
                          #e.g. if pricemethod was opside, it sent a buy order at mktAsk. fill at greater of that ask, and current ask
                        } else txnprice = as.numeric(getPrice(mktdataTimestamp, prefer=prefer)[,1]) #filled at 'price'
                      }
                    ) # end switch on frequency
             },
             limit= ,
             stoplimit =,
             iceberg = {
               if (!isBBOmktdata) {
                 if( orderType == 'iceberg'){
                   stop("iceberg orders only supported for BBO data")
                 } 
                 # check to see if price moved through the limit                        
                 if((orderQty > 0 && orderType != 'stoplimit') || (orderQty < 0 && (orderType=='stoplimit'))) {
                   # buy limit, or sell stoplimit
                   if( (has.Lo(mktdata) && orderPrice > as.numeric(Lo(mktdataTimestamp)[,1])) || 
                         (!has.Lo(mktdata) && orderPrice > as.numeric(getPrice(mktdataTimestamp, prefer=prefer)[,1])))
                   {
                     if(orderType == 'stoplimit')
                         txnprice <- min(orderPrice, Op(mktdataTimestamp)[,1])
                     else
                         txnprice <- orderPrice
                     txntime = timestamp
                   } else next() # price did not move through my order, should go to next order  
                 } else if((orderQty < 0 && orderType != 'stoplimit') || (orderQty > 0 && (orderType=='stoplimit'))) { 
                   # sell limit or buy stoplimit
                   if ( (has.Hi(mktdata) && orderPrice < as.numeric(Hi(mktdataTimestamp)[,1])) ||
                          (!has.Hi(mktdata) && orderPrice < as.numeric(getPrice(mktdataTimestamp,prefer=prefer)[,1])) )
                   {
                     if(orderType == 'stoplimit')
                         txnprice <- max(orderPrice, Op(mktdataTimestamp)[,1])
                     else
                         txnprice <- orderPrice
                     txntime = timestamp
                   } else next() # price did not move through my order, should go to next order 
                 } else {
                   warning('ignoring order with quantity of zero')
                   next()
                 }
               } else if(isBBOmktdata){
                 # check side/qty
                 if(orderQty > 0){ # positive quantity 'buy'
                   if (orderType == 'stoplimit') {
                     if(orderPrice <= as.numeric(getPrice(mktdataTimestamp,prefer='ask')[,1])){
                       # mktprice moved above our stop buy price 
                       txnprice = orderPrice #assume we got filled at our stop price
                       #txnprice = as.numeric(getPrice(mktdataTimestamp,prefer='ask')[,1]) #presumes unique timestamps
                       txntime = timestamp
                     } else next()
                   } else {
                     if(orderPrice >= as.numeric(getPrice(mktdataTimestamp,prefer='ask')[,1])){
                       # price we're willing to pay is higher than the offer price, so execute at the prevailing price
                       #txnprice = orderPrice
                       txnprice = as.numeric(getPrice(mktdataTimestamp,prefer='ask')[,1]) #presumes unique timestamps
                       txntime = timestamp
                     } else next()
                   }
                 } else { # negative quantity 'sell'
                   if (orderType == 'stoplimit') {
                     if(orderPrice >= as.numeric(getPrice(mktdataTimestamp,prefer='bid')[,1])){
                       # mktprice moved below our stop sell price
                       txnprice = orderPrice #assumption is that we're filled at our stop price
                       #txnprice = as.numeric(getPrice(mktdataTimestamp,prefer='bid')[,1]) #presumes unique timestamp
                       txntime = timestamp
                     } else next()
                   } else {
                     if(orderPrice <= as.numeric(getPrice(mktdataTimestamp,prefer='bid')[,1])){
                       # we're willing to sell at a better price than the bid, so execute at the prevailing price
                       # txnprice = orderPrice
                       txnprice = as.numeric(getPrice(mktdataTimestamp,prefer='bid')[,1]) #presumes unique timestamp
                       txntime = timestamp
                     } else next()
                   } 
                 }
                 
                 
                 if( orderType == 'iceberg'){
                   #we've transacted, so the old order was closed, put in a new one
                   neworder<-addOrder(portfolio=portfolio,
                                      symbol=symbol,
                                      timestamp=timestamp,
                                      qty=orderQty,
                                      price=as.numeric(getPrice(mktdataTimestamp,prefer=prefer)[,1]), 
                                      ordertype=orderType,
                                      side=ordersubset[ii,"Order.Side"],
                                      threshold=orderThreshold,
                                      status="open",
                                      replace=FALSE, return=TRUE,
                                      ,...=..., TxnFees=txnfees)
                   
                   ordersubset<-rbind(ordersubset, neworder)
                   
                   ordersubset[ii,"Order.Status"]<-'replaced'
                   ordersubset[ii,"Order.StatusTime"]<-format(timestamp, "%Y-%m-%d %H:%M:%S")
                   next()
                 } 
               }
             },
             stoptrailing = {
               if(isBBOmktdata)
               {
                 
                 order.side <- ordersubset[ii, "Order.Side"]
                 mvstop <- FALSE
                 absOrderThreshold <- abs(orderThreshold)
                 # +++++++++ stop order price - buy
                 # ~~~~~~~~~ market price
                 # --------- stop order price - sell
                 if(orderQty > 0) {  # positive quantity 'buy'
                   prefer <- 'ask'
                   mktPrice <- as.numeric(getPrice(mktdataTimestamp,prefer=prefer)[,1])
                   # check to see if price moved through the limit
                   if(mktPrice >= orderPrice) {  # buy when price >= stop
                     txnprice <- mktPrice
                     txntime <- timestamp
                   }
                   # move stop if price < stop - thresh
                   else {
                     mvstop <- orderPrice - absOrderThreshold > mktPrice
                     new.order.price <- min(orderPrice, mktPrice + absOrderThreshold)
                     #new.order.price <- mktPrice + absOrderThreshold
                   }
                 } else {  # negative quantity 'sell'
                   prefer <- 'bid'
                   mktPrice <- as.numeric(getPrice(mktdataTimestamp,prefer=prefer)[,1])
                   # check to see if price moved through the limit
                   if(mktPrice <= orderPrice) {  # sell when price <= stop
                     txnprice <- mktPrice
                     txntime <- timestamp
                   }
                   # move stop if price > stop + thresh
                   else {
                     mvstop <- orderPrice + absOrderThreshold < mktPrice
                     new.order.price <- max(orderPrice, mktPrice - absOrderThreshold)
                     #new.order.price <- mktPrice - absOrderThreshold
                   }
                 }
                 if( isTRUE(mvstop) ){
                   # if ordersubset[ii, "Order.Qty"] was character, we must recover it
                   new.order.qty <- ordersubset[ii, "Order.Qty"]
                   if(!is.na(suppressWarnings(as.numeric(new.order.qty))))
                     new.order.qty <- as.numeric(new.order.qty)
                   
                   neworder<-addOrder(portfolio=portfolio,
                                      symbol=symbol,
                                      timestamp=timestamp,
                                      qty=new.order.qty,
                                      price=new.order.price-orderThreshold,
                                      ordertype=orderType,
                                      prefer=prefer,
                                      side=order.side,
                                      threshold=orderThreshold,
                                      status="open",
                                      replace=FALSE, return=TRUE,
                                      orderset=ordersubset[ii,"Order.Set"],
                                      label=ordersubset[ii,"Rule"],
                                      ,...=..., TxnFees=txnfees)
                   
                   ordersubset<-rbind(ordersubset, neworder)
                   
                   ordersubset[ii,"Order.Status"]<-'replaced'
                   ordersubset[ii,"Order.StatusTime"]<-format(timestamp, "%Y-%m-%d %H:%M:%S")
                   next()
                 }
                 # else next
               }
               else if(isOHLCmktdata)
               {
                 # check to see if price moved through the limit
                 
                 order.side <- ordersubset[ii, "Order.Side"]
                 
                 if(order.side == 'long'  && as.numeric(Lo(mktdataTimestamp)[,1]) < orderPrice
                    || order.side == 'short' && as.numeric(Hi(mktdataTimestamp)[,1]) > orderPrice)
                 {
                   txnprice <- orderPrice
                   txntime <- timestamp
                 } 
                 else
                 {
                   # do we need to change the trailing stop?
                   
                   order.threshold <- as.numeric(ordersubset[ii, "Order.Threshold"])
                   
                   if(order.side == 'long')
                     new.order.price <- max(orderPrice, as.numeric(Hi(mktdataTimestamp)[,1]) + order.threshold)
                   if(order.side == 'short')
                     new.order.price <- min(orderPrice, as.numeric(Lo(mktdataTimestamp)[,1]) + order.threshold)
                   
                   if(new.order.price != orderPrice)
                   {
                     # adjust trailing stop
                     
                     order.qty <- ordersubset[ii, "Order.Qty"]   # if orderQty='all' we must recover it
                     
                     neworder<-addOrder(portfolio=portfolio,
                                        symbol=symbol,
                                        timestamp=timestamp,
                                        qty=order.qty,
                                        price=new.order.price - order.threshold,
                                        ordertype=orderType,
                                        side=order.side,
                                        threshold=order.threshold,
                                        status="open",
                                        replace=FALSE, return=TRUE,
                                        orderset=ordersubset[ii,"Order.Set"],
                                        label=ordersubset[ii,"Rule"],
                                        ,...=..., TxnFees=txnfees)
                     
                     ordersubset<-rbind(ordersubset, neworder)
                     
                     ordersubset[ii,"Order.Status"]<-'replaced'
                     ordersubset[ii,"Order.StatusTime"]<-format(timestamp, "%Y-%m-%d %H:%M:%S")
                     
                     next()
                   }
                 }
               }
               
             } # end stoptrailing
      )
      
      if(!is.null(txnprice) && !isTRUE(is.na(txnprice)))
      {
        #make sure we don't cross through zero
        pos<-getPosQty(portfolio,symbol,timestamp)
        
        if (orderQty == 0)  # reject the order (should be exit/market/all)
        {
          ordersubset[ii,"Order.Status"]<-'rejected'
        }
        else    #add the transaction
        {
          if(ordersubset[ii,"Order.Qty"] != 'trigger')
          {
            addTxn(Portfolio=portfolio, Symbol=symbol, TxnDate=txntime, 
                   TxnQty=orderQty, TxnPrice=txnprice , ...=..., TxnFees=txnfees)
          }
          ordersubset[ii,"Order.Status"]<-'closed'
        }
        ordersubset[ii,"Order.StatusTime"]<-format(timestamp, "%Y-%m-%d %H:%M:%S")
        
        #close all other orders in the same order set
        OrdersetTag = toString(ordersubset[ii,"Order.Set"])
        OpenInOrderset.i = which(ordersubset[,"Order.Status"] == 'open' & ordersubset[,"Order.Set"] == OrdersetTag)
        
        # skip this if there are no orders
        if(length(OpenInOrderset.i) > 0)
        {
          ordersubset[OpenInOrderset.i, "Order.Status"] = 'canceled'
          ordersubset[OpenInOrderset.i, "Order.StatusTime"]<-format(timestamp, "%Y-%m-%d %H:%M:%S")
          
        } 
      }
    } #end loop over open orders  
    
    # now put the orders back in
    # assign order book back into place (do we need a non-exported "put" function?)
    orderbook[[portfolio]][[symbol]] <- ordersubset
    assign(paste("order_book",portfolio,sep='.'),orderbook,envir=.strategy)
  } # end check for open orders
  
  # return list of orers filled in this call for order chain processing
  if(length(OpenOrders.i) > 0)
  {
    OpenOrders <- ordersubset[OpenOrders.i,]
    JustClosedOrders.i <- which(OpenOrders[,"Order.Status"]=="closed")
    
    if(length(JustClosedOrders.i) > 0)
      return( OpenOrders[JustClosedOrders.i,] )
    
  }
  return(NULL)
}

###############################################################################
# R (http://r-project.org/) Quantitative Strategy Model Framework
#
# Copyright (c) 2009-2015
# Peter Carl, Dirk Eddelbuettel, Brian G. Peterson, 
# Jeffrey Ryan, Joshua Ulrich, and Garrett See 
#
# This library is distributed under the terms of the GNU Public License (GPL)
# for full details see the file COPYING
#
# $Id: ruleOrderProc.R 1712 2015-11-02 17:48:45Z bodanker $
#
###############################################################################