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

[noreply at r-forge.r-project.org]

Author: braverock
Date: 2011-09-25 19:18:03 +0200 (Sun, 25 Sep 2011)
New Revision: 788

Modified:
   pkg/quantstrat/R/initialize.R
   pkg/quantstrat/R/strategy.R
Log:
- add core of initStrategy functionality based on Garrett's function in sandbox

Modified: pkg/quantstrat/R/initialize.R
===================================================================
--- pkg/quantstrat/R/initialize.R	2011-09-25 00:39:29 UTC (rev 787)
+++ pkg/quantstrat/R/initialize.R	2011-09-25 17:18:03 UTC (rev 788)
@@ -4,14 +4,76 @@
 #
 ###############################################################################
 
-initStrategy <- function(strategy=NULL, portfolio=NULL, symbols=NULL, getSymbols=TRUE, initPortf=TRUE, initAcct=TRUE, initOrders=TRUE, unique=TRUE) {
+#' @author Garrett See, Brian Peterson
+initStrategy <- function(strategy, portfolio, symbols, get.Symbols=TRUE, 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
-    
+    #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
+        for (sym in symbols) {
+            if(!is.instrument(getInstrument(sym,silent=TRUE))) {
+                instrument.auto(sym, currency=currency)
+            }   
+            tmp <- try(get(sym,pos=env),silent=TRUE)
+            #test for is.xts here?
+            if (inherits(tmp, 'try-error')) getsyms <- c(getsyms, sym)
+        }
+        if (!is.null(getsyms)) getSymbols(getsyms,from=initDate) #get the data that didn't exist in env
+    }
+    if(isTRUE(init.Portf)){
+        initPortf(name=portfolio, symbols=symbols, currency=currency, ...=...)
+    }
+    if(isTRUE(init.Acct)){
+        if(hasArg(account)) account<-account else account<-portfolio
+        initAcct(name=account, portfolios=portfolio, currency=currency, ...=...)
+    }
+    if(isTRUE(init.Orders)){
+        initOrders(portfolio=portfolio, symbols=symbols, ...=...)
+    }
+
     # additionally, we should put an initialization slot in the strategy and have 
     # an add.init function (like add.indicator, etc) that could have 
     # arbitrary user-defined initialization functions added to the initialization steps
     
+    #now do whatrever else the user stuck in this init slot...
+    for (init_o in strategy$init){
+        if(!is.function(get(init_o$name))){
+            message(paste("Skipping initialization function",init_o$name,"because there is no function by that name to call"))
+            next()      
+        }
+        
+        if(!isTRUE(init_o$enabled)) next()
+        
+        # see 'S Programming p. 67 for this matching
+        fun<-match.fun(init_o$name)
+        
+        .formals  <- formals(fun)
+        onames <- names(.formals)
+        
+        pm <- pmatch(names(init_o$arguments), onames, nomatch = 0L)
+        #if (any(pm == 0L))
+        #    warning(paste("some arguments stored for",init_o$name,"do not match"))
+        names(init_o$arguments[pm > 0L]) <- onames[pm]
+        .formals[pm] <- init_o$arguments[pm > 0L]       
+        
+        # now add arguments from parameters
+        if(length(parameters)){
+            pm <- pmatch(names(parameters), onames, nomatch = 0L)
+            names(parameters[pm > 0L]) <- onames[pm]
+            .formals[pm] <- parameters[pm > 0L]
+        }
+        
+        #now add dots
+        if (length(nargs)) {
+            pm <- pmatch(names(nargs), onames, nomatch = 0L)
+            names(nargs[pm > 0L]) <- onames[pm]
+            .formals[pm] <- nargs[pm > 0L]
+        }
+        .formals$... <- NULL
+        
+        do.call(fun,.formals)
+    }            
 }
 
 add.init <- function(strategy, name, arguments, parameters=NULL, label=NULL, ..., enabled=TRUE, indexnum=NULL, store=FALSE) {

Modified: pkg/quantstrat/R/strategy.R
===================================================================
--- pkg/quantstrat/R/strategy.R	2011-09-25 00:39:29 UTC (rev 787)
+++ pkg/quantstrat/R/strategy.R	2011-09-25 17:18:03 UTC (rev 788)
@@ -6,7 +6,7 @@
 #' @param store TRUE/FALSE whether to store the strategy in the .strategy environment, or return it.  default FALSE
 #' @export
 strategy <- function(name, ..., assets=NULL, constraints=NULL ,store=FALSE)
-{ # modeled on GPL R-Forge pkg roi by Stefan Thuessel,Kurt Hornik,David Meyer
+{ # originally modeled on framework code in GPL R-Forge pkg roi by Stefan Thuessel,Kurt Hornik,David Meyer
     
     if(!is.null(assets)){
         if(is.numeric(assets)){
@@ -68,8 +68,9 @@
 #' @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
 #' @export
-applyStrategy <- function(strategy , portfolios, mktdata=NULL , parameters=NULL, ..., verbose=TRUE ) {
+applyStrategy <- function(strategy , portfolios, mktdata=NULL , parameters=NULL, ..., verbose=TRUE, symbols=NULL ) {
     #TODO add Date subsetting
     #TODO add saving of modified market data
     
@@ -83,10 +84,11 @@
 	
 	
     for (portfolio in portfolios) {
-		
-		# TODO FIXME evaluate parameter table here, add outer loop
-		
-		ret[[portfolio]]<-list() # this is slot [[i]] which we will use later
+        
+		# TODO call to initStrategy will go here!
+        # initStrategy(strategy, portfolio, symbols, ...=...)
+        
+   		ret[[portfolio]]<-list() # this is slot [[i]] which we will use later
         pobj<-getPortfolio(portfolio)
         symbols<-names(pobj$symbols)
         sret<-list()