[Blotter-commits] r1553 - in pkg/quantstrat: . R man

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Oct 27 18:33:00 CET 2013


Author: braverock
Date: 2013-10-27 18:33:00 +0100 (Sun, 27 Oct 2013)
New Revision: 1553

Modified:
   pkg/quantstrat/NAMESPACE
   pkg/quantstrat/R/strategy.R
   pkg/quantstrat/man/applyStrategy.Rd
Log:
- make memory usage in applyStrategy more efficient with an environment
- only accumulate ret list if debug=TRUE (replaces verbose arg)

Modified: pkg/quantstrat/NAMESPACE
===================================================================
--- pkg/quantstrat/NAMESPACE	2013-10-26 23:09:00 UTC (rev 1552)
+++ pkg/quantstrat/NAMESPACE	2013-10-27 17:33:00 UTC (rev 1553)
@@ -1,5 +1,5 @@
+export(add.distribution)
 export(add.distribution.constraint)
-export(add.distribution)
 export(add.indicator)
 export(add.init)
 export(add.rule)
@@ -11,10 +11,11 @@
 export(applyParameter)
 export(applyRules)
 export(applySignals)
+export(applyStrategy)
 export(applyStrategy.rebalancing)
-export(applyStrategy)
+export(applyStrategy.rebalancing.training)
+export(chart.forward)
 export(chart.forward.training)
-export(chart.forward)
 export(delete.paramset)
 export(enable.rule)
 export(get.orderbook)
@@ -23,6 +24,7 @@
 export(getOrders)
 export(getParameterTable)
 export(getPosLimit)
+export(getStrategy)
 export(initOrders)
 export(initStrategy)
 export(is.strategy)

Modified: pkg/quantstrat/R/strategy.R
===================================================================
--- pkg/quantstrat/R/strategy.R	2013-10-26 23:09:00 UTC (rev 1552)
+++ pkg/quantstrat/R/strategy.R	2013-10-27 17:33:00 UTC (rev 1553)
@@ -92,7 +92,7 @@
 #' @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 debug 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
@@ -100,72 +100,101 @@
 #' @seealso \code{\link{strategy}},  \code{\link{applyIndicators}}, 
 #'  \code{\link{applySignals}}, \code{\link{applyRules}},
 #'  \code{\link{initStrategy}}, 
