[Blotter-commits] r1219 - in pkg/quantstrat: R demo

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Fri Oct 12 00:21:01 CEST 2012


Author: braverock
Date: 2012-10-12 00:21:01 +0200 (Fri, 12 Oct 2012)
New Revision: 1219

Added:
   pkg/quantstrat/R/applyStrategy.rebalancing.R
Modified:
   pkg/quantstrat/R/ruleSignal.R
   pkg/quantstrat/R/rules.R
   pkg/quantstrat/demo/rsi.R
Log:
- fix rsi demo to work with newer fn defaults
- initial commit of applyStrategy.rebalancing
- avoid dindex buffer overflow in ruleSignal

Copied: pkg/quantstrat/R/applyStrategy.rebalancing.R (from rev 1161, pkg/quantstrat/R/strategy.R)
===================================================================
--- pkg/quantstrat/R/applyStrategy.rebalancing.R	                        (rev 0)
+++ pkg/quantstrat/R/applyStrategy.rebalancing.R	2012-10-11 22:21:01 UTC (rev 1219)
@@ -0,0 +1,179 @@
+#' apply the strategy to arbitrary market data, with periodic rebalancing
+#' 
+#' This function is the wrapper that holds together the execution of a strategy with rebalancing rules.
+#' 
+#' @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
+#' @param parameters named list of parameters to be applied during evaluation of the strategy, default NULL
+#' @param ... any other passthru parameters
+#' @param verbose if TRUE, return output list
+#' @param symbols character vector identifying symbols to initialize a portfolio for, default NULL
+#' @param initStrat whether to use (experimental) initialization code, default FALSE
+#' @param updateStrat whether to use (experimental) wrapup code, default FALSE
+#' @export
+#' @seealso \code{\link{strategy}},  \code{\link{applyIndicators}}, 
+#'  \code{\link{applySignals}}, \code{\link{applyRules}},
+#'  \code{\link{initStrategy}}, \code{\link{applyStrategy}}
+applyStrategy.rebalancing <- function(strategy , 
+                                      portfolios, 
+                                      mktdata=NULL , 
+                                      parameters=NULL, 
+                                      ..., 
+                                      verbose=TRUE, 
+                                      symbols=NULL, 
+                                      initStrat=FALSE, 
+                                      updateStrat=FALSE ) 
+{
+   
+    ret<-list()
+    
+	if (!is.strategy(strategy)) {
+    	s<-try(getStrategy(strategy))
+    	if(inherits(strategy,"try-error"))
+    	    stop ("You must supply an object of type 'strategy'.")
+    } else {
+        s <- strategy
+    }
+    
+    # check rebalancing rules here to see whether we need to bother, and call applyRules if we don't
+    if(length(s$rules[['rebalance']])>=1){
+        #initialize the rebalancing periods
+        periods<-NULL
+        for (rule in s$rules[['rebalance']]){
+            if(isTRUE(rule$path.dep)){ # only apply to path dependent rule
+                # check for sigcol, sigval, otherwise use all
+                if(is.null(rule$arguments$rebalance_on)){
+                    warning(paste(rule$label,'does not have a rebalance_on period defined! Mayhem may ensue!'))
+                } else {
+                    periods<-c(periods,rule$arguments$rebalance_on)
+                }
+            }
+        }
+        periods<-unique(periods)
+    } else {
+        stop('no rebalance rules detected, use applyStrategy instead, it will be faster')
+        return(applyStrategy(strategy=s , 
+                portfolios=portfolios, 
+                mktdata=mktdata , 
+                parameters=parameters, 
+                verbose=verbose, 
+                symbols=symbols, 
+                initStrat=initStrat, 
+                updateStrat=updateStrat, 
+                ... )
+        )
+    }
+
+    if (missing(mktdata)) load.mktdata=TRUE else load.mktdata=FALSE
+    
+    for (portfolio in portfolios) {
+
+		# initStrategy
+        if(isTRUE(initStrat)) initStrategy(strategy=s, portfolio, symbols, ...=...)
+        
+   		ret[[portfolio]]<-list() # this is slot [[i]] which we will use later
+        pobj<-getPortfolio(portfolio)
+        symbols<-names(pobj$symbols)
+
+        st<-new.env()
+        #should be able to use this directly
+        #assign(st,paste(s$name,'mktdata',sep='.'),pos=.strategy)
+        
+        if(length(periods)>1){ warning('no guarantee multiple-periodicity rebalancing will work just yet, patches welcome.') }
+        st$periods<-periods
+        # get the rebalancing periods list for this portfolio
+        plist<-list()
+        for( period in periods ) {
+            from<-as.POSIXlt(index(pobj$summary)[1],tz=indexTZ(pobj$summary))
+            # this sequence should work pretty generically
+            plist[[period]]<-seq(from=from, to=as.POSIXlt(Sys.Date()), by = period)
+            #TODO FIXME sort out a more robust 'to' parameter for this
+        }
+        st$plist<-plist
+        
+        if (length(plist) >1) pindex<-lapply(plist,c)
+        else pindex<-plist[[1]]
+        
+        pindex<-xts(1:length(pindex),order.by=pindex)
+        pindex<-index(pindex)
+        st$rebalance_index<-pindex
+        
+        #first do the path-independent stuff for indicators and signals
+        for (symbol in symbols){
+            sret<-list()
+            if(isTRUE(load.mktdata)) mktdata <- get(symbol)
+
+            #loop over indicators
+            sret$indicators <- applyIndicators(strategy=s , mktdata=mktdata , parameters=parameters, ... )
+            #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=s, mktdata=mktdata, sret$indicators, parameters=parameters, ... )
+            #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    
+            }
+            # store mktdata
+            assign(symbol,mktdata,pos=st) #creates an object named for 'symbol' in the 'st' environment
+            
+            sret$rules<-list()
+            ret[[portfolio]][[symbol]]<-sret
+            #TODO capture rebalance periods here?
+        
+        } # end path-independent loop over indicators and signals by symbol
+        
+        #now we need to do the endpoints loop. 
+        for(i in 2:length(pindex)){
+            #the proper endpoints for each symbol will vary, so we need to get them separately, and subset each one
+            for (symbol in symbols){
+                sret<-ret[[portfolio]][[symbol]]
+
+                mktdata<-get(symbol,pos=st)
+                #now subset
+                md_subset<-mktdata[as.POSIXct(index(mktdata))>pindex[i-1]&as.POSIXct(index(mktdata))<=pindex[i]]
+                if(nrow(mktdata)<1) next()
+                #applyRules to this subset for this instrument  
+                sret$rules$pathdep<-c(sret$rules$pathdep,
+                                      applyRules(portfolio=portfolio, symbol=symbol, strategy=s, mktdata=md_subset, Dates=NULL, indicators=sret$indicators, signals=sret$signals, parameters=parameters,  ..., path.dep=TRUE))
+                
+                ret[[portfolio]][[symbol]]<-sret
+            } #end loop over symbols for this sub-period
+            
+            #now call the rebalancing rules
+            #to nest different rebalancing periods, we need to check if the pindex 'i' is in specific rebalance_on periods
+            # specifically, we need to check if *this* index is in st$plist$period
+            for(period in names(st$plist)){
+                if(i %in% st$plist[[period]]){
+                    #this index is a rebalancing index for period
+                    #call the rebalance rules for this period
+                    #still need to separate the rules by rebalancing period, this will call them all
+                    ruleProc(s$rules$rebalance,timestamp=pindex[i], path.dep=TRUE, 'rebalance', ..., mktdata=md_subset, parameters=parameters)
+                }
+            }
+        }
+        
+        # updateStrat
+        if(isTRUE(updateStrat)) updateStrategy(strategy, portfolio, Symbols=symbols, ...=...)
+        
+    }
+    
+    if(verbose) return(ret)
+}
+
+
+###############################################################################
+# R (http://r-project.org/) Quantitative Strategy Model Framework
+#
+# Copyright (c) 2009-2012
+# Peter Carl, Dirk Eddelbuettel, Brian G. Peterson, Jeffrey Ryan, and Joshua Ulrich 
+#
+# This library is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id$
+#
+###############################################################################

