R/hftsimulator.r

##' @title queryorder
##' @description get current queuing orders.
##' @details return a data.frame of current queuing orders, each row of
##' the data.frame representing an order, queryorder will return all of the
##' queuing orders if orderid is NULL. when there is no queuing orders,
##' queryorder will return a data.frame with 0 rows.
##' @param orderids specyfing order ids to be queried, return all orders if
##' orderids=NULL, default NULL.
##' @return a data.frame of queuing orders.
##' @examples
##' \dontrun{
##' ## get all queuing orders
##' queryorder()
##' ## get all orders that satisfying orderid%in%c("order1","order2")
##' queryorder(orderids=c("order1","order2"))
##' }
##' @export
queryorder <- function(orderids=NULL){
    if(is.null(orderids))
        return(.tradingstates$orders)
    else
        return(.tradingstates$orders[.tradingstates$orders$orderid%in%orderids,])
}

##' @title querycapital
##' @description get current capital status.
##' @details return a data.frame of current capital status, each row
##' of the data.frame representing an instrument, if instrumentids is not NULL,
##' querycapital will return the capital status specified by instrumentids.
##' @param instrumentids specifying instrumentids to be queried, return total
##' capital status if instrumentids=NULL, default NULL.
##' @return a data.frame of all specified instruments' current status
##' @examples
##' \dontrun{
##' ## get total capital status
##' querycapital()
##' ## get capital status of TF1603 and T1603
##' querycapital(instrumentids=c("TF1603","T1603"))
##' }
##' @export
querycapital <- function(instrumentids=NULL){
    if(!is.null(instrumentids))
        return(.tradingstates$capital[.tradingstates$capital$instrumentid%in%instrumentids,])
    else
        return(.tradingstates$capital)
}

##' @title ordersubmission
##' @description
##' take one of the following order actions: open, close, closetoday,
##' closepreday and cancel.
##' @details ordersubmission submit an order specified by the user, it also
##' take some additional actions after the submission. For example, if set
##' timeoutlist=TRUE and timeoutsleep=1, the simulator will first submit an
##' order and cancel it if the order is not executed in the next second.
##' @seealso \link{multisubmission} \link{timeoutchasesubmission}
##' \link{timeoutsubmission} \link{chasesubmission}
##' @param instrumentid character, instrument identifier.
##' @param orderid character, specifying an unique order id, can be generated
##' by randomid().
##' @param direction integer, specifying trading direction. 1 for long,
##' -1 for short.
##' @param price numeric, specifiying order pirce.NOTE: when price=0,
##' ordersubmission() will submit a market order; when price=NULL,
##' ordersubmission() will take the corresponding bid1 or ask1 price as
##' submitted price.
##' @param hands integer, specifying amount to be submitted.
##' @param action character, specifying submit action, action can take value
##' from one of "open","close","closetoday","closepreday" and "cancel". amount
##' submitted in action='close' can not be greater than the sum of current
##' holdings and queuing open hands.
##' @param timeoutlist logical, indicating wether to give current order a
##' timeout interval, the length of the interval is specified by timeoutsleep.
##' if the order hasn't been executed after a time interval greater than
##' timeoutsleep, the order will be canceled.
##' @param timeoutchase logical, indicating whether to chase order when timeout.
##' @param timeoutsleep numeric, specifying the timeout inverval in seconds.
##' @param chaselist logical, indicating wether to put this order to
##' auto-chase list. if the order hasn' been executed for a time inverval
##' longer than chasesleep, the simulator will cancel this order(if needed),
##' then submit a new one with the sampe hands and a price equal to the
##' bid1/ask1 price. the simulator will repeat this action until the original
##' submitted amount is executed.
##' @param chasesleep numeric, specifying the time interval between each
##' execution check. In seconds.
##' @return order status code.
##' @examples
##' \dontrun{
##' ## submit an open order, buy 1 hand of TF1603 at price 99
##' ## a length 5 random orderid is generated by randomid(5)
##' ordersubmission(instrumentid="TF1603",orderid=randomid(5),
##'                 direction=1,price=99,hands=1,action="open")
##' }
##' @export
ordersubmission <- function(instrumentid="TF1603",orderid=NULL,direction=1,price=0,hands=1,action="open",timeoutlist=FALSE,timeoutchase=FALSE,timeoutsleep=1,chaselist=FALSE,chasesleep=1){

    tradetime=.tradingstates$currenttradetime

    if(is.null(orderid)){
        warning("orderid not specified, generating a random id")
        orderid <- randomid(10)
    }
    match.arg(action,choices = c("open","close","closetoday","closepreday","cancel"))
    if(is.null(instrumentid)){
        stop("instrumentid must not be NULL!")
    }

    ## cancel order
    if(action=="cancel"){
        canceledorder <- .tradingstates$orders[.tradingstates$orders$orderid==orderid,]
        .tradingstates$orders <- .tradingstates$orders[.tradingstates$orders$orderid!=orderid,]
        .writeorderhistory(instrumentid,orderid,canceledorder$direction,canceledorder$hands,canceledorder$price,tradeprice=0,status=5,action,cost=0)
        return(5)
    }
    
    if(any(c(hands%%1!=0, hands<=0, isTRUE(price<0) , !(direction%in%c(-1,1))))){
        stop("illegal parameter values!")
    }

    .sucker <- function(LONGHOLDINGS,SHORTHOLDINGS){
        vol <- abs(hands)
        if(direction==-1){
            ## close long, hold>0, untrade<0
            hold <- sum(.tradingstates$capital[[LONGHOLDINGS]][.tradingstates$capital$instrumentid==instrumentid])
            nethold <- hold+untrade
            if( (hold==0) | direction==sign(nethold) |
                vol>abs(hold) | vol>abs(nethold) |
                (any(currentinstrument$price==0&currentinstrument$direction==direction&currentinstrument$action%in%c("close",action)) & price==0) ){
                .writeorderhistory(instrumentid,orderid,direction,hands,price,tradeprice=0,status=6,action,cost=0)
                stop("submission failed, status code: 6, orderid: ",orderid)
            }
        }
        else{
            ## close short, hold<0, untrade>0
            hold <- sum(.tradingstates$capital[[SHORTHOLDINGS]][.tradingstates$capital$instrumentid==instrumentid])
            nethold <- hold+untrade
            if( (hold==0) | direction==sign(nethold) |
                vol>abs(hold) | vol>abs(nethold) |
                (any(currentinstrument$price==0&currentinstrument$direction==direction&currentinstrument$action%in%c("close",action)) & price==0) ){
                .writeorderhistory(instrumentid,orderid,direction,hands,price,tradeprice=0,status=6,action,cost=0)
                stop("submission failed, status code: 6, orderid: ",orderid)
            }
        }
    }
    
    ## special requirements when action!=cancel
    ## get most recent orderbook
    mostrecentorderbook <- .INSTRUMENT$orderbook[[instrumentid]]
    ## submist bid1 or ask1 when price=NULL
    if(is.null(price)){
        price <- ifelse(direction==1,mostrecentorderbook$buybook$price[1],mostrecentorderbook$sellbook$price[1])
    }
    
    ## tmp file, used to update order state
    orders <- .tradingstates$orders
    currentinstrument <- orders[orders$instrumentid==instrumentid,]
    if(orderid%in%currentinstrument$orderid){
        stop("orderid already exists!")
    }
    if(action=="open"){
        ## only one market order is allowed in each position
        if(any(currentinstrument$price==0&currentinstrument$direction==direction&currentinstrument$action=="open") & price==0){
            .writeorderhistory(instrumentid,orderid,direction,hands,price,tradeprice=0,status=6,action,cost=0)
            stop(6)
        }
        orders <- rbind(orders,data.frame(instrumentid=instrumentid,orderid=orderid,direction=direction,price=price,hands=hands,action=action,initialhands=hands,timeoutlist=timeoutlist,timeoutchase=timeoutchase,timeoutsleep=timeoutsleep,chaselist=chaselist,chasesleep=chasesleep,submitstart=tradetime,stringsAsFactors=FALSE))
        ## save prior orders
        if(price>0){
            .priororders(mostrecentorderbook = mostrecentorderbook,orderid = orderid,direction = direction,price=price)
        }
        .tradingstates$orders <- orders
        .writeorderhistory(instrumentid,orderid,direction,hands,price,tradeprice=0,status=3,action,cost=0)
        return(3)
    }
    else if(action=="close"){
        ## untrade closes
        untrade <- sum(currentinstrument$hands[currentinstrument$direction==direction&currentinstrument$action%in%c("close","closepreday","closetoday")])*direction #untrade(long)<0, untrade(short)>0
        .sucker("totallongholdings","totalshortholdings")

        orders <- rbind(orders,data.frame(instrumentid=instrumentid,orderid=orderid,direction=direction,price=price,hands=hands,action=action,initialhands=hands,timeoutlist=timeoutlist,timeoutchase=timeoutchase,timeoutsleep=timeoutsleep,chaselist=chaselist,chasesleep=chasesleep,submitstart=tradetime,stringsAsFactors=FALSE))
        
        if(price>0)
            .priororders(mostrecentorderbook = mostrecentorderbook,orderid = orderid,direction = direction,price=price)

        .tradingstates$orders <- orders
        .writeorderhistory(instrumentid,orderid,direction,hands,price,tradeprice=0,status=3,action,cost=0)
        return(3)
    }
    else if(action=="closetoday"){
        ## untrade closes
        untrade <- sum(currentinstrument$hands[currentinstrument$direction==direction&currentinstrument$action%in%c("close","closetoday")])*direction
        .sucker("longholdingstoday","shortholdingstoday")

        orders <- rbind(orders,data.frame(instrumentid=instrumentid,orderid=orderid,direction=direction,price=price,hands=hands,action=action,initialhands=hands,timeoutlist=timeoutlist,timeoutchase=timeoutchase,timeoutsleep=timeoutsleep,chaselist=chaselist,chasesleep=chasesleep,submitstart=tradetime,stringsAsFactors=FALSE))
        if(price>0)
            .priororders(mostrecentorderbook = mostrecentorderbook,orderid = orderid,direction = direction,price=price)

        .tradingstates$orders <- orders
        .writeorderhistory(instrumentid,orderid,direction,hands,price,tradeprice=0,status=3,action,cost=0)
        return(3)
    }
    else{
        ## closepreday
        ## untrade closes
        untrade <- sum(currentinstrument$hands[currentinstrument$direction==direction&currentinstrument$action%in%c("close","closepreday")])*direction
        .sucker("longholdingspreday","shortholdingspreday")

        orders <- rbind(orders,data.frame(instrumentid=instrumentid,orderid=orderid,direction=direction,price=price,hands=hands,action=action,initialhands=hands,timeoutlist=timeoutlist,timeoutchase=timeoutchase,timeoutsleep=timeoutsleep,chaselist=chaselist,chasesleep=chasesleep,submitstart=tradetime,stringsAsFactors=FALSE))
        if(price>0)
            .priororders(mostrecentorderbook = mostrecentorderbook,orderid = orderid,direction = direction,price=price)

        .tradingstates$orders <- orders
        .writeorderhistory(instrumentid,orderid,direction,hands,price,tradeprice=0,status=3,action,cost=0)
        return(3)
    }
}

