R/backtest.R

In sivasunku/rulesNtrades: Apply rules on equities

#' backtest the given strategies & provide the 
#'  The difference between backtest & backtestV2 is , former technicallu loops all shorts/longs in one for loop. V2 - in different for loops.
#' @note
#' 
#' @param pf - portfolio to be tested
#' @param dataset - OHLCV with price objects, preferably xts
#' @param parms      - parameters defining slp, profit booking etc. see tradeparms function
#' @param startat    - From which row of the dataset to start testing. default 3
#' @param longE - A function which has conditions for long entry
#' @param longX  - A function that has conditions for long exit
#' @param shortE - A function which has conditions for short entry
#' @param shortX  - A function that has conditions for short exit
#' @param calcLimits - This is sample function given in this package, this can be overwritten by providing as parameter
#' @param ...     - Can pass instrument names like instr & other things needed by longE,shortE functions etc.
#' @return portfolio name that has all the trades,transactions.
#' 
#' @export
backtest  <- function(pf,dataset,parms,startat = 2,
                        longE,longX,
                        shortE,shortX,
                        calcLimits = calcLimits,
                        ...) {
  if (!is.OHLC(dataset) || !is.xts(dataset) ){
    stop("backtest - dataset is not OHLC")
  }
  maxR <- nrow(dataset)
  i <- max(2,startat)
  
  #default the instrument
  dots  <- list(...)
  instr <- ifelse(is.null(dots$instr),"default",dots$instr)
  
  ## --- Long Positions Check --------------------------------------------------
  pos <- position(instr)
  doAct <- TRUE
  for (i in 1:maxR){
    actFlag <- FALSE
    ### ------ Check Exits and conds-------------------------------------------
    if ( isopen(pos) ){
      pos$barCount <- pos$barCount + 1
      ## ---- Check for Exit --------------------------------------------------
      if( isshort(pos) ){
        pos <- shortX(pos,parms,dataset,i,...)
      } else {
        pos <-  longX(pos,parms,dataset,i,...)
      }
      add.table.positions(pf,bar = dataset[i,],pos)
      ## ---- Check if Closed or profit booking -----------------------------
      if ( isclosed(pos) ) {
        add.trxns.position(pf,pos,type = 'CLOSE')
        add.trades.position(pf,pos)
        
        pos$openQty   <- pos$openQty - pos$closeQty
        #Create new dummy position if position becomes complete zero
        if ( pos$openQty == 0) {
          pos$closeFlag <- TRUE
          pos <- position(instr)
          actFlag <- TRUE
        } else {
          pos$closeFlag <- FALSE
          pos$closeQty <- 0
          pos$closeReason <- "None"
        }
      }
    }
    
    #If same day new positions can be taken or not.
    if ( parms$sameDayFlag == FALSE ) {
      doAct <- ifelse(actFlag,FALSE,TRUE)
    }
    
    ### ------ OPEN the position -----------------------------------------------
    tempPos <- longE(parms,dataset,i,...)
    if ( (!isopen(pos)) && islong(tempPos) && (doAct) && (parms$longTrades) ){
      pos <- tempPos
      #Increase the id when position is created
      incr.positions.id(pf)
      pos$id <- get.positions.id(pf)
      #if(pos$id >=3) {browser()}
      add.trxns.position(pf,tempPos,type = 'OPEN')
    }
    tempPos <- shortE(parms,dataset,i,...)
    if ( (!isopen(pos)) && isshort(tempPos) && (doAct) && (parms$shortTrades) ){
      pos <- tempPos
      #Increase the id when position is created
      incr.positions.id(pf)
      pos$id <- get.positions.id(pf)
      #if(pos$id >=3) {browser()}
      add.trxns.position(pf,tempPos,type = 'OPEN')
    }
    
    ### ------ Calculate the limits---------------------------------------------
    pos <- calcLimits(pos,parms,dataset,i)
  } #End of Long positions For loop
  
  ## ---- Return Code --------------------------------------------------------------
  return(pf) 
}