Modified: pkg/quantstrat/R/ruleSignal.R
===================================================================
--- pkg/quantstrat/R/ruleSignal.R	2012-10-11 20:47:44 UTC (rev 1218)
+++ pkg/quantstrat/R/ruleSignal.R	2012-10-11 22:21:01 UTC (rev 1219)
@@ -55,7 +55,10 @@
         osFUN<-match.fun(osFUN)
 
 #   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)))
+    if (!is.na(timestamp) && 
+            nrow(data[timestamp])>0 && 
+            (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-10-11 20:47:44 UTC (rev 1218)
+++ pkg/quantstrat/R/rules.R	2012-10-11 22:21:01 UTC (rev 1219)
@@ -257,7 +257,7 @@
         nargs=NULL
     }
     
-    Dates=unique(index(mktdata)) # should this be index() instead?  
+    Dates=unique(index(mktdata))  
     
     #we could maybe do something more sophisticated, but this should work
     if(isTRUE(path.dep)){ #initialize the dimension reduction index (dindex)
@@ -265,6 +265,7 @@
         assign.dindex(dindex)
         #pre-process for dimension reduction here
         for ( type in names(strategy$rules)){
+            if(type=='rebalance') next()
             # check if there's anything to do
             if(length(strategy$rules[[type]])>=1){
                 for (rule in strategy$rules[[type]]){
@@ -284,8 +285,9 @@
             }    
         }
         dindex<-get.dindex()
-        if(length(dindex)==0) dindex=1
         
+        if(length(dindex)==0) dindex=1 #should this just return?
+        
         #for debugging, set dindex to all index values:
         #assign.dindex(1:length(index(mktdata)))
         #print(dindex)

Modified: pkg/quantstrat/demo/rsi.R
===================================================================
--- pkg/quantstrat/demo/rsi.R	2012-10-11 20:47:44 UTC (rev 1218)
+++ pkg/quantstrat/demo/rsi.R	2012-10-11 22:21:01 UTC (rev 1219)
@@ -19,12 +19,12 @@
 stratRSI <- add.signal(strategy = stratRSI, name="sigThreshold",arguments = list(threshold=30, column="RSI",relationship="lt",cross=TRUE),label="RSI.lt.30")
 
 # There are two rules:
-#'## we would Use osMaxPos to put trade on in layers, or to a maximum position. 
+#'## we use osMaxPos to put trade on in layers, or to a maximum position. 
 # The first is to sell when the RSI crosses above the threshold
-stratRSI <- add.rule(strategy = stratRSI, name='ruleSignal', arguments = list(sigcol="RSI.gt.70", sigval=TRUE, orderqty=-1000, ordertype='market', orderside='short', pricemethod='market', replace=FALSE), type='enter', path.dep=TRUE)
+stratRSI <- add.rule(strategy = stratRSI, name='ruleSignal', arguments = list(sigcol="RSI.gt.70", sigval=TRUE, orderqty=-1000, ordertype='market', orderside='short', pricemethod='market', replace=FALSE, osFUN=osMaxPos), type='enter', path.dep=TRUE)
 stratRSI <- add.rule(strategy = stratRSI, name='ruleSignal', arguments = list(sigcol="RSI.lt.30", sigval=TRUE, orderqty='all', ordertype='market', orderside='short', pricemethod='market', replace=FALSE), type='exit', path.dep=TRUE)
 # The second is to buy when the RSI crosses below the threshold
-stratRSI <- add.rule(strategy = stratRSI, name='ruleSignal', arguments = list(sigcol="RSI.lt.30", sigval=TRUE, orderqty= 1000, ordertype='market', orderside='long', pricemethod='market', replace=FALSE), type='enter', path.dep=TRUE)
+stratRSI <- add.rule(strategy = stratRSI, name='ruleSignal', arguments = list(sigcol="RSI.lt.30", sigval=TRUE, orderqty= 1000, ordertype='market', orderside='long', pricemethod='market', replace=FALSE, osFUN=osMaxPos), type='enter', path.dep=TRUE)
 stratRSI <- add.rule(strategy = stratRSI, name='ruleSignal', arguments = list(sigcol="RSI.gt.70", sigval=TRUE, orderqty='all', ordertype='market', orderside='long', pricemethod='market', replace=FALSE), type='exit', path.dep=TRUE)
 
 #add changeable parameters
@@ -52,8 +52,9 @@
 port.st<-'RSI' #use a string here for easier changing of parameters and re-trying
 
 initPortf(port.st, symbols=symbols, initDate=initDate)
-initAcct(port.st, portfolios=port.st, initDate=initDate)
+initAcct(port.st, portfolios=port.st, initDate=initDate,initEq=initEq)
 initOrders(portfolio=port.st, initDate=initDate)
+for(symbol in symbols){ addPosLimit(port.st, symbol, initDate, 300, 3 ) } #set max pos 
 
 print("setup completed")
 



More information about the Blotter-commits mailing list