##' @title multisubmission
##' 
##' @description submit multiple orders, a simple wrapper of ordersubmission.
##' instrumentid, direction, price, hands and action must be of length one or
##' the same length with the number of orders; orderid must be of length zero
##' or the same length with the number of orders!
##' @seealso \link{ordersubmission} \link{timeoutchasesubmission}
##' \link{timeoutsubmission} \link{chasesubmission}
##' @param instrumentid character, instrument identifier
##' @param orderid character, if length(orderid)==0 (default), multisubmission
##' will generate a random id for each order
##' @param direction integer, specifying trading direction. 1 for long,
##' -1 for short.
##' @param price numeric, specifiying order pirce.default NULL.
##' NOTE: when price=0, ordersubmission will submit a market order; when
##' price=NULL, ordersubmission() will take the corresponding bid1 or ask1
##' price as order price.
##' @param hands integer, specifying hands to be submitted.
##' @param action character, action can take value from one of "open","close",
##' "closetoday","closepreday" and "cancel". hands submitted in action='close'
##' can not be greater than the sum of current holdings and queuing open hands.
##' @param timeoutlist logical, specyfing wether to give current order a
##' timeout interval, the length of the interval is specified by timeoutsleep.
##' if the order hasn't been executed after a time interval greater than
##' timeoutsleep, the order will be canceled.
##' @param timeoutchase logical, indicating whether to chase order when timeout.
##' @param timeoutsleep numeric, specifying the timeout inverval in seconds.
##' @param chaselist logical, specifying wether to put this order to
##' auto-chase list. if the order hasn' been executed for a time inverval
##' longer than chasesleep, the simulator will cancel this order(if needed),
##' then submit a new one with the sampe hands and a price equal to the
##' bid1/ask1 price. the simulator will repeat this action until the original
##' submitted amount is executed.
##' @param chasesleep numeric, specifying the time interval between each
##' execution check. In seconds.
##' @return order status code.
##' @examples
##' \dontrun{
##' ## submit an one hand long open order at each bid price of TF1512.
##' multisubmission(instrumentid="TF1512",orderid=NULL,direction=1,
##'                 price=orderbook$buybook$price,hands=1,action='open')
##' }
##' @export
multisubmission <- function(instrumentid="qtid",orderid=NULL,direction=1,price=NULL,hands=1,action="open",timeoutlist=FALSE,timeoutchase=FALSE,timeoutsleep=1,chaselist=FALSE,chasesleep=1){
    ## multiple orders
    tryCatch(expr={
        ## special effects when price=NULL
        if(is.null(price)){
            if(length(orderid)==0){
                orders <- data.frame(instrumentid=instrumentid,direction=direction,hands=hands,action=action,timeoutlist=timeoutlist,timeoutchase=timeoutchase,timeoutsleep=timeoutsleep,chaselist=chaselist,chasesleep=chasesleep,stringsAsFactors = FALSE)
                orderids <- NULL
                for(i in 1:nrow(orders)){orderids <- c(orderids,randomid(5))}
                orders$orderid <- orderids
            }
            else{
                orders <- data.frame(instrumentid=instrumentid,orderid=orderid,direction=direction,hands=hands,action=action,timeoutlist=timeoutlist,timeoutchase=timeoutchase,timeoutsleep=timeoutsleep,chaselist=chaselist,chasesleep=chasesleep,stringsAsFactors = FALSE)
            }
        }
        else{
            ## price is not null
            if(length(orderid)==0){
                orders <- data.frame(instrumentid=instrumentid,direction=direction,price=price,hands=hands,action=action,timeoutlist=timeoutlist,timeoutchase=timeoutchase,timeoutsleep=timeoutsleep,chaselist=chaselist,chasesleep=chasesleep,stringsAsFactors = FALSE)
                orderids <- NULL
                for(i in 1:nrow(orders)){orderids <- c(orderids,randomid(5))}
                orders$orderid <- orderids
            }
            else{
                orders <- data.frame(instrumentid=instrumentid,orderid=orderid,direction=direction,price=price,hands=hands,action=action,timeoutlist=timeoutlist,timeoutchase=timeoutchase,timeoutsleep=timeoutsleep,chaselist=chaselist,chasesleep=chasesleep,stringsAsFactors = FALSE)
            }
        }
    },
             warning=function(w){stop("instrumentid, direction, price, hands action timeoutlist, timeoutchase, timeoutsleep, chaselist and chasesleep must be of length one or the same length with the number of orders!! orderid must be of length zero or the same length with the number of orders!")},
             error=function(e){stop("instrumentid, direction, price, hands action timeoutlist, timeoutchase, timeoutsleep, chaselist and chasesleep must be of length one or the same length with the number of orders!! orderid must be of length zero or the same length with the number of orders!")})
    
    for(i in 1:nrow(orders)){
        ordersubmission(instrumentid = orders$instrumentid[i],
                        orderid = orders$orderid[i],direction = orders$direction[i],
                        price=orders$price[i],hands = orders$hands[i],action = orders$action[i],
                        timeoutlist=orders$timeoutlist[i],
                        timeoutchase=orders$timeoutchase[i],
                        timeoutsleep=orders$timeoutsleep[i],
                        chaselist=orders$chaselist[i],
                        chasesleep=orders$chasesleep[i])
    }
    return()
}

