[Blotter-commits] r393 - pkg/quantstrat/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Sep 12 19:27:11 CEST 2010
Author: braverock
Date: 2010-09-12 19:27:10 +0200 (Sun, 12 Sep 2010)
New Revision: 393
Modified:
pkg/quantstrat/R/orders.R
pkg/quantstrat/R/rules.R
pkg/quantstrat/R/signals.R
pkg/quantstrat/R/traderules.R
Log:
- fix passing of dots and TxnFees. bug reported by Andre Barosso < andre <dot> barroso <at> gmail <dot> com >
Modified: pkg/quantstrat/R/orders.R
===================================================================
--- pkg/quantstrat/R/orders.R 2010-09-10 13:50:48 UTC (rev 392)
+++ pkg/quantstrat/R/orders.R 2010-09-12 17:27:10 UTC (rev 393)
@@ -35,9 +35,9 @@
orders<-list()
orders[[portfolio]]<-list()
}
- ordertemplate<-xts(as.matrix(t(c(0,NA,"init","long",0,"closed",as.character(as.POSIXct(initDate)),1))),order.by=as.POSIXct(initDate))
- colnames(ordertemplate) <- c("Order.Qty","Order.Price","Order.Type","Order.Side","Order.Threshold","Order.Status","Order.StatusTime","Order.Set")
-
+ ordertemplate<-xts(as.matrix(t(c(0,NA,"init","long",0,"closed",as.character(as.POSIXct(initDate)),1,0))),order.by=as.POSIXct(initDate))
+ colnames(ordertemplate) <- c("Order.Qty","Order.Price","Order.Type","Order.Side","Order.Threshold","Order.Status","Order.StatusTime","Order.Set","Txn.Fees")
+
if(is.null(symbols)) {
pfolio<-getPortfolio(portfolio)
symbols<-names(pfolio$symbols)
@@ -76,21 +76,21 @@
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)))
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"'))
if(!is.null(ordertype)) {
if(is.na(charmatch(ordertype,c("market","limit","stoplimit","stoptrailing")))){
stop(paste("ordertype:",ordertype,' must be one of "market","limit","stoplimit", or "stoptrailing"'))
- }
- }
+ }
+ }
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 {
@@ -178,13 +178,15 @@
#' @param tmult if TRUE, threshold is a percent multiplier for \code{price}, not a scalar to be added/subtracted from price. threshold will be dynamically converted to a scalar at time of order entry
#' @param replace TRUE/FALSE, whether to replace any other open order(s) on this portfolio symbol, default TRUE
#' @param return if TRUE, return the row that makes up the order, default FALSE (will assign into the environment)
+#' @param dots any other passthru parameters
+#' @param TxnFees numeric fees (usually negative) or function name for calculating TxnFees (processing happens later, not in this function)
#' @export
-addOrder <- function(portfolio, symbol, timestamp, qty, price, ordertype, side, threshold=NULL, status="open", statustimestamp='' , delay=.00001, tmult=FALSE, replace=TRUE, return=FALSE)
+addOrder <- function(portfolio, symbol, timestamp, qty, price, ordertype, side, threshold=NULL, status="open", statustimestamp='' , delay=.00001, tmult=FALSE, replace=TRUE, return=FALSE, ..., TxnFees=0)
{
# 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[[portfolio]])))
-
+
#data quality checks
if(!is.numeric(qty)) stop (paste("Quantity must be numeric:",qty))
if(qty==0) stop("qty",qty,"must be positive or negative")
@@ -194,7 +196,7 @@
if(price==0) stop("price",price,"must be positive or negative")
if(is.null(price)) stop("price",price,"must not be NULL")
if(is.na(price)) stop("price",price,"must not be NA")
-
+
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 ) {
@@ -213,19 +215,19 @@
if(isTRUE(tmult)){
#get the difference between the threshold*price and the price
threshold = (price*threshold)-price
- }
+ }
}
) #end type switch
- } else {
+ } else {
stop(paste("Threshold may only be applied to a stop order type",ordertype,threshold))
}
- }
-
+ }
+
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?
-
+
# subset by time and symbol
if(!is.null(timestamp)& length(timestamp)>=1){
timespan<-paste("::",timestamp,sep='')
@@ -233,9 +235,9 @@
# construct the timespan of the entire series
timespan=paste(index(first(orderbook),index(last(orderbook)),sep='::'))
}
-
+
statustimestamp=NA # new orders don't have a status time
-
+
#handle order sets
#get the order set if length(price)>1
if(length(price)>1) {
@@ -254,20 +256,20 @@
# insert new order
if(is.timeBased(timestamp)) ordertime<-timestamp+delay
else ordertime<-as.POSIXct(timestamp)+delay
-
+
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))
+ neworder<-xts(as.matrix(t(c(qty[i], price[i], ordertype[i], side, threshold[i], status, statustimestamp, order.set,TxnFees))),order.by=(ordertime))
if(is.null(order)) order<-neworder
else order <- rbind(order,neworder)
}
- if(ncol(order)!=8) {
+ if(ncol(order)!=9) {
print("bad order(s):")
print(order)
next()
}
-
+
if(!isTRUE(return)){
if(isTRUE(replace)) updateOrders(portfolio=portfolio, symbol=symbol,timespan=timespan, ordertype=ordertype, side=side, oldstatus="open", newstatus="replaced", statustimestamp=timestamp)
# get order book
@@ -279,7 +281,7 @@
return()
} else {
return(order)
- }
+ }
}
#' update an order or orders
@@ -371,6 +373,7 @@
for (ii in procorders ){
txnprice=NULL
txntime=as.character(index(ordersubset[ii,]))
+ txnfees=ordersubset[ii, ]$Txn.Fees
switch(ordersubset[ii,]$Order.Type,
market = {
txnprice=as.numeric(getPrice(mktdata[txntime], prefer='close'))
@@ -394,7 +397,7 @@
}
)
if(!is.null(txnprice)){
- addTxn(Portfolio=portfolio, Symbol=symbol, TxnDate=txntime, TxnQty=as.numeric(ordersubset[ii,]$Order.Qty), TxnPrice=txnprice ,...=...)
+ addTxn(Portfolio=portfolio, Symbol=symbol, TxnDate=txntime, TxnQty=as.numeric(ordersubset[ii,]$Order.Qty), TxnPrice=txnprice , ...=..., TxnFees=txnfees)
ordersubset[ii,]$Order.Status<-'closed'
ordersubset[ii,]$Order.StatusTime<-txntime
}
@@ -406,6 +409,7 @@
for (ii in procorders ){
#browser()
txnprice=NULL
+ txnfees=ordersubset[ii, ]$Txn.Fees
switch(ordersubset[ii,]$Order.Type,
market = {
txnprice = as.numeric(getPrice(mktdata[timestamp]))
@@ -423,7 +427,7 @@
} else {
# price did not move through my order
next() # should go to next order
- }
+ }
} else if(is.BBO(mktdata)){
# check side/qty
if(as.numeric(ordersubset[ii,]$Order.Qty)>0){ # positive quantity 'buy'
@@ -437,16 +441,16 @@
# we're willing to sell at a better price than the bid, so execute at the limit
txnprice = as.numeric(ordersubset[ii,]$Order.Price)
txntime = as.character(timestamp)
- } else next()
- }
+ } else next()
+ }
} else {
# no depth data, either OHLC or BBO, getPrice explicitly using symbol ?
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()
+ } else next()
}
-
+
},
stoptrailing = {
# if market moved through my price, execute
@@ -466,7 +470,7 @@
# if market is beyond price+(-threshold), replace order
if(is.null(txnprice)) {
# we didn't trade, so check to see if we need to move the stop
-
+
# first figure out how to find a price
if (is.OHLC(mktdata)){
prefer='close'
@@ -480,17 +484,18 @@
prefer=NULL # see if getPrice can figure it out
}
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(ordersubset[ii,]$Order.Qty),
+ neworder<-addOrder(portfolio=portfolio,
+ symbol=symbol,
+ timestamp=timestamp,
+ 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)
+ ordertype=ordersubset[ii,]$Order.Type,
+ side=ordersubset[ii,]$Order.Side,
+ threshold=ordersubset[ii,]$Order.Threshold,
+ status="open",
+ replace=FALSE, return=TRUE,
+ ,...=..., TxnFees=ordersubset[ii,]$TxnFees)
+ if (is.null(neworders)) neworders=neworder else neworders = rbind(neworders,neworder)
ordersubset[ii,]$Order.Status<-'replaced'
ordersubset[ii,]$Order.StatusTime<-as.character(timestamp)
next()
@@ -500,13 +505,13 @@
}
)
if(!is.null(txnprice)& !is.na(txnprice)){
- addTxn(Portfolio=portfolio, Symbol=symbol, TxnDate=txntime, TxnQty=as.numeric(ordersubset[ii,]$Order.Qty), TxnPrice=txnprice ,...=...)
+ addTxn(Portfolio=portfolio, Symbol=symbol, TxnDate=txntime, TxnQty=as.numeric(ordersubset[ii,]$Order.Qty), TxnPrice=txnprice , ...=..., TxnFees=txnfees)
ordersubset[ii,]$Order.Status<-'closed'
ordersubset[ii,]$Order.StatusTime<-as.character(timestamp)
}
} #end loop over open orders
if(!is.null(neworders)) ordersubset=rbind(ordersubset,neworders)
-
+
} # end higher frequency processing
) # end switch on freq
Modified: pkg/quantstrat/R/rules.R
===================================================================
--- pkg/quantstrat/R/rules.R 2010-09-10 13:50:48 UTC (rev 392)
+++ pkg/quantstrat/R/rules.R 2010-09-12 17:27:10 UTC (rev 393)
@@ -136,7 +136,7 @@
rm('...')
nargs=NULL
}
-
+
.formals <- formals(fun)
onames <- names(.formals)
rule$arguments$timestamp = timestamp
@@ -145,14 +145,14 @@
# if (any(pm == 0L)) message(paste("some arguments stored for",rule$name,"do not match"))
names(rule$arguments[pm > 0L]) <- onames[pm]
.formals[pm] <- rule$arguments[pm > 0L]
-
+
# now add arguments from parameters
if(length(parameters)){
pm <- pmatch(names(parameters), onames, nomatch = 0L)
names(parameters[pm > 0L]) <- onames[pm]
.formals[pm] <- parameters[pm > 0L]
}
-
+
#now add dots
if (length(nargs)) {
pm <- pmatch(names(nargs), onames, nomatch = 0L)
@@ -160,7 +160,7 @@
.formals[pm] <- nargs[pm > 0L]
}
.formals$... <- NULL
-
+
tmp_val<-do.call(fun,.formals)
## if(!is.null(tmp_val)){
## if(is.null(names(tmp_val)) & ncol(tmp_val)==1) names(tmp_val)<-rule$label
@@ -176,7 +176,7 @@
mktdata <<- mktdata
ret <<- ret
hold <<- hold #TODO FIXME hold processing doesn't work yet
-
+
#print(tmp_val)
} #end rules loop
} # end sub process function
@@ -187,12 +187,12 @@
hold=FALSE
holdtill=first(time(Dates))-1 # TODO FIXME make holdtill default more robust?
-
+
for(d in 1:length(Dates)){ # d is a date slot counter
# I shouldn't have to do this but we lose the class for the element
# when we do for(date in Dates)
timestamp=Dates[d]
-
+
# check to see if we need to release a hold
if(isTRUE(hold) & holdtill<timestamp){
hold=FALSE
@@ -202,44 +202,44 @@
switch( type ,
pre = {
if(length(strategy$rules[[type]])>=1){
- ruleProc(strategy$rules$pre,timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol, ruletype=type)
+ ruleProc(strategy$rules$pre,timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol, ruletype=type, ...)
}
},
risk = {
if(length(strategy$rules$risk)>=1){
- ruleProc(strategy$rules$risk,timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol, ruletype=type)
- }
+ ruleProc(strategy$rules$risk,timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol, ruletype=type,...)
+ }
},
order = {
if(isTRUE(hold)) next()
if(length(strategy$rules[[type]])>=1) {
- ruleProc(strategy$rules[[type]],timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol, ruletype=type)
+ ruleProc(strategy$rules[[type]],timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol, ruletype=type,...)
} else {
#(mktdata, portfolio, symbol, timestamp, slippageFUN=NULL)
timespan<-paste("::",timestamp,sep='')
- ruleOrderProc(portfolio=portfolio, symbol=symbol, mktdata=mktdata, timespan=timespan)
+ ruleOrderProc(portfolio=portfolio, symbol=symbol, mktdata=mktdata, timespan=timespan,...)
}
},
rebalance =, exit = , enter = , entry = {
- if(isTRUE(hold)) next()
+ if(isTRUE(hold)) next()
if(type=='exit'){
# must have a position for an exit rules to fire
if (getPosQty(Portfolio=portfolio,Symbol=symbol,Date=timestamp)==0) next()
}
if(length(strategy$rules[[type]])>=1) {
- ruleProc(strategy$rules[[type]],timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol, ruletype=type)
- }
+ ruleProc(strategy$rules[[type]],timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol, ruletype=type,...)
+ }
},
post = {
#TODO do we processfor hold here, or not?
if(length(strategy$rules$post)>=1) {
- ruleProc(strategy$rules$post,timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol, ruletype=type)
+ ruleProc(strategy$rules$post,timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol, ruletype=type,...)
}
}
- ) # end switch
+ ) # end switch
} #end type loop
} # end dates loop
-
+
mkdata<<-mktdata
if(is.null(ret)) {
return(mktdata)
Modified: pkg/quantstrat/R/signals.R
===================================================================
--- pkg/quantstrat/R/signals.R 2010-09-10 13:50:48 UTC (rev 392)
+++ pkg/quantstrat/R/signals.R 2010-09-12 17:27:10 UTC (rev 393)
@@ -22,12 +22,12 @@
tmp_signal$arguments<-arguments
if(!is.null(parameters)) tmp_signal$parameters = parameters
if(length(list(...))) tmp_signal<-c(tmp_signal,list(...))
-
+
if(!hasArg(indexnum) | (hasArg(indexnum) & is.null(indexnum))) indexnum = length(strategy$signals)+1
tmp_signal$call<-match.call()
class(tmp_signal)<-'strat_signal'
strategy$signals[[indexnum]]<-tmp_signal
-
+
if (store) assign(strategy$name,strategy,envir=as.environment(.strategy))
else return(strategy)
}
@@ -41,12 +41,12 @@
#' @export
applySignals <- function(strategy, mktdata, indicators=NULL, parameters=NULL, ...) {
#TODO add Date subsetting
-
+
# TODO check for symbol name in mktdata using Josh's code:
# symbol <- strsplit(colnames(mktdata)[1],"\\.")[[1]][1]
-
+
# TODO handle indicator lists as well as indicators that were cbound to mktdata
-
+
if (!is.strategy(strategy)) {
strategy<-try(getStrategy(strategy))
if(inherits(strategy,"try-error"))
@@ -153,9 +153,9 @@
ask = {relationship = 'gt'}
)
}
-
+
colNums <- match.names(columns,colnames(data))
-
+
opr <- switch( relationship,
gt = , '>'='>',
lt =, '<'='<',
@@ -163,7 +163,7 @@
gte=, gteq=, ge=, ">=" = ">=",
lte=, lteq=, le=, "<=" = "<="
)
-
+
ret_sig <- do.call( opr, list(data[,colNums[1]], data[,colNums[2]]))
} else {
Modified: pkg/quantstrat/R/traderules.R
===================================================================
--- pkg/quantstrat/R/traderules.R 2010-09-10 13:50:48 UTC (rev 392)
+++ pkg/quantstrat/R/traderules.R 2010-09-12 17:27:10 UTC (rev 393)
@@ -33,7 +33,8 @@
#' @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','maker'), 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, TxnFees=0 )
+{
if(!is.function(osFUN)) osFUN<-match.fun(osFUN)
#print(paste(symbol,timestamp))
#print(data[timestamp][,sigcol])
@@ -46,10 +47,13 @@
#calculate order price using pricemethod
pricemethod<-pricemethod[1] #only use the first if not set by calling function
-
- if(hasArg(prefer)) prefer=match.call(expand.dots=TRUE)$prefer
+
+ if(hasArg(prefer)) prefer=match.call(expand.dots=TRUE)$prefer
else prefer = NULL
-
+
+ #if(hasArg(TxnFees)) TxnFees=match.call(expand.dots=TRUE)$TxnFees
+ #else TxnFees=0
+
switch(pricemethod,
opside = {
if (orderqty>0)
@@ -88,9 +92,9 @@
# no threshold, put it on the averages?
stop('maker orders without specified prices and without threholds not (yet?) supported')
if(is.BBO(data)){
-
+
} else {
-
+
}
}
}
@@ -116,7 +120,7 @@
}
}
if(!is.null(orderqty) & !orderqty == 0 & !is.null(orderprice)){
- addOrder(portfolio=portfolio, symbol=symbol, timestamp=timestamp, qty=orderqty, price=orderprice, ordertype=ordertype, side=orderside, threshold=threshold, status="open", replace=replace , delay=delay, ...)
+ addOrder(portfolio=portfolio, symbol=symbol, timestamp=timestamp, qty=orderqty, price=orderprice, ordertype=ordertype, side=orderside, threshold=threshold, status="open", replace=replace , delay=delay, ...=..., TxnFees=TxnFees)
}
}
}
More information about the Blotter-commits
mailing list