Benchmark Portfolio

For comparison with the optimal portfolio(s) we eventually develop, we’ll start by creating a benchmark portfolio in which every asset is given equal weight unconditionally.

# Create a vector of equal weights
equal_weights <- rep(1 / ncol(txg_returns), ncol(txg_returns))

# Compute the benchmark returns
txg_benchmark <- Return.portfolio(R = txg_returns, 
                                weights = equal_weights 
                                #rebalance_on = 'quarters'
                                )
colnames(txg_benchmark) <- 'benchmark'

# Plot the benchmark returns
plot(txg_benchmark)

# benchmark mean
mean(txg_benchmark)

## [1] 0.00144597

# Benchmark standard deviation
sd(txg_benchmark)

## [1] 0.01109487

# Plot benchmark monthly mean
benchmark_monthly_mean <- apply.monthly(txg_benchmark, mean)
plot(benchmark_monthly_mean)

Just for reference; good to know. So hopefully we can do better than this (we certainly can)

Next I’m going to mess around with a few portfolio types/constraints, for example giving priority to return-maximizing vs. risk-minimizing priority, restricting to long investments only, per-asset weight constraints, etc.
To start I’ll be using PortfolioAnalytics’ random optimization method with a set of 20,000 (or fewer, more like 5,000) random portfolios, primarily because I can run the optimizations in a matter of minutes, whereas if I were to use a package like DEoptim every time each exploratory optimization would take half an hour or more on my laptop here, and for this first investigative section it’s not worth the time.
I’ll use the DEoptim and pso methods once I set the specs for my final optimized portfolio below.
Also note that the specifications and optimization runs below are just a sample of different constraints, targets, etc. I’ve tried, for the sake of presentation and because there’s really no reason for me to display all of the trial-and-error.

Run random optimization

# Random portfolios
rp <- random_portfolios(txg_spec, 5000, 'sample')

# Run optimization - method = random
txg_opt_rand <- optimize.portfolio(R = txg_returns, 
                                    portfolio = txg_spec, 
                                    optimize_method = 'random',
                                    rp = rp,
                                    trace = TRUE)

## Warning: executing %dopar% sequentially: no parallel backend registered

# Plot
plot(txg_opt_rand, main = 'Random Optimized Portfolio',
     risk.col = 'StdDev', neighbors = 10)

First of all, these are unnecessarily low returns, which means we should consider relaxing our contraints or targetting a portfolio with a positive weight sum.
((Also it looks like our optimum portfolio is far to the right, meaning that the target we set for standard deviation, our risk metric, could probably be decreased without a significant corresponding drop in returns. In other words, we have a pretty low-risk portfolio. In fact, looking at the plot above, we could feasibly expect similar average return levels for portfolios with sds in the 0.013~0.014 range as for portfolios in the 0.015~0.020 range (given the specs we set).))

Portfolio Specification ‘final’

First off, I’m going to define one last portfolio specification object that we’ll use for some serious optimization. In this specification I will include shorting and a specific risk-budget while sticking to Mean-Risk objectives.

txg_spec_final <- portfolio.spec(colnames(txg_returns))

## Add Constraints

# Add a weight sum constraint such that the weights sum to ~1
txg_spec_final <- add.constraint(portfolio = txg_spec_final,
                                 type = 'weight_sum', 
                                 min_sum = 0.99, max_sum = 1.01)

# Add a box constraint such that no asset can have a weight that is 
# greater than 20% or less than 20%
txg_spec_final <- add.constraint(portfolio = txg_spec_final,
                                 type = 'box', 
                                 min = -0.2, max = 0.2)


## Add Objectives

# Add an objective to maximize quadratic utility, b = 0.25
#txg_spec_final_qu <- add.objective(portfolio = txg_spec_final,
#                                   type = 'quadratic_utility',
#                                   risk_aversion = 0.25)

# Add an objective to maximize portfolio return
txg_spec_final <- add.objective(portfolio = txg_spec_final, 
                                type = 'return', 
                                name = 'mean',
                                target = 0.0015)

