[Blotter-commits] r1152 - in pkg/quantstrat: R demo
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Sep 4 21:27:10 CEST 2012
Author: opentrades
Date: 2012-09-04 21:27:09 +0200 (Tue, 04 Sep 2012)
New Revision: 1152
Added:
pkg/quantstrat/demo/luxor.orderchains.R
Removed:
pkg/quantstrat/demo/Rplots.pdf
Modified:
pkg/quantstrat/R/ruleOrderProc.R
pkg/quantstrat/R/ruleSignal.R
pkg/quantstrat/R/rules.R
Log:
added support for orderchains in add.rule() - see: demo/luxor.orderchains.R
removed "entry" ruletype
Modified: pkg/quantstrat/R/ruleOrderProc.R
===================================================================
--- pkg/quantstrat/R/ruleOrderProc.R 2012-09-03 18:54:24 UTC (rev 1151)
+++ pkg/quantstrat/R/ruleOrderProc.R 2012-09-04 19:27:09 UTC (rev 1152)
@@ -76,12 +76,10 @@
if( NROW(mktdataTimestamp) > 1 ) mktdataTimestamp <- last(mktdataTimestamp)
isOHLCmktdata <- is.OHLC(mktdata)
isBBOmktdata <- is.BBO(mktdata)
- for (ii in OpenOrders.i ){
- if(ordersubset[ii, "Order.Status"] != "open") # need to check this bc sideeffects may have changed order.status in this loop
- {
- #print("@@@@@@@@ status changed from open")
- next()
- }
+ for (ii in OpenOrders.i )
+ {
+ if(ordersubset[ii, "Order.Status"] != "open") # need to check this bc sideeffects may have changed order.status in this loop
+ next()
txnprice=NULL
@@ -91,18 +89,16 @@
orderQty <- ordersubset[ii,"Order.Qty"]
if(orderQty=='all')
- {
+ {
# this has to be an exit or risk order, so:
orderQty=-1*getPosQty(Portfolio=portfolio,Symbol=symbol,Date=timestamp)
orderside<-ordersubset[ii, "Order.Side"]
if(((orderQty>0 && orderside=='long') || (orderQty<0 && orderside=='short')))
{
# this condition may occur if (for example) a signal triggers an 'increase LONG pos' and 'close all SHORT pos' simultaneously
- # hence this is legal condition, and we must 0 the orderQty to reject the order
+ # hence this is legal condition, and we must 0 the orderQty to reject the order
-# warning('trying to exit/market/all position but orderQty sign ', orderQty,' does not match orderside ', orderside)
-
- orderQty = 0
+ orderQty = 0
}
}
orderQty<-as.numeric(orderQty)
@@ -220,7 +216,6 @@
,...=..., TxnFees=txnfees)
if (is.null(neworders)) neworders=neworder else neworders = rbind(neworders,neworder)
ordersubset[ii,"Order.Status"]<-'replaced'
-# ordersubset[ii,"Order.StatusTime"]<-as.character(timestamp)
ordersubset[ii,"Order.StatusTime"]<-format(timestamp, "%Y-%m-%d %H:%M:%S")
next()
}
@@ -292,7 +287,6 @@
,...=..., TxnFees=txnfees)
if (is.null(neworders)) neworders=neworder else neworders = rbind(neworders,neworder)
ordersubset[ii,"Order.Status"]<-'replaced'
- #ordersubset[ii,"Order.StatusTime"]<-as.character(as.POSIXlt(statustimestamp, Sys.getenv('TZ')))
ordersubset[ii,"Order.StatusTime"]<-format(timestamp, "%Y-%m-%d %H:%M:%S")
next()
}
@@ -300,28 +294,21 @@
# else next
}
)
- if(!is.null(txnprice) && !isTRUE(is.na(txnprice))) {
+ if(!is.null(txnprice) && !isTRUE(is.na(txnprice)))
+ {
#make sure we don't cross through zero
pos<-getPosQty(portfolio,symbol,timestamp)
- # this is handled correctly in addTxn now, so this isn't needed anymore
-# if ( (pos > 0 && orderQty < -pos) || (pos < 0 && orderQty > -pos) ) {
-# warning("orderQty of ",orderQty,
-# " would cross through zero, adjusting qty to ",-pos)
-# orderQty <- -pos
-# }
-
- if (orderQty == 0) # reject the order (should be exit/market/all)
- {
+ if (orderQty == 0) # reject the order (should be exit/market/all)
+ {
ordersubset[ii,"Order.Status"]<-'rejected'
- }
- else #add the transaction
- {
+ }
+ else #add the transaction
+ {
addTxn(Portfolio=portfolio, Symbol=symbol, TxnDate=txntime,
TxnQty=orderQty, TxnPrice=txnprice , ...=..., TxnFees=txnfees)
ordersubset[ii,"Order.Status"]<-'closed'
- }
-# ordersubset[ii,"Order.StatusTime"]<-as.character(timestamp)
+ }
ordersubset[ii,"Order.StatusTime"]<-format(timestamp, "%Y-%m-%d %H:%M:%S")
#close all other orders in the same order set
@@ -330,9 +317,8 @@
# skip this if there are no orders
if(length(OpenInOrderset.i) > 0)
- {
+ {
ordersubset[OpenInOrderset.i, "Order.Status"] = 'canceled'
-# ordersubset[OpenInOrderset.i, "Order.StatusTime"]<-as.character(timestamp)
ordersubset[OpenInOrderset.i, "Order.StatusTime"]<-format(timestamp, "%Y-%m-%d %H:%M:%S")
}
}
@@ -344,7 +330,20 @@
orderbook[[portfolio]][[symbol]] <- ordersubset
assign(paste("order_book",portfolio,sep='.'),orderbook,envir=.strategy)
} # end check for open orders
+
+ # return list of orers filled in this call for order chain processing
+ if(length(OpenOrders.i) > 0)
+ {
+ OpenOrders <- ordersubset[OpenOrders.i,]
+ JustClosedOrders.i <- which(OpenOrders[,"Order.Status"]=="closed")
+
+ if(length(JustClosedOrders.i) > 0)
+ return( OpenOrders[JustClosedOrders.i,] )
+
+ }
+ return(NULL)
}
+
###############################################################################
# R (http://r-project.org/) Quantitative Strategy Model Framework
#
Modified: pkg/quantstrat/R/ruleSignal.R
===================================================================
--- pkg/quantstrat/R/ruleSignal.R 2012-09-03 18:54:24 UTC (rev 1151)
+++ pkg/quantstrat/R/ruleSignal.R 2012-09-04 19:27:09 UTC (rev 1152)
@@ -55,7 +55,8 @@
#print(paste(symbol,timestamp, sigval))
#print(data[timestamp][,sigcol])
#browser()
- if (!is.na(timestamp) && !is.na(data[timestamp][,sigcol]) && data[timestamp][,sigcol] == sigval) {
+# if (!is.na(timestamp) && !is.na(data[timestamp][,sigcol]) && data[timestamp][,sigcol] == sigval) {
+ if (!is.na(timestamp) && (ruletype=='chain' || (!is.na(data[timestamp][,sigcol]) && data[timestamp][,sigcol] == sigval))) {
#calculate order price using pricemethod
pricemethod<-pricemethod[1] #only use the first if not set by calling function
Modified: pkg/quantstrat/R/rules.R
===================================================================
--- pkg/quantstrat/R/rules.R 2012-09-03 18:54:24 UTC (rev 1151)
+++ pkg/quantstrat/R/rules.R 2012-09-04 19:27:09 UTC (rev 1152)
@@ -15,6 +15,7 @@
#' \item{rebalance}{ rules executed specifically in a portfolio context, unnecessary in univariate strategies}
#' \item{exit}{ rules to determine whether to exit a position}
#' \item{enter}{ rules to determine whether to enter or increase a position}
+#' \item{chain}{ rules executed upon fill of the corresponding order, identified by label
#' }
#' The rules will be executed by type, in the order listed above.
#' Multiple rules of each type may be defined, as with signals and indicators,
@@ -62,7 +63,7 @@
#' @param arguments named list of default arguments to be passed to an rule function when executed
#' @param parameters vector of strings naming parameters to be saved for apply-time definition
#' @param label arbitrary text label for rule output, NULL default will be converted to '<name>.rule'
-#' @param type one of "risk","order","rebalance","exit","enter", see Details
+#' @param type one of "risk","order","rebalance","exit","enter","chain" see Details
#' @param ... any other passthru parameters
#' @param enabled TRUE/FALSE whether the rule is enabled for use in applying the strategy, default TRUE
#' @param indexnum if you are updating a specific rule, the index number in the $rules[type] list to update
@@ -72,7 +73,7 @@
#' @param storefun TRUE/FALSE whether to store the function in the rule, default TRUE. setting this option to FALSE may slow the backtest, but makes \code{\link{debug}} usable
#' @return if \code{strategy} was the name of a strategy, the name. It it was a strategy, the updated strategy.
#' @export
-add.rule <- function(strategy, name, arguments, parameters=NULL, label=NULL, type=c(NULL,"risk","order","rebalance","exit","enter"), ..., enabled=TRUE, indexnum=NULL, path.dep=TRUE, timespan=NULL, store=FALSE, storefun=TRUE) {
+add.rule <- function(strategy, name, arguments, parameters=NULL, label=NULL, type=c(NULL,"risk","order","rebalance","exit","enter","chain"), parent=NULL, ..., enabled=TRUE, indexnum=NULL, path.dep=TRUE, timespan=NULL, store=FALSE, storefun=TRUE) {
if (!is.strategy(strategy)) {
strategy<-try(getStrategy(strategy))
if(inherits(strategy,"try-error"))
@@ -81,7 +82,7 @@
}
type=type[1]
if(is.null(type)) stop("You must specify a type")
- if(is.na(charmatch(type,c("risk","order","rebalance","exit","enter","pre","post")))) stop(paste("type:",type,' must be one of "risk", "order", "rebalance", "exit", "enter", "pre", or "post"'))
+ if(is.na(charmatch(type,c("risk","order","rebalance","exit","enter","chain","pre","post")))) stop(paste("type:",type,' must be one of "risk", "order", "rebalance", "exit", "enter", "chain", "pre", or "post"'))
tmp_rule<-list()
if(!is.function(name) && isTRUE(storefun)) {
if(!is.function(get(name))){
@@ -96,24 +97,29 @@
} else {
fn <- name
}
-
+
tmp_rule$name<-fn
tmp_rule$type<-type
+ if(type == 'chain')
+ {
+ if(is.null(parent)) stop("You must specify a parent if ruletype=='chain'")
+ tmp_rule$parent<-parent
+ }
tmp_rule$enabled<-enabled
if (!is.list(arguments)) stop("arguments must be passed as a named list")
- if(is.null(label)) label = paste(name,"rule",sep='.')
+ if(is.null(label)) label = paste(name,"rule",sep='.')
tmp_rule$label<-label
tmp_rule$arguments<-arguments
- if(!is.null(parameters)) tmp_rule$parameters = parameters
- if(!is.null(timespan)) tmp_rule$timespan = timespan
- tmp_rule$path.dep<-path.dep
- if(length(list(...))) tmp_rule<-c(tmp_rule,list(...))
-
+ if(!is.null(parameters)) tmp_rule$parameters = parameters
+ if(!is.null(timespan)) tmp_rule$timespan = timespan
+ tmp_rule$path.dep<-path.dep
+ if(length(list(...))) tmp_rule<-c(tmp_rule,list(...))
+
tmp_rule$call<-match.call()
class(tmp_rule)<-'trade_rule'
if(!hasArg(indexnum) | (hasArg(indexnum) & is.null(indexnum))) indexnum = length(strategy$rules[[type]])+1
strategy$rules[[type]][[indexnum]]<-tmp_rule
-
+
if (store) assign(strategy$name,strategy,envir=as.environment(.strategy))
else return(strategy)
strategy$name
@@ -294,12 +300,12 @@
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 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)) {
@@ -309,8 +315,8 @@
}
.formals$... <- NULL
- # any rule-specific prefer-parameters should override global prefer parameter
- if(!is.null(rule$arguments$prefer)) .formals$prefer = rule$arguments$prefer
+ # any rule-specific prefer-parameters should override global prefer parameter
+ if(!is.null(rule$arguments$prefer)) .formals$prefer = rule$arguments$prefer
tmp_val<-do.call(fun,.formals)
@@ -319,7 +325,7 @@
hold <<- hold #TODO FIXME hold processing doesn't work unless custom rule has set it with <<-
holdtill <<- holdtill
- #print(tmp_val)
+# print(paste('tmp_val ==', tmp_val))
} #end rules loop
} # end sub process function ruleProc
@@ -645,7 +651,7 @@
# evaluate the rule types in the order listed in the documentation
# thanks to Aleksandr Rudnev for tracking this down (R-SIG-Finance, 2011-01-25)
if(is.null(rule.order)){
- types <- sort(factor(names(strategy$rules), levels=c("pre","risk","order","rebalance","exit","enter","entry","post")))
+ types <- sort(factor(names(strategy$rules), levels=c("pre","risk","order","rebalance","exit","enter","chain","post")))
} else {
print("Be aware that order of operations matters, and poor choises in rule order can create unintended consequences.")
types <- rule.order
@@ -667,13 +673,35 @@
ruleProc(strategy$rules[[type]],timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol, ruletype=type, mktinstr=mktinstr, ...)
} else {
#(mktdata, portfolio, symbol, timestamp, slippageFUN=NULL)
- if (isTRUE(path.dep)){
- timespan <- format(timestamp, "::%Y-%m-%d %H:%M:%OS6")
- } else timespan=NULL
- ruleOrderProc(portfolio=portfolio, symbol=symbol, mktdata=mktdata, timespan=timespan, ...)
+
+ if (isTRUE(path.dep))
+ timespan <- format(timestamp, "::%Y-%m-%d %H:%M:%OS6")
+ else
+ timespan=NULL
+
+ closed.orders <- ruleOrderProc(portfolio=portfolio, symbol=symbol, mktdata=mktdata, timespan=timespan, ...)
}
},
- rebalance =, exit = , enter = , entry = {
+ chain = {
+ if(!is.null(closed.orders))
+ {
+ chain.rules <- strategy$rules[[type]]
+ for(parent in closed.orders[,'Rule'])
+ {
+ # there should be a nicer way to do this in R :-) JH
+ rules <- list()
+ for(rule in chain.rules)
+ if(!is.null(rule$parent) && rule$parent == parent)
+ rules = c(rules, list(rule))
+
+ if(length(rules) > 0)
+ {
+ ruleProc(rules, timestamp=timestamp, path.dep=path.dep, mktdata=mktdata, portfolio=portfolio, symbol=symbol, ruletype=type, mktinstr=mktinstr, ...)
+ }
+ }
+ }
+ },
+ rebalance =, exit = , enter = {
if(isTRUE(hold)) next()
# if(type=='exit'){
# if(length(strategy$rules$exit)==length(grep('market',strategy$rules$exit))){
Deleted: pkg/quantstrat/demo/Rplots.pdf
===================================================================
(Binary files differ)
Added: pkg/quantstrat/demo/luxor.orderchains.R
===================================================================
--- pkg/quantstrat/demo/luxor.orderchains.R (rev 0)
+++ pkg/quantstrat/demo/luxor.orderchains.R 2012-09-04 19:27:09 UTC (rev 1152)
@@ -0,0 +1,269 @@
+#!/usr/bin/Rscript --vanilla
+#
+# Jan Humme (@opentrades) - August 2012
+#
+# Tested and found to work correctly using blotter r1123
+#
+# From Jaekle & Tamasini: A new approach to system development and portfolio optimisation (ISBN 978-1-905641-79-6)
+#
+# Paragraph 3.4: inserting an intraday time filter
+
+options(width = 240)
+#Sys.setenv(TZ="GMT")
+
+.fast = 1
+.slow = 44
+
+.qty=100000
+.th=0.0005
+.txn=-30
+.timespan = 'T08:00/T12:00'
+.timespan = 'T00:00/T23:59'
+
+.stoploss=0.001
+.takeprofit=0.005
+
+initDate = '2002-10-21'
+.from='2002-10-21'
+#.to='2008-07-04'
+#.to='2003-12-31'
+.to='2002-10-31'
+#.to='2002-12-31'
+#.from='2006-01-01'
+#.to='2006-12-31'
+#.from='2007-01-01'
+#.to='2007-12-31'
+
+####
+
+s = 'luxor'
+p = 'forex'
+a = 'IB1'
+
+###
+
+require(quantstrat)
+
+currency(c('GBP', 'USD'))
+
+exchange_rate(c('GBPUSD'), tick_size=0.0001)
+
+setSymbolLookup.FI('~/R.symbols/', 'GBPUSD')
+#setSymbolLookup.FI('../data/', 'GBPUSD')
+
+###
+
+getSymbols('GBPUSD', from=.from, to=.to, verbose=FALSE)
+GBPUSD = to.minutes30(GBPUSD)
+GBPUSD = align.time(to.minutes30(GBPUSD), 1800)
+
+###
+
+initPortf(p, symbols='GBPUSD', initDate=initDate, currency='USD')
+initAcct(a, portfolios=p, initDate=initDate, currency='USD')
+
+###
+
+initOrders(p, initDate=initDate)
+
+### strategy ######################################################################
+
+addPosLimit(
+ portfolio=p,
+ symbol='GBPUSD',
+ timestamp=initDate,
+ maxpos=.qty)
+
+strategy(s, store=TRUE)
+
+### indicators
+
+add.indicator(s, name = "SMA",
+ arguments = list(
+ x = quote(Cl(mktdata)),
+ n = .fast
+ ),
+ label="nFast"
+)
+
+add.indicator(s, name="SMA",
+ arguments = list(
+ x = quote(Cl(mktdata)),
+ n = .slow
+ ),
+ label="nSlow"
+)
+
+### signals
+
+add.signal(s, name = 'sigCrossover',
+ arguments = list(
+ columns=c("nFast","nSlow"),
+ relationship="gte"
+ ),
+ label='long'
+)
+
+add.signal(s, name = 'sigCrossover',
+ arguments = list(
+ columns=c("nFast","nSlow"),
+ relationship="lt"
+ ),
+ label='short'
+)
+
+### rules ############
+
+### stop-loss
+
+add.rule(s, name = 'ruleSignal',
+ arguments=list(sigcol='long' , sigval=TRUE,
+ replace=FALSE,
+ orderside='long',
+ ordertype='stoplimit',
+ tmult=TRUE,
+ threshold=-.stoploss,
+ TxnFees=.txn,
+ orderqty='all',
+ orderset='ocolong'
+ ),
+ type='chain',
+ parent='EnterLONG',
+ label='StopLossLONG'
+)
+
+add.rule(s, name = 'ruleSignal',
+ arguments=list(sigcol='short' , sigval=TRUE,
+ replace=FALSE,
+ orderside='short',
+ ordertype='stoplimit',
+ tmult=TRUE,
+ threshold=.stoploss,
+ TxnFees=.txn,
+ orderqty='all',
+ orderset='ocoshort'
+ ),
+ type='chain',
+ parent='EnterSHORT',
+ label='StopLossSHORT'
+)
+
+### take-profit
+
+add.rule(s, name = 'ruleSignal',
+ arguments=list(sigcol='long' , sigval=TRUE,
+ replace=FALSE,
+ orderside='long',
+ ordertype='limit',
+ tmult=TRUE,
+ threshold=.takeprofit,
+ TxnFees=.txn,
+ orderqty='all',
+ orderset='ocolong'
+ ),
+ type='chain',
+ parent='EnterLONG',
+ label='TakeProfitLONG'
+)
+
+add.rule(s, name = 'ruleSignal',
+ arguments=list(sigcol='short' , sigval=TRUE,
+ replace=FALSE,
+ orderside='short',
+ ordertype='limit',
+ tmult=TRUE,
+ threshold=-.takeprofit,
+ TxnFees=.txn,
+ orderqty='all',
+ orderset='ocoshort'
+ ),
+ type='chain',
+ parent='EnterSHORT',
+ label='TakeProfitSHORT'
+)
+
+###
+
+add.rule(s, name = 'ruleSignal',
+ arguments=list(sigcol='long' , sigval=TRUE,
+ replace=TRUE,
+ orderside='short',
+ ordertype='market',
+ TxnFees=.txn,
+ orderqty='all',
+ orderset='ocoshort'
+ ),
+ type='exit',
+ timespan = .timespan,
+ label='Exit2LONG'
+)
+
+add.rule(s, name = 'ruleSignal',
+ arguments=list(sigcol='short', sigval=TRUE,
+ replace=TRUE,
+ orderside='long' ,
+ ordertype='market',
+ TxnFees=.txn,
+ orderqty='all',
+ orderset='ocolong'
+ ),
+ type='exit',
+ timespan = .timespan,
+ label='Exit2SHORT')
+
+add.rule(s, name = 'ruleSignal',
+ arguments=list(sigcol='long' , sigval=TRUE,
+ replace=FALSE,
+ orderside='long' ,
+ ordertype='stoplimit',
+ prefer='High',
+ threshold=.th,
+ TxnFees=0,
+ orderqty=+.qty,
+ osFUN=osMaxPos,
+ orderset='ocolong'
+ ),
+ type='enter',
+ timespan = .timespan,
+ label='EnterLONG'
+)
+
+add.rule(s, name = 'ruleSignal',
+ arguments=list(sigcol='short', sigval=TRUE,
+ replace=FALSE,
+ orderside='short',
+ ordertype='stoplimit',
+ prefer='Low',
+ threshold=-.th,
+ TxnFees=0,
+ orderqty=-.qty,
+ osFUN=osMaxPos,
+ orderset='ocoshort'
+ ),
+ type='enter',
+ timespan = .timespan,
+ label='EnterSHORT'
+)
+
+#
+
+###############################################################################
+
+applyStrategy(s, p, verbose = FALSE)
+#applyStrategy(s, p, prefer='Open', verbose = FALSE)
+
+updatePortf(p, Symbols='GBPUSD', ,Dates=paste('::',as.Date(Sys.time()),sep=''))
+
+###############################################################################
+
+chart.Posn(p, "GBPUSD")
+
+print(getOrderBook(p))
+
+#txns <- getTxns(p, 'GBPUSD')
+#txns
+##txns$Net
+#cat('Net profit:', sum(txns$Net.Txn.Realized.PL), '\n')
+
+print(tradeStats(p, 'GBPUSD'))
+
Property changes on: pkg/quantstrat/demo/luxor.orderchains.R
___________________________________________________________________
Added: svn:executable
+ *
More information about the Blotter-commits
mailing list