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