R/backtest-pfolioBacktesting.R

In fPortfolioBacktest: Rmetrics - Portfolio Backtesting

# This library is free software; you can redistribute it and/or
# modify it under the terms of the GNU Library General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later version.
#
# This library is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Library General Public License for more details.
#
# You should have received a copy of the GNU Library General
# Public License along with this library; if not, write to the
# Free Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA  02111-1307  USA

# Copyrights (C)
# for this R-port:
#   1999 - 2009, Rmetrics Association, Zurich
#   1999 - 2009, Diethelm Wuertz <wuertz@itp.phys.ethz.ch>  
#   www.rmetrics.org
# for code accessed (or partly included) from other R-ports 
#   and other sources see R's copyright and license files


################################################################################
# FUNCTION:                    DESCRIPTION:
#  portfolioBacktesting         Performs a portfolio backtesting
#  portfolioSmoothing           Smoothes the weights of a portfolio backtesting
################################################################################


portfolioBacktesting <-
function(
    formula, 
    data, 
    spec = portfolioSpec(), 
    constraints = "LongOnly", 
    backtest = portfolioBacktest(),
    trace = TRUE)
{
    # A function implemented by William Chen and Diethelm Wuertz
    
    # Description:
    #   Backtests a portfolio on rolling windows
   
    # Arguments:
    #   formula - a formula expression to select benchmark and assets
    #       from the data set
    #   data - data set of assets returns, an object of class fPFLOLIODATA 
    #       or timeSeries
    #   spec - portfolio specification, an object of class fPFLOLIOSPEC,
    #       by default as returned by the function portfolioSpec()
    #   constraints - portfolio constraints, a vector of character strings
    #   backtest - portfolio backtest specification, an object of 
    #       class fPFLOLIOBACKTEST, by default as returned by the function
    #       portfolioBacktest
    #   trace - a logical, should the backtesting be traced ?
    
    # Value:
    #   A list with the following elements 
    #   formula - the input formula 
    #   data - the input data set
    #   spec - the input portfolio specification 
    #   constraints - the input constraints 
    #   backtest - the input backtest specification  
    #   benchmarkName - the name of the benchmark returns 
    #   assetsNames - the names of the assets returns
    #   weights - the rolling weights matrix 
    #   strategyList - the rolling list of optimized portfolios 
    #   Sigma - ...
   
    # Details:
    #   Allows for user specified rolling Windows
    #   Smoothing is separated and can be user specified
   
    # Example:
    #   portfolioBacktesting(formula, data, spec, constraints, backtest)
   
    # FUNCTION:
   
    # Data:
    if (class(data) == "fPFOLIODATA") {
        Data = data
        data = getSeries(data)
    } else if (class(data) == "timeSeries") {
        Data = portfolioData(data, spec)
    }
    
    # Constraints:
    if (class(constraints) == "fPFOLIOSPEC") {
        Constraints = constraints
        constraints = Constraints@stringConstraints
    } else if (class(constraints) == "character") {
        Constraints = portfolioConstraints(data, spec, constraints)
    }
            
    # Formula, Benchmark and Asset Labels:
    benchmarkName = as.character(formula)[2]
    assetsNames = strsplit(gsub(" ", "", as.character(formula)[3]), "\\+")[[1]]
    nAssets = length(assetsNames)
   
    # Trace the Specifications and Data Info:
    if(trace) {
        cat("\nPortfolio Backtesting:\n")
        cat("\nAssets:             ", assetsNames)
        cat("\nBenchmark:          ", benchmarkName)
        cat("\nStart Series:       ", as.character(start(data)))
        cat("\nEnd Series:         ", as.character(end(data)))
        cat("\n  Type:             ", getType(spec))
        cat("\n  Cov Estimator:    ", getEstimator(spec))
        cat("\n  Solver:           ", getSolver(spec))
        cat("\nPortfolio Windows:  ", getWindowsFun(backtest))
        cat("\n  Horizon:          ", getWindowsHorizon(backtest))
        cat("\nPortfolio Strategy: ", getStrategyFun(backtest))
        cat("\nPortfolio Smoother: ", getSmootherFun(backtest))
        cat("\n  doubleSmoothing:  ", getSmootherDoubleSmoothing(backtest))
        cat("\n  Lambda:           ", getSmootherLambda(backtest))
    }

    # We invest in the "Strategy" or (return) efficient Portfolio:
    if(trace) {
        cat("\n\nPortfolio Optimization:")
        cat("\nOptimization Period\tTarget\tBenchmark\t Weights\n")
    }

    # Create Rolling Windows:
    windowsFun = match.fun(getWindowsFun(backtest))
    rollingWindows = windowsFun(data, backtest)
    from = rollingWindows$from
    to = rollingWindows$to

    # Roll the Portfolio:
    strategyFun = match.fun(getStrategyFun(backtest))
    strategyList = list()
    
    # WC: track the sigma over time:
    Sigma = NULL
     
    for (i in 1:length(from)) 
    {
        # Optimize the Portfolio:
        pfSeries = window(data[, assetsNames], start = from[i], end = to[i])
        bmSeries = window(data[, benchmarkName], start = from[i], end = to[i])
        pfSeries = portfolioData(pfSeries, spec)
        Sigma = c(Sigma, mean(diag(getSigma(pfSeries))))
        strategy = strategyFun(
            data = getSeries(pfSeries), 
            spec = spec, 
            constraints = constraints, 
            backtest = backtest)
        strategyList[[i]] = strategy
   
        # Trace Optionally the Results:
        if (trace) {
            cat(as.character(from[i]), as.character(to[i]))
            spReturn = getTargetReturn(strategy@portfolio)[[2]]
            cat("\t", round(spReturn[1], digits = 3))
            bmReturn = mean(series(bmSeries))
            cat("\t", round(bmReturn, digits = 3))
            nAssets = length(assetsNames)
            weights = round(getWeights(strategy), digits = 3)
            cat("\t")
            for (i in 1:length(assetsNames)) cat("\t", weights[i])         
            cat("\t  * ", round(sum(weights), 2))
            cat("\n")
        }  
    }
   
    # Extract Portfolio Investment Weights for the current period:
    weights = NULL
    for (i in 1:length(strategyList)) 
        weights = rbind(weights, getWeights(strategyList[[i]]))
    rownames(weights) = as.character(to)
    colnames(weights) = assetsNames
   
    # Compose Result:
    ans = list(
        formula = formula,
        data = data,
        spec = spec,
        constraints = constraints,
        backtest = backtest,
        benchmarkName = benchmarkName,
        assetsNames = assetsNames,
        weights = weights,
        strategyList = strategyList, 
        Sigma = Sigma)
   
    # Return Value:
    class(ans) <- c("portfolioBacktesting", "list")
    invisible(ans)
}


