[Blotter-commits] r1385 - in pkg/quantstrat: . R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Jan 28 23:04:22 CET 2013
Author: opentrades
Date: 2013-01-28 23:04:22 +0100 (Mon, 28 Jan 2013)
New Revision: 1385
Added:
pkg/quantstrat/R/chart.forward.testing.R
pkg/quantstrat/R/chart.forward.training.R
Removed:
pkg/quantstrat/R/chart.forward.R
Modified:
pkg/quantstrat/DESCRIPTION
pkg/quantstrat/NAMESPACE
pkg/quantstrat/R/walk.forward.R
Log:
- added include.insamples flag to walk.forward() to request including complete in-sample portfolios
- include.insamples==TRUE save all portfolios in file
- added chart.forward.testing() to display all thoe portfolios for comparison
- some preparations preparing for walk.forward() to deal with multi-symbol portfolios
- renamed chart.forward() to chart.forward.training()
Modified: pkg/quantstrat/DESCRIPTION
===================================================================
--- pkg/quantstrat/DESCRIPTION 2013-01-24 21:25:24 UTC (rev 1384)
+++ pkg/quantstrat/DESCRIPTION 2013-01-28 22:04:22 UTC (rev 1385)
@@ -22,7 +22,8 @@
ByteCompile: TRUE
Collate:
'applyStrategy.rebalancing.R'
- 'chart.forward.R'
+ 'chart.forward.testing.R'
+ 'chart.forward.training.R'
'indicators.R'
'initialize.R'
'match.names.R'
Modified: pkg/quantstrat/NAMESPACE
===================================================================
--- pkg/quantstrat/NAMESPACE 2013-01-24 21:25:24 UTC (rev 1384)
+++ pkg/quantstrat/NAMESPACE 2013-01-28 22:04:22 UTC (rev 1385)
@@ -11,9 +11,10 @@
export(applyParameter)
export(applyRules)
export(applySignals)
+export(applyStrategy)
export(applyStrategy.rebalancing)
-export(applyStrategy)
-export(chart.forward)
+export(chart.forward.testing)
+export(chart.forward.training)
export(delete.paramset)
export(getOrderBook)
export(getOrders)
Deleted: pkg/quantstrat/R/chart.forward.R
===================================================================
--- pkg/quantstrat/R/chart.forward.R 2013-01-24 21:25:24 UTC (rev 1384)
+++ pkg/quantstrat/R/chart.forward.R 2013-01-28 22:04:22 UTC (rev 1385)
@@ -1,57 +0,0 @@
-#' Chart to analyse walk.forward() objective function
-#'
-#' @param audit.filename name of .audit environment file as produced by walk.forward()
-#'
-#' @export
-
-chart.forward <- function(audit.filename)
-{
- if(!require(xtsExtra, quietly=TRUE)) stop('The "xtsExtra" package is required to use this function')
-
- .audit <- NULL
-
- load(audit.filename)
-
- # extract all portfolio names from the audit environment
- portfolios.st = ls(name=.audit, pattern='portfolio.*')
- n <- length(portfolios.st)
-
- # calculate Net.Trading.PL for each portfolio, one xts col per portfolio
- PL.xts <- xts()
- for(portfolio.st in portfolios.st)
- {
- p <- getPortfolio(portfolio.st, envir=.audit)
-
- R <- cumsum(p$summary['2004-01-01/','Net.Trading.PL'])
- names(R) <- portfolio.st
-
- PL.xts <- cbind(PL.xts, R)
- }
-
- # add a column for the chosen portfolio, doubling it
- chosen.one <- .audit$param.combo.nr
- chosen.portfolio.st = ls(name=.audit, pattern=glob2rx(paste('portfolio', '*', chosen.one, sep='.')))
- R <- PL.xts[,chosen.portfolio.st]
- PL.xts <- cbind(PL.xts, R)
-
- # add drawdown columns for all portfolio columns
- CumMax <- cummax(PL.xts)
- Drawdowns.xts <- -(CumMax - PL.xts)
- data.to.plot <- as.xts(cbind(PL.xts, Drawdowns.xts))
-
- # now plot it
- dev.new()
- plot.xts(
- data.to.plot,
- screens=rep(1:2,each=n+1),
- col=c(rep('grey',n), 'blue'),
- minor.ticks=FALSE,
- main=NA
- )
- title(
- main='Walk Forward Analysis',
- sub=audit.filename
- )
-
- .audit <- NULL
-}
Added: pkg/quantstrat/R/chart.forward.testing.R
===================================================================
--- pkg/quantstrat/R/chart.forward.testing.R (rev 0)
+++ pkg/quantstrat/R/chart.forward.testing.R 2013-01-28 22:04:22 UTC (rev 1385)
@@ -0,0 +1,59 @@
+#' Chart to analyse walk.forward() objective function
+#'
+#' @param audit.filename name of .audit environment file as produced by walk.forward()
+#'
+#' @export
+
+chart.forward.testing <- function(audit.filename)
+{
+ if(!require(xtsExtra, quietly=TRUE)) stop('The "xtsExtra" package is required to use this function')
+
+ .audit <- NULL
+
+ load(audit.filename)
+
+ # extract all portfolio names from the audit environment
+ portfolios.st = ls(name=.audit, pattern='portfolio.*')
+ n <- length(portfolios.st)
+
+ # calculate Net.Trading.PL for each portfolio, one xts col per portfolio
+ PL.xts <- xts()
+ for(portfolio.st in portfolios.st)
+ {
+ p <- getPortfolio(portfolio.st, envir=.audit)
+
+ R <- cumsum(p$summary['2004-01-01/','Net.Trading.PL'])
+ names(R) <- portfolio.st
+
+ PL.xts <- cbind(PL.xts, R)
+ }
+
+ # add a column for the chosen portfolio, doubling it
+ #chosen.one <- .audit$param.combo.nr
+ #chosen.portfolio.st = ls(name=.audit, pattern=glob2rx(paste('portfolio', '*', chosen.one, sep='.')))
+ testing.portfolio.st = 'portfolio.futures'
+
+ R <- PL.xts[,testing.portfolio.st]
+ PL.xts <- cbind(PL.xts, R)
+
+ # add drawdown columns for all portfolio columns
+ CumMax <- cummax(PL.xts)
+ Drawdowns.xts <- -(CumMax - PL.xts)
+ data.to.plot <- as.xts(cbind(PL.xts, Drawdowns.xts))
+
+ # now plot it
+ dev.new()
+ plot.xts(
+ data.to.plot,
+ screens=rep(1:2,each=n+1),
+ col=c(rep('grey',n), 'blue'),
+ minor.ticks=FALSE,
+ main=NA
+ )
+ title(
+ main='Walk Forward Analysis',
+ sub=audit.filename
+ )
+
+ .audit <- NULL
+}
Copied: pkg/quantstrat/R/chart.forward.training.R (from rev 1384, pkg/quantstrat/R/chart.forward.R)
===================================================================
--- pkg/quantstrat/R/chart.forward.training.R (rev 0)
+++ pkg/quantstrat/R/chart.forward.training.R 2013-01-28 22:04:22 UTC (rev 1385)
@@ -0,0 +1,57 @@
+#' Chart to analyse walk.forward() objective function
+#'
+#' @param audit.filename name of .audit environment file as produced by walk.forward()
+#'
+#' @export
+
+chart.forward.training <- function(audit.filename)
+{
+ if(!require(xtsExtra, quietly=TRUE)) stop('The "xtsExtra" package is required to use this function')
+
+ .audit <- NULL
+
+ load(audit.filename)
+
+ # extract all portfolio names from the audit environment
+ portfolios.st = ls(name=.audit, pattern='portfolio.*')
+ n <- length(portfolios.st)
+
+ # calculate Net.Trading.PL for each portfolio, one xts col per portfolio
+ PL.xts <- xts()
+ for(portfolio.st in portfolios.st)
+ {
+ p <- getPortfolio(portfolio.st, envir=.audit)
+
+ R <- cumsum(p$summary['2004-01-01/','Net.Trading.PL'])
+ names(R) <- portfolio.st
+
+ PL.xts <- cbind(PL.xts, R)
+ }
+
+ # add a column for the chosen portfolio, doubling it
+ chosen.one <- .audit$param.combo.nr
+ chosen.portfolio.st = ls(name=.audit, pattern=glob2rx(paste('portfolio', '*', chosen.one, sep='.')))
+ R <- PL.xts[,chosen.portfolio.st]
+ PL.xts <- cbind(PL.xts, R)
+
+ # add drawdown columns for all portfolio columns
+ CumMax <- cummax(PL.xts)
+ Drawdowns.xts <- -(CumMax - PL.xts)
+ data.to.plot <- as.xts(cbind(PL.xts, Drawdowns.xts))
+
+ # now plot it
+ dev.new()
+ plot.xts(
+ data.to.plot,
+ screens=rep(1:2,each=n+1),
+ col=c(rep('grey',n), 'blue'),
+ minor.ticks=FALSE,
+ main=NA
+ )
+ title(
+ main='Walk Forward Analysis',
+ sub=audit.filename
+ )
+
+ .audit <- NULL
+}
Modified: pkg/quantstrat/R/walk.forward.R
===================================================================
--- pkg/quantstrat/R/walk.forward.R 2013-01-24 21:25:24 UTC (rev 1384)
+++ pkg/quantstrat/R/walk.forward.R 2013-01-28 22:04:22 UTC (rev 1385)
@@ -35,10 +35,11 @@
#' @param period the period unit, as a character string, eg. 'days' or 'months'
#' @param k.training the number of periods to use for training, eg. '3' months
#' @param nsamples the number of sample param.combos to draw from the paramset for training; 0 means all samples (see also apply.paramset)
-#' @param audit.prefix prefix to generate filenames for storage of audit data
+#' @param audit.prefix prefix to generate filenames for storage of audit data. For each training set, a separate file is created, containing an enviroment called .audit, with all in-sample portfolios and orderbooks as well as information as to which param.combos were evaluated, and the result of the objective function. In addition, a special file is generated that contains portfolio and orderbook for the concatenated testing param.combos as selected by the objective function, plus (optionally) complete in-sample portfolios and orderbooks for reference (see include.insamples)
#' @param k.testing the number of periods to use for testing, eg. '1 month'
#' @param obj.func a user provided function returning the best param.combo from the paramset, based on training results; defaults to 'max'
#' @param obj.args a user provided argument to obj.func, defaults to quote(tradeStats.list$Net.Trading.PL)
+#' @param include.insamples will optionally run a full backtest for each param.combo in the paramset, and add the resulting in-sample portfolios and orderbooks to the file '<prefix>.results.RData'; default TRUE
#' @param ... optional parameters to pass to apply.paramset()
#' @param verbose dumps a lot of info during the run if set to TRUE, defaults to FALSE
#'
@@ -54,6 +55,7 @@
period, k.training, nsamples=0, audit.prefix=NULL, k.testing,
obj.func=function(x){which(x==max(x))},
obj.args=list(x=quote(tradeStats.list$Net.Trading.PL)),
+ include.insamples=TRUE,
..., verbose=FALSE)
{
must.have.args(match.call(), c('portfolio.st', 'strategy.st', 'paramset.label', 'k.training'))
@@ -65,114 +67,143 @@
results <- list()
- for(symbol.st in names(portfolio$symbols))
+ # assuming that timespans for all portfolio symbols are same, so ok to use 1st symbol to calculate end points
+ symbol.st <- names(portfolio$symbols)[1]
+ symbol <- get(symbol.st)
+
+ ep <- endpoints(symbol, on=period)
+
+ total.start <- ep[1 + k.training] + 1
+ total.timespan <- paste(index(symbol[total.start]), '', sep='/')
+
+ k <- 1; while(TRUE)
{
- symbol <- get(symbol.st)
+ result <- list()
- ep <- endpoints(symbol, on=period)
+ # start and end of training window
+ training.start <- ep[k] + 1
+ training.end <- ep[k + k.training]
- k <- 1; while(TRUE)
+ # stop if training.end is beyond last data
+ if(is.na(training.end))
+ break
+
+ training.timespan <- paste(index(symbol[training.start]), index(symbol[training.end]), sep='/')
+
+ if(!missing(k.testing) && k.testing>0)
{
- result <- list()
+ # start and end of testing window
+ testing.start <- ep[k + k.training] + 1
+ testing.end <- ep[k + k.training + k.testing]
- # start and end of training window
- training.start <- ep[k] + 1
- training.end <- ep[k + k.training]
-
- # stop if training.end is beyond last data
- if(is.na(training.end))
+ # stop if testing.end is beyond last data
+ if(is.na(testing.end))
break
- training.timespan <- paste(index(symbol[training.start]), index(symbol[training.end]), sep='/')
+ testing.timespan <- paste(index(symbol[testing.start]), index(symbol[testing.end]), sep='/')
+ }
- if(!missing(k.testing) && k.testing>0)
- {
- # start and end of testing window
- testing.start <- ep[k + k.training] + 1
- testing.end <- ep[k + k.training + k.testing]
+ result$training.timespan <- training.timespan
- # stop if testing.end is beyond last data
- if(is.na(testing.end))
- break
+ print(paste('=== training', paramset.label, 'on', training.timespan))
- testing.timespan <- paste(index(symbol[testing.start]), index(symbol[testing.end]), sep='/')
- }
+ .audit <- NULL
+ if(!is.null(audit.prefix))
+ .audit <- new.env()
- result$training.timespan <- training.timespan
+ # run backtests on training window
+ result$apply.paramset <- apply.paramset(strategy.st=strategy.st, paramset.label=paramset.label,
+ portfolio.st=portfolio.st, account.st=account.st,
+ mktdata=symbol[training.timespan], nsamples=nsamples,
+ calc='slave', audit=.audit, verbose=verbose, ...=...)
- print(paste('=== training', paramset.label, 'on', training.timespan))
+ tradeStats.list <- result$apply.paramset$tradeStats
- .audit <- NULL
- if(!is.null(audit.prefix))
- .audit <- new.env()
+ if(!missing(k.testing) && k.testing>0)
+ {
+ if(!is.function(obj.func))
+ stop(paste(obj.func, 'unknown obj function', sep=': '))
- # run backtests on training window
- result$apply.paramset <- apply.paramset(strategy.st=strategy.st, paramset.label=paramset.label,
- portfolio.st=portfolio.st, account.st=account.st,
- mktdata=symbol[training.timespan], nsamples=nsamples,
- calc='slave', audit=.audit, verbose=verbose, ...=...)
+ # select best param.combo
+ param.combo.idx <- do.call(obj.func, obj.args)
+ if(length(param.combo.idx) == 0)
+ stop('obj.func() returned empty result')
- tradeStats.list <- result$apply.paramset$tradeStats
+ param.combo <- tradeStats.list[param.combo.idx, 1:grep('Portfolio', names(tradeStats.list)) - 1]
+ param.combo.nr <- row.names(tradeStats.list)[param.combo.idx]
- if(!missing(k.testing) && k.testing>0)
+ if(!is.null(.audit))
{
- if(!is.function(obj.func))
- stop(paste(obj.func, 'unknown obj function', sep=': '))
+ assign('obj.func', obj.func, envir=.audit)
+ assign('param.combo.idx', param.combo.idx, envir=.audit)
+ assign('param.combo.nr', param.combo.nr, envir=.audit)
+ assign('param.combo', param.combo, envir=.audit)
+ }
- # select best param.combo
- param.combo.idx <- do.call(obj.func, obj.args)
- if(length(param.combo.idx) == 0)
- stop('obj.func() returned empty result')
+ # configure strategy to use selected param.combo
+ strategy <- quantstrat:::install.param.combo(strategy, param.combo, paramset.label)
- param.combo <- tradeStats.list[param.combo.idx, 1:grep('Portfolio', names(tradeStats.list)) - 1]
- param.combo.nr <- row.names(tradeStats.list)[param.combo.idx]
+ result$testing.timespan <- testing.timespan
- if(!is.null(.audit))
- {
- assign('obj.func', obj.func, envir=.audit)
- assign('param.combo.idx', param.combo.idx, envir=.audit)
- assign('param.combo.nr', param.combo.nr, envir=.audit)
- assign('param.combo', param.combo, envir=.audit)
- }
+ print(paste('=== testing param.combo', param.combo.nr, 'on', testing.timespan))
+ print(param.combo)
- # configure strategy to use selected param.combo
- strategy <- quantstrat:::install.param.combo(strategy, param.combo, paramset.label)
+ # run backtest using selected param.combo
+ applyStrategy(strategy, portfolios=portfolio.st, mktdata=symbol[testing.timespan])
+ }
+ else
+ {
+ if(is.null(tradeStats.list))
+ warning(paste('no trades in training window', training.timespan, '; skipping test'))
- result$testing.timespan <- testing.timespan
-# result$param.combo.idx <- param.combo.idx
-# result$param.combo <- param.combo
-# result$strategy <- strategy
+ k <- k + 1
+ }
- print(paste('=== testing param.combo', param.combo.nr, 'on', testing.timespan))
- print(param.combo)
+ if(!is.null(.audit))
+ {
+ save(.audit, file=paste(audit.prefix, symbol.st, index(symbol[training.start]), index(symbol[training.end]), 'RData', sep='.'))
- # run backtest using selected param.combo
- applyStrategy(strategy, portfolios=portfolio.st, mktdata=symbol[testing.timespan])
- }
- else
- {
- if(is.null(tradeStats.list))
- warning(paste('no trades in training window', training.timespan, '; skipping test'))
+ .audit <- NULL
+ }
- k <- k + 1
- }
+ results[[k]] <- result
- if(!is.null(.audit))
- {
- save(.audit, file=paste(audit.prefix, index(symbol[training.start]), index(symbol[training.end]), 'RData', sep='.'))
+ k <- k + k.testing
+ }
+ #updatePortf(portfolio.st, Dates=paste('::',as.Date(Sys.time()),sep=''))
+ updatePortf(portfolio.st, Dates=total.timespan, sep='')
- .audit <- NULL
- }
+ results$tradeStats <- tradeStats(portfolio.st)
+ #results$portfolio <- portfolio
- results[[k]] <- result
+ if(!is.null(audit.prefix))
+ {
+ .audit <- new.env()
- k <- k + k.testing
+ portfolio <- getPortfolio(portfolio.st)
+ orderbook <- getOrderBook(portfolio.st)
+ account <- getAccount(account.st)
+
+ put.portfolio(portfolio.st, portfolio, envir=.audit)
+ put.orderbook(portfolio.st, orderbook, envir=.audit)
+ put.account(account.st, account, envir=.audit)
+
+ assign('tradeStats', results$tradeStats, envir=.audit)
+
+ if(include.insamples)
+ {
+ # run backtests on in-sample reference portfolios
+ result$apply.paramset <- apply.paramset(strategy.st=strategy.st, paramset.label=paramset.label,
+ portfolio.st=portfolio.st, account.st=account.st,
+ #mktdata=NULL, nsamples=nsamples,
+ mktdata=symbol[total.timespan], nsamples=nsamples,
+ calc='slave', audit=.audit, verbose=verbose, ...=...)
}
- }
- updatePortf(portfolio.st, Dates=paste('::',as.Date(Sys.time()),sep=''))
- results$portfolio <- portfolio
- results$tradeStats <- tradeStats(portfolio.st)
+ save(.audit, file=paste(audit.prefix, 'results', 'RData', sep='.'))
+ .audit <- NULL
+ }
return(results)
}
+
More information about the Blotter-commits
mailing list