##' @title timeoutsubmission
##' 
##' @description submit an order with timeout checking. The order will be
##' canceled when it hasn't been executed for a duration longer than
##' timeoutsleep
##'
##' @details timeoutsubmission is a wrapper of ordersubmission, it act the same
##' as ordersubmission(...,timeoutlist=TRUE,chaselist=FALSE)
##' @seealso \link{multisubmission} \link{timeoutchasesubmission} \link{ordersubmission} \link{chasesubmission}
##' @param instrumentid character, instrument identifier.
##' @param orderid character, specifying an unique order id, can be generated
##' by randomid().
##' @param direction integer, specifying trading direction. 1 for long,
##' -1 for short.
##' @param price numeric, specifiying order pirce.NOTE: when price=0,
##' ordersubmission() will submit a market order; when price=NULL,
##' ordersubmission() will take the corresponding bid1 or ask1 price as
##' submitted price.
##' @param hands integer, specifying amount to be submitted.
##' @param action character, specifying submit action, action can take value
##' from one of "open","close","closetoday","closepreday" and "cancel". amount
##' submitted in action='close' can not be greater than the sum of current
##' holdings and queuing open hands.
##' @param timeoutsleep numeric, specifying the timeout inverval in seconds.
##' @return order status code.
##' @examples
##' \dontrun{
##' ## submit an open order, buy 1 hand of TF1603 at price 99
##' ## cancel the order if it's not executed in the next 10 seconds
##' timeoutsubmission(instrumentid="TF1603",orderid=randomid(5),
##'                 direction=1,price=99,hands=1,action="open".
##'                 timeoutsleep=10)
##' }
##' @export
timeoutsubmission <- function(instrumentid="qtid",orderid=NULL,direction=1,price=0,hands=1,action="open",timeoutsleep=1){
    if(missing(timeoutsleep)){
        warning("'timeoutsleep' not found! set to 1")
    }
    ordersubmission(instrumentid=instrumentid,
                    orderid=orderid,
                    direction=direction,
                    price=price,hands=hands,
                    action=action,
                    timeoutlist=TRUE,
                    timeoutsleep=timeoutsleep)
    return()
}

##' @title chasesubmission
##' 
##' @description chase bid1 or ask1. after every 'chasesleep' seconds,
##' simulator will check wether current order's price equals to bid1 or
##' ask1 price, if not, order chaser will replace it with a new one satisfying
##' the price condition.
##' @details chasesubmission is a wrapper of ordersubmission, it act the same
##' as ordersubmission(...,timeoutlist=FALSE,chaselist=TRUE).
##' @seealso \link{multisubmission} \link{timeoutchasesubmission}
##' \link{ordersubmission} \link{chasesubmission}
##' @param instrumentid character, instrument identifier.
##' @param orderid character, specifying an unique order id, can be generated
##' by randomid().
##' @param direction integer, specifying trading direction. 1 for long,
##' -1 for short.
##' @param price numeric, specifiying order pirce.NOTE: when price=0,
##' ordersubmission() will submit a market order; when price=NULL,
##' ordersubmission() will take the corresponding bid1 or ask1 price as
##' submitted price.
##' @param hands integer, specifying amount to be submitted.
##' @param action character, specifying submit action, action can take value
##' from one of "open","close","closetoday","closepreday" and "cancel". amount
##' submitted in action='close' can not be greater than the sum of current
##' holdings and queuing open hands.
##' @param chasesleep numeric, specifying the time interval between each
##' execution check. In seconds.
##' @return order status code.
##' @examples
##' \dontrun{
##' ## submit an open order, buy 1 hand of TF1603 at price 99
##' ## chase bid1 price if it's not executed in the next 10 seconds
##' ## recheck the price condition  every 10 seconds.
##' chasesubmission(instrumentid="TF1603",orderid=randomid(5),
##'                 direction=1,price=99,hands=1,action="open".
##'                 chasesleep=10)
##' }
##' @export
chasesubmission <- function(instrumentid="qtid",orderid=NULL,direction=1,price=0,hands=1,action="open",chasesleep=1){
    if(missing(chasesleep)){
        warning("'chasesleep' not found! set to 1")
    }
    ordersubmission(instrumentid=instrumentid,
                    orderid=orderid,
                    direction=direction,
                    price=price,hands=hands,
                    action=action,
                    chaselist = TRUE,
                    chasesleep=chasesleep)
    return()
}

##' @title timeoutchasesubmission
##' @description submit an order with timeout checking, chase bid1 or ask1.
##' price to execute it when timeout. type ?ordersumission, ?timeoutsubmission
##' and ?chasesubmission for more information.
##' @details timeoutchaseubmission is a wrapper of ordersubmission, it act the
##' same as ordersubmission(...,timeoutlist=TRUE,chaselist=TRUE)
##' @seealso \link{multisubmission} \link{ordersubmission}
##' \link{timeoutsubmission} \link{chasesubmission}
##' @param instrumentid character, instrument identifier.
##' @param orderid character, specifying an unique order id, can be generated
##' by randomid().
##' @param direction integer, specifying trading direction. 1 for long,
##' -1 for short.
##' @param price numeric, specifiying order pirce.NOTE: when price=0,
##' ordersubmission() will submit a market order; when price=NULL,
##' ordersubmission() will take the corresponding bid1 or ask1 price as
##' submitted price.
##' @param hands integer, specifying amount to be submitted.
##' @param action character, specifying submit action, action can take value
##' from one of "open","close","closetoday","closepreday" and "cancel". amount
##' submitted in action='close' can not be greater than the sum of current
##' holdings and queuing open hands.
##' @param timeoutsleep numeric, specifying the timeout inverval in seconds.
##' @param chasesleep numeric, specifying the time interval between each
##' execution check. In seconds.
##' @return order status code.
##' @examples
##' \dontrun{
##' ## submit an open order, buy 1 hand of TF1603 at price 99
##' ## chase bid1 price if it's not executed in the next 5 seconds
##' ## recheck the price condition  every 10 seconds.
##' chasesubmission(instrumentid="TF1603",orderid=randomid(5),
##'                 direction=1,price=99,hands=1,action="open".
##'                 timeoutsleep=5,
##'                 chasesleep=10)
##' }
##' @export
timeoutchasesubmission <- function(instrumentid="qtid",orderid=NULL,direction=1,price=0,hands=1,action="open",timeoutsleep=1,chasesleep=1){
    if(missing(timeoutsleep)){
        warning("'timeoutsleep' not found! set to 1")
    }
    if(missing(chasesleep)){
        warning("'chasesleep' not found! set to 1")
    }
    ordersubmission(instrumentid=instrumentid,
                    orderid=orderid,
                    direction=direction,
                    price=price,hands=hands,
                    action=action,
                    timeoutlist = TRUE,timeoutchase = TRUE,
                    timeoutsleep=timeoutsleep,
                    chasesleep=chasesleep)
    return()
}

##' @title meanopen
##' @description calculate unclosed orders' mean open price for a specific instrument
##' and holdings side.
##' @details meanopen will calculate mean price according to following rules: 1. earlier open orders are prior to be closed. 2. return volume weighted mean of unclosed order's transaction price.
##' @param instrumentid character, instrument identifier.
##' @param side character, "long" or "short", specifying holdings's side.
##' @return numeric, mean open price.
##' @examples
##' \dontrun{
##' ## check long holdings' mean open price of TF1603
##' meanopen("TF1603","long")
##' }
##' @export
meanopen <- function(instrumentid=character(),side="long"){
    match.arg(side,c("long","short"))
    if(side=="long"){
        IDX <- .tradingstates$unclosedlong$instrumentid==instrumentid
        if(nrow(.tradingstates$unclosedlong[IDX,])==0){
            return(NULL)
        }
        else{
            return(sum(.tradingstates$unclosedlong$tradeprice[IDX]*.tradingstates$unclosedlong$tradehands[IDX])/sum(.tradingstates$unclosedlong$tradehands[IDX]))
        }
    }
    else{
        IDX <- .tradingstates$unclosedshort$instrumentid==instrumentid
        if(nrow(.tradingstates$unclosedshort[IDX,])==0){
            return(NULL)
        }
        else{
            return(sum(.tradingstates$unclosedshort$tradeprice[IDX]*.tradingstates$unclosedshort$tradehands[IDX])/sum(.tradingstates$unclosedshort$tradehands[IDX]))
        }
    }
}