# Add an objective to minimize portfolio standard deviation
txg_spec_final <- add.objective(portfolio = txg_spec_final, 
                                type = 'risk', 
                                name = 'StdDev')

# Add an objective to limit risk contribution
txg_spec_final_rb <- add.objective(portfolio = txg_spec_final,
                                type = 'risk_budget', name = 'ES',
                                arguments = list(p=0.925, clean = 'boudt'),
                                max_prisk = 0.3)

 
# Print the portfolio specification
#txg_spec_final

Random Optimization

Showing StdDev and ES measures of risk
(As well as comparing RiskBudget (…_final_rb) spec vs. pure Mean/SD (…_final) spec)

# Random portfolios (Sample)
rp <- random_portfolios(txg_spec_final_rb, 5000, 'sample')
#TEMP
rpsd <- random_portfolios(txg_spec_final, 5000, 'sample')

txg_opt_sample <- optimize.portfolio(R = txg_returns,
                                    portfolio = txg_spec_final_rb,
                                    optimize_method = 'random', 
                                    rp = rp,
                                    trace = TRUE)
#_final/SD
txg_opt_sample_sd <- optimize.portfolio(R = txg_returns,
                                    portfolio = txg_spec_final,
                                    optimize_method = 'random', 
                                    rp = rpsd,
                                    trace = TRUE)


plot(txg_opt_sample, 
     main = 'txg_opt_final_rb Optimized Portfolio - Random (sample)',
     risk.col = 'StdDev', neighbors = 10)

plot(txg_opt_sample, 
     main = 'txg_opt_final_rb Optimized Portfolio - Random (sample)',
     risk.col = 'ES', neighbors = 10)

#_final/SD
plot(txg_opt_sample_sd, 
     main = 'txg_opt_final Optimized Portfolio - Random (sample)',
     risk.col = 'StdDev', neighbors = 10)

PSO (Particle Swarm Optimization)

# Random portfolios (Sample)
rp <- random_portfolios(txg_spec_final_rb, 5000, 'sample')

txg_opt_pso <- optimize.portfolio(R = txg_returns,
                                    portfolio = txg_spec_final_rb,
                                    optimize_method = 'pso', 
                                    rp = rp,
                                    momentFUN = 'set.portfolio.moments',
                                    method = 'boudt', k = 3,
                                    trace = TRUE)

txg_returns_pso <- Return.portfolio(R = txg_returns, 
                                    weights = extractWeights(txg_opt_pso))
colnames(txg_returns_pso) <- 'pso'

Comparison to benchmark

If you’ll recall the benchmark portfolio we created with equal weights..

txg_benchmark_cs <- apply(txg_benchmark, 2, cumsum)
txg_returns_pso_cs <- apply(txg_returns_pso, 2, cumsum)
txg_bench_cumret <- as.numeric(txg_benchmark_cs)
txg_pso_cumret <- as.numeric(txg_returns_pso_cs)

par(mfrow = c(1, 1))
plot(index(txg_returns), txg_pso_cumret, type = 's', col = 'blue', xlab = 'Date', ylab = 'Returns')
lines(index(txg_returns), txg_bench_cumret, type = 's', col = 'black')
title('PSO Optimized Returns vs. Benchmark')
legend('bottomright', legend = c('PSO_Returns', 'Benchmark'),
       lty = c(1, 1), col = c('blue', 'black'))

Random Optimization (boudt moments)

Run optimization with boudt statistical factors model moments

# Random portfolios (Sample)
rp <- random_portfolios(txg_spec_final_rb, 5000, 'sample')

txg_opt_rand_bdt <- optimize.portfolio(R = txg_returns,
                                    portfolio = txg_spec_final_rb,
                                    optimize_method = 'random', 
                                    rp = rp,
                                    momentFUN = 'set.portfolio.moments',
                                    method = 'boudt', k = 3,
                                    trace = TRUE)

plot(txg_opt_rand_bdt, 
     main = 'txg_opt_final_rb Optimized Portfolio - Random - boudt moments',
     risk.col = 'StdDev', neighbors = 10)

