This is the code supplement to a three-part article series which appears in CityWire on the 24th, 25th, and 26th of January 2023. If you have not read the articles you are missing most of the narrative. You can check them out here.

In our case study we meet Lisa who comes to us with three goals:

1. She dreams of giving $1 million to a charity supporting foster children within the next 20 years.
2. She needs to retire in 15 years (and we calculate this will require $6.75 million).
3. She would like to purchase a $250,000 sailboat in 4 years.

After administering a goal worksheet (which is the goals-based equivalent of a risk-tolerance questionnaire), we rank and value the goals:

1. Retirement, valued at 1.00;
2. Sailboat, valued at 0.35;
3. Charity, valued at 0.07.

Now it is a matter of optimizing Lisa’s wealth allocation across goals, as well as her allocation to investments within goals.

First, let’s load the libraries and build the functions we will rely on later.

library(tidyverse)
library(Rsolnp)

## Lisa, a simple case study for GBI. 
## We are going to illustrate the goals-based process, the optimization scheme,
## and how to rebalance.

# Build functions we will need later =============================================
# This function returns taxes owed on the rebalance
tax_cost <- function( current_weights, weights, tax_rate, gain_loss ){
  sum( (weights - current_weights) * (gain_loss) ) * tax_rate
}

# This function returns the probability of achieving the goal
phi.f <- function( required_wealth, initial_wealth, time_horizon, return, volatility, 
                   current_weights, weights, tax_rate, gain_loss ){
  if( initial_wealth >= required_wealth ){
    return(1)
  } else {
    required_return <- ( required_wealth / 
                           (initial_wealth + 
                              tax_cost(current_weights, weights, tax_rate, gain_loss)))^(1 / time_horizon) - 1
    return( 1 - pnorm(required_return, return, volatility) )
  }
}

# This function will be used later in the within-goal optimization
optim.f <- function(weights){
  phi.f( required_wealth, initial_wealth, time_horizon,
         sum(weights * returns),
         sqrt(t(weights) %*% covariance %*% weights),
         current_weights, weights, tax_rate, gain_loss)
}

# This will return the utility of an across-goal allocation
utility.f <- function( across_goal_weights ){
  # Value of the goal times the previously-found optimal probability of achievement,
  # given the across-goal allocation.
  Lisa$Value[1] * optimal_phi_A[ (round(across_goal_weights[1],2) * 100) ] + 
    Lisa$Value[2] * optimal_phi_B[ (round(across_goal_weights[2],2) * 100) ] +
    Lisa$Value[3] * optimal_phi_C[ (round(across_goal_weights[3],2) * 100) ]
}

Our next step is to detail Lisa’s situation and code our capital market expectations (CMEs). This is super simple so we are coding only four asset classes. For each, we are detailing the return, standard deviation, and correlation matrix. Note that volatility and correlations are what produce the covariance matrix.

# Let's build Lisa's situation, and also detail our CMEs =========================
# Lisa's wealth, transferred-in company stock with gain of $92,000.
wealth_pool <- 1800000
tax_rate <- 0.15
current_weights <- c(1.00, 0.00, 0.00, 0.00) # weights of stocks, bonds, commodities, gamble
gain_loss <- c(92000, 0, 0, 0)

# Define Lisa's goals-space
Lisa <- data.frame( 'Name' = c('Retire', 'Sailboat', 'Foster'),
                    'Value' = c(1.00, 0.35, 0.07),
                    'WealthRequirement'= c(6750000, 250000, 1000000),
                    'Time' = c(15, 4, 20))