##' @title holdingsprofit
##' @description calculate unclosed holdings' dynamic profit. require
##' setting unclosed=TRUE in HFTsimulator.
##' total_profit = holdings_profit + closed_profit
##' @details
##' long holdings' dynamic profit = holdings * (last_price - mean_open_price),
##' short holdings' dynamic profit = holdings * (mean_open_price - lastprice).
##' @seealso \link{HFTsimulator} \link{meanopen} \link{closedprofit}
##' @param instrumentid character, instrument identifier.
##' @param side character, "long" or "short", specifying holdings's side.
##' @return numeric, holdings profit.
##' @examples
##' \dontrun{
##' ## get longholding's profit of TF1603
##' holdingsprofit("TF1603","long")
##' }
##' @export
holdingsprofit <- function(instrumentid=character(),side="long"){
    MEANOPEN <- meanopen(instrumentid,side)
    if(is.null(MEANOPEN)){return(0)}
    lastprice <- .INSTRUMENT$lastprice[[instrumentid]]
    multiplier <- .INSTRUMENT$multiplier[[instrumentid]]
    ## get holdings
    HOLDINGS <- ifelse(side=="long",.tradingstates$capital$totallongholdings[.tradingstates$capital$instrumentid==instrumentid],.tradingstates$capital$totalshortholdings[.tradingstates$capital$instrumentid==instrumentid])

    return(HOLDINGS*(lastprice-MEANOPEN)*multiplier)
}

##' @title closed profit
##' @description calculate closed profit. require setting closed=TRUE in
##' HFTsimulator.
##' @details closed profit is the most recent cash when all holdings are
##' equal to zero. total_profit = holdings_profit + closed_profit.
##' @seealso \link{HFTsimulator} \link{holdingsprofit}
##' @param instrumentid character, instrument identifier
##' @return numeric, closed profit
##' @examples
##' \dontrun{
##' ## get closed profit of TF1603
##' closedprofit("TF1603")
##' }
##' @export
closedprofit <- function(instrumentid){
    return(.tradingstates$closedtracker$cash[.tradingstates$closedtracker$instrumentid==instrumentid])
}


##' @title randomid
##' @description generage a random order id
##' @param n number of chars
##' @return character, order id
##' @examples
##' \dontrun{
##' ## generate a 5 characters' order id
##' randomid(5)
##' }
##' @importFrom stats runif
##' @export
randomid <- function(n){paste(letters[ceiling(runif(n,0,26))],collapse = "")}

##' @title isnewday
##' @description check if current instrument's data comes from a new day.
##' @param instrumentid character, instrument identifier, unique.
##' @return logical, indication wether current data come from a new trading day.
##' @export 
isnewday <- function(instrumentid){
    return(.tradingstates$startoftheday[instrumentid])
}

##' @title perfectexecution
##' @description execute and order immediatele with a specified price, without
##' going through the simulation system. Can be used to comparing simulated
##' strategy with a perfect situation.
##' @param instrumentid character, instrument identifier.
##' @param orderid character, specifying an unique order id, can be generated
##' by randomid().
##' @param direction integer, specifying trading direction. 1 for long,
##' -1 for short.
##' @param price numeric, specifiying order pirce.
##' @param hands integer, specifying amount to be submitted.
##' @param action character, specifying submit action, action can take value
##' from one of "open","close","closetoday","closepreday" and "cancel". amount
##' submitted in action='close' can not be greater than the sum of current
##' holdings and queuing open hands.
##' @return nothing.
##' @examples
##' \dontrun{
##' ## submit an open order, buy 1 hand of TF1603 at price 99
##' ## the order will be executed immediately at price 99
##' perfectexecution(instrumentid="TF1603",orderid='xxx',
##'                 direction=1,price=99,hands=1,action="open")
##' }
##' @importFrom methods is
##' @export
perfectexecution<-function(instrumentid,orderid="xxx",direction,price,hands,action){

    tradetime=.tradingstates$currenttradetime

    if(any(hands<=0)) stop("hands must be greater than zero!")
    if(is(direction,"character") | any(!direction%in%c(-1,1))) stop("direction must be numeric or integer of value  1 or -1!")
    if(any(price<=0)) stop("price must be greater than 0!")
    if(any(!action%in%c("open","close"))) stop("action can only be open or close!")
    
    ## multiple orders
    tryCatch(orders <- data.frame(instrumentid=instrumentid,direction=direction,price=price,hands=hands,action=action,stringsAsFactors = FALSE),
             warning=function(w){stop("instrumentid, direction, price, hands and action must be of length one or the same length with the number of orders!!")},
             error=function(e){stop("instrumentid, direction, price, hands and action must be of length one or the same length with the number of orders!!")})
    
    for(i in 1:nrow(orders)){
        fee <- .INSTRUMENT$fee[[instrumentid]]
        closeprior <- .INSTRUMENT$closeprior[[instrumentid]]
        multiplier <- .INSTRUMENT$multiplier[[instrumentid]]
        ## additional evaluation expression durring debuging, do not  delete
        ## eval(parse(text = paste(".tradingstates$currenttimeformat <- ",ENV,"$timeformat",sep ="")))
        
        ## add initial hands
        id <- randomid(5)
        .tradingstates$orders <- data.frame(instrumentid="someinstrument",orderid=id,direction=0,price=0,hands=0,action="someaction",initialhands=orders$hands[i],timeoutlist=FALSE,timeoutchase=FALSE,timeoutsleep=1,chaselist=FALSE,chasesleep=1,submitstart=tradetime,stringsAsFactors=FALSE)
        
        cost <- .updatecapital(orders$instrumentid[i],orders$direction[i],orders$hands[i],orders$action[i],orders$price[i],fee,closeprior,multiplier)
        .writecapitalhistory(instrumentid=orders$instrumentid[i],tradeprice=orders$price[i],tradehands=orders$hands[i],cost=cost)
        .writeorderhistory(instrumentid=orders$instrumentid[i],orderid=id,direction=orders$direction[i],hands=0,price=orders$price[i],tradeprice=orders$price[i],status=0,action=orders$action[i],cost=cost)
        .writetraded(orders$instrumentid[i],id,orders$action[i],orders$direction[i],orders$hands[i],orders$price[i])
        .trackclosed(orders$instrumentid[i],orders$action[i],orders$direction[i],orders$hands[i],orders$price[i],multiplier)
        .trackunclosed(orders$instrumentid[i],id,orders$action[i],orders$direction[i],orders$hands[i],orders$price[i])
    }
    
}

##' @title closeall
##' @description close all holdings of a specific instrument, if close price is
##' not specified, the holdings will be closed with market orders.
##' @seealso \link{chasecloseall}
##' @param instrumentid character, specyfing instrument to be closed.
##' @param price numeric, specyfing limit close order's price, if NULL, 
##' simulator will close the holdings with market orders.
##' @details closeall can only close one instrument at a time
##' @return nothing
##' @export
closeall <- function(instrumentid="qtid",price=NULL){
    
    capital <- querycapital(instrumentids = instrumentid)
    if(nrow(capital)==0){
        warning(paste(instrumentid,"not found!"))
        return()
    }
    if(length(instrumentid)>1){
        stop("close more than one instruments!")
    }
    if(capital$totallongholdings<=0 & capital$totalshortholdings>=0){
        print("no holdings to be closed")
        return()
    }

    ## ordersubmission
    if(capital$totallongholdings!=0)
        ordersubmission(instrumentid=instrumentid,orderid = randomid(5),
                        direction = -1,price = 0,hands=capital$totallongholdings,action = "close")
    if(capital$totalshortholdings!=0)
        ordersubmission(instrumentid=instrumentid,orderid = randomid(5),
                        direction = 1,price = 0,hands= -capital$totalshortholdings,action = "close")
    
    return()
}