# ------------------------------------------------------------------------------


portfolioSmoothing <-
function(object, backtest, trace = TRUE)
{
    # A function implemented by William Chen and Diethelm Wuertz
    
    # Description:
    #   Flexible Weights Smoother Function
   
    # Arguments:
    #   object - an object as returned by the function portfolioBacktesting()
    #   backtest - an S4 class object of 'FPFOLIOBACKTEST', the same as
    #       used in the function portfolioBacktesting() or a user modified
    #       version
    #   trace - a logical, should the computation be traced ?
    
    # Value:
    #   a list with the following entries
    
    # Example:
    #   data=100*SWX.RET; object=portfolioBacktesting(LP40~SBI+SPI+SII, data)
    #   portfolioSmoothing(object, portfolioBacktest())
   
    # FUNCTION:
   
    # Backtest Settings:
    formula = object$formula
    data = object$data
    spec = object$spec
    constraints = object$constraints
    backtest = object$backtest = backtest
    benchmarkName = object$benchmarkName
    assetsNames = object$assetsNames
    weights = object$weights
    skip = getSmootherSkip(backtest)
    if (skip > 0) weights = weights[-(1:skip), ]
    nAssets = ncol(weights)
   
    # Add Smooth Weights to Backtest object:
    if (trace) print("smooth ...")
    smoother = match.fun(getSmootherFun(backtest))
    smoothWeights = object$smoothWeights = smoother(weights, spec, backtest)
   
    # Compute Monthly Assets and Benchmark Returns:
    if (trace) print("aggregate ...")
    ow <- options("warn")
    options(warn = -1)
    monthlyAssets = object$monthlyAssets =
        applySeries(data[, assetsNames], by = "monthly", FUN = colSums)
    monthlyBenchmark = object$monthlyBenchmark =
        applySeries(data[, benchmarkName], by = "monthly", FUN = colSums)
    options(ow)   
       
    # Compute Offset Return of Rolling Portfolio compared to Benchmark:
    if (trace) print("offset ...")
    cumX = colCumsums(data[, benchmarkName])
    lastX <- window(cumX, start = start(cumX), end = rownames(weights)[1] )
    offsetReturn = as.vector(lastX[end(lastX), ])
    names(offsetReturn) <- as.character(end(lastX))
    object$offsetReturn <- offsetReturn

    # Backtest Return Series:
    Datum = as.vector(rownames(smoothWeights))
    nDatum = length(Datum)
    Portfolio = Benchmark = NULL
    for (i in 1:(nDatum-1)) {
        Portfolio = rbind(Portfolio, as.vector((
            as.matrix(monthlyAssets[Datum[i+1], ]) %*% smoothWeights[Datum[i], ])))
        Benchmark = rbind(Benchmark, as.vector(monthlyBenchmark[Datum[i+1], ]))
    }
   
    P = timeSeries(data = Portfolio, charvec = Datum[-1], units = "Portfolio")
    object$portfolioReturns = portfolio = colCumsums(P)
    object$P = P
   
    B = timeSeries(data = Benchmark, charvec = Datum[-1], units = "Benchmark")
    object$benchmarkReturns = benchmark = colCumsums(B)
    object$B = B
     
    daily = colCumsums(data[, benchmarkName])
    Daily = window(daily, start = start(portfolio), end = end(portfolio))

    portfolio = portfolio - portfolio[1] + Daily[1]
    benchmark = benchmark - benchmark[1] + Daily[1]
   
    # Do Plot:
    # ylim = range(c(as.vector(benchmark), as.vector(portfolio), 
    #   as.vector(daily)))
    # plot(daily, type = "l", ylim = ylim)
    #
    # lines(benchmark, lwd = 2, col = "blue")
    # lines(portfolio, lwd = 2, col = "red")
    # points(benchmark, lwd = 2, pch = 19, col = "blue")
    # points(portfolio, lwd = 2, pch = 19, col = "red")
   
    # Add to backtest:
    object$portfolio = portfolio
    object$benchmark = benchmark
   
    # Backtest Statistics:
    P = as.vector(P)
    B = as.vector(B)
    Stats = c(sum(P, na.rm = TRUE), sum(B))
    Stats = rbind(Stats, c(mean(P, na.rm = TRUE), mean(B)))
    Stats = rbind(Stats, c(sd(P, na.rm = TRUE), sd(B)))
    Stats = rbind(Stats, c(min(P, na.rm = TRUE), min(B)))
    colnames(Stats) = c(
        "Portfolio",
        "Benchmark")
    rownames(Stats) = c(
        "Total Return",
        "Mean Return",
        "StandardDev Return",
        "Maximum Loss")
    object$stats = Stats
   
    # Annual Lines:
    # YYYY = as.character(1990:2010)
    # for (year in YYYY)
    #   abline(v = as.POSIXct(paste(year, "-01-01", sep ="")), col = "green")
   
    # Return Value:
    class(object) <- c("portfolioBacktesting", "list")
    object
} 


################################################################################