Portfolio Comparisons

Set up dataframe to plot benchmark, pso, and DEoptim cumulative returns together with ggplot2. Chances are I won’t echo the code for creating our cumret (cumulative returns) matrices. It’s not super interesting or relavent to our ultimate goal here.

cumrets <- cbind(txg_pso_cumret, txg_de_cumret, 
                 txg_rand_cumret, txg_bench_cumret)
cumrets <- as.data.frame(cumrets)
colnames(cumrets) <- c('PSO', 'DEoptim', 'Random', 'Benchmark')
cumrets$Date <- index(txg_returns)
cumrets_melt <- melt(cumrets, id = c('Date'))
colnames(cumrets_melt) <- c('Date', 'Portfolio', 'Returns')

cumret_plot <- ggplot(cumrets_melt, aes(x = Date, y = Returns, col = Portfolio)) + 
        geom_line(linetype = 1, alpha = 0.6, size = 1.3) +
        scale_color_manual(values = c('blue', 'green', 'red', 'black')) +
        ylab('Cumulative Returns') +
        ggtitle('Cumul.Returns Comparison')
        
cumret_plot

The pso doesn’t perform as well in this case in terms of mean and cumulative returns, but this may actually flip if we change our objective target mean returns, or even modify the sample size when constructing our random portfolios set. For instance if we remove the ‘target’ argument for our returns objective, the simple random optimization yields higher cumulative returns, while our two other global solvers dip below the benchmark (of course, there are corresponding drops in our StdDev and ES risk measures, so depending on the investment strategy these optimizations with lower cumulative historical returns may be the preferred choice). On the other hand when I was testing different optimization strategies with a rp sample size of 50~500 instead of 5,000+, the pso method resulted in significantly higher cumulative returns, with simple random performing near the benchmark and DEoptim displaying fairly low returns (without much compensation by reduction in standard deviation, mind you).

I think this is more evidence that compared to truly important steps in portfolio optimization such as individual asset analysis and investment strategy considerations, the optimization method is relatively arbitrary, given the amount of random variation and generally similar estimated return/risk measures across several runthroughs. On the other hand, rp sample size and the choice of whether to include rebalancing or not do play a role when selecting the right portfolio.

Also keep in mind that this ‘benchmark’ as shown above is just an arbitrary possible portfolio, in which the asset weights all happen to be equal. More than anything else it’s included as a check to confirm that we’re not producing wildly high or low cumulative return series, which would be evidence of potential oddities in the data or errors during the optimization process.

OK I kinda got sidetracked this morning comparing different optimization methods ^^;; The above is just one plotted comparison in cumulative returns over time (there are other metrics that deserve comparing, of course). I ended up testing a number of other combinations of constraints, objectives, opt_methods, etc., and my conclusion so far is that for this kind of simple optimization of a portfolio of asset returns, what matters more than the flavor of global solver we use are the constraints/objectives and/or targets we set, as well as just taking our time when selecting the assets to include in the first place.

Anyway, now I’ll move on to what I originally intended on continuing with: backchecking through rebalancing.

rp <- random_portfolios(txg_spec_final_rb, 5000, 'sample')

# Run a rebalancing optimization ((((((will need longer term data!!))))))
txg_opt_rebal <- optimize.portfolio.rebalancing(R = txg_returns, 
                                                portfolio = txg_spec_final_rb, 
                                                optimize_method = 'random',
                                                rp = rp,
                                                rebalance_on = 'quarters', 
                                                training_period = 12,
                                                rolling_window = 8
)

# Print the results
print(txg_opt_rebal)

## **************************************************
## PortfolioAnalytics Optimization with Rebalancing
## **************************************************
## 
## Call:
## optimize.portfolio.rebalancing(R = txg_returns, portfolio = txg_spec_final_rb, 
##     optimize_method = "random", rp = rp, rebalance_on = "quarters", 
##     training_period = 12, rolling_window = 8)
## 
## Number of rebalancing dates:  10 
## First rebalance date:
## [1] "2016-03-31 JST"
## Last rebalance date:
## [1] "2018-05-24 JST"
## 
## Annualized Portfolio Rebalancing Return:
## [1] 0.2072883
## 
## Annualized Portfolio Standard Deviation:
## [1] 0.1804005