##' @title cancelall
##' @description cancel all satisfied orders
##' @details cancelall will cancel all orders satisfying user specified
##' filter conditions, a fillter won't be considered when it is NULL.
##' @seealso  \link{replaceall}
##' @param instrumentid character, specifying a filter for instrument
##' identifiers.
##' @param direction integer, specifying a filter for trading directions.
##' 1 for long and -1 for short.
##' @param action character, specifying a filter for actions, can take value
##' from one of "open","close","closetoday","closepreday"
##' @param pricemin numeric, specifying a filter for price lower limit.
##' @param pricemax numeric, specifying a filter for price upper limit.
##' @param orderid character, specifying the set of orderids to be canceled.
##' NOTE: if orderid is not null, cancelall will disregard any other filters
##' and cancel orders only by orderid.
##' @return nothing
##' @examples
##' \dontrun{
##' ## cancel all orders satisfy direction==-1
##' cancelall(direction==-1)
##' }
##' @export
cancelall <- function(instrumentid=NULL,direction=NULL,action=NULL,pricemin=NULL,pricemax=NULL,orderid=NULL){
    orders <- .tradingstates$orders
    if(nrow(orders)==0){
        return()
    }
    
    ## orderid is not null
    if(!is.null(orderid)){
        orders <- orders[orders$orderid%in%orderid,]
        if(nrow(orders)==0){
            return()
        }
        for(i in seq_along(orders$orderid)){
            ordersubmission(instrumentid = orders$instrumentid[i],orderid = orders$orderid[i],action = "cancel")
        }
        return()
    }
    ## orderid is null
    if(!is.null(instrumentid)){
        orders <- orders[orders$instrumentid%in%instrumentid,]
    }
    if(!is.null(direction)){
        orders <- orders[orders$direction==direction,]
    }
    if(!is.null(action)){
        orders <- orders[orders$action%in%action,]
    }
    if(!is.null(pricemin)){
        orders <- orders[orders$price>=pricemin,]
    }
    if(!is.null(pricemax)){
        orders <- orders[orders$price<=pricemax,]
    }
    if(nrow(orders)==0){
        return()
    }
    for(i in seq_along(orders$orderid)){
        ordersubmission(instrumentid = orders$instrumentid[i],orderid = orders$orderid[i],action = "cancel")
    }
    return()
}

##' @title replaceall
##' @description replace all satisfied orders with one new one, which has a new
##' price and a hands equal to the cumulated hands of orders replaced.
##' @seealso  \link{cancelall}
##' @param instrumentid character, specifying a filter for instrument
##' identifiers.
##' @param direction integer, specifying a filter for trading directions.
##' 1 for long and -1 for short.
##' @param action character, specifying a filter for actions, can take value
##' from one of "open","close","closetoday","closepreday"
##' @param pricemin numeric, specifying a filter for price lower limit.
##' @param pricemax numeric, specifying a filter for price upper limit.
##' @param newprice numeric, new order price, will replace with a market order
##' when newprice=0.
##' @return nothing
##' @examples
##'\dontrun{
##' ## find all orders satisfy direction==-1 and action=='open' and
##' ## price <=101, replace them with a new order with price 100.01.
##' replaceall(tradetime,"TF1512",direction=-1,action='open',
##'            pricemax=101,newprice=100.01)
##' }
##' @export
replaceall <- function(instrumentid=NULL,direction=NULL,action=NULL,pricemin=NULL,pricemax=NULL,newprice=NULL){
    ## cancel old orders
    orders <- .tradingstates$orders
    if(nrow(orders)==0){
        print("no orders to replace")
        return()
    }
    if(is.null(instrumentid) | is.null(direction) | is.null(action) | is.null(newprice) ){
        stop("instrumentid, direction, action and newprice can not be NULL!")
    }
    else{
        orders <- orders[orders$instrumentid%in%instrumentid &
                         orders$direction==direction &
                         orders$action%in%action,]
    }
    if(!is.null(pricemin)){
        orders <- orders[orders$price>=pricemin,]
    }
    if(!is.null(pricemax)){
        orders <- orders[orders$price<=pricemax,]
    }
    if(nrow(orders)==0){
        print("no orders to replace")
        return()
    }
    for(i in seq_along(orders$orderid)){
        ordersubmission(instrumentid = orders$instrumentid[i],orderid = orders$orderid[i],action = "cancel")
    }
    ## submit a new one
    ordersubmission(instrumentid = instrumentid,orderid = randomid(5),direction=direction,price=newprice,hands=sum(orders$hands),action = action)
    return()
}

##' @title lazysubmission
##' @description submit a target holding, simulator will cancel all irrevelant
##' orders and chase bid1 or ask1 price automatically until the target holding
## is achieved. This function can only be used when set tc=TRUE in HFTsimualtor.
##' @seealso  \link{HFTsimulator}
##' @param instrumentid character, instrument identifier
##' @param longholding integer, specifying target long holdings of
##' 'instrumentid', longholding must be greater than or equal to 0.
##' @param shortholding integer, specifying target short holdings of
##' 'instrumentid', shortholding must be less than or equal to 0.
##' @return nothing
##' @examples
##'\dontrun{
##'  lazysubmission("TF1512",longholding=5,shortholding=-3)
##' }
##' @export
lazysubmission <- function(instrumentid,longholding=NULL,shortholding=NULL){
    
    tradetime=.tradingstates$currenttradetime
    if(!.tradingstates$tc){
        stop("lazysubmission: trade center not enabled! pleas set tc=TRUE at initialization")
    }
    
    if(!is.null(longholding)){
        .tradingstates$th$longholding[.tradingstates$th$instrumentid==instrumentid] <- longholding
    }
    if(!is.null(shortholding)){
        .tradingstates$th$shortholding[.tradingstates$th$instrumentid==instrumentid] <- shortholding
    }
    
    ## update immediatelly
    .tradingstates$justchanged[instrumentid] <- TRUE
    .tradingstates$lastchange[instrumentid] <- tradetime
    .tradecenter(instrumentid)

}

##' @title submitmultilevelopen
##' @description submit multiple open orders while cancel all other orders
##' satisfying the cancel conditions, cancel conditions are specified by
##' cancelallother, cancelprime,  cancelsub and cancelnotinthebook.
##' @seealso  \link{multisubmission} \link{cancelall}
##' @param instrumentid character, instrument identifier.
##' @param LEVELS integer, specifying postions in order book. Orders will be
##' submmited to these positions.
##' @param hands integer, specifying amount to be submitted.
##' @param DIRECTION integer, specifying trading direction. 1 for long,
##' -1 for short.
##' @param  cancelallother, logical, indicating wehter or not  cancel all other
##' orders that satisfying in the order book but with different prices.
##' @param  cancelprime cancel all orders with higher priority price
##' @param  cancelsub cancel all orders with lower priority price
##' @param  cancelnotinthebook cancel orders not in orderbook
##' @return nothing.
##' @importFrom stats na.omit
##' @export
submitmultilevelopen <- function(instrumentid,LEVELS=c(1,2),hands=1,cancelallother=FALSE,cancelprime=FALSE,cancelsub=FALSE,DIRECTION=1,cancelnotinthebook=FALSE){
    LIMITS <- .tradingstates$orders[.tradingstates$orders$price!=0&.tradingstates$orders$direction==DIRECTION,]
    if(DIRECTION==1){
        orderbook <- .INSTRUMENT$orderbook[[instrumentid]]$buybook
    }
    else{
        orderbook <- .INSTRUMENT$orderbook[[instrumentid]]$sellbook
    }

    if(nrow(LIMITS)!=0){
        idx <- match(LIMITS$price,orderbook$price)
        ## 0. cancel orders not in the book
        if(cancelnotinthebook){
            if(any(is.na(idx))){
                cancelall(orderid = LIMITS$orderid[is.na(idx)])
            }
        }
        ## 1. conditional cancel and open
        if(any(!is.na(idx))){
            LIMITS <- LIMITS[!is.na(idx),]
            idx <- na.omit(idx)
            ## 1.1 cancel
            if(cancelallother){
                allother <- !(idx%in%LEVELS)
                if(any(allother)){
                    cancelall(orderid = LIMITS$orderid[allother])
                }
            }
            else if(cancelprime){
                primeorders <- idx<min(LEVELS)
                if(any(primeorders)){
                    cancelall(orderid = LIMITS$orderid[primeorders])
                }
            }
            else if(cancelsub){
                suborders <- idx>max(LEVELS)
                if(any(suborders)){
                    cancelall(orderid = LIMITS$orderid[suborders])
                }
            }
            ## 1.2 open
            neworders <- !(LEVELS%in%idx)
            if(any(neworders)){
                multisubmission(instrumentid=instrumentid,direction = DIRECTION,price = orderbook$price[LEVELS[neworders]],hands = hands,action = "open")
            }
        }
    }
    else{
        multisubmission(instrumentid=instrumentid,direction = DIRECTION,price = orderbook$price[LEVELS],hands = hands,action = "open")
    }
    
}

