[Blotter-commits] r1559 - pkg/quantstrat/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Oct 31 00:30:01 CET 2013
Author: bodanker
Date: 2013-10-31 00:30:00 +0100 (Thu, 31 Oct 2013)
New Revision: 1559
Modified:
pkg/quantstrat/R/ruleOrderProc.R
pkg/quantstrat/R/ruleSignal.R
pkg/quantstrat/R/rules.R
pkg/quantstrat/R/utils.R
Log:
- add curIndex arguments to ruleOrderProc and ruleSignal because
xts subsetting via integer is much faster than via POSIXct
- don't remove '...' in modify.args when they are in formals and dots=TRUE
Modified: pkg/quantstrat/R/ruleOrderProc.R
===================================================================
--- pkg/quantstrat/R/ruleOrderProc.R 2013-10-30 22:29:47 UTC (rev 1558)
+++ pkg/quantstrat/R/ruleOrderProc.R 2013-10-30 23:30:00 UTC (rev 1559)
@@ -52,6 +52,11 @@
ruleOrderProc <- function(portfolio, symbol, mktdata, timestamp=NULL, ordertype=NULL, ..., slippageFUN=NULL)
{
if(is.null(timestamp)) return()
+ # Get row index of timestamp for faster subsetting
+ if(hasArg(curIndex))
+ curIndex <- eval(match.call(expand.dots=TRUE)$curIndex, parent.frame())
+ else
+ curIndex <- mktdata[timestamp,which.i=TRUE]
orderbook <- getOrderBook(portfolio)
ordersubset <- orderbook[[portfolio]][[symbol]]
@@ -79,7 +84,7 @@
return(NULL)
} else {
- mktdataTimestamp <- mktdata[timestamp]
+ mktdataTimestamp <- mktdata[curIndex]
# only keep the last observation per time stamp
if( NROW(mktdataTimestamp) > 1 ) mktdataTimestamp <- last(mktdataTimestamp)
isOHLCmktdata <- is.OHLC(mktdata)
Modified: pkg/quantstrat/R/ruleSignal.R
===================================================================
--- pkg/quantstrat/R/ruleSignal.R 2013-10-30 22:29:47 UTC (rev 1558)
+++ pkg/quantstrat/R/ruleSignal.R 2013-10-30 23:30:00 UTC (rev 1559)
@@ -59,10 +59,13 @@
if(!is.function(osFUN))
osFUN<-match.fun(osFUN)
- if (!is.na(timestamp) &&
- nrow(mktdata[timestamp])>0 &&
- (ruletype=='chain' || (!is.na(mktdata[timestamp][,sigcol]) && mktdata[timestamp][,sigcol] == sigval))
- )
+ # Get row index of timestamp for faster subsetting
+ if(hasArg(curIndex))
+ curIndex <- eval(match.call(expand.dots=TRUE)$curIndex, parent.frame())
+ else
+ curIndex <- mktdata[timestamp,which.i=TRUE]
+
+ if(curIndex > 0 && curIndex <= nrow(mktdata) && (ruletype=='chain' || (!is.na(mktdata[curIndex,sigcol]) && mktdata[curIndex,sigcol]==sigval)))
{
#calculate order price using pricemethod
pricemethod<-pricemethod[1] #only use the first if not set by calling function
@@ -87,7 +90,7 @@
if(length(col.idx) > 1)
stop(paste('more than one indicator column in mktdata matches threshold name "', threshold, '"', sep=''))
- threshold <- as.numeric(mktdata[,col.idx][timestamp])
+ threshold <- as.numeric(mktdata[curIndex,col.idx])
}
}
@@ -140,7 +143,7 @@
else
prefer='bid' # we're selling, so give it to them for what they're bidding
}
- orderprice <- try(getPrice(x=mktdata, prefer=prefer)[,1][timestamp])
+ orderprice <- try(getPrice(x=mktdata[curIndex,], prefer=prefer)[,1])
},
passive =,
work =,
@@ -151,7 +154,7 @@
else
prefer='ask' # we're selling, so work the ask price
}
- orderprice <- try(getPrice(x=mktdata, prefer=prefer)[,1][timestamp])
+ orderprice <- try(getPrice(x=mktdata[curIndex,], prefer=prefer)[,1])
},
maker = {
if(hasArg(price) & length(match.call(expand.dots=TRUE)$price)>1) {
@@ -159,9 +162,9 @@
orderprice <- try(match.call(expand.dots=TRUE)$price)
} else {
if(!is.null(threshold)) {
- baseprice<- last(getPrice(x=mktdata)[,1][timestamp]) # this should get either the last trade price or the Close
+ baseprice <- last(getPrice(x=mktdata[curIndex,])[,1]) # 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=mktdata)[,1][timestamp]) # this should get either the last trade price or the Close
+ baseprice <- last(getPrice(x=mktdata[curIndex,])[,1]) # 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
Modified: pkg/quantstrat/R/rules.R
===================================================================
--- pkg/quantstrat/R/rules.R 2013-10-30 22:29:47 UTC (rev 1558)
+++ pkg/quantstrat/R/rules.R 2013-10-30 23:30:00 UTC (rev 1559)
@@ -587,17 +587,17 @@
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, mktinstr=mktinstr, parameters=parameters, ...)
+ ruleProc(strategy$rules$pre,timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol, ruletype=type, mktinstr=mktinstr, parameters=parameters, curIndex=curIndex, ...)
}
},
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, mktinstr=mktinstr,parameters=parameters, ...)
+ ruleProc(strategy$rules$risk,timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol, ruletype=type, mktinstr=mktinstr,parameters=parameters, curIndex=curIndex, ...)
}
},
order = {
if(length(strategy$rules[[type]])>=1) {
- ruleProc(strategy$rules[[type]],timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol, ruletype=type, mktinstr=mktinstr, parameters=parameters, ...)
+ ruleProc(strategy$rules[[type]],timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol, ruletype=type, mktinstr=mktinstr, parameters=parameters, curIndex=curIndex, ...)
} else {
#(mktdata, portfolio, symbol, timestamp, slippageFUN=NULL)
@@ -606,7 +606,7 @@
else
timestamp=NULL
- closed.orders <- ruleOrderProc(portfolio=portfolio, symbol=symbol, mktdata=mktdata, timestamp=timestamp, periodicity=freq, ...)
+ closed.orders <- ruleOrderProc(portfolio=portfolio, symbol=symbol, mktdata=mktdata, timestamp=timestamp, periodicity=freq, curIndex=curIndex, ...)
}
},
chain = {
@@ -626,7 +626,7 @@
txn.price <- last(txns$Txn.Price) # last() because there may be more than one txn at this timestamp
#ruleProc(rules[j], timestamp=timestamp, path.dep=path.dep, mktdata=mktdata, portfolio=portfolio, symbol=symbol, ruletype=type, mktinstr=mktinstr, parameters=list(chain.price=as.numeric(closed.chain$Order.Price[i]), ...))
- ruleProc(rules[j], timestamp=timestamp, path.dep=path.dep, mktdata=mktdata, portfolio=portfolio, symbol=symbol, ruletype=type, mktinstr=mktinstr, parameters=list(chain.price=txn.price))
+ ruleProc(rules[j], timestamp=timestamp, path.dep=path.dep, mktdata=mktdata, portfolio=portfolio, symbol=symbol, ruletype=type, mktinstr=mktinstr, parameters=list(chain.price=txn.price), curIndex=curIndex)
}
}
}
@@ -637,7 +637,7 @@
if(isTRUE(path.dep)) openOrdersLen <- length(getOrders(portfolio=portfolio, symbol=symbol, status="open", timespan=timestamp,which.i=TRUE))
if(length(strategy$rules[[type]])>=1) {
- ruleProc(strategy$rules[[type]],timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol, ruletype=type, mktinstr=mktinstr, parameters=parameters, ...)
+ ruleProc(strategy$rules[[type]],timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol, ruletype=type, mktinstr=mktinstr, parameters=parameters, curIndex=curIndex, ...)
}
if(isTRUE(path.dep) && length(getOrders(portfolio=portfolio, symbol=symbol, status="open", timespan=timestamp,which.i=TRUE)) != openOrdersLen) {
assign.dindex(c(get.dindex(),curIndex+1))
@@ -646,7 +646,7 @@
post = {
#TODO do we process for 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, mktinstr=mktinstr, parameters=parameters, ...)
+ ruleProc(strategy$rules$post,timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol, ruletype=type, mktinstr=mktinstr, parameters=parameters, curIndex=curIndex, ...)
}
}
) # end switch
@@ -682,7 +682,7 @@
if(!isTRUE(rule$enabled)) next()
# check to see if we should run in this timespan
- if(!is.null(rule$timespan) && nrow(mktdata[timestamp][rule$timespan])==0) next()
+ if(!is.null(rule$timespan) && nrow(mktdata[curIndex][rule$timespan])==0) next()
# modify a few things
rule$arguments$timestamp = timestamp
@@ -695,7 +695,7 @@
# now add arguments from parameters
.formals <- modify.args(.formals, parameters)
# now add dots
- .formals <- modify.args(.formals, ...)
+ .formals <- modify.args(.formals, ..., dots=TRUE)
# any rule-specific prefer-parameters should override global prefer parameter
if(!is.null(rule$arguments$prefer)) .formals$prefer = rule$arguments$prefer
Modified: pkg/quantstrat/R/utils.R
===================================================================
--- pkg/quantstrat/R/utils.R 2013-10-30 22:29:47 UTC (rev 1558)
+++ pkg/quantstrat/R/utils.R 2013-10-30 23:30:00 UTC (rev 1559)
@@ -84,7 +84,7 @@
if(dots && !is.null(.formals$...)) {
dotnames <- names(arglist[pm == 0L])
.formals[dotnames] <- arglist[dotnames]
- .formals$... <- NULL
+ #.formals$... <- NULL # should we assume we matched them all?
}
.formals
More information about the Blotter-commits
mailing list