[Blotter-commits] r1524 - pkg/quantstrat/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Oct 11 21:43:26 CEST 2013
Author: bodanker
Date: 2013-10-11 21:43:26 +0200 (Fri, 11 Oct 2013)
New Revision: 1524
Modified:
pkg/quantstrat/R/indicators.R
pkg/quantstrat/R/initialize.R
pkg/quantstrat/R/rules.R
pkg/quantstrat/R/signals.R
pkg/quantstrat/R/utils.R
pkg/quantstrat/R/wrapup.R
Log:
- Condense argument matching into a single function
Modified: pkg/quantstrat/R/indicators.R
===================================================================
--- pkg/quantstrat/R/indicators.R 2013-10-09 20:07:02 UTC (rev 1523)
+++ pkg/quantstrat/R/indicators.R 2013-10-11 19:43:26 UTC (rev 1524)
@@ -148,12 +148,6 @@
stop ("You must supply an object of type 'strategy'.")
}
ret <- NULL
- nargs <-list(...)
- if(length(nargs)==0) nargs=NULL
- if (length('...')==0 | is.null('...')) {
- #rm('...')
- nargs=NULL
- }
# First, delete any colums in mktdata that correspond to indicators we're about
# to (re)calculate and cbind.
@@ -165,14 +159,6 @@
for (indicator in strategy$indicators){
if(!is.function(get(indicator$name))){
if(!is.function(get(paste("sig",indicator$name,sep='.')))){
- # 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]
- }
-
-
message(paste("Skipping indicator",indicator$name,"because there is no function by that name to call"))
next()
} else {
@@ -182,36 +168,16 @@
if(!isTRUE(indicator$enabled)) next()
- # see 'S Programming p. 67 for this matching
- fun<-match.fun(indicator$name)
- .formals <- formals(fun)
- onames <- names(.formals)
+ # replace default function arguments with indicator$arguments
+ .formals <- formals(indicator$name)
+ .formals <- modify.args(.formals, indicator$arguments, dots=TRUE)
+ # now add arguments from parameters
+ .formals <- modify.args(.formals, parameters)
+ # now add dots
+ .formals <- modify.args(.formals, list(...))
- pm <- pmatch(names(indicator$arguments), onames, nomatch = 0L)
- names(indicator$arguments[pm > 0L]) <- onames[pm]
- .formals[pm] <- indicator$arguments[pm > 0L]
- if (any(pm == 0L)){
- warning(paste("some arguments stored for",indicator$name,"do not match"))
- .formals<-c(.formals,indicator$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]
- }
+ tmp_val <- do.call(indicator$name, .formals)
- #now add arguments from dots
- if (length(nargs)) {
- pm <- pmatch(names(nargs), onames, nomatch = 0L)
- names(nargs[pm > 0L]) <- onames[pm]
- .formals[pm] <- nargs[pm > 0L]
- }
- .formals$... <- NULL
-
- tmp_val<-do.call(fun,.formals)
-
#add label
if(is.null(colnames(tmp_val)))
colnames(tmp_val) <- seq(ncol(tmp_val))
Modified: pkg/quantstrat/R/initialize.R
===================================================================
--- pkg/quantstrat/R/initialize.R 2013-10-09 20:07:02 UTC (rev 1523)
+++ pkg/quantstrat/R/initialize.R 2013-10-11 19:43:26 UTC (rev 1524)
@@ -94,36 +94,16 @@
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]
-
+ # replace default function arguments with init_o$arguments
+ .formals <- formals(init_o$name)
+ .formals <- modify.args(.formals, init_o$arguments, dots=TRUE)
# 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]
- }
+ .formals <- modify.args(.formals, parameters)
+ # now add dots
+ .formals <- modify.args(.formals, list(...))
- #now add dots
- dargs<-list(...)
- if (length(dargs)) {
- pm <- pmatch(names(dargs), onames, nomatch = 0L)
- names(dargs[pm > 0L]) <- onames[pm]
- .formals[pm] <- dargs[pm > 0L]
- }
- .formals$... <- NULL
-
- do.call(fun,.formals)
- }
+ do.call(init_o$name, .formals)
+ }
}
#' add arbitrary initialization functions to a strategy
Modified: pkg/quantstrat/R/rules.R
===================================================================
--- pkg/quantstrat/R/rules.R 2013-10-09 20:07:02 UTC (rev 1523)
+++ pkg/quantstrat/R/rules.R 2013-10-11 19:43:26 UTC (rev 1524)
@@ -281,12 +281,6 @@
stop ("You must supply an object of type 'strategy'.")
}
ret <- NULL
- nargs <-list(...)
- if(length(nargs)==0) nargs=NULL
- if (length('...')==0 | is.null('...')) {
- rm('...')
- nargs=NULL
- }
Dates=unique(index(mktdata))
@@ -691,47 +685,23 @@
# check to see if we should run in this timespan
if(!is.null(rule$timespan) && nrow(mktdata[timestamp][rule$timespan])==0) next()
- # see 'S Programming' p. 67 for this matching
- if(is.function(rule$name)) fun <- rule$name
- else fun<-match.fun(rule$name)
-
- nargs <-list(...)
- if(length(nargs)==0) nargs=NULL
- if (length('...')==0 | is.null('...')) {
- rm('...')
- nargs=NULL
- }
-
- .formals <- formals(fun)
-
- onames <- names(.formals)
+ # modify a few things
rule$arguments$timestamp = timestamp
rule$arguments$ruletype = ruletype
rule$arguments$label = rule$label
- pm <- pmatch(names(rule$arguments), onames, nomatch = 0L)
- # if (any(pm == 0L)) message(paste("some arguments stored for",rule$name,"do not match"))
- names(rule$arguments[pm > 0L]) <- onames[pm]
- .formals[pm] <- rule$arguments[pm > 0L]
-
+
+ # replace default function arguments with rule$arguments
+ .formals <- formals(rule$name)
+ .formals <- modify.args(.formals, rule$arguments, dots=TRUE)
# 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]
- }
+ .formals <- modify.args(.formals, parameters)
+ # now add dots
+ .formals <- modify.args(.formals, list(...))
- #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
-
# any rule-specific prefer-parameters should override global prefer parameter
if(!is.null(rule$arguments$prefer)) .formals$prefer = rule$arguments$prefer
- tmp_val<-do.call(fun,.formals)
+ tmp_val <- do.call(rule$name, .formals)
# print(paste('tmp_val ==', tmp_val))
} #end rules loop
Modified: pkg/quantstrat/R/signals.R
===================================================================
--- pkg/quantstrat/R/signals.R 2013-10-09 20:07:02 UTC (rev 1523)
+++ pkg/quantstrat/R/signals.R 2013-10-11 19:43:26 UTC (rev 1524)
@@ -84,12 +84,6 @@
stop ("You must supply an object of type 'strategy'.")
}
ret <- NULL
- nargs <-list(...)
- if(length(nargs)==0) nargs=NULL
- if (length('...')==0 | is.null('...')) {
- rm('...')
- nargs=NULL
- }
for (signal in strategy$signals){
#TODO check to see if they've already been calculated
@@ -105,35 +99,16 @@
if(!isTRUE(signal$enabled)) next()
- # see 'S Programming p. 67 for this matching
- fun<-match.fun(signal$name)
+ # replace default function arguments with signal$arguments
+ .formals <- formals(signal$name)
+ .formals <- modify.args(.formals, signal$arguments, dots=TRUE)
+ # now add arguments from parameters
+ .formals <- modify.args(.formals, parameters)
+ # now add dots
+ .formals <- modify.args(.formals, list(...))
- .formals <- formals(fun)
- onames <- names(.formals)
-
- pm <- pmatch(names(signal$arguments), onames, nomatch = 0L)
- #if (any(pm == 0L))
- # warning(paste("some arguments stored for",signal$name,"do not match"))
- names(signal$arguments[pm > 0L]) <- onames[pm]
- .formals[pm] <- signal$arguments[pm > 0L]
+ tmp_val <- do.call(signal$name, .formals)
- # 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
-
- tmp_val<-do.call(fun,.formals)
-
#add label
if(is.null(colnames(tmp_val)))
colnames(tmp_val) <- seq(ncol(tmp_val))
Modified: pkg/quantstrat/R/utils.R
===================================================================
--- pkg/quantstrat/R/utils.R 2013-10-09 20:07:02 UTC (rev 1523)
+++ pkg/quantstrat/R/utils.R 2013-10-11 19:43:26 UTC (rev 1524)
@@ -52,3 +52,47 @@
}
}
+modify.args <- function(formals, arglist, dots=FALSE)
+{
+ # see 'S Programming' p. 67 for this matching
+
+ # nothing to do if arglist is empty; return formals
+ if(!length(arglist))
+ return(formals)
+
+ argnames <- names(arglist)
+ if(!is.list(arglist) && !is.null(argnames) && !any(argnames == ""))
+ stop("'arglist' must be a *named* list, with no names == \"\"")
+
+ .formals <- formals
+ onames <- names(.formals)
+
+ pm <- pmatch(argnames, onames, nomatch = 0L)
+ #if(any(pm == 0L))
+ # message(paste("some arguments stored for", fun, "do not match"))
+ names(arglist[pm > 0L]) <- onames[pm]
+ .formals[pm] <- arglist[pm > 0L]
+
+ # include all elements from arglist if function formals contain '...'
+ if(dots && !is.null(.formals$...)) {
+ dotnames <- names(arglist[pm == 0L])
+ .formals[dotnames] <- arglist[dotnames]
+ .formals$... <- NULL
+ }
+
+ .formals
+}
+
+###############################################################################
+# R (http://r-project.org/) Quantitative Strategy Model Framework
+#
+# Copyright (c) 2009-2012
+# Peter Carl, Dirk Eddelbuettel, Brian G. Peterson,
+# Jeffrey Ryan, Joshua Ulrich, and Garrett See
+#
+# This library is distributed under the terms of the GNU Public License (GPL)
+# for full details see the file COPYING
+#
+# $Id: rules.R 1452 2013-05-04 22:39:39Z opentrades $
+#
+###############################################################################
Modified: pkg/quantstrat/R/wrapup.R
===================================================================
--- pkg/quantstrat/R/wrapup.R 2013-10-09 20:07:02 UTC (rev 1523)
+++ pkg/quantstrat/R/wrapup.R 2013-10-11 19:43:26 UTC (rev 1524)
@@ -109,35 +109,15 @@
if(!isTRUE(wrapup_o$enabled)) next()
- # see 'S Programming p. 67 for this matching
- fun<-match.fun(wrapup_o$name)
-
- .formals <- formals(fun)
- onames <- names(.formals)
-
- pm <- pmatch(names(wrapup_o$arguments), onames, nomatch = 0L)
- #if (any(pm == 0L))
- # warning(paste("some arguments stored for",wrapup_o$name,"do not match"))
- names(wrapup_o$arguments[pm > 0L]) <- onames[pm]
- .formals[pm] <- wrapup_o$arguments[pm > 0L]
-
+ # replace default function arguments wrapup_o$arguments
+ .formals <- formals(wrapup_o$name)
+ .formals <- modify.args(.formals, wrapup_o$arguments, dots=TRUE)
# 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]
- }
+ .formals <- modify.args(.formals, parameters)
+ # now add dots
+ .formals <- modify.args(.formals, list(...))
- #now add dots
- dargs<-list(...)
- if (length(dargs)) {
- pm <- pmatch(names(dargs), onames, nomatch = 0L)
- names(dargs[pm > 0L]) <- onames[pm]
- .formals[pm] <- dargs[pm > 0L]
- }
- .formals$... <- NULL
-
- out[[wrapup_o$name]]<-do.call(fun,.formals)
+ out[[wrapup_o$name]] <- do.call(wrapup_o$name, .formals)
}
}
More information about the Blotter-commits
mailing list