##' @title chasecloseall
##' @description chase close all holdings of a specific instrument.
##' @seealso \link{closeall}
##' @details chasecloseall can only close one instrument at a time, simulator
##' will recheck if the order price is equal to current bid1 or ask1 price every
##' chasesleep seconds, if not, simulator will cancel it and submit a new one.
##' This action will be repeated until all specified holdings are executed.
##' @param instrumentid character, specyfing instrument to be closed.
##' @param chasesleep numeric, specyfing order chasing interval.
##' @return nothing
##' @export
chasecloseall <- function(instrumentid,chasesleep=1){
    ## long holdings
    LH <- .tradingstates$capital$totallongholdings[.tradingstates$capital$instrumentid==instrumentid]
    ## short holdigns
    SH <- .tradingstates$capital$totalshortholdings[.tradingstates$capital$instrumentid==instrumentid]
    ## long close
    LC <- sum(.tradingstates$orders$hands[.tradingstates$orders$instrumentid==instrumentid & .tradingstates$orders$direction==1 & .tradingstates$orders$action=="close"])
    ## short close
    SC <- sum(.tradingstates$orders$hands[.tradingstates$orders$instrumentid==instrumentid & .tradingstates$orders$direction==-1 & .tradingstates$orders$action=="close"])

    orderbook <- .INSTRUMENT$orderbook[[instrumentid]]

    if(LH-SC>0){
        chasesubmission(instrumentid=instrumentid,orderid = randomid(5),
                        direction = -1,price = orderbook$sellbook$price[1],hands = LH-SC,action = "close",chasesleep = chasesleep)
    }

    if((-SH)-LC>0){
        chasesubmission(instrumentid=instrumentid,orderid = randomid(5),
                        direction = 1,price = orderbook$buybook$price[1],hands = (-SH)-LC,action = "close",chasesleep = chasesleep)
    }

}

## market order flow:
## bid1,ask1 : previous bid1 and ask1 prices
## lastprice,volume : current last price and volume
## AGGREGATE: indicating return cumulate value or not
## return a matirx with two columes.

##' @title BIS
##' @description market order flow.
##' @details extract market order flow form give transaction data.
##' @param lastprice last trading price.
##' @param bid1 previous orderbook's bid1 price.
##' @param ask1 previous orderbook's ask1 price.
##' @param volume last trading volume.
##' @param AGGREGATE specyfing wether to aggretate all buyer/seller initiated
##' volumes together.
##' @return a matrix of two columns corresponding to buyer and seller initialed
##' order flow.
##' @export
BSI <- function(lastprice,bid1,ask1,volume,AGGREGATE=FALSE){
    mid <- (bid1+ask1)/2
    if(AGGREGATE){
        BI <- sum(volume[lastprice>mid],na.rm = TRUE)
        SI <- sum(volume[lastprice<mid],na.rm = TRUE)
        other <- sum(volume[lastprice==mid],na.rm = TRUE)/2
        BI <- BI+other
        SI <- SI+other
        return(c(BI=BI,SI=SI))
    }
    else{
        BI <- volume
        SI <- volume
        BI[lastprice<mid] <- 0
        SI[lastprice>mid] <- 0
        idx <- lastprice==mid
        if(any(idx)){
            BI[idx] <- volume[idx]/2
            SI[idx] <- BI[idx]
        }
        return(cbind(BI,SI))
    }
}

## limit order flow:
BSO <- function(orderbook,preorderbook,bsi){
    
}



##' @title S
##' @description shortcut
##' @param instrumentid character, instrument identifier.
##' @param attr name or call
##' @export
S <- function(instrumentid,attr){
    attr <- substitute(attr)
    if(!is.character(attr)) attr <- deparse(attr)
    switch(attr,
           "orders.non" = nrow(.tradingstates$orders[.tradingstates$orders$instrumentid=="a",])==0,
           "orders.exist" = nrow(.tradingstates$orders[.tradingstates$orders$instrumentid=="a",])!=0,
           "longopen" = .tradingstates$orders[.tradingstates$orders$action=="open" & .tradingstates$orders$direction==1 &.tradingstates$orders$instrumentid==instrumentid,],
           "longopen.non" = nrow(.tradingstates$orders[.tradingstates$orders$action=="open" & .tradingstates$orders$direction==1 &.tradingstates$orders$instrumentid==instrumentid,])==0,
           "longopen.exist" = nrow(.tradingstates$orders[.tradingstates$orders$action=="open" & .tradingstates$orders$direction==1 &.tradingstates$orders$instrumentid==instrumentid,])!=0,
           "shortopen" = .tradingstates$orders[.tradingstates$orders$action=="open"&.tradingstates$orders$direction==-1 &.tradingstates$orders$instrumentid==instrumentid,],
           "shortopen.non" = nrow(.tradingstates$orders[.tradingstates$orders$action=="open"&.tradingstates$orders$direction==-1 &.tradingstates$orders$instrumentid==instrumentid,])==0,
           "shortopen.exist" = nrow(.tradingstates$orders[.tradingstates$orders$action=="open"&.tradingstates$orders$direction==-1 &.tradingstates$orders$instrumentid==instrumentid,])!=0,
           "longclose" = .tradingstates$orders[.tradingstates$orders$action=="close"&.tradingstates$orders$direction==1 &.tradingstates$orders$instrumentid==instrumentid,],
           "longclose.non" = nrow(.tradingstates$orders[.tradingstates$orders$action=="close"&.tradingstates$orders$direction==1 &.tradingstates$orders$instrumentid==instrumentid,])==0,
           "longclose.exist" = nrow(.tradingstates$orders[.tradingstates$orders$action=="close"&.tradingstates$orders$direction==1 &.tradingstates$orders$instrumentid==instrumentid,])!=0,
           "shortclose" = .tradingstates$orders[.tradingstates$orders$action=="close"&.tradingstates$orders$direction==-1 &.tradingstates$orders$instrumentid==instrumentid,],
           "shortclose.non" = nrow(.tradingstates$orders[.tradingstates$orders$action=="close"&.tradingstates$orders$direction==-1 &.tradingstates$orders$instrumentid==instrumentid,])==0,
           "shortclose.exist" = nrow(.tradingstates$orders[.tradingstates$orders$action=="close"&.tradingstates$orders$direction==-1 &.tradingstates$orders$instrumentid==instrumentid,])!=0,
           "holdings.exist" = .tradingstates$capital$totallongholdings[.tradingstates$capital$instrumentid==instrumentid] >0 | .tradingstates$capital$totalshortholdings[.tradingstates$capital$instrumentid==instrumentid]<0,
           "holdings.non" = .tradingstates$capital$totallongholdings[.tradingstates$capital$instrumentid==instrumentid] ==0 & .tradingstates$capital$totalshortholdings[.tradingstates$capital$instrumentid==instrumentid]==0,
           "longholdings.exist" = .tradingstates$capital$totallongholdings[.tradingstates$capital$instrumentid==instrumentid]>0,
           "longholdings.non" = .tradingstates$capital$totallongholdings[.tradingstates$capital$instrumentid==instrumentid]==0,
           "shortholdings.exist" = .tradingstates$capital$totalshortholdings[.tradingstates$capital$instrumentid==instrumentid]<0,
           "shortholdings.non" = .tradingstates$capital$totalshortholdings[.tradingstates$capital$instrumentid==instrumentid]==0
           )
}


