[Blotter-commits] r258 - in pkg/quantstrat: R demo
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Feb 24 21:40:24 CET 2010
Author: braverock
Date: 2010-02-24 21:40:24 +0100 (Wed, 24 Feb 2010)
New Revision: 258
Modified:
pkg/quantstrat/R/indicators.R
pkg/quantstrat/R/orders.R
pkg/quantstrat/R/rules.R
pkg/quantstrat/R/signals.R
pkg/quantstrat/R/strategy.R
pkg/quantstrat/demo/simplestrat.R
Log:
- multiple small fixes to make applyStrategy() run without error
Modified: pkg/quantstrat/R/indicators.R
===================================================================
--- pkg/quantstrat/R/indicators.R 2010-02-24 15:22:11 UTC (rev 257)
+++ pkg/quantstrat/R/indicators.R 2010-02-24 20:40:24 UTC (rev 258)
@@ -94,7 +94,7 @@
}
#print(tmp_val)
} #end indicators loop
- mkdata<<-mktdata
+ mktdata<<-mktdata
if(is.null(ret)) {
return(mktdata)
}
Modified: pkg/quantstrat/R/orders.R
===================================================================
--- pkg/quantstrat/R/orders.R 2010-02-24 15:22:11 UTC (rev 257)
+++ pkg/quantstrat/R/orders.R 2010-02-24 20:40:24 UTC (rev 258)
@@ -44,7 +44,7 @@
}
if(!is.null(symbols)){
for (symbol in symbols){
- orders[[portfolio]]$symbol <- ordertemplate
+ orders[[portfolio]][[symbol]] <- ordertemplate
}
} else {
stop("You must specify a symbols list or a valid portfolio to retrieve the list from.")
@@ -73,12 +73,16 @@
{
# 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)))
orderset<-NULL
#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) & !length(grep(ordertype,c("market","limit","stoplimit","stoptrailing")))==1) stop(paste("ordertype:",ordertype,' must be one of "market","limit","stoplimit", or "stoptrailing"'))
+ if(!is.null(ordertype)) {
+ if(!length(grep(ordertype,c("market","limit","stoplimit","stoptrailing")))==1){
+ stop(paste("ordertype:",ordertype,' must be one of "market","limit","stoplimit", or "stoptrailing"'))
+ }
+ }
# subset by time and symbol
if(!is.null(timestamp)){
@@ -97,13 +101,13 @@
# extract
orderset<-orderbook[[symbol]][timespan]
if(!is.null(status)){
- orderset<-orderset[which(orderset[,"Order.Status"==status])]
+ orderset<-orderset[which(orderset[,"Order.Status"]==status)]
}
if(!is.null(ordertype)) {
- orderset<-orderset[which(orderset[,"Order.Type"==ordertype])]
+ orderset<-orderset[which(orderset[,"Order.Type"]==ordertype)]
}
if(!is.null(side)) {
- orderset<-orderset[which(orderset[,"Order.Side"==side])]
+ orderset<-orderset[which(orderset[,"Order.Side"]==side)]
}
return(orderset)
}
@@ -244,6 +248,7 @@
# get open orders
procorders<-getOrders(portfolio=portfolio, symbol=symbol, status="open", timestamp=timestamp, ordertype=ordertype)
freq = periodicity(mktdata)
+ if (!is.null(procorders)){
if (nrow(procorders)>=1){
# get previous bar
prevtime=time(mktdata[mktdata[timestamp,which.i=TRUE]-1])
@@ -389,6 +394,7 @@
} # end higher frequency processing
) # end switch on freq
} # end check for open orders
+ }
# now put the orders back in
updateOrderMatrix(portfolio=portfolio, symbol=symbol, updatedorders=procorders)
}
Modified: pkg/quantstrat/R/rules.R
===================================================================
--- pkg/quantstrat/R/rules.R 2010-02-24 15:22:11 UTC (rev 257)
+++ pkg/quantstrat/R/rules.R 2010-02-24 20:40:24 UTC (rev 258)
@@ -106,7 +106,7 @@
nargs=NULL
}
- ruleProc <- function (ruletypelist,timestamp=NULL, ...){
+ ruleProc <- function (ruletypelist,timestamp=NULL, path.dep, ...){
for (rule in ruletypelist){
#TODO check to see if they've already been calculated
if (!rule$path.dep==path.dep) next()
@@ -162,7 +162,7 @@
if(!isTRUE(path.dep)) Dates=''
hold=FALSE
- holdtill=NULL
+ 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
@@ -177,19 +177,19 @@
for ( type in names(strategy$rules)){
switch( type ,
pre = {
- if(length(strategy$rules[type])>=1){
- ruleProc(strategy$rules$pre,timestamp=timestamp)
+ if(length(strategy$rules[[type]])>=1){
+ ruleProc(strategy$rules$pre,timestamp=timestamp, path.dep=path.dep)
}
},
risk = {
if(length(strategy$rules$risk)>=1){
- ruleProc(strategy$rules$risk,timestamp=timestamp)
+ ruleProc(strategy$rules$risk,timestamp=timestamp, path.dep=path.dep)
}
},
order = {
if(isTRUE(hold)) next()
- if(length(strategy$rules[type])>=1) {
- ruleProc(strategy$rules[type],timestamp=timestamp)
+ if(length(strategy$rules[[type]])>=1) {
+ ruleProc(strategy$rules[[type]],timestamp=timestamp, path.dep=path.dep)
} else {
#(mktdata, portfolio, symbol, timestamp, slippageFUN=NULL)
ruleOrderProc(portfolio=portfolio, symbol=symbol, mktdata=mktdata, timestamp=timestamp)
@@ -197,14 +197,14 @@
},
rebalance =, exit = , enter = {
if(isTRUE(hold)) next()
- if(length(strategy$rules[type])>=1) {
- ruleProc(strategy$rules$risk,timestamp=timestamp)
+ if(length(strategy$rules[[type]])>=1) {
+ ruleProc(strategy$rules$risk,timestamp=timestamp, path.dep=path.dep)
}
},
post = {
#TODO do we processfor hold here, or not?
if(length(strategy$rules$post)>=1) {
- ruleProc(strategy$rules$post,timestamp=timestamp)
+ ruleProc(strategy$rules$post,timestamp=timestamp, path.dep=path.dep)
}
}
) # end switch
Modified: pkg/quantstrat/R/signals.R
===================================================================
--- pkg/quantstrat/R/signals.R 2010-02-24 15:22:11 UTC (rev 257)
+++ pkg/quantstrat/R/signals.R 2010-02-24 20:40:24 UTC (rev 258)
@@ -99,7 +99,7 @@
}
#print(tmp_val)
} #end signals loop
- mkdata<<-mktdata
+ mktdata<<-mktdata
if(is.null(ret)) {
return(mktdata)
}
@@ -126,7 +126,7 @@
relationship=relationship[1] #only use the first one
if (length(columns==2)){
ret_sig=NULL
- columns <- match.names(colnames(data),columns)
+ columns <- match.names(columns,colnames(data))
switch(relationship,
'>' =,
'gt' = {ret_sig = data[,columns[1]] > data[,columns[2]]},
@@ -179,7 +179,7 @@
#' @export
sigPeak <- function(label,data,column, direction=c("peak","bottom")){
#should we only do this for one column?
- column<-match.names(colnames(data),column)
+ column<-match.names(column,colnames(data))
direction=direction[1] # only use the first]
#(Lag(IBM[,4],2)<Lag(IBM[,4],1)) & Lag(IBM[,4],1) >IBM[,4]
switch(direction,
@@ -205,7 +205,7 @@
sigThreshold <- function(label, data, column, threshold=0, relationship=c("gt","lt","eq","gte","lte")) {
relationship=relationship[1] #only use the first one
ret_sig=NULL
- column <- match.names(colnames(data),column)
+ column <- match.names(column, colnames(data))
switch(relationship,
'>' =,
'gt' = {ret_sig = data[,column] > threshold},
Modified: pkg/quantstrat/R/strategy.R
===================================================================
--- pkg/quantstrat/R/strategy.R 2010-02-24 15:22:11 UTC (rev 257)
+++ pkg/quantstrat/R/strategy.R 2010-02-24 20:40:24 UTC (rev 258)
@@ -60,6 +60,11 @@
}
#' apply the strategy to arbitrary market data
+#'
+#' if \code{mktdata} is NULL, the default, the mktdata variable will be populated
+#' for each symbol via a call to get (getSymbols??, not yet)
+#'
+#'
#' @param strategy an object of type 'strategy' to add the indicator to
#' @param portfolios a list of portfolios to apply the strategy to
#' @param mktdata an xts object containing market data. depending on indicators, may need to be in OHLCV or BBO formats, default NULL
@@ -76,31 +81,37 @@
if(inherits(strategy,"try-error"))
stop ("You must supply an object of type 'strategy'.")
}
- i=1
for (portfolio in portfolios) {
- ret[portfolio]<-list() # this is slot [[i]] which we will use later
+ ret[[portfolio]]<-list() # this is slot [[i]] which we will use later
pobj<-getPortfolio(portfolio)
symbols<-names(pobj)
sret<-list()
for (symbol in symbols){
+ ret[[portfolio]][[symbol]]<-list()
if(is.null(mktdata)) mktdata <- get(symbol)
#loop over indicators
- sret$indicators <- applyIndicators(strategy , mktdata , ... )
-
+ sret$indicators <- applyIndicators(strategy=strategy , mktdata=mktdata , ... )
+ #this should be taken care of by the mktdata<<-mktdata line in the apply* fn
+ if(inherits(sret$indicators,"xts") & nrow(mktdata)==nrow(sret$indicators)){
+ mktdata<-sret$indicators
+ }
+
#loop over signal generators
- sret$signals <- applySignals(strategy, mktdata, ret$indicators, ... )
-
+ sret$signals <- applySignals(strategy=strategy, mktdata=mktdata, ret$indicators, ... )
+ #this should be taken care of by the mktdata<<-mktdata line in the apply* fn
+ if(inherits(sret$signals,"xts") & nrow(mktdata)==nrow(sret$signals)){
+ mktdata<-sret$signals
+ }
+
#loop over rules
# non-path-dep first
sret$rules<-list()
sret$rules$nonpath<-applyRules(portfolio=portfolio, symbol=symbol, strategy=strategy, mktdata=mktdata, Dates=NULL, indicators=sret$indicators, signals=sret$signals, ..., path.dep=FALSE)
sret$rules$pathdep<-applyRules(portfolio=portfolio, symbol=symbol, strategy=strategy, mktdata=mktdata, Dates=NULL, indicators=sret$indicators, signals=sret$signals, ..., path.dep=TRUE)
}
- ret[[i]][symbol]<-sret
- i=i+1
+ ret[[portfolio]][[symbol]]<-sret
}
-
return(ret)
}
Modified: pkg/quantstrat/demo/simplestrat.R
===================================================================
--- pkg/quantstrat/demo/simplestrat.R 2010-02-24 15:22:11 UTC (rev 257)
+++ pkg/quantstrat/demo/simplestrat.R 2010-02-24 20:40:24 UTC (rev 258)
@@ -1,3 +1,5 @@
+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)
@@ -7,7 +9,7 @@
portfolio.st='simplestrat'
account.st='simplestrat'
-initPortf(portfolio.st,'IBM', initDate=initDate)
+initPortf(portfolio.st,symbols='IBM', initDate=initDate)
initAcct(account.st,portfolios='simplestrat', initDate=initDate)
initOrders(portfolio=portfolio.st,initDate=initDate)
@@ -25,12 +27,13 @@
s<- add.signal(s,name="sigCrossover",arguments = list(data=quote(mktdata),columns=c("Close","up"),relationship="gt"),label="Cl.gt.UpperBand")
s<- add.signal(s,name="sigCrossover",arguments = list(data=quote(mktdata),columns=c("Close","dn"),relationship="lt"),label="Cl.lt.LowerBand")
-IBM.sigs<-applySignals(s,mktdata=IBM.inds)
+#IBM.sigs<-applySignals(s,mktdata=IBM.inds)
# lets add some rules
-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='order')
-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='order')
+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')
#TODO add thresholds and stop-entry and stop-exit handling to test
-#getSymbols("IBM")
-# applyStrategy(strategy='s' , portfolios='simplestrat', mktdata="IBM")
\ No newline at end of file
+getSymbols("IBM")
+out<-applyStrategy(strategy='s' , portfolios='simplestrat')
\ No newline at end of file
More information about the Blotter-commits
mailing list