[Blotter-commits] r382 - pkg/quantstrat/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Aug 26 13:26:06 CEST 2010
Author: braverock
Date: 2010-08-26 13:26:06 +0200 (Thu, 26 Aug 2010)
New Revision: 382
Modified:
pkg/quantstrat/R/orders.R
pkg/quantstrat/R/traderules.R
Log:
- initial support for market maker orders
(paired orders or order sets on both sides of market)
Modified: pkg/quantstrat/R/orders.R
===================================================================
--- pkg/quantstrat/R/orders.R 2010-08-24 19:27:24 UTC (rev 381)
+++ pkg/quantstrat/R/orders.R 2010-08-26 11:26:06 UTC (rev 382)
@@ -75,7 +75,7 @@
# get order book
orderbook <- getOrderBook(portfolio)
if(!length(grep(symbol,names(orderbook[[portfolio]])))==1) stop(paste("symbol",symbol,"does not exist in portfolio",portfolio,"having symbols",names(orderbook)))
- orderset<-orderbook[[portfolio]][[symbol]]
+ ordersubset<-orderbook[[portfolio]][[symbol]]
#data quality checks
if(!is.null(status) & !length(grep(status,c("open", "closed", "canceled","replaced")))==1) stop(paste("order status:",status,' must be one of "open", "closed", "canceled", or "replaced"'))
@@ -85,18 +85,18 @@
}
}
- indices <- which(#if(!is.null(timespan)) orderset[timespan,which.i=TRUE] else TRUE &
- if(!is.null(status)) orderset[,"Order.Status"]==status else TRUE &
- if(!is.null(ordertype)) orderset[,"Order.Type"]==ordertype else TRUE &
- if(!is.null(status)) orderset[,"Order.Side"]==side else TRUE
+ indices <- which(#if(!is.null(timespan)) ordersubset[timespan,which.i=TRUE] else TRUE &
+ if(!is.null(status)) ordersubset[,"Order.Status"]==status else TRUE &
+ if(!is.null(ordertype)) ordersubset[,"Order.Type"]==ordertype else TRUE &
+ if(!is.null(status)) ordersubset[,"Order.Side"]==side else TRUE
)
if(isTRUE(which.i)){
return(indices)
} else {
# extract
- orderset<-orderbook[[portfolio]][[symbol]][indices,]
- return(orderset)
+ ordersubset<-orderbook[[portfolio]][[symbol]][indices,]
+ return(ordersubset)
}
}
@@ -195,9 +195,9 @@
if(is.null(price)) stop("price",price,"must not be NULL")
if(is.na(price)) stop("price",price,"must not be NA")
- if(!length(grep(side,c('long','short')))==1) stop(paste("side:",side," must be one of 'long' or 'short'"))
- if(is.na(charmatch(ordertype,c("market","limit","stoplimit","stoptrailing")))) stop(paste("ordertype:",ordertype,' must be one of "market","limit","stoplimit", or "stoptrailing"'))
- if(!is.null(threshold) ) {
+ if(!is.null(side) & !length(grep(side,c('long','short')))==1) stop(paste("side:",side," must be one of 'long' or 'short'"))
+ if(is.na(charmatch(ordertype,c("market","limit","stoplimit","stoptrailing")))) stop(paste("ordertype:",ordertype,' must be one of "market","limit","stoplimit",or "stoptrailing"'))
+ if(!is.null(threshold) & length(price)>1 ) {
if(length(grep(ordertype,c("stoplimit","stoptrailing")))==1) {
#we have a threshold set on a stop* order, process it
switch(ordertype,
@@ -219,7 +219,9 @@
} else {
stop(paste("Threshold may only be applied to a stop order type",ordertype,threshold))
}
- } else { threshold=NA } #NA is not ignored like NULL is
+ }
+
+ if(is.null(threshold)) threshold=NA #NA is not ignored like NULL is
if(!length(grep(status,c("open", "closed", "canceled","replaced")))==1) stop(paste("order status:",status,' must be one of "open", "closed", "canceled", or "replaced"'))
# TODO do we need to check for collision, and increment timestamp? or alternately update?
@@ -235,16 +237,34 @@
statustimestamp=NA # new orders don't have a status time
#handle order sets
- order.set=NA
-
+ #get the order set if length(price)>1
+ if(length(prices)>1) {
+ order.set<-max(getOrders(portfolio=portfolio, symbol=symbol, status='open', timespan=timespan, ordertype=NULL, side=NULL,which.i=FALSE)$Order.Set)
+ if(is.na(order.set)) order.set<-1
+ } else {
+ order.set=NA
+ }
+
+ #set up the other parameters
+ if (!length(qty)==length(price)) qty <- rep(qty,length(price))
+ if (!length(ordertype)==length(price)) ordertype <- rep(ordertype,length(price))
+ if (!length(threshold)==length(price)) threshold <- rep(threshold,length(price))
+ #if (!length(param)==length(price)) param <- rep(param,length(price))
+
# insert new order
if(is.timeBased(timestamp)) ordertime<-timestamp+delay
else ordertime<-as.POSIXct(timestamp)+delay
- order<-xts(as.matrix(t(c(qty, price, ordertype, side, threshold, status, statustimestamp, order.set))),order.by=(ordertime))
-# colnames(order) <- c("Order.Qty","Order.Price","Order.Type","Order.Side","Order.Threshold","Order.Status","Order.StatusTime","Order.Set")
- #print(order)
- if(ncol(order)!=8) {
- print(paste("bad order:",order))
+
+ order<-NULL
+ for (i in 1:length(price)){
+ neworder<-xts(as.matrix(t(c(qty[i], price[i], ordertype[i], side, threshold[i], status, statustimestamp, order.set))),order.by=(ordertime))
+ if(is.null(order)) order<-neworder
+ else order <- rbind(order,neworder)
+ }
+
+ if(ncol(order)!=8) {
+ print("bad order(s):")
+ print(order)
next()
}
@@ -330,7 +350,7 @@
ruleOrderProc <- function(portfolio, symbol, mktdata, timespan, ordertype=NULL, ..., slippageFUN=NULL)
{
orderbook <- getOrderBook(portfolio)
- orderset <- orderbook[[portfolio]][[symbol]]
+ ordersubset <- orderbook[[portfolio]][[symbol]]
# get open orders
procorders=NULL
@@ -350,8 +370,8 @@
# next process daily
for (ii in procorders ){
txnprice=NULL
- txntime=as.character(index(orderset[ii,]))
- switch(orderset[ii,]$Order.Type,
+ txntime=as.character(index(ordersubset[ii,]))
+ switch(ordersubset[ii,]$Order.Type,
market = {
txnprice=as.numeric(getPrice(mktdata[txntime], prefer='close'))
#if(!is.null(ncol(txnprice)) & ncol(txnprice)>1) txnprice = as.numeric(getPrice(mktdata[timestamp], symbol=symbol, prefer='close'))
@@ -360,9 +380,9 @@
stoplimit = {
# check to see if price moved through the limit
tmpprices<-last(mktdata[timestamp])
- if ( isTRUE(orderset[ii, ]$Order.Price > getPrice(tmpprices, prefer = "Lo")) &
- isTRUE(orderset[ii, ]$Order.Price < getPrice(tmpprices, prefer = "Hi")) ) {
- txnprice=as.numeric(orderset[ii,]$Order.Price)
+ if ( isTRUE(ordersubset[ii, ]$Order.Price > getPrice(tmpprices, prefer = "Lo")) &
+ isTRUE(ordersubset[ii, ]$Order.Price < getPrice(tmpprices, prefer = "Hi")) ) {
+ txnprice=as.numeric(ordersubset[ii,]$Order.Price)
txntime=as.character(timestamp)
} else {
# price did not move through my order
@@ -374,9 +394,9 @@
}
)
if(!is.null(txnprice)){
- addTxn(Portfolio=portfolio, Symbol=symbol, TxnDate=txntime, TxnQty=as.numeric(orderset[ii,]$Order.Qty), TxnPrice=txnprice ,...=...)
- orderset[ii,]$Order.Status<-'closed'
- orderset[ii,]$Order.StatusTime<-txntime
+ addTxn(Portfolio=portfolio, Symbol=symbol, TxnDate=txntime, TxnQty=as.numeric(ordersubset[ii,]$Order.Qty), TxnPrice=txnprice ,...=...)
+ ordersubset[ii,]$Order.Status<-'closed'
+ ordersubset[ii,]$Order.StatusTime<-txntime
}
} #end loop over open orders
}, #end daily and lower frequency processing
@@ -386,7 +406,7 @@
for (ii in procorders ){
#browser()
txnprice=NULL
- switch(orderset[ii,]$Order.Type,
+ switch(ordersubset[ii,]$Order.Type,
market = {
txnprice = as.numeric(getPrice(mktdata[timestamp]))
#TODO extend this to figure out which side to prefer
@@ -397,8 +417,8 @@
stoplimit = {
if (is.OHLC(mktdata)){
# check to see if price moved through the limit
- if(orderset[ii,]$Order.Price>Lo(mktdata[timestamp]) & orderset[ii,]$Order.Price<Hi(mktdata[timestamp]) ) {
- txnprice = as.numeric(orderset[ii,]$Order.Price)
+ if(ordersubset[ii,]$Order.Price>Lo(mktdata[timestamp]) & ordersubset[ii,]$Order.Price<Hi(mktdata[timestamp]) ) {
+ txnprice = as.numeric(ordersubset[ii,]$Order.Price)
txntime = as.character(timestamp)
} else {
# price did not move through my order
@@ -406,23 +426,23 @@
}
} else if(is.BBO(mktdata)){
# check side/qty
- if(as.numeric(orderset[ii,]$Order.Qty)>0){ # positive quantity 'buy'
- if(as.numeric(orderset[ii,]$Order.Price)>=as.numeric(getPrice(mktdata[timestamp],prefer='offer'))){
+ if(as.numeric(ordersubset[ii,]$Order.Qty)>0){ # positive quantity 'buy'
+ if(as.numeric(ordersubset[ii,]$Order.Price)>=as.numeric(getPrice(mktdata[timestamp],prefer='offer'))){
# price we're willing to pay is higher than the offer price, so execute at the limit
- txnprice = as.numeric(orderset[ii,]$Order.Price)
+ txnprice = as.numeric(ordersubset[ii,]$Order.Price)
txntime = as.character(timestamp)
} else next()
} else { # negative quantity 'sell'
- if(as.numeric(orderset[ii,]$Order.Price) <= as.numeric(getPrice(mktdata[timestamp],prefer='bid'))){
+ if(as.numeric(ordersubset[ii,]$Order.Price) <= as.numeric(getPrice(mktdata[timestamp],prefer='bid'))){
# we're willing to sell at a better price than the bid, so execute at the limit
- txnprice = as.numeric(orderset[ii,]$Order.Price)
+ txnprice = as.numeric(ordersubset[ii,]$Order.Price)
txntime = as.character(timestamp)
} else next()
}
} else {
# no depth data, either OHLC or BBO, getPrice explicitly using symbol ?
- if(orderset[ii,]$Order.Price==getPrice(mktdata[timestamp], symbol=symbol, prefer='price')){
- txnprice = as.numeric(orderset[ii,]$Order.Price)
+ if(ordersubset[ii,]$Order.Price==getPrice(mktdata[timestamp], symbol=symbol, prefer='price')){
+ txnprice = as.numeric(ordersubset[ii,]$Order.Price)
txntime = as.character(timestamp)
} else next()
}
@@ -430,16 +450,16 @@
},
stoptrailing = {
# if market moved through my price, execute
- if(as.numeric(orderset[ii,]$Order.Qty)>0){ # positive quantity 'buy'
- if(orderset[ii,]$Order.Price>=getPrice(mktdata[timestamp],prefer='offer')){
+ if(as.numeric(ordersubset[ii,]$Order.Qty)>0){ # positive quantity 'buy'
+ if(ordersubset[ii,]$Order.Price>=getPrice(mktdata[timestamp],prefer='offer')){
# price we're willing to pay is higher than the offer price, so execute at the limit
- txnprice = as.numeric(orderset[ii,]$Order.Price)
+ txnprice = as.numeric(ordersubset[ii,]$Order.Price)
txntime = as.character(timestamp)
}
} else { # negative quantity 'sell'
- if(orderset[ii,]$Order.Price<=getPrice(mktdata[timestamp],prefer='bid')){
+ if(ordersubset[ii,]$Order.Price<=getPrice(mktdata[timestamp],prefer='bid')){
# we're willing to sell at a better price than the bid, so execute at the limit
- txnprice = as.numeric(orderset[ii,]$Order.Price)
+ txnprice = as.numeric(ordersubset[ii,]$Order.Price)
txntime = as.character(timestamp)
}
}
@@ -451,7 +471,7 @@
if (is.OHLC(mktdata)){
prefer='close'
} else if(is.BBO(mktdata)) {
- if(as.numeric(orderset[ii,]$Order.Qty)>0){
+ if(as.numeric(ordersubset[ii,]$Order.Qty)>0){
prefer='offer'
} else {
prefer='bid'
@@ -459,20 +479,20 @@
} else {
prefer=NULL # see if getPrice can figure it out
}
- if( getPrice(mktdata[timestamp],prefer=prefer)+orderset[ii,]$Order.Threshold > orderset[ii,]$Order.Price ){
+ if( getPrice(mktdata[timestamp],prefer=prefer)+ordersubset[ii,]$Order.Threshold > ordersubset[ii,]$Order.Price ){
neworder<-addOrder(portfolio=portfolio,
symbol=symbol,
timestamp=timestamp,
- qty=as.numeric(orderset[ii,]$Order.Qty),
- price=getgetPrice(mktdata[timestamp],prefer=prefer)+orderset[ii,]$Order.Threshold,
- ordertype=orderset[ii,]$Order.Type,
- side=orderset[ii,]$Order.Side,
- threshold=orderset[ii,]$Order.Threshold,
+ qty=as.numeric(ordersubset[ii,]$Order.Qty),
+ price=getgetPrice(mktdata[timestamp],prefer=prefer)+ordersubset[ii,]$Order.Threshold,
+ ordertype=ordersubset[ii,]$Order.Type,
+ side=ordersubset[ii,]$Order.Side,
+ threshold=ordersubset[ii,]$Order.Threshold,
status="open",
replace=FALSE, return=TRUE)
if (is.null(neworders)) neworders=neworder else neworders = rbind(neworders,neworder)
- orderset[ii,]$Order.Status<-'replaced'
- orderset[ii,]$Order.StatusTime<-as.character(timestamp)
+ ordersubset[ii,]$Order.Status<-'replaced'
+ ordersubset[ii,]$Order.StatusTime<-as.character(timestamp)
next()
}
}
@@ -480,19 +500,19 @@
}
)
if(!is.null(txnprice)& !is.na(txnprice)){
- addTxn(Portfolio=portfolio, Symbol=symbol, TxnDate=txntime, TxnQty=as.numeric(orderset[ii,]$Order.Qty), TxnPrice=txnprice ,...=...)
- orderset[ii,]$Order.Status<-'closed'
- orderset[ii,]$Order.StatusTime<-as.character(timestamp)
+ addTxn(Portfolio=portfolio, Symbol=symbol, TxnDate=txntime, TxnQty=as.numeric(ordersubset[ii,]$Order.Qty), TxnPrice=txnprice ,...=...)
+ ordersubset[ii,]$Order.Status<-'closed'
+ ordersubset[ii,]$Order.StatusTime<-as.character(timestamp)
}
} #end loop over open orders
- if(!is.null(neworders)) orderset=rbind(orderset,neworders)
+ if(!is.null(neworders)) ordersubset=rbind(ordersubset,neworders)
} # end higher frequency processing
) # end switch on freq
# now put the orders back in
# assign order book back into place (do we need a non-exported "put" function?)
- orderbook[[portfolio]][[symbol]] <- orderset
+ orderbook[[portfolio]][[symbol]] <- ordersubset
assign(paste("order_book",portfolio,sep='.'),orderbook,envir=.strategy)
} # end check for open orders
}
Modified: pkg/quantstrat/R/traderules.R
===================================================================
--- pkg/quantstrat/R/traderules.R 2010-08-24 19:27:24 UTC (rev 381)
+++ pkg/quantstrat/R/traderules.R 2010-08-26 11:26:06 UTC (rev 382)
@@ -1,15 +1,19 @@
#' default rule to generate a trade order on a signal
#'
-#' \code{pricemethod} may be one of 'market' or 'opside'
+#' \code{pricemethod} may be one of 'market', 'opside', or 'maker'
#' which will either try to get the price of the 'market' at \code{timestamp} and use this as the order price
-#' or 'opside' which will use the 'ask' price if you're buying and the 'bid' price if you're selling
+#' or 'opside' which will use the 'ask' price if you're buying and the 'bid' price if you're selling, crossing
+#' the market at the time of order entry to attempt to set an aggressive price to get the trade.
+#' The 'maker' \code{pricemethod} will create a pair of orders for both bid and offer, modeling market making
+#' activities by having orders on both sides. This will then create an Order.Set, and use the threshold to
+#' set the prices for these orders.
#'
#' If \code{threshold} is not numeric or \code{NULL} it should be the character string describing a function that can calculate a threshold.
#' Ideally this will be a column lookup on a non-path-dependent indicator calculated in advance.
#'
#' If \code{orderside} is NULL, the function will attempt to calculate the side from the current position
-#' (if any) and the order quantity.
+#' (if any), the order quantity, and the order type.
#'
#' @param data an xts object containing market data. depending on rules, may need to be in OHLCV or BBO formats, and may include indicator and signal information
#' @param timestamp timestamp coercible to POSIXct that will be the time the order will be inserted on
@@ -22,14 +26,14 @@
#' @param replace TRUE/FALSE, whether to replace any other open order(s) on this portfolio symbol, default TRUE
#' @param delay what delay to add to timestamp when inserting the order into the order book, in seconds
#' @param osFUN function or text descriptor of function to use for order sizing, default \code{\link{osNoOp}}
-#' @param pricemethod one of 'market' or 'opside', see Details
+#' @param pricemethod one of 'market', 'opside', or 'maker', see Details
#' @param portfolio text name of the portfolio to place orders in
#' @param symbol identifier of the instrument to place orders for. The name of any associated price objects (xts prices, usually OHLC) should match these
#' @param ... any other passthru parameters
#' @param ruletype one of "risk","order","rebalance","exit","entry", see \code{\link{add.rule}}
#' @seealso \code{\link{osNoOp}} , \code{\link{add.rule}}
#' @export
-ruleSignal <- function(data=mktdata, timestamp, sigcol, sigval, orderqty=0, ordertype, orderside=NULL, threshold=NULL, replace=TRUE, delay=0.0001, osFUN='osNoOp', pricemethod=c('market','opside'), portfolio, symbol, ..., ruletype ) {
+ruleSignal <- function(data=mktdata, timestamp, sigcol, sigval, orderqty=0, ordertype, orderside=NULL, threshold=NULL, replace=TRUE, delay=0.0001, osFUN='osNoOp', pricemethod=c('market','opside','maker'), portfolio, symbol, ..., ruletype ) {
if(!is.function(osFUN)) osFUN<-match.fun(osFUN)
#print(paste(symbol,timestamp))
#print(data[timestamp][,sigcol])
@@ -42,23 +46,60 @@
#calculate order price using pricemethod
pricemethod<-pricemethod[1] #only use the first if not set by calling function
- switch(pricemethod,
+
+ if(hasArg(prefer)) prefer=match.call(expand.dots=TRUE)$prefer
+ else prefer = NULL
+
+ switch(pricemethod,
opside = {
if (orderqty>0)
prefer='ask' # we're buying, so pay what they're asking
else
prefer='bid' # we're selling, so give it to them for what they're bidding
- orderprice <- try(getPrice(x=data,prefer=prefer))
- },
+ orderprice <- try(getPrice(x=data, prefer=prefer))[as.character(timestamp)]
+ },
market = {
- if(hasArg(prefer)) prefer=match.call(expand.dots=TRUE)$prefer
- else prefer = NULL
- orderprice <- try(getPrice(x=data, prefer=prefer))
- }
+ orderprice <- try(getPrice(x=data, prefer=prefer))[as.character(timestamp)]
+ },
+ maker = {
+ if(hasArg(price) & length(match.call(expand.dots=TRUE)$price)>1) {
+ # we have prices, just use them
+ orderprice <- try(match.call(expand.dots=TRUE)$price)
+ } else {
+ if(!is.null(threshold)) {
+ baseprice<- last(getPrice(x=data)[as.character(timestamp)]) # this should get either the last trade price or the Close
+ if(hasArg(tmult) & isTRUE(match.call(expand.dots=TRUE)$tmult)) {
+ baseprice<- last(getPrice(x=data)[as.character(timestamp)]) # this should get either the last trade price or the Close
+ # threshold is a multiplier of current price
+ if (length(threshold)>1){
+ orderprice <- baseprice * threshold # assume the user has set proper threshold multipliers for each side
+ } else {
+ orderprice <- c(baseprice*threshold,baseprice*(1+1-threshold)) #just bracket on both sides
+ }
+ } else {
+ # tmult is FALSE or NULL, threshold is numeric
+ if (length(threshold)>1){
+ orderprice <- baseprice + threshold # assume the user has set proper threshold numerical offsets for each order
+ } else {
+ orderprice <- c(baseprice+threshold,baseprice+(-threshold)) #just bracket on both sides
+ }
+ }
+ } else{
+ # no threshold, put it on the averages?
+ stop('maker orders without specified prices and without threholds not (yet?) supported')
+ if(is.BBO(data)){
+
+ } else {
+
+ }
+ }
+ }
+ if(length(orderqty)==1) orderqty <- c(orderqty,-orderqty) #create paired market maker orders at the same size
+ }
)
if(inherits(orderprice,'try-error')) orderprice<-NULL
- if(length(orderprice>1)) orderprice<-last(orderprice[as.character(timestamp)])
- if(is.null(orderside) & !orderqty == 0){
+ if(length(orderprice>1) & !ordertype=='maker') orderprice<-last(orderprice[as.character(timestamp)])
+ if(is.null(orderside) & !isTRUE(orderqty == 0)){
curqty<-getPosQty(Portfolio=portfolio, Symbol=symbol, Date=timestamp)
if (curqty>0 ){
#we have a long position
@@ -75,7 +116,6 @@
}
}
if(!is.null(orderqty) & !orderqty == 0 & !is.null(orderprice)){
- # print(orderprice)
addOrder(portfolio=portfolio, symbol=symbol, timestamp=timestamp, qty=orderqty, price=orderprice, ordertype=ordertype, side=orderside, threshold=threshold, status="open", replace=replace , delay=delay, ...)
}
}
@@ -83,6 +123,7 @@
#TODO ruleORSignal
#TODO ruleANDSingnal
+# perhaps this could be done using the approach of sigFormula, or perhaps we should advise users to use sigFormula to create a signal you can use ruleSignal on. Thoughts?
#' default order sizing function
More information about the Blotter-commits
mailing list