SCM

SCM Repository

[blotter] Diff of /pkg/quantstrat/demo/faber.R
ViewVC logotype

Diff of /pkg/quantstrat/demo/faber.R

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 450, Sat Nov 13 18:30:40 2010 UTC revision 1489, Tue Aug 13 14:51:33 2013 UTC
# Line 45  Line 45 
45  # Load required libraries  # Load required libraries
46  require(quantstrat)  require(quantstrat)
47    
48    #correct for TZ issues if they crop up
49    oldtz<-Sys.getenv('TZ')
50    if(oldtz=='') {
51            Sys.setenv(TZ="GMT")
52    }
53  # Try to clean up in case the demo was run previously  # Try to clean up in case the demo was run previously
54  try(rm("account.faber","portfolio.faber",pos=.blotter),silent=TRUE)  suppressWarnings(rm("account.faber","portfolio.faber",pos=.blotter))
55  try(rm("ltaccount","ltportfolio","ClosePrice","CurrentDate","equity","GSPC","stratFaber","initDate","initEq","Posn","UnitSize","verbose"),silent=TRUE)  suppressWarnings(rm("ltaccount", "ltportfolio", "ClosePrice", "CurrentDate", "equity",
56  try(rm("order_book.faber",pos=.strategy),silent=TRUE)              "GSPC", "stratFaber", "initDate", "initEq", "Posn", "UnitSize", "verbose"))
57    suppressWarnings(rm("order_book.faber",pos=.strategy))
58    
59    ##### PLACE DEMO AND TEST DATES HERE #################
60    #
61    #if(isTRUE(options('in_test')$in_test))
62    #  # use test dates
63    #  {initDate="2011-01-01"
64    #  endDate="2012-12-31"
65    #  } else
66    #  # use demo defaults
67    #  {initDate="1999-12-31"
68    #  endDate=Sys.Date()}
69    
70  # Set initial values  # Set initial values
71  initDate='1997-12-31'  initDate='1997-12-31'
# Line 76  Line 93 
93    
94  # Initialize portfolio and account  # Initialize portfolio and account
95  initPortf('faber', symbols=symbols, initDate=initDate)  initPortf('faber', symbols=symbols, initDate=initDate)
96  initAcct('faber', portfolios='faber', initDate=initDate)  initAcct('faber', portfolios='faber', initDate=initDate, initEq=100000)
97  initOrders(portfolio='faber', initDate=initDate)  initOrders(portfolio='faber', initDate=initDate)
98    
99  print("setup completed")  print("setup completed")
100    
101  # Initialize a strategy object  # Initialize a strategy object
102  stratFaber <- strategy("faber")  strategy("faber", store=TRUE)
103    
104  # Add an indicator  # Add an indicator
105  stratFaber <- add.indicator(strategy = stratFaber, name = "SMA", arguments = list(x = quote(Cl(mktdata)), n=10), label="SMA10")  add.indicator('faber', name = "SMA", arguments = list(x = quote(Cl(mktdata)), n=10), label="SMA10")
106    
107  # There are two signals:  # There are two signals:
108  # The first is when monthly price crosses over the 10-month SMA  # The first is when monthly price crosses over the 10-month SMA
109  stratFaber <- add.signal(stratFaber,name="sigCrossover",arguments = list(columns=c("Close","SMA10"),relationship="gt"),label="Cl.gt.SMA")  add.signal('faber',name="sigCrossover",arguments = list(columns=c("Close","SMA10"),relationship="gte"),label="Cl.gt.SMA")
110  # The second is when the monthly price crosses under the 10-month SMA  # The second is when the monthly price crosses under the 10-month SMA
111  stratFaber <- add.signal(stratFaber,name="sigCrossover",arguments = list(columns=c("Close","SMA10"),relationship="lt"),label="Cl.lt.SMA")  add.signal('faber',name="sigCrossover",arguments = list(columns=c("Close","SMA10"),relationship="lt"),label="Cl.lt.SMA")
112    
113  # There are two rules:  # There are two rules:
114  # The first is to buy when the price crosses above the SMA  # The first is to buy when the price crosses above the SMA
115  stratFaber <- add.rule(stratFaber, name='ruleSignal', arguments = list(sigcol="Cl.gt.SMA", sigval=TRUE, orderqty=1000, ordertype='market', orderside='long', pricemethod='market'), type='enter', path.dep=TRUE)  add.rule('faber', name='ruleSignal', arguments = list(sigcol="Cl.gt.SMA", sigval=TRUE, orderqty=500, ordertype='market', orderside='long', pricemethod='market',TxnFees=-5), type='enter', path.dep=TRUE)
116  # The second is to sell when the price crosses below the SMA  # The second is to sell when the price crosses below the SMA
117  stratFaber <- add.rule(stratFaber, name='ruleSignal', arguments = list(sigcol="Cl.lt.SMA", sigval=TRUE, orderqty='all', ordertype='market', orderside='long', pricemethod='market'), type='exit', path.dep=TRUE)  add.rule('faber', name='ruleSignal', arguments = list(sigcol="Cl.lt.SMA", sigval=TRUE, orderqty='all', ordertype='market', orderside='long', pricemethod='market',TxnFees=-5), type='exit', path.dep=TRUE)
118    
119  # Process the indicators and generate trades  # Process the indicators and generate trades
120  start_t<-Sys.time()  start_t<-Sys.time()
121  out<-try(applyStrategy(strategy=stratFaber , portfolios='faber'))  out<-try(applyStrategy(strategy='faber' , portfolios='faber'))
122  end_t<-Sys.time()  end_t<-Sys.time()
123  print("Strategy Loop:")  print("Strategy Loop:")
124  print(end_t-start_t)  print(end_t-start_t)
# Line 111  Line 128 
128    
129  start_t<-Sys.time()  start_t<-Sys.time()
130  updatePortf(Portfolio='faber',Dates=paste('::',as.Date(Sys.time()),sep=''))  updatePortf(Portfolio='faber',Dates=paste('::',as.Date(Sys.time()),sep=''))
131    updateAcct('faber')
132    updateEndEq('faber')
133  end_t<-Sys.time()  end_t<-Sys.time()
134  print("trade blotter portfolio update:")  print("trade blotter portfolio update:")
135  print(end_t-start_t)  print(end_t-start_t)
# Line 119  Line 138 
138  themelist<-chart_theme()  themelist<-chart_theme()
139  themelist$col$up.col<-'lightgreen'  themelist$col$up.col<-'lightgreen'
140  themelist$col$dn.col<-'pink'  themelist$col$dn.col<-'pink'
141    
142    dev.new()
143    layout(mat=matrix(1:(length(symbols)+1),ncol=2))
144  for(symbol in symbols){  for(symbol in symbols){
145        chart.Posn(Portfolio='faber',Symbol=symbol,theme=themelist,TA="add_SMA(n=10,col='darkgreen')")
146    }
147    
148    ret1 <- PortfReturns('faber')
149    ret1$total<-rowSums(ret1)
150    View(ret1)
151    
152    if("package:PerformanceAnalytics" %in% search() || require("PerformanceAnalytics",quietly=TRUE)){
153            getSymbols("SPY", src='yahoo', index.class=c("POSIXt","POSIXct"), from='1999-01-01')
154            SPY<-to.monthly(SPY)
155            SPY.ret<-Return.calculate(SPY$SPY.Close)
156            index(SPY.ret)<-index(ret1)
157      dev.new()      dev.new()
158      chart.Posn(Portfolio='faber',Symbol=symbol,theme=themelist)          charts.PerformanceSummary(cbind(ret1$total,SPY.ret), geometric=FALSE, wealth.index=TRUE)
     plot(add_SMA(n=10,col='darkgreen', on=1))  
159  }  }
160    
161    faber.stats<-tradeStats('faber')[,c('Net.Trading.PL','Max.Drawdown','Num.Trades','Profit.Factor','Std.Dev.Trade.PL','Largest.Winner','Largest.Loser','Max.Equity','Min.Equity')]
162    View(faber.stats)
163    
164    Sys.setenv(TZ=oldtz)
165  ###############################################################################  ###############################################################################
166  # R (http://r-project.org/) Quantitative Strategy Model Framework  # R (http://r-project.org/) Quantitative Strategy Model Framework
167  #  #
168  # Copyright (c) 2009-2010  # Copyright (c) 2009-2012
169  # Peter Carl, Dirk Eddelbuettel, Brian G. Peterson, Jeffrey Ryan, and Joshua Ulrich  # Peter Carl, Dirk Eddelbuettel, Brian G. Peterson,
170    # Jeffrey Ryan, Joshua Ulrich, and Garrett See
171  #  #
172  # This library is distributed under the terms of the GNU Public License (GPL)  # This library is distributed under the terms of the GNU Public License (GPL)
173  # for full details see the file COPYING  # for full details see the file COPYING
# Line 138  Line 175 
175  # $Id$  # $Id$
176  #  #
177  ###############################################################################  ###############################################################################
178    
179    ##### PLACE THIS BLOCK AT END OF DEMO SCRIPT ###################
180    # book  = getOrderBook(port)
181    # stats = tradeStats(port)
182    # rets  = PortfReturns(acct)
183    ################################################################

Legend:
Removed from v.450  
changed lines
  Added in v.1489

root@r-forge.r-project.org
ViewVC Help
Powered by ViewVC 1.0.0  
Thanks to:
Vienna University of Economics and Business Powered By FusionForge