##' @title HFTsimulator
##' @description high-frequency trading simulator.
##' @details
##' Initialize simulator states, including simulation back ground
##' functionalities and many ohter simulator related parameters. All
##' states related variables are saved in an environment named
##' '.tradingstates'. Queuing orders and capital state will be saved and
##' kept updated in tradingstates during simulation. There are two improtant
##' data.frames stored in this envrionment, 'orders' and 'capital'. All
##' current queuing orders will be stored as one rows in orders during
##' simulation. if there is no queuing order, orders will be a data.frame
##' with 0 row. each instruments' capital state will be stored as one row in
##' capital. capital has at least one row. \code{queryorder()} and
##' \code{qureycapital()} can be used inside strategy function to fetch orders
##' and capital from .tradingstates.
##' @seealso \link{lazysubmission} \link{cancelall} \link{queryorder}
#' \link{querycapital} \link{meanopen} \link{holdingsprofit}
##' @param stg function, strategy function.
##' @param ... parameters passed to stg.
##' @param datalist data.frame or list, specifying taq data used in the
##' simulation. datalist must be a list of data.frame(s) or a data.frame.
##' @param formatlist list, specifying taq data format, formatlist is either a
##' list of data format specifycation or a list of lists of specifications.
##' @param instrumentids character, spefifying instruments to be traded.

