[Blotter-commits] r1148 - pkg/quantstrat/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sun Sep 2 17:45:44 CEST 2012
Author: braverock
Date: 2012-09-02 17:45:44 +0200 (Sun, 02 Sep 2012)
New Revision: 1148
Modified:
pkg/quantstrat/R/initialize.R
pkg/quantstrat/R/signals.R
pkg/quantstrat/R/wrapup.R
Log:
- minor updates to init and wrapup
- fix typo
Modified: pkg/quantstrat/R/initialize.R
===================================================================
--- pkg/quantstrat/R/initialize.R 2012-08-30 23:19:27 UTC (rev 1147)
+++ pkg/quantstrat/R/initialize.R 2012-09-02 15:45:44 UTC (rev 1148)
@@ -5,20 +5,54 @@
###############################################################################
#' run standard and custom strategy initialization functions
+#'
+#' \code{initStrategy} will run a series of common initialization functions at the
+#' beginning of an \code{\link{applyStrategy}} call.
+#'
+#' \describe{
+#' \item{get.Symbols}{if TRUE, 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}
+#' \item{init.Acct}{if TRUE, will call \code{\link[blotter]{initAccount}}
+#' to initialize the account object}
+#' \item{init.Orders}{if TRUE, will call \code{\link{initOrders}}
+#' to initialize the order book for this test}
+#' \item{unique}{not yet implemented, will force a unique portfolio and account name
+#' if the portfolio, account, or order book already exist}
+#' }
+#'
#' @param strategy object of type \code{strategy} to initialize data/containers for
#' @param portfolio portfolio
#' @param symbols symbols
-#' @param get.Symbols TRUE/FALSE, default TRUE:
-#' @param init.Portf TRUE/FALSE, default TRUE:
-#' @param init.Acct TRUE/FALSE, default TRUE:
-#' @param init.Orders TRUE/FALSE, default TRUE:
-#' @param unique TRUE/FALSE, default TRUE:
-#' @param \dots any other passtrhrough parameters
+#' @param parameters named list of parameters to be applied during evaluation of the strategy, default NULL
+#' @param get.Symbols TRUE/FALSE, default TRUE
+#' @param init.Portf TRUE/FALSE, default TRUE
+#' @param init.Acct TRUE/FALSE, default TRUE
+#' @param init.Orders TRUE/FALSE, default TRUE
+#' @param unique TRUE/FALSE, default TRUE
+#' @param \dots any other passthrough parameters
#' @author Garrett See, Brian Peterson
#' @export
-initStrategy <- function(strategy, portfolio, symbols, get.Symbols=TRUE, init.Portf=TRUE, init.Acct=TRUE, init.Orders=TRUE, unique=TRUE,...) {
+#' @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,...) {
# basic idea is to do all the common set-up stuff
# create portfolio, account, orderbook
+
+ if (!is.strategy(strategy)) {
+ strategy<-try(getStrategy(strategy))
+ if(inherits(strategy,"try-error"))
+ stop ("You must supply an object or the name of an object of type 'strategy'.")
+ store=TRUE
+ }
+
+ #set default values that will break the intialization
+ if(!hasArg(currency)){
+ 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
@@ -30,24 +64,28 @@
#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 (!is.null(getsyms)) getSymbols(getsyms,from=initDate, ...=...) #get the data that didn't exist in env
}
- if(isTRUE(init.Portf)){
+
+ if(isTRUE(init.Portf) & !isTRUE(is.portfolio(portfolio))){
+ if(hasArg(portfolio)) portfolio<-portfolio else portfolio<-strategy$name
+
+ #TODO FIXME implment unique here
+
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(is.account(account))) 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...
+ # 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"))
@@ -76,10 +114,11 @@
}
#now add dots
- if (length(nargs)) {
- pm <- pmatch(names(nargs), onames, nomatch = 0L)
- names(nargs[pm > 0L]) <- onames[pm]
- .formals[pm] <- nargs[pm > 0L]
+ 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
@@ -113,7 +152,12 @@
#' @return if \code{strategy} was the name of a strategy, the name. It it was a strategy, the updated strategy.
#' @export
add.init <- function(strategy, name, arguments, parameters=NULL, label=NULL, ..., enabled=TRUE, indexnum=NULL, store=FALSE) {
- if(!is.strategy(strategy)) stop("You must pass in a strategy object to manipulate")
+ if (!is.strategy(strategy)) {
+ strategy<-try(getStrategy(strategy))
+ if(inherits(strategy,"try-error"))
+ stop ("You must supply an object or the name of an object of type 'strategy'.")
+ store=TRUE
+ }
tmp_init<-list()
tmp_init$name<-name
if(is.null(label)) label = paste(name,"ind",sep='.')
Modified: pkg/quantstrat/R/signals.R
===================================================================
--- pkg/quantstrat/R/signals.R 2012-08-30 23:19:27 UTC (rev 1147)
+++ pkg/quantstrat/R/signals.R 2012-09-02 15:45:44 UTC (rev 1148)
@@ -299,7 +299,7 @@
#' generate a signal from a formula
#'
-#' This code takes advantage of some base R functionality that can treat an R object (in this case the internal mktdata object in quantstrat) as an enfironment or 'frame' using \code{\link{parent.frame}}.
+#' This code takes advantage of some base R functionality that can treat an R object (in this case the internal mktdata object in quantstrat) as an environment or 'frame' using \code{\link{parent.frame}}.
#' This allows the columns of the data to be addressed without any major manipulation, simply by column name. In most cases in quantstrat, this will be either the price/return columns, or columns added by indicators or prior signals.
#' The formula will return TRUE/FALSE for each row comparison as a time series column which can then be used for rule execution. The \code{formula} will be evaluated using \code{\link{eval}} as though in an if statement.
#'
Modified: pkg/quantstrat/R/wrapup.R
===================================================================
--- pkg/quantstrat/R/wrapup.R 2012-08-30 23:19:27 UTC (rev 1147)
+++ pkg/quantstrat/R/wrapup.R 2012-09-02 15:45:44 UTC (rev 1148)
@@ -45,9 +45,24 @@
#' rather than tick. A custom wrapup function could take your high frequency
#' data and transform it to lower frequency data before the call to \code{\link{updatePortf}}.
#'
+#' The 'standard wrapup functions included are:
+#' \describe{
+#' \item{update.Portf}{ if TRUE, will call \code{\link[blotter]{updatePortf}}
+#' to mark the book in the portfolio.
+#' }
+#' \item{update.Acct}{ if TRUE, will call \code{\link[blotter]{updateAcct}}
+#' to mark the blotter account for this test.
+#' }
+#' \item{update.EndEq}{ if TRUE, will call \code{\link[blotter]{updateEndEq}}
+#' to update the account equity after all other accounting has been completed.
+#' }
+#' }
+#'
+#' @param strategy object of type \code{strategy} to initialize data/containers for
#' @param portfolio string identifying a portfolio
#' @param account string identifying an account. Same as \code{portfolio} by default
#' @param Symbols character vector of names of symbols whose portfolios will be updated
+#' @param parameters named list of parameters to be applied during evaluation of the strategy, default NULL
#' @param Dates optional xts-style ISO-8601 time range to run updatePortf over, default NULL (will use times from Prices)
#' @param Prices optional xts object containing prices and timestamps to mark the book on, default NULL
#' @param update.Portf TRUE/FALSE if TRUE (default) a call will be made to \code{updatePortf}
@@ -60,9 +75,11 @@
#' @author Garrett See, Brian Peterson
#' @export
updateStrategy <-
-function(portfolio='default',
+function(strategy,
+ portfolio='default',
account=portfolio,
- Symbols=NULL,
+ Symbols=NULL,
+ parameters=NULL,
Dates=NULL,
Prices=NULL,
update.Portf=TRUE,
@@ -72,56 +89,68 @@
chart=TRUE,
...)
{
+
+ if (!is.strategy(strategy)) {
+ strategy<-try(getStrategy(strategy))
+ if(inherits(strategy,"try-error"))
+ stop ("You must supply an object or the name of an object of type 'strategy'.")
+ store=TRUE
+ }
+ out <- list()
+
#first do whatever the user stuck in this wrapup slot...
- 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(!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]
-
- # 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)
- }
+ 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(!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]
+
+ # 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
+ 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 <- list()
+
if(isTRUE(update.Portf)){
out[[paste('portfolio',portfolio,sep='.')]] <- updatePortf(Portfolio=portfolio, Symbols=Symbols, Dates=Dates, Prices=Prices,...=...)
}
if(isTRUE(update.Acct)){
- out[[paste('account',portfolio,sep='.')]] <- updateAcct(name=account,Dates=Dates,...=...)
+ out[[paste('account',account,sep='.')]] <- updateAcct(name=account,Dates=Dates,...=...)
}
if(isTRUE(update.EndEq)){
updateEndEq(Account=account,Dates=Dates,...=...)
- if(showEq) cat('EndingEq: ', getEndEq(Account=account,Date=Sys.time()), '\n')
+ if(showEq) cat('Ending Account Equity: ', getEndEq(Account=account,Date=Sys.time()), '\n')
}
if(isTRUE(chart)){
for (symbol in names(getPortfolio(portfolio)$symbols) ){
More information about the Blotter-commits
mailing list