[Blotter-commits] r281 - in pkg/quantstrat: R demo
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Mar 10 00:19:16 CET 2010
Author: bodanker
Date: 2010-03-10 00:19:16 +0100 (Wed, 10 Mar 2010)
New Revision: 281
Modified:
pkg/quantstrat/R/match.names.R
pkg/quantstrat/R/signals.R
pkg/quantstrat/demo/BBands.R
Log:
- match.names() now matches the end of the column name string, to avoid
more than one match if other columns contain OHLCV names.
- Updated sigCrossover to handle more than one column.
- Changed column(s) in sigComparison, sigPeak, sigThreshold to colNum(s)
to avoid clashing with the respective function formals.
- Added a check/error to sigComparison for "Close" in columns formal when
relationship=='op'.
- Fiddled with (data mined) the BBands example to make it profitable.
Modified: pkg/quantstrat/R/match.names.R
===================================================================
--- pkg/quantstrat/R/match.names.R 2010-03-08 09:08:34 UTC (rev 280)
+++ pkg/quantstrat/R/match.names.R 2010-03-09 23:19:16 UTC (rev 281)
@@ -16,7 +16,7 @@
match.names <- function(match_names,data_names) {
loc<-NULL
for (mname in match_names){
- t<-grep(mname,data_names)
+ t<-grep(paste(mname,"$",sep=""),data_names)
if(is.null(loc)) loc<-t
else loc <- c(loc,t)
}
Modified: pkg/quantstrat/R/signals.R
===================================================================
--- pkg/quantstrat/R/signals.R 2010-03-08 09:08:34 UTC (rev 280)
+++ pkg/quantstrat/R/signals.R 2010-03-09 23:19:16 UTC (rev 281)
@@ -129,6 +129,9 @@
if (length(columns==2)){
ret_sig=NULL
if (relationship=='op'){
+ # (How) can this support "Close"? --jmu
+ if(columns[1] %in% c("Close","Cl","close"))
+ stop("Close not supported with relationship=='op'")
switch(columns[1],
Low =,
low =,
@@ -139,19 +142,19 @@
ask = {relationship = 'gt'}
)
}
- columns <- match.names(columns,colnames(data))
+ colNums <- match.names(columns,colnames(data))
switch(relationship,
'>' =,
- 'gt' = {ret_sig = data[,columns[1]] > data[,columns[2]]},
+ 'gt' = {ret_sig = data[,colNums[1]] > data[,colNums[2]]},
'<' ,
- 'lt' = {ret_sig = data[,columns[1]] < data[,columns[2]]},
- 'eq' = {ret_sig = data[,columns[1]] == data[,columns[2]]}, #FIXME any way to specify '='?
+ 'lt' = {ret_sig = data[,colNums[1]] < data[,colNums[2]]},
+ 'eq' = {ret_sig = data[,colNums[1]] == data[,colNums[2]]}, #FIXME any way to specify '='?
'gte' =,
'gteq'=,
- 'ge' = {ret_sig = data[,columns[1]] >= data[,columns[2]]}, #FIXME these fail with an 'unexpected =' error if you use '>='
+ 'ge' = {ret_sig = data[,colNums[1]] >= data[,colNums[2]]}, #FIXME these fail with an 'unexpected =' error if you use '>='
'lte' =,
'lteq'=,
- 'le' = {ret_sig = data[,columns[1]] <= data[,columns[2]]}
+ 'le' = {ret_sig = data[,colNums[1]] <= data[,colNums[2]]}
)
} else {
stop("comparison of more than two columns not supported yet, patches welcome")
@@ -176,12 +179,12 @@
#' @param relationship one of c("gt","lt","eq","gte","lte") or reasonable alternatives
#' @export
sigCrossover <- function(label,data, columns, relationship=c("gt","lt","eq","gte","lte")) {
- ret_sig = NA
+ ret_sig = FALSE
lng<-length(columns)
for (i in 1:(lng-1)) {
- if (!is.na(ret_sig)) break()
- ret_sig = ifelse(diff(sigComparison(label=label,data=data,columns=columns[c(i,lng)],relationship=relationship))==1,TRUE,NA)
+ ret_sig = ret_sig | diff(sigComparison(label=label,data=data,columns=columns[c(i,lng)],relationship=relationship))==1
}
+ is.na(ret_sig) <- which(!ret_sig)
colnames(ret_sig)<-label
return(ret_sig)
}
@@ -197,12 +200,12 @@
#' @export
sigPeak <- function(label,data,column, direction=c("peak","bottom")){
#should we only do this for one column?
- column<-match.names(column,colnames(data))
+ colNum<-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,
- "peak" = { Lag(data[,column],2) < Lag(data[,column],1) & Lag(data[,column],1) > data[,column] } ,
- "bottom","valley" = { Lag(data[,column],2) > Lag(data[,column],1) & Lag(data[,column],1) < data[,column] }
+ "peak" = { Lag(data[,colNum],2) < Lag(data[,colNum],1) & Lag(data[,colNum],1) > data[,colNum] } ,
+ "bottom","valley" = { Lag(data[,colNum],2) > Lag(data[,colNum],1) & Lag(data[,colNum],1) < data[,colNum] }
)
colnames(ret_sig)<-paste(label,direction,"sig",sep='.')
return(ret_sig)
@@ -223,19 +226,19 @@
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(column, colnames(data))
+ colNum <- match.names(column, colnames(data))
switch(relationship,
'>' =,
- 'gt' = {ret_sig = data[,column] > threshold},
+ 'gt' = {ret_sig = data[,colNum] > threshold},
'<' =,
- 'lt' = {ret_sig = data[,column] < threshold},
- 'eq' = {ret_sig = data[,column] == threshold}, #FIXME any way to specify '='?
+ 'lt' = {ret_sig = data[,colNum] < threshold},
+ 'eq' = {ret_sig = data[,colNum] == threshold}, #FIXME any way to specify '='?
'gte' =,
'gteq'=,
- 'ge' = {ret_sig = data[,column] >= threshold}, #FIXME these fail with an 'unexpected =' error if you use '>='
+ 'ge' = {ret_sig = data[,colNum] >= threshold}, #FIXME these fail with an 'unexpected =' error if you use '>='
'lte' =,
'lteq'=,
- 'le' = {ret_sig = data[,column] <= threshold}
+ 'le' = {ret_sig = data[,colNum] <= threshold}
)
colnames(ret_sig)<-label
return(ret_sig)
Modified: pkg/quantstrat/demo/BBands.R
===================================================================
--- pkg/quantstrat/demo/BBands.R 2010-03-08 09:08:34 UTC (rev 280)
+++ pkg/quantstrat/demo/BBands.R 2010-03-09 23:19:16 UTC (rev 281)
@@ -6,7 +6,7 @@
currency('USD')
stock('IBM',currency='USD',multiplier=1)
-initDate='1997-12-31'
+initDate='2006-12-31'
initEq=1000000
portfolio.st='bbands'
@@ -17,8 +17,10 @@
initOrders(portfolio=portfolio.st,initDate=initDate)
s <- strategy("bbands")
+SD = 2
+N = 20
#s <- add.indicator(strategy = s, name = "SMA", arguments = list(x = quote(Cl(mktdata)), n=10), label="SMA10")
-s <- add.indicator(strategy = s, name = "BBands", arguments = list(HLC = quote(HLC(mktdata)), sd = 2, n=20, maType=quote(SMA)))
+s <- add.indicator(strategy = s, name = "BBands", arguments = list(HLC = quote(HLC(mktdata)), sd=SD, n=N, maType=quote(SMA)))
#if you wanted to manually apply a signal function for demonstration
@@ -29,16 +31,21 @@
#s<- add.signal(s,name="sigComparison",arguments = list(data=quote(mktdata),columns=c("Close","Open"),relationship="gt"),label="Cl.gt.Op")
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")
-
+#s<- add.signal(s,name="sigCrossover",arguments = list(data=quote(mktdata),columns=c("Low","up"), relationship="gt"),label="Lo.gt.UpperBand")
+#s<- add.signal(s,name="sigCrossover",arguments = list(data=quote(mktdata),columns=c("High","dn"), relationship="lt"),label="Hi.lt.LowerBand")
+s<- add.signal(s,name="sigCrossover",arguments = list(data=quote(mktdata),columns=c("High","Low","mavg"),relationship="op"),label="Cross.Mid")
#IBM.sigs<-applySignals(s,mktdata=IBM.inds)
# 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='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')
+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')
+#s <- add.rule(s,name='ruleSignal', arguments = list(data=quote(mktdata),sigcol="Lo.gt.UpperBand",sigval=TRUE, orderqty= 'all', ordertype='market', orderside=NULL, threshold=NULL),type='exit')
+#s <- add.rule(s,name='ruleSignal', arguments = list(data=quote(mktdata),sigcol="Hi.lt.LowerBand",sigval=TRUE, orderqty= 'all', ordertype='market', orderside=NULL, threshold=NULL),type='exit')
+s <- add.rule(s,name='ruleSignal', arguments = list(data=quote(mktdata),sigcol="Cross.Mid",sigval=TRUE, orderqty= 'all', ordertype='market', orderside=NULL, threshold=NULL),type='exit')
#TODO add thresholds and stop-entry and stop-exit handling to test
-getSymbols("IBM")
+getSymbols("IBM",from=initDate)
start_t<-Sys.time()
out<-try(applyStrategy(strategy='s' , portfolios='bbands'))
# look at the order book
@@ -47,7 +54,7 @@
end_t-start_t
updatePortf(Portfolio='bbands',Dates=paste('::',as.Date(Sys.time()),sep=''))
chart.Posn(Portfolio='bbands',Symbol='IBM',theme='white')
-plot(addBBands(on=1,sd=2,n=20))
+plot(addBBands(on=1,sd=SD,n=N))
###############################################################################
# R (http://r-project.org/) Quantitative Strategy Model Framework
#
More information about the Blotter-commits
mailing list