-applyStrategy <- function(strategy , portfolios, mktdata=NULL , parameters=NULL, ..., verbose=TRUE, symbols=NULL, initStrat=FALSE, updateStrat=FALSE ) {
-    #TODO add Date subsetting
-    #TODO add saving of modified market data
+applyStrategy <- function(strategy , 
+                          portfolios, 
+                          mktdata=NULL , 
+                          parameters=NULL, 
+                          ..., 
+                          debug=FALSE, 
+                          symbols=NULL, 
+                          initStrat=FALSE, 
+                          updateStrat=FALSE ) {
+
+  #TODO add saving of modified market data
+  
+  if(isTRUE(debug)) ret<-list()
     
-    ret<-list()
-    
 	if (!is.strategy(strategy)) {
-    	strategy<-try(getStrategy(strategy))
-    	if(inherits(strategy,"try-error"))
-    	    stop ("You must supply an object of type 'strategy'.")
-    } 
-	
-    if (missing(mktdata) || is.null(mktdata)) load.mktdata=TRUE else load.mktdata=FALSE
-	
-    for (portfolio in portfolios) {
-        
-		  # call initStrategy
-      if(isTRUE(initStrat)) initStrategy(strategy=strategy, portfolio, symbols, ...=...)
-        
-   		ret[[portfolio]]<-list() # this is slot [[i]] which we will use later
-      pobj<-.getPortfolio(portfolio)
-      symbols<- ls(pobj$symbols)
-      sret<-list()
-      for (symbol in symbols){
-        if(isTRUE(load.mktdata)) mktdata <- get(symbol)
-        
-        # loop over indicators
-        sret$indicators <- applyIndicators(strategy=strategy , mktdata=mktdata , parameters=parameters, ... )
-        
-        if(inherits(sret$indicators,"xts") & nrow(mktdata)==nrow(sret$indicators)){
-          mktdata<-sret$indicators
-        }
-        
-        # loop over signal generators
-        sret$signals <- applySignals(strategy=strategy, mktdata=mktdata, sret$indicators, parameters=parameters, ... )
-
-        if(inherits(sret$signals,"xts") & nrow(mktdata)==nrow(sret$signals)){
-          mktdata<-sret$signals    
-        }
-        
-        #loop over rules  
-        sret$rules<-list()
-        
-        # only fire nonpath/pathdep when true 
-        # TODO make this more elegant
-        pd <- FALSE
-        for(i in 1:length(strategy$rules)){  
-          if(length(strategy$rules[[i]])!=0){z <- strategy$rules[[i]]; if(z[[1]]$path.dep==TRUE){pd <- TRUE}}
-        }
-        
-        sret$rules$nonpath<-applyRules(portfolio=portfolio, symbol=symbol, strategy=strategy, mktdata=mktdata, Dates=NULL, indicators=sret$indicators, signals=sret$signals, parameters=parameters,  ..., path.dep=FALSE)
-        
-        # Check for open orders
-        rem.orders <- suppressWarnings(getOrders(portfolio=portfolio, symbol=symbol, status="open")) #, timespan=timespan, ordertype=ordertype,which.i=TRUE)
-        if(NROW(rem.orders)>0){pd <- TRUE}
-        if(pd==TRUE){sret$rules$pathdep<-applyRules(portfolio=portfolio, symbol=symbol, strategy=strategy, mktdata=mktdata, Dates=NULL, indicators=sret$indicators, signals=sret$signals, parameters=parameters,  ..., path.dep=TRUE)}
-        
-        ret[[portfolio]][[symbol]]<-sret
-      }
-      
-      # call updateStrategy
-      if(isTRUE(updateStrat)) updateStrategy(strategy, portfolio, Symbols=symbols, ...=...)
-      
-    }
-    
-    if(verbose) return(ret)
+	  strategy<-try(getStrategy(strategy))
+	  if(inherits(strategy,"try-error"))
+	    stop ("You must supply an object of type 'strategy'.")
+	} 
+     
+     if (missing(mktdata) || is.null(mktdata)) load.mktdata=TRUE else load.mktdata=FALSE
+     
+     for (portfolio in portfolios) {
+       
+       # call initStrategy
+       if(isTRUE(initStrat)) initStrategy(strategy=strategy, portfolio, symbols, ...=...)
+       
+       if(isTRUE(debug)) ret[[portfolio]]<-list() # this is slot [[i]] which we will use later
+       pobj<-.getPortfolio(portfolio)
+       symbols<- ls(pobj$symbols)
+       sret<-new.env(hash=TRUE)
+       
+       for (symbol in symbols){
+         if(isTRUE(load.mktdata)) mktdata <- get(symbol)
+         
+         # loop over indicators
+         sret$indicators <- applyIndicators(strategy=strategy , mktdata=mktdata , parameters=parameters, ... )
+         
+         if(inherits(sret$indicators,"xts") & nrow(mktdata)==nrow(sret$indicators)){
+           mktdata<-sret$indicators
+           sret$indicators <- NULL
+         }
+         
+         # loop over signal generators
+         sret$signals <- applySignals(strategy=strategy, mktdata=mktdata, parameters=parameters, ... )
+         
+         if(inherits(sret$signals,"xts") & nrow(mktdata)==nrow(sret$signals)){
+           mktdata<-sret$signals
+           sret$signals<-NULL
+         }
+         
+         #loop over rules  
+         sret$rules<-list()
+         
+         # only fire nonpath/pathdep when true 
+         # TODO make this more elegant
+         pd <- FALSE
+         for(i in 1:length(strategy$rules)){  
+           if(length(strategy$rules[[i]])!=0){z <- strategy$rules[[i]]; if(z[[1]]$path.dep==TRUE){pd <- TRUE}}
+         }
+         
+         sret$rules$nonpath<-applyRules(portfolio=portfolio, 
+                                        symbol=symbol, 
+                                        strategy=strategy, 
+                                        mktdata=mktdata, 
+                                        Dates=NULL, 
+                                        indicators=sret$indicators, 
+                                        signals=sret$signals, 
+                                        parameters=parameters,  
+                                        ..., 
+                                        path.dep=FALSE)
+         
+         # Check for open orders
+         rem.orders <- suppressWarnings(getOrders(portfolio=portfolio, symbol=symbol, status="open")) #, timespan=timespan, ordertype=ordertype,which.i=TRUE)
+         if(NROW(rem.orders)>0){pd <- TRUE}
+         if(pd==TRUE){sret$rules$pathdep<-applyRules(portfolio=portfolio, 
+                                                     symbol=symbol, 
+                                                     strategy=strategy, 
+                                                     mktdata=mktdata, 
+                                                     Dates=NULL, 
+                                                     indicators=sret$indicators, 
+                                                     signals=sret$signals, 
+                                                     parameters=parameters,  
+                                                     ..., 
+                                                     path.dep=TRUE)}
+         
+         if(isTRUE(debug)) ret[[portfolio]][[symbol]]<-sret
+       }
+       
+       # call updateStrategy
+       if(isTRUE(updateStrat)) updateStrategy(strategy, portfolio, Symbols=symbols, ...=...)
+       
+     }
+     
+     if(isTRUE(debug)) return(ret)
 }
 
 #' test to see if object is of type 'strategy'
@@ -182,7 +211,8 @@
 #' @aliases
 #' get.strategy
 #' getStrategy
-#' @export
+#' @export get.strategy
+#' @export getStrategy
 get.strategy <- getStrategy <- function(x, envir=.strategy){
     tmp_strat<-get(as.character(x),pos=envir, inherits=TRUE)
     if( inherits(tmp_strat,"try-error") | !is.strategy(tmp_strat) ) {

Modified: pkg/quantstrat/man/applyStrategy.Rd
===================================================================
--- pkg/quantstrat/man/applyStrategy.Rd	2013-10-26 23:09:00 UTC (rev 1552)
+++ pkg/quantstrat/man/applyStrategy.Rd	2013-10-27 17:33:00 UTC (rev 1553)
@@ -3,7 +3,7 @@
 \title{apply the strategy to arbitrary market data}
 \usage{
   applyStrategy(strategy, portfolios, mktdata = NULL,
-    parameters = NULL, ..., verbose = TRUE, symbols = NULL,
+    parameters = NULL, ..., debug = FALSE, symbols = NULL,
     initStrat = FALSE, updateStrat = FALSE)
 }
 \arguments{
@@ -22,7 +22,7 @@
 
   \item{...}{any other passthru parameters}
 
-  \item{verbose}{if TRUE, return output list}
+  \item{debug}{if TRUE, return output list}
 
   \item{symbols}{character vector identifying symbols to
   initialize a portfolio for, default NULL}



More information about the Blotter-commits mailing list