[Blotter-commits] r1745 - pkg/quantstrat/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Apr 3 16:50:15 CEST 2016
Author: bodanker
Date: 2016-04-03 16:50:14 +0200 (Sun, 03 Apr 2016)
New Revision: 1745
Modified:
pkg/quantstrat/R/indicators.R
pkg/quantstrat/R/initialize.R
pkg/quantstrat/R/rules.R
pkg/quantstrat/R/signals.R
pkg/quantstrat/R/wrapup.R
Log:
More robust function search (fixes #6310)
get() throws an error if it cannot find an object, and it's possible it
may find a non-function object in the search path before the function
with the same name.
Update all the places we search for functions by name by using the
following strategy:
Check if input argument is a function. If it is, set Fun object to
input argument. Othewise use exists() to see if a function of that name
can be found. If we can find a function, assign it to Fun using get().
Then use do.call() on Fun object to avoid another search. If we can't
find a function, write a message and stop processing.
Modified: pkg/quantstrat/R/indicators.R
===================================================================
--- pkg/quantstrat/R/indicators.R 2016-04-03 14:22:28 UTC (rev 1744)
+++ pkg/quantstrat/R/indicators.R 2016-04-03 14:50:14 UTC (rev 1745)
@@ -163,15 +163,24 @@
mktdata <- mktdata[, keep]
for (indicator in strategy$indicators){
- if(!is.function(get(indicator$name))){
- if(!is.function(get(paste("sig",indicator$name,sep='.')))){
- message(paste("Skipping indicator",indicator$name,"because there is no function by that name to call"))
- next()
+ if(is.function(indicator$name)) {
+ indFun <- indicator$name
+ } else {
+ if(exists(indicator$name, mode="function")) {
+ indFun <- get(indicator$name, mode="function")
} else {
- indicator$name<-paste("ind",indicator$name,sep='.')
+ ind.name <- paste("ind", indicator$name, sep=".")
+ if(exists(ind.name, mode="function")) {
+ indFun <- get(ind.name, mode="function")
+ indicator$name <- ind.name
+ } else {
+ message("Skipping indicator ", indicator$name,
+ " because there is no function by that name to call")
+ next
+ }
}
}
-
+
if(!isTRUE(indicator$enabled)) next()
# replace default function arguments with indicator$arguments
@@ -184,7 +193,7 @@
# remove ... to avoid matching multiple args
.formals$`...` <- NULL
- tmp_val <- do.call(indicator$name, .formals)
+ tmp_val <- do.call(indFun, .formals)
#add label
if(is.null(colnames(tmp_val)))
Modified: pkg/quantstrat/R/initialize.R
===================================================================
--- pkg/quantstrat/R/initialize.R 2016-04-03 14:22:28 UTC (rev 1744)
+++ pkg/quantstrat/R/initialize.R 2016-04-03 14:50:14 UTC (rev 1745)
@@ -97,11 +97,18 @@
# arbitrary user-defined initialization functions added to the initialization steps
# now do whatever 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(is.function(init_o$name)) {
+ init_oFun <- init_o$name
+ } else {
+ if(exists(init_o$name, mode="function")) {
+ init_oFun <- get(init_o$name, mode="function")
+ } else {
+ message("Skipping initialization function ", init_o$name,
+ " because there is no function by that name to call.")
+ next
+ }
}
-
+
if(!isTRUE(init_o$enabled)) next()
# replace default function arguments with init_o$arguments
@@ -114,7 +121,7 @@
# remove ... to avoid matching multiple args
.formals$`...` <- NULL
- do.call(init_o$name, .formals)
+ do.call(init_oFun, .formals)
}
}
@@ -193,15 +200,22 @@
## 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(is.function(init_s$name)) {
+ init_sFun <- init_s$name
+ } else {
+ if(exists(init_s$name, mode="function")) {
+ init_sFun <- get(init_s$name, mode="function")
+ } else {
+ message("Initialization function ", init_s$name, " not found. Skipping")
+ return()
+ }
}
if(!isTRUE(init_s$enabled)) next()
## (from initStrategy)
- ## replace default function arguments with init_o$arguments
+ ## replace default function arguments with init_s$arguments
.formals <- formals(init_s$name)
.formals <- modify.args(.formals, init_s$arguments, dots=TRUE)
## now add dots
@@ -209,7 +223,7 @@
## remove ... to avoid matching multiple args
.formals$`...` <- NULL
- do.call(init_s$name, .formals)
+ do.call(init_sFun, .formals)
}
Modified: pkg/quantstrat/R/rules.R
===================================================================
--- pkg/quantstrat/R/rules.R 2016-04-03 14:22:28 UTC (rev 1744)
+++ pkg/quantstrat/R/rules.R 2016-04-03 14:50:14 UTC (rev 1745)
@@ -87,15 +87,19 @@
if(is.na(charmatch(type,c("risk","order","rebalance","exit","enter","chain","pre","post")))) stop(paste("type:",type,' must be one of "risk", "order", "rebalance", "exit", "enter", "chain", "pre", or "post"'))
tmp_rule<-list()
if(!is.function(name) && isTRUE(storefun)) {
- if(!is.function(get(name))){
- if(!is.function(get(paste("rule",name,sep='.')))){
- message(paste("Skipping rule",name,"because there is no function by that name to call"))
- next()
+ if(exists(name, mode="function")) {
+ fn <- get(name, mode="function")
+ } else {
+ rule.name <- paste("rule", name, sep=".")
+ if(exists(rule.name, mode="function")) {
+ fn <- get(rule.name, mode="function")
+ name <- rule.name
} else {
- name<-paste("rule",rule$name,sep='.')
+ message("Skipping rule ", name,
+ " because there is no function by that name to call")
+ next
}
}
- fn<-match.fun(name)
} else {
fn <- name
}
@@ -653,17 +657,25 @@
for (rule in ruletypelist){
#TODO check to see if they've already been calculated
if (!rule$path.dep==path.dep) next()
- if(!is.function(rule$name)) {
- if(!is.function(get(rule$name))){
- if(!is.function(get(paste("rule",rule$name,sep='.')))){
- message(paste("Skipping rule",rule$name,"because there is no function by that name to call"))
- next()
+
+ if(is.function(rule$name)) {
+ ruleFun <- rule$name
+ } else {
+ if(exists(rule$name, mode="function")) {
+ ruleFun <- get(rule$name, mode="function")
+ } else {
+ rule.name <- paste("rule", rule$name, sep=".")
+ if(exists(rule.name, mode="function")) {
+ ruleFun <- get(rule.name, mode="function")
+ rule$name <- rule.name
} else {
- rule$name<-paste("rule",rule$name,sep='.')
+ message("Skipping rule ", rule$name,
+ " because there is no function by that name to call")
+ next
}
- }
+ }
}
-
+
if(!isTRUE(rule$enabled)) next()
# check to see if we should run in this timespan
@@ -696,7 +708,7 @@
if(!is.null(rule$arguments$prefer)) .formals$prefer = rule$arguments$prefer
# evaluate rule in applyRules' environment
- tmp_val <- do.call(rule$name, .formals, envir=parent.frame(1))
+ tmp_val <- do.call(ruleFun, .formals, envir=parent.frame(1))
# print(paste('tmp_val ==', tmp_val))
} #end rules loop
Modified: pkg/quantstrat/R/signals.R
===================================================================
--- pkg/quantstrat/R/signals.R 2016-04-03 14:22:28 UTC (rev 1744)
+++ pkg/quantstrat/R/signals.R 2016-04-03 14:50:14 UTC (rev 1745)
@@ -93,16 +93,25 @@
for (signal in strategy$signals){
#TODO check to see if they've already been calculated
-
- if(!is.function(get(signal$name))){
- if(!is.function(get(paste("sig",signal$name,sep='.')))){
- message(paste("Skipping signal",signal$name,"because there is no function by that name to call"))
- next()
+
+ if(is.function(signal$name)) {
+ sigFun <- signal$name
+ } else {
+ if(exists(signal$name, mode="function")) {
+ sigFun <- get(signal$name, mode="function")
} else {
- signal$name<-paste("sig",signal$name,sep='.')
+ sig.name <- paste("sig", signal$name, sep=".")
+ if(exists(sig.name, mode="function")) {
+ sigFun <- get(sig.name, mode="function")
+ signal$name <- sig.name
+ } else {
+ message("Skipping signal ", signal$name,
+ " because there is no function by that name to call")
+ next
+ }
}
}
-
+
if(!isTRUE(signal$enabled)) next()
# replace default function arguments with signal$arguments
@@ -115,7 +124,7 @@
# remove ... to avoid matching multiple args
.formals$`...` <- NULL
- tmp_val <- do.call(signal$name, .formals)
+ tmp_val <- do.call(sigFun, .formals)
#add label
if(is.null(colnames(tmp_val)))
Modified: pkg/quantstrat/R/wrapup.R
===================================================================
--- pkg/quantstrat/R/wrapup.R 2016-04-03 14:22:28 UTC (rev 1744)
+++ pkg/quantstrat/R/wrapup.R 2016-04-03 14:50:14 UTC (rev 1745)
@@ -102,9 +102,16 @@
#first do whatever the user stuck in this wrapup slot...
if(length(strategy$wrapup)>0){
for (wrapup_o in strategy$wrapup){
- if(!is.function(get(wrapup_o$name))){
- message(paste("Skipping wrapup",wrapup_o$name,"because there is no function by that name to call"))
- next()
+ if(is.function(wrapup_o$name)) {
+ wrapup_oFun <- wrapup_o$name
+ } else {
+ if(exists(wrapup_o$name, mode="function")) {
+ wrapup_oFun <- get(wrapup_o$name, mode="function")
+ } else {
+ message("Skipping wrapup function ", wrapup_o$name,
+ " because there is no function by that name to call.")
+ next
+ }
}
if(!isTRUE(wrapup_o$enabled)) next()
@@ -119,7 +126,7 @@
# remove ... to avoid matching multiple args
.formals$`...` <- NULL
- out[[wrapup_o$name]] <- do.call(wrapup_o$name, .formals)
+ out[[wrapup_o$name]] <- do.call(wrapup_oFun, .formals)
}
}
More information about the Blotter-commits
mailing list