# Define our capital market expectations for 4 assets
# Define returns
returns <- c(0.12, 0.05, 0.08, 0.00

# Define covariance matrix, note that covariance = correlation * row vol * column vol
covariance <- matrix(
  #     Asset A           Asset B           Asset C         Asset D
  c( 1.00*0.16*0.16, -0.10*0.16*0.06,  0.35*0.16*0.12,  0.00*0.16*0.85, # Asset A
    -0.10*0.06*0.16,  1.00*0.06*0.06, -0.20*0.06*0.12,  0.00*0.06*0.85, # Asset B
     0.35*0.12*0.16, -0.20*0.12*0.06,  1.00*0.12*0.12,  0.00*0.12*0.85, # Asset C
     0.00,            0.00,            0.00,            1.00*0.75*0.85),# Asset D
  byrow = T, ncol = 4, nrow = 4)

Next, we will optimize each goal’s investment allocation if we allocate 1% of total wealth to it, then 2%, then 3%, and so on. In this example, I used a Monte Carlo engine, but I have also used a nonlinear optimizer with success. Once we have the optimal allocation to investments within each goal, we optimize the wealth allocation across the goals.

We have to approach the problem like this because it is recursive: the optimal allocation of investments within each goal depends on the optimal allocation of wealth across goals, but the optimal allocation across goals depends on the investment allocation within each goal. We solve this recursively problem by finding all optimal within-goal allocations first, then using that knowledge to find the optimal across-goal allocation.

# Build optimization scheme ======================================================
# Step 1: Find optimal within-goal allocation for each level of wealth allocation
num_goals <- length(Lisa$Value)
num_assets <- length(returns)
goal_allocation <- seq(0.01, 0.99, 0.01)

# Build empty matrices to hold optimal within-goal investment allocations,
# rows are across-goal allocations, columns are investments A through D
optimal_weights_A <- optimal_weights_B <- optimal_weights_C <- 
  matrix( nrow = length(goal_allocation), ncol = num_assets )
optimal_phi_A <- optimal_phi_B <- optimal_phi_C <- 0

# Build 10,000 MC trials
# Each row is a portfolio trial, each column is an asset.
w <- matrix( runif(num_assets * 10000), ncol = num_assets )
weight_trials <- t( apply(w, 1, FUN = function(x) round(x[1:4]^2/sum(x[1:4]^2), 3) ) )

# Loop through each level of goal_allocation and log each goal's optimal portfolio
for(i in 1:length(goal_allocation)){
  initial_wealth <- goal_allocation[i] * wealth_pool
  
  # Goal A, probability of achievement
  required_wealth <- Lisa$WealthRequirement[1]
  time_horizon <- Lisa$Time[1]
  phi_A <- apply( weight_trials, 1, optim.f)
  
  # Find and log weights with highest probability
  optimal_weights_A[i,] <- weight_trials[ which(phi_A == max(phi_A))[1], ]
  optimal_phi_A[i] <- max(phi_A)
  
  # Goal B, probability of achievement
  required_wealth <- Lisa$WealthRequirement[2]
  time_horizon <- Lisa$Time[2]
  phi_B <- apply( weight_trials, 1, optim.f)
  
  # Find and log weights with highest probability
  optimal_weights_B[i,] <- weight_trials[ which(phi_B == max(phi_B))[1], ]
  optimal_phi_B[i] <- max(phi_B)
  
  # Goal C, probability of achievement
  required_wealth <- Lisa$WealthRequirement[3]
  time_horizon <- Lisa$Time[3]
  phi_C <- apply( weight_trials, 1, optim.f)
  # Find and log weights with highest probability
  optimal_weights_C[i,] <- weight_trials[ which(phi_C == max(phi_C))[1], ]
  optimal_phi_C[i] <- max(phi_C)
}

# Step 2: Find the optimal across-goal allocation
w <- matrix( runif(num_goals * 10000), ncol = num_goals )
weight_trials <- t( apply(w, 1, FUN = function(x) x[1:num_goals]/sum(x[1:num_goals])))

u=0
A=0
B=0
C=0
for(i in 1:nrow(weight_trials)){
  A <- round(weight_trials[i,1]*100)
  B <- round(weight_trials[i,2]*100)
  C <- round(weight_trials[i,3]*100)
  
  u[i] <- Lisa$Value[1] * optimal_phi_A[ ifelse(A == 0, 1, A) ] +
    Lisa$Value[2] * optimal_phi_B[ ifelse(B == 0, 1, B) ]+
    Lisa$Value[3] * optimal_phi_C[ ifelse(C == 0, 1, C) ]
}

And from here it is simply a matter of returning the results!

# See results ========================================================
# Dollar value allocated to each goal
optimal_across_goal_weight * wealth_pool

# Optimal probabilities of goal achievement
optimal_phi_A[ index_A ]
optimal_phi_B[ index_B ]
optimal_phi_C[ index_C ]

# Optimal investment weights within each goal
optimal_weights_A[ index_A, ]
optimal_weights_B[ index_B, ]
optimal_weights_C[ index_C, ]

We find that Lisa is best served with the following allocation to each goal:

• $1.5 million to Retirement, which yields a 54% probability of achievement with a 100% allocation to Asset A.
• $258,800 to the Sailboat, which means it can be purchased today!
• $39,500 to Charity, yielding a 40% probability of achievement with a 100% allocation to the lottery-like Asset D.

Note that the approach of goals-based investing (sometimes mistakenly called “goal-based investing”) allowed us to advise on going ahead and purchasing the sailboat today, and also allowed us to allocate to the lottery-like investment. Modern portfolio theory would entirely eliminate Asset D from consideration and would, therefore, yield a lower probability of goal achievement than the goals-based approach.

If you are interested in a more in-depth look at the whole topic of goals-based investing, check out my new book, recently published with Wiley, Goals-Based Portfolio Theory. It covers the history, theory, practice, and some implications of the approach.