[Blotter-commits] r1615 - pkg/quantstrat/R

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Mon Jun 23 19:39:27 CEST 2014


Author: signori
Date: 2014-06-23 19:39:27 +0200 (Mon, 23 Jun 2014)
New Revision: 1615

Modified:
   pkg/quantstrat/R/initialize.R
   pkg/quantstrat/R/strategy.R
Log:
Added initBySymbol switch in applyStrategy to handle arbitrary initialization code for each symbol within the Symbols loop

Modified: pkg/quantstrat/R/initialize.R
===================================================================
--- pkg/quantstrat/R/initialize.R	2014-06-04 14:40:03 UTC (rev 1614)
+++ pkg/quantstrat/R/initialize.R	2014-06-23 17:39:27 UTC (rev 1615)
@@ -10,7 +10,7 @@
 #' beginning of an \code{\link{applyStrategy}} call.
 #' 
 #' \describe{
-#'      \item{get.Symbols}{if TRUE, will call \code{\link[quantmod]{getSymbols}} 
+#'      \item{get.Symbols}{if FALSE, will call \code{\link[quantmod]{getSymbols}} 
 #'                          on all symbols included in the \code{symbols} vector}
 #'      \item{init.Portf}{if TRUE, will call \code{\link[blotter]{initPortf}} 
 #'                          to initialize the portfolio object}
@@ -22,11 +22,13 @@
 #'                          if the portfolio, account, or order book already exist}
 #' }
 #'
+#' If used in conjuction with \code{initBySymbol}, \code{get.Symbols} should be \code{FALSE}.
+#' 
 #' @param strategy object of type \code{strategy} to initialize data/containers for
 #' @param portfolio portfolio
 #' @param symbols symbols
 #' @param parameters named list of parameters to be applied during evaluation of the strategy, default NULL
-#' @param get.Symbols TRUE/FALSE, default TRUE
+#' @param get.Symbols TRUE/FALSE, default FALSE
 #' @param init.Portf TRUE/FALSE, default TRUE 
 #' @param init.Acct TRUE/FALSE, default TRUE 
 #' @param init.Orders TRUE/FALSE, default TRUE 
@@ -35,7 +37,16 @@
 #' @author Garrett See, Brian Peterson
 #' @export
 #' @seealso \code{\link{applyStrategy}}, \code{\link{add.init}},  