# Chart the weights
chart.Weights(txg_opt_rebal, main = 'Weights - Random Rebal (Quarters)',
              colorset = colorRamps::primary.colors())

There is some variation in the weighting of assets over time, which is a hallmark of the type of portfolio (assets chosen for potential Future growth + strong IT sector assets) we have chosen to work with. The most stable players as I run multiple optimizations seem to be Apple, FedEx, Microsoft, ROSS, and Amazon which are household names that have recently shown strong returns, and wouldn’t be so volatile in terms of their weights in a rebalanced optimized portfolio over time. Some of the other assets, however, are stocks with lower continuity in their rolling returns and volatility, and would contribute to a rebalanced portfolio with many period-to-period changes. However!, the assets with consistent weights over time above will differ depending on the portfolio that happens to be selected from a set of random portfolios (which I reproduce each time I run this code).
Below we visualize the change over time of assets’ percent risk contribution:

# Chart the percentage contribution to risk
chart.RiskBudget(txg_opt_rebal, match.col = 'ES',
                 risk.type = 'percentage', 
                 colorset = colorRamps::primary.colors())

Again, some decent volatility here. The choice between a portfolio that is rebalanced versus one that is not is primarily one of investment strategy. For example if we choose some growth assets on a hunch that they will show higher returns in time t+1 despite their low performance today (t), then maybe we shouldn’t rebalance as that would be contrary to our original incentive for choosing the assets. However if we want to play a little more risk-free, given the generally accurate assumption that asset returns display serial correlation, we could rebalance on say, quarters, in order to reevaluate our asset weights each quarter to adjust for performance over time. It is my understanding that rebalancing is generally embraced as a wise strategy for the average stock-based portfolio, as you can most often decrease risk without any theoretical drops in average returns over time (again, investment strategy should be considered, and there is always risk due to randomness/the unknown, or what we term ‘chance’).

Below is a similar rebalanced optimization using DEoptim

txg_returns_rand_rebal <- Return.portfolio(R = txg_returns,
                                weights = extractWeights(txg_opt_rebal))

colnames(txg_returns_rand_rebal) <- 'rand_rebal'

# Creating rebalanced pf using DEoptim

rp <- random_portfolios(txg_spec_final_rb, 5000, 'sample')

# Run a rebalancing optimization
txg_opt_rebal_de <- optimize.portfolio.rebalancing(R = txg_returns, 
                                                portfolio = txg_spec_final_rb, 
                                                optimize_method = 'DEoptim',
                                                rp = rp,
                                                rebalance_on = 'quarters', 
                                                training_period = 12,
                                                rolling_window = 8
)

txg_returns_de_rebal <- Return.portfolio(R = txg_returns,
                                weights = extractWeights(txg_opt_rebal_de))

colnames(txg_returns_de_rebal) <- 'de_rebal'

# Combine the returns
opt_rets <- cbind(txg_benchmark, txg_returns_rand, txg_returns_rand_rebal, txg_returns_de, txg_returns_de_rebal, txg_returns_pso)

# Compute annualized returns
table.AnnualizedReturns(R = opt_rets)

##                           benchmark   rand rand_rebal     de de_rebal
## Annualized Return            0.4171 0.5695     0.2073 0.5293   0.4199
## Annualized Std Dev           0.1761 0.2260     0.1804 0.2356   0.1749
## Annualized Sharpe (Rf=0%)    2.3682 2.5205     1.1490 2.2468   2.4008
##                              pso
## Annualized Return         0.1950
## Annualized Std Dev        0.2758
## Annualized Sharpe (Rf=0%) 0.7070

# Chart the performance summary
charts.PerformanceSummary(R = opt_rets, main = 'Returns Performance')