[Blotter-commits] r260 - in pkg/quantstrat: R demo
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Feb 25 00:01:02 CET 2010
Author: braverock
Date: 2010-02-25 00:01:02 +0100 (Thu, 25 Feb 2010)
New Revision: 260
Modified:
pkg/quantstrat/R/orders.R
pkg/quantstrat/R/rules.R
pkg/quantstrat/R/traderules.R
pkg/quantstrat/demo/simplestrat.R
Log:
- multiple small fixes to make applyStrategy() run without error
Modified: pkg/quantstrat/R/orders.R
===================================================================
--- pkg/quantstrat/R/orders.R 2010-02-24 21:15:45 UTC (rev 259)
+++ pkg/quantstrat/R/orders.R 2010-02-24 23:01:02 UTC (rev 260)
@@ -99,7 +99,7 @@
}
# extract
- orderset<-orderbook[[symbol]][timespan]
+ orderset<-orderbook[[portfolio]][[symbol]][timespan]
if(!is.null(status)){
orderset<-orderset[which(orderset[,"Order.Status"]==status)]
}
@@ -148,7 +148,7 @@
{
# get order book
orderbook <- getOrderBook(portfolio)
- if(!length(grep(symbol,names(orderbook)))==1) stop(paste("symbol",symbol,"does not exist in portfolio",portfolio,"having symbols",names(orderbook)))
+ 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))
Modified: pkg/quantstrat/R/rules.R
===================================================================
--- pkg/quantstrat/R/rules.R 2010-02-24 21:15:45 UTC (rev 259)
+++ pkg/quantstrat/R/rules.R 2010-02-24 23:01:02 UTC (rev 260)
@@ -148,20 +148,22 @@
.formals$... <- NULL
tmp_val<-do.call(fun,.formals)
- if(is.null(names(tmp_val)) & ncol(tmp_val)==1) names(tmp_val)<-rule$label
- if (nrow(mktdata)==nrow(tmp_val) | length(mktdata)==length(tmp_val)) {
- # the rule returned a time series, so we'll name it and cbind it
- mktdata<-cbind(mktdata,tmp_val)
- } else {
- # the rule returned something else, add it to the ret list
- if(is.null(ret)) ret<-list()
- ret[[rule$name]]<-tmp_val
+ if(!is.null(tmp_val)){
+ if(is.null(names(tmp_val)) & ncol(tmp_val)==1) names(tmp_val)<-rule$label
+ if (nrow(mktdata)==nrow(tmp_val) | length(mktdata)==length(tmp_val)) {
+ # the rule returned a time series, so we'll name it and cbind it
+ mktdata<-cbind(mktdata,tmp_val)
+ } else {
+ # the rule returned something else, add it to the ret list
+ if(is.null(ret)) ret<-list()
+ ret[[rule$name]]<-tmp_val
+ }
}
+ mktdata <<- mktdata
+ ret <<- ret
+ hold <<- hold #TODO FIXME hold processing doesn't work yet
#print(tmp_val)
} #end rules loop
- mktdata <<- mktdata
- ret <<- ret
- hold <<- hold
} # end sub process function
#TODO FIXME we should probably do something more sophisticated, but this should work
@@ -185,18 +187,18 @@
switch( type ,
pre = {
if(length(strategy$rules[[type]])>=1){
- ruleProc(strategy$rules$pre,timestamp=timestamp, path.dep=path.dep, mktdata=mktdata)
+ ruleProc(strategy$rules$pre,timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol)
}
},
risk = {
if(length(strategy$rules$risk)>=1){
- ruleProc(strategy$rules$risk,timestamp=timestamp, path.dep=path.dep, mktdata=mktdata)
+ ruleProc(strategy$rules$risk,timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol)
}
},
order = {
if(isTRUE(hold)) next()
if(length(strategy$rules[[type]])>=1) {
- ruleProc(strategy$rules[[type]],timestamp=timestamp, path.dep=path.dep, mktdata=mktdata)
+ ruleProc(strategy$rules[[type]],timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol)
} else {
#(mktdata, portfolio, symbol, timestamp, slippageFUN=NULL)
ruleOrderProc(portfolio=portfolio, symbol=symbol, mktdata=mktdata, timestamp=timestamp)
@@ -205,13 +207,13 @@
rebalance =, exit = , enter = {
if(isTRUE(hold)) next()
if(length(strategy$rules[[type]])>=1) {
- ruleProc(strategy$rules[[type]],timestamp=timestamp, path.dep=path.dep, mktdata=mktdata)
+ ruleProc(strategy$rules[[type]],timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol)
}
},
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)
+ ruleProc(strategy$rules$post,timestamp=timestamp, path.dep=path.dep, mktdata=mktdata,portfolio=portfolio, symbol=symbol)
}
}
) # end switch
Modified: pkg/quantstrat/R/traderules.R
===================================================================
--- pkg/quantstrat/R/traderules.R 2010-02-24 21:15:45 UTC (rev 259)
+++ pkg/quantstrat/R/traderules.R 2010-02-24 23:01:02 UTC (rev 260)
@@ -30,10 +30,12 @@
#' @export
ruleSignal <- function(mktdata, timestamp, sigcol, sigval, orderqty=0, ordertype, orderside, threshold=NULL, replace=TRUE, delay=0.0001, osFUN='osNoOp', pricemethod=c('market','opside'), portfolio, symbol, ... ) {
if(!is.function(osFUN)) osFUN<-match.fun(osFUN)
- if (mktdata[timestamp][,sigcol] == sigval) {
+ if (!is.na(mktdata[timestamp][,sigcol]) & mktdata[timestamp][,sigcol] == sigval) {
#TODO add fancy formals matching for osFUN
- orderqty <- osFUN(strategy, mktdata, timestamp, orderqty, ordertype, orderside, portfolio, symbol)
+
+ orderqty <- osFUN(strategy=strategy, mktdata=mktdata, timestamp=timestamp, orderqty=orderqty, ordertype=ordertype, orderside=orderside, portfolio=portfolio, symbol=symbol)
#calculate order price using pricemethod
+ pricemethod<-pricemethod[1] #only use the first if not set by calling function
switch(pricemethod,
opside = {
if (orderqty>0)
@@ -47,7 +49,7 @@
}
)
if(inherits(orderprice,'try-error')) orderprice<-NULL
- if(is.NULL(orderside) & !orderqty == 0){
+ if(is.null(orderside) & !orderqty == 0){
curqty<-getPosQty(Portfolio=portfolio, Symbol=symbol, Date=timestamp)
if (curqty>0 ){
#we have a long position
@@ -64,7 +66,7 @@
}
}
if(!is.null(orderqty) & !orderqty == 0 & !is.null(orderprice)){
- addOrder(portfolio, symbol, timestamp, orderqty, 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, ...)
}
}
}
@@ -85,7 +87,7 @@
#' @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
#' @export
-osNoOp <- function(mktdata, timestamp, orderqty, ordertype, orderside, portfolio, symbol){
+osNoOp <- function(orderqty, ...){
return(orderqty)
}
Modified: pkg/quantstrat/demo/simplestrat.R
===================================================================
--- pkg/quantstrat/demo/simplestrat.R 2010-02-24 21:15:45 UTC (rev 259)
+++ pkg/quantstrat/demo/simplestrat.R 2010-02-24 23:01:02 UTC (rev 260)
@@ -1,7 +1,7 @@
require(quantstrat)
try(rm("order_book.simplestrat",pos=.strategy),silent=TRUE)
try(rm("account.simplestrat","portfolio.simplestrat",pos=.blotter),silent=TRUE)
-try(rm("account.st","portfolio.st","IBM","s","initDate","initEq"),silent=TRUE)
+try(rm("account.st","portfolio.st","IBM","s","initDate","initEq",'start_t','end_t'),silent=TRUE)
initDate='1997-12-31'
initEq=1000000
@@ -31,9 +31,12 @@
# lets add some rules
s
-s <- add.rule(s,name='ruleSignal', arguments = list(data=quote(mktdata),sigcol="Cl.gt.UpperBand",sigval=TRUE, orderqty=-100, ordertype='sell', orderside=NULL, threshold=NULL),type='enter')
-s <- add.rule(s,name='ruleSignal', arguments = list(data=quote(mktdata),sigcol="Cl.lt.LowerBand",sigval=TRUE, orderqty= 100, ordertype='buy' , orderside=NULL, threshold=NULL),type='enter')
+s <- add.rule(s,name='ruleSignal', arguments = list(data=quote(mktdata),sigcol="Cl.gt.UpperBand",sigval=TRUE, orderqty=-100, ordertype='market', orderside=NULL, threshold=NULL),type='enter')
+s <- add.rule(s,name='ruleSignal', arguments = list(data=quote(mktdata),sigcol="Cl.lt.LowerBand",sigval=TRUE, orderqty= 100, ordertype='market' , orderside=NULL, threshold=NULL),type='enter')
#TODO add thresholds and stop-entry and stop-exit handling to test
getSymbols("IBM")
-out<-applyStrategy(strategy='s' , portfolios='simplestrat')
\ No newline at end of file
+start_t<-Sys.time()
+out<-try(applyStrategy(strategy='s' , portfolios='simplestrat'))
+end_t<-Sys.time()
+end_t-start_t
\ No newline at end of file
More information about the Blotter-commits
mailing list