##' @param tc logical, indicating wehter to use a simulated tradecenter. when
##' tc=TRUE, only lazysubmission can be used as submit function in stg. Defalut
##' FALSE.
##' @param Sleep numeric, idle time length of simulated tradecenter, measured
##' in seconds, default 1.
##' @param DIGITSSECS integer, specifying second digits, default 3.
##' @param septraded logical, indicating wether to record traded orders
##' separately.
##' @param unclosed logical, indicating wether to track all unclosed orders,
##' set unclosed=TRUE when you need to calculate mean open price and open
##' profit. Default TRUE.
##' @param closed logical, indicating wether to track all zero holding states,
##' set closed=TRUE when you need to calculate close profit, default TRUE.
##' @param interdaily logical, indicating wether to support interdaily strategies,
##' most of the time MM strategies are appiled in intraday situations,
##' set it to TRUE only when you know exactly what you are doing. Defalut FALSE.
##' @param verboselimitpriors logical, indicating wether to record all prior 
##' limit orders' informations. if verboselimitpriors=TRUE,  simulator will
##' contatenate all limitpriors in a list named 'verbosepriors'. Default TRUE.
##' @return a list containing all kinds of histories and current states.
##' @importFrom stats runif
##' @importFrom utils setTxtProgressBar txtProgressBar
##' @importFrom methods is
##' @export
HFTsimulator <- function(stg,...,instrumentids,datalist,formatlist,
                         tc=FALSE,Sleep=1,DIGITSSECS=3,septraded=FALSE,unclosed=TRUE,closed=TRUE,interdaily=FALSE,
                         verboselimitpriors=TRUE){
    ## strategy function check
    if(!is(stg,"function")){
        stop(substitute(stg),"is not a function!")
    }
    ## data check
    ## put all data in a list, the list is of the same length of instrumetids
    if(!is(instrumentids,"character")) stop("instrumentids must be of type character.")
    if(is(datalist,"list")){
        if(length(instrumentids)!=length(datalist)) stop("length of instrumentids is not equal to length of datalist!")
        names(datalist) <- instrumentids #sequence of the datas must be in accordance with instrumentids.
    }else if(is(datalist,"data.frame")){
        if(length(instrumentids)!=1) stop("unequal length of data and instrumentids")
        eval(parse(text = paste("datalist<- list(",instrumentids,"=datalist)",sep = ""))) #convert to list
    }else{
        stop("datalist must be of type data.frame or list")
    }
    ## data format check
    ## put all dataformat in a list, the list is of the same length of instrumetids
    requiredformat <- c("pbuyhands","pbuyprice","psellhands","psellprice","ptradetime","plastprice","pvolume")
    if(all(requiredformat%in%names(formatlist))){
        eval(parse(text = paste("formatlist <- list(",paste(paste(instrumentids,"=formatlist"),collapse = ","),")")))
    }else if(all(requiredformat%in%names(formatlist[[1]]))){
        if(length(formatlist)!=1 & length(formatlist)!=length(instrumentids)) stop("unequal length of formatlist and datalist.")
    }else{
        stop("missing format specifications in ",substitute(formatlist))
    }

    cat("Initializing simulator states...")

    .CFEupdate <- function(DATA,INSTRUMENTID){
        DATA <- unlist(strsplit(paste(DATA,collapse = ","),split = ","))
        ## extract information
        tradetime <<- .extractinfo("tradetime",DATA,ptradetime=.INSTRUMENT$ptradetime[[INSTRUMENTID]],timeformat=.INSTRUMENT$timeformat[[INSTRUMENTID]])
        ## keep tracking most recent tradetime IMPORTANT
        .tradingstates$currenttradetime <- tradetime
        ## interdaily trading-----------------------------------
        if(.tradingstates$interdaily){
            ## reset instrument trading start indicator
            .tradingstates$startoftheday[INSTRUMENTID] <- FALSE
            HMOS <- .extractinfo("HMOS",DATA,ptradetime=.INSTRUMENT$ptradetime[[INSTRUMENTID]],timeformat=.INSTRUMENT$timeformat[[INSTRUMENTID]])
            .INSTRUMENT$current[[INSTRUMENTID]] <- ifelse(HMOS<=.INSTRUMENT$endoftheday[[INSTRUMENTID]],as.numeric(difftime(HMOS,"1970-01-01 00:00:00.000",units = "secs")+.INSTRUMENT$tomidnight[[INSTRUMENTID]]),as.numeric(difftime(HMOS,.INSTRUMENT$endoftheday[[INSTRUMENTID]],units = "secs")))
            ## new day condition
            if(.INSTRUMENT$current[[INSTRUMENTID]]<.INSTRUMENT$pre[[INSTRUMENTID]]){
                ## instrument trading start indicator
                .tradingstates$startoftheday[INSTRUMENTID] <- TRUE
                ## reset total volume and orderbook
                .INSTRUMENT$pretotalvolume <- .INSTRUMENT$pretotalvolume[names(.INSTRUMENT$pretotalvolume)!=INSTRUMENTID]
                .INSTRUMENT$preorderbook <- .INSTRUMENT$preorderbook[names(.INSTRUMENT$preorderbook)!=INSTRUMENTID]
                IDX <- .tradingstates$capital$instrumentid==INSTRUMENTID
                ## move holdings to preholdins
                .tradingstates$capital[IDX,c("longholdingspreday","shortholdingspreday")] <- .tradingstates$capital[IDX,c("longholdingspreday","shortholdingspreday")]+.tradingstates$capital[IDX,c("longholdingstoday","shortholdingstoday")]
                .tradingstates$capital[IDX,c("longholdingstoday","shortholdingstoday")] <- c(0,0)
                ## .INSTRUMENT$newday[[INSTRUMENTID]] <- FALSE
            }
            .INSTRUMENT$pre[[INSTRUMENTID]] <- .INSTRUMENT$current[[INSTRUMENTID]]
        }
        ## interdaily trading-----------------------------------
        lastprice <<- .extractinfo("lastprice",DATA,plastprice=.INSTRUMENT$plastprice[[INSTRUMENTID]])
        .INSTRUMENT$lastprice[[INSTRUMENTID]] <- lastprice
        totalvolume <<- .extractinfo("volume",DATA,pvolume=.INSTRUMENT$pvolume[[INSTRUMENTID]])
        if(! INSTRUMENTID%in%names(.INSTRUMENT$pretotalvolume) ){
            .INSTRUMENT$pretotalvolume[[INSTRUMENTID]] <- totalvolume
        }
        volume <<- totalvolume-.INSTRUMENT$pretotalvolume[[INSTRUMENTID]]
        orderbook <<- .extractinfo("orderbook",DATA,pbuyhands=.INSTRUMENT$pbuyhands[[INSTRUMENTID]],pbuyprice=.INSTRUMENT$pbuyprice[[INSTRUMENTID]],psellhands=.INSTRUMENT$psellhands[[INSTRUMENTID]],psellprice=.INSTRUMENT$psellprice[[INSTRUMENTID]])
        if(! INSTRUMENTID%in%names(.INSTRUMENT$preorderbook) ){
            .INSTRUMENT$preorderbook[[INSTRUMENTID]] <- orderbook
        }
        .INSTRUMENT$orderbook[[INSTRUMENTID]] <- orderbook
        preorderbook <<- .INSTRUMENT$preorderbook[[INSTRUMENTID]] #might be useful
                
        ## update states
        .updateinstrument(instrumentid=INSTRUMENTID,lastprice,volume,orderbook,.INSTRUMENT$preorderbook[[INSTRUMENTID]],.INSTRUMENT$fee[[INSTRUMENTID]],.INSTRUMENT$closeprior[[INSTRUMENTID]],multiplier=.INSTRUMENT$multiplier[[INSTRUMENTID]])
        ## save as previous values
        .INSTRUMENT$pretotalvolume[[INSTRUMENTID]] <- totalvolume
        .INSTRUMENT$preorderbook[[INSTRUMENTID]] <- orderbook
        ## some automatic functions
        .timeoutdetector()
        .orderchaser()
        .tradecenter(INSTRUMENTID)
    }
    
    ## garbage picker
    garbagepicker <- eval(parse(text = deparse(stg)))
    
    ## environment settings
    options(digits.secs=DIGITSSECS)
    options(stringsAsFactors = FALSE)
    
    ## initialize simulator state
    .tradingstates$tc <- tc             #trade-center
    .tradingstates$septraded <- septraded
    .tradingstates$interdaily <- interdaily #interdaily support
    .tradingstates$Sleep <- Sleep           #trade-center idle time
    .tradingstates$closed <- closed         #recored all closed orders
    .tradingstates$unclosed <- unclosed     #track all unclosed orders

    .tradingstates$orders <- data.frame(
        instrumentid=character(),
        orderid=character(),direction=numeric(),
        price=numeric(),hands=numeric(),
        action=character(),
        initialhands=numeric(),
        timeoutlist=logical(),          #wether to check timeout
        timeoutchase=logical(),         #wether to chase after timeout
        timeoutsleep=numeric(),          #length of timeout,in secs
        chaselist=logical(),            #wether to chase
        chasesleep=numeric(),           #length of chase sleep time,secs
        submitstart=character(),        #chase or timeout start time
        stringsAsFactors=FALSE)
    .tradingstates$limitprior <- NULL    #high prior limit orders
    .tradingstates$capital <- data.frame(
        instrumentid=character(),
        longholdingstoday=numeric(), shortholdingstoday=numeric(),
        longholdingspreday=numeric(),shortholdingspreday=numeric(),
        totallongholdings=numeric(),totalshortholdings=numeric(),
        cash=numeric(),stringsAsFactors=FALSE
        )
    .tradingstates$th <- data.frame(instrumentid=character(),longholding=numeric(),
                                   shortholding=numeric(),stringsAsFactors = FALSE) #targetholdings required by trade center
    .tradingstates$orderhistory <- data.frame(
        instrumentid=character(),orderid=character(),
        direction=numeric(),price=numeric(),
        hands=numeric(),action=character(),
        tradetime=character(),tradeprice=numeric(),
        cost=numeric(),status=numeric(),
        initialhands=numeric(),
        stringsAsFactors = FALSE)
    .tradingstates$capitalhistory <- data.frame(
        instrumentid=character(),
        longholdingstoday=numeric(), shortholdingstoday=numeric(),
        longholdingspreday=numeric(),shortholdingspreday=numeric(),
        totallongholdings=numeric(),totalshortholdings=numeric(),
        cash=numeric(),tradetime=character(),
        tradeprice=numeric(),tradehands=numeric(),cost=numeric(),
        stringsAsFactors=FALSE)
    .tradingstates$longopen <- data.frame(
        instrumentid=character(),orderid=character(),
        action=character(),
        direction=numeric(),
        tradehands=numeric(),
        tradeprice=numeric(),
        stringsAsFactors = FALSE)
    .tradingstates$shortclose <- .tradingstates$longopen
    .tradingstates$shortopen <- .tradingstates$longopen
    .tradingstates$shortclose <- .tradingstates$longopen
    .tradingstates$currenttradetime <- character() #current time tracker
    .tradingstates$startoftheday <- logical()      #interdaily
    .tradingstates$verbosepriors <- NULL
    .tradingstates$justchanged <- NULL
    .tradingstates$lastchange <- NULL
    .tradingstates$closedtracker <- data.frame(instrumentid=character(),cash=numeric(),stringsAsFactors=FALSE) #closed
    .tradingstates$unclosedlong <- .tradingstates$longopen
    .tradingstates$unclosedshort <- .tradingstates$longopen


    ## <<<<<<<<<<<<<<< TO DO >>>>>>>>>>>>>>>
    ## rearrange data sequence (to support multiple instruments with different data formats)
    if(length(formatlist)>=2){
        if(any(vapply(2:length(formatlist),function(i){
            !identical(formatlist[[i]],formatlist[[i-1]])
        },FUN.VALUE = logical(1)))) stop("multiple instruments with different data formats is not supported yet.")
    }
    ## merge all instruments' data to a large data.frame
    tags <- rep(instrumentids,times=vapply(datalist,function(d){nrow(d)},FUN.VALUE = numeric(1)))
    datalist <- lapply(datalist,function(d){names(d) <- paste("V",1:ncol(d),sep = "");return(d)})
    datalist <- do.call(rbind,datalist)
    datalist$instrumentid <- tags
    datalist <- datalist[order(datalist[,formatlist[[1]]$ptradetime]),] #order by time
    
    ## initialize instruments' states
    if(length(formatlist)==1 & length(formatlist)!=length(instrumentids)){
        formatlist <- rep(formatlist,length(instrumentids))
        names(formatlist) <- instrumentids
    }
    for(instrumentid in instrumentids){

        dataformat <- formatlist[[instrumentid]]
        
        if(is.null(dataformat[["fee"]])){
            dataformat$fee=c(long=0,short=0,closetoday=0,closepreday=0)
        }
        if(is.null(dataformat[["closeprior"]])){
            dataformat$closeprior = "today"
        }
        if(is.null(dataformat[["timeformat"]])){
            dataformat$timeformat = "%Y-%m-%d %H:%M:%OS"
        }
        if(is.null(dataformat[["endoftheday"]])){
            dataformat$endoftheday="23:59:59.999"
        }
        if(is.null(dataformat[["multiplier"]])){
            dataformat$multiplier=1
        }

        .initializeinstrument(instrumentid=instrumentid,
                             pbuyhands=dataformat$pbuyhands,
                             pbuyprice=dataformat$pbuyprice,
                             psellhands=dataformat$psellhands,
                             psellprice=dataformat$psellprice,
                             ptradetime=dataformat$ptradetime,
                             plastprice=dataformat$plastprice,
                             pvolume=dataformat$pvolume,
                             fee=dataformat$fee,
                             closeprior=dataformat$closeprior,
                             timeformat=dataformat$timeformat,
                             endoftheday=dataformat$endoftheday,
                             multiplier=dataformat$multiplier)
    }

    cat("done\n")

    pb <- txtProgressBar(min = 1,max = nrow(datalist),style = 3)
    ## initialize tmp vars
    tradetime <- character(1)
    lastprice <- numeric(1)
    totalvolume <- numeric(1)
    volume <- numeric(1)
    orderbook <- list()
    preorderbook <- list()
    ## simulation
    for(i in 1:nrow(datalist)){
        .CFEupdate(DATA = datalist[i,],INSTRUMENTID = datalist[i,"instrumentid"])
        garbagepicker(...)
        if(verboselimitpriors){
            .verboselimitpriors()
        }
        setTxtProgressBar(pb,i)
    }
    cat("\n")
    invisible(list(orderhistory=.tradingstates$orderhistory,capitalhistory=.tradingstates$capitalhistory,queuingorders=.tradingstates$orders,capital=.tradingstates$capital,verbosepriors=.tradingstates$verbosepriors))

}
chenhaotian/High-Frequency-Trading-Simulation-System documentation built on May 13, 2019, 3:52 p.m.