-initStrategy <- function(strategy, portfolio, symbols, parameters=NULL, get.Symbols=TRUE, init.Portf=TRUE, init.Acct=TRUE, init.Orders=TRUE, unique=TRUE,...) {
+initStrategy <- function(strategy,
+                         portfolio,
+                         symbols,
+                         parameters   = NULL,
+                         get.Symbols  = FALSE,
+                         init.Portf   = TRUE,
+                         init.Acct    = TRUE,
+                         init.Orders  = TRUE,
+                         unique       = TRUE,
+                         ...) {
     # basic idea is to do all the common set-up stuff
     # create portfolio, account, orderbook
 
@@ -51,8 +62,7 @@
         if(!is.null(strategy$currency)) currency <- strategy$currency
         else currency<-'USD'
     } 
-    
-    
+        
     #if any 'symbols' are not defined as instruments, we'll make a basic instrument
     if(isTRUE(get.Symbols)){
         getsyms <- NULL #symbols that aren't in .GlobalEnv that we'll have to get
@@ -160,6 +170,50 @@
     else return(strategy)
 }
 
+#' Run standard and custom symbol initialization functions
+#'
+#' \code{initSymbol} will load a symbol and run user-defined functions to pre-process the symbol's data
+#' before constructing indicators.
+#'
+#' The custom initialization must be defined as named list containing
+#' \describe{
+#'   \item{name}{function name}
+#'   \item{argument}{list of arguments}
+#'   \item{enabled}{TRUE or FALSE}
+#' }
+#' and included as the slot \code{init_symbol} of the strategy object. 
+#' 
+#' @param strategy an object (or the name of an object) of type 'strategy' to add the init function definition to
+#' @param symbol   symbol
+#' @param ...      
+
+#' @export
+initSymbol <- function(strategy, symbol, ...){
+    getSymbols(symbol, env = .GlobalEnv)
+
+    ## run user-defined initialization function contained in the strategy slot init_symbol
+    init_s <- strategy$init_symbol
+    if(!is.function(get(init_s$name))){
+        message(paste("Iniziatialization function", init_s$name, "not found. Skipping"))
+        return()
+    }
+
+    if(!isTRUE(init_s$enabled)) next()
+
+    ## (from initStrategy)
+    ## replace default function arguments with init_o$arguments
+    .formals <- formals(init_s$name)
+    .formals <- modify.args(.formals, init_s$arguments, dots=TRUE)
+    ## now add dots
+    .formals <- modify.args(.formals, NULL, ..., dots=TRUE)
+    ## remove ... to avoid matching multiple args
+    .formals$`...` <- NULL
+    
+    do.call(init_s$name, .formals)
+}
+
+
+
 ###############################################################################
 # R (http://r-project.org/) Quantitative Strategy Model Framework
 #
@@ -169,6 +223,6 @@
 # This library is distributed under the terms of the GNU Public License (GPL)
 # for full details see the file COPYING
 #
-# $Id$
+# $Id: initialize.R 1561 2013-11-01 15:51:45Z bodanker $
 #
 ###############################################################################

Modified: pkg/quantstrat/R/strategy.R
===================================================================
--- pkg/quantstrat/R/strategy.R	2014-06-04 14:40:03 UTC (rev 1614)
+++ pkg/quantstrat/R/strategy.R	2014-06-23 17:39:27 UTC (rev 1615)
@@ -96,37 +96,42 @@
 #' @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
+#' @param initBySymbol whether to load and initialize each instrument within the \code{Symbols} loop. See \code{\link{initSymbol}} for details on how
+#'                     to run a custom function. Moreover, if the argument \code{Interval} is available (as passthrough to \code{updatePortf} via \code{updateStrat}),
+#'                     each instrument is downsampled to the frequency specified by \code{Interval} for the purpose of marking the Portfolio.
+#'                     Notice that this happenes only after the strategy has been applied.
 #' @param gc if TRUE, call \code{\link{gc}} after each symbol run, default FALSE (experimental)
 #' @param delorders if TRUE, delete the order book for a symbol at the end of the symbols loop, will cause issues with rebalancing, default FALSE (experimental)
 #' @export
 #' @seealso \code{\link{strategy}},  \code{\link{applyIndicators}}, 
 #'  \code{\link{applySignals}}, \code{\link{applyRules}},
 #'  \code{\link{initStrategy}}, 
-applyStrategy <- function(strategy , 
+applyStrategy <- function(strategy, 
                           portfolios, 
-                          mktdata=NULL , 
+                          mktdata=NULL, 
                           parameters=NULL, 
                           ..., 
                           debug=FALSE, 
                           symbols=NULL, 
                           initStrat=FALSE, 
                           updateStrat=FALSE,
+                          initBySymbol=FALSE,
                           gc=FALSE,
                           delorders=FALSE) {
 
   #TODO add saving of modified market data
   
-  if(isTRUE(debug)) ret<-list()
+    if(isTRUE(debug)) 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 (!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
+    if (missing(mktdata) || is.null(mktdata)) load.mktdata=TRUE else load.mktdata=FALSE
      
-     for (portfolio in portfolios) {
+    for (portfolio in portfolios) {
        
        # call initStrategy
        if(isTRUE(initStrat)) initStrategy(strategy=strategy, portfolio, symbols, ...=...)
@@ -137,10 +142,13 @@
        sret<-new.env(hash=TRUE)
        
        for (symbol in symbols){
-         if(isTRUE(load.mktdata)) mktdata <- get(symbol)
+         if(isTRUE(load.mktdata)){
+             if(isTRUE(initBySymbol)) initSymbol(strategy, symbol, ... = ...)
+             mktdata <- get(symbol)
+         }
          
          # loop over indicators
-         sret$indicators <- applyIndicators(strategy=strategy , mktdata=mktdata , parameters=parameters, ... )
+         sret$indicators <- applyIndicators(strategy=strategy, mktdata=mktdata , parameters=parameters, ... )
          
          if(inherits(sret$indicators,"xts") & nrow(mktdata)==nrow(sret$indicators)){
            mktdata<-sret$indicators
@@ -157,8 +165,8 @@
          
          #loop over rules  
          sret$rules<-list()
-         
-         # only fire nonpath/pathdep when true 
+             
+         # only fire nonpath/pathdep when true
          # TODO make this more elegant
          pd <- FALSE
          for(i in 1:length(strategy$rules)){  
@@ -192,6 +200,25 @@
                                                      path.dep=TRUE,
                                                      debug=debug)}
          
+         if(isTRUE(initBySymbol)) {
+             if(hasArg(Interval)){
+                 Interval <- match.call(expand.dots=TRUE)$Interval
+                 if(!is.null(Interval)){
+                     temp.symbol <- get(symbol) 
+                     ep_args     <- blotter:::.parse_interval(Interval)
+                     temp.symbol <- temp.symbol[endpoints(temp.symbol, on = ep_args$on, k = ep_args$k)]
+                     if(hasArg(prefer)){
+                         prefer      <- match.call(expand.dots=TRUE)$prefer
+                         temp.symbol <- getPrice(temp.symbol, prefer=prefer)[,1]
+                     }
+                     assign(symbol, temp.symbol, envir = .GlobalEnv)
+                 }
+             } else {
+                 rm(list = symbol)
+                 gc()
+             }
+         }
+             
          if(isTRUE(debug)) ret[[portfolio]][[symbol]]<-sret
          
          if(isTRUE(delorders)) .strategy[[paste("order_book",portfolio,sep='.')]][[symbol]]<-NULL #WARNING: This is VERY DESTRUCTIVE  
@@ -279,6 +306,6 @@
 # This library is distributed under the terms of the GNU Public License (GPL)
 # for full details see the file COPYING
 #
-# $Id$
+# $Id: strategy.R 1594 2014-03-29 20:39:45Z braverock $
 #
 ###############################################################################



More information about the Blotter-commits mailing list