# Optimization of a portfolio of stocks

I would like to use Mathematica to perform an optimization of a portfolio composed by 10 stocks. I did the first part to compute yields and expected yields, but I don't know how to finish the optimization.

portf = {"AAPL", "BA", "IBM", "BMW.DE", "DIS", "R", "PEP", "BRBY.L", "AXP", "BTI"}

priceShift = FinancialData[#, "Price", {{2004}, {2011}, "Month"}][[All, 2]] & /@ portf


I am interested in the minimization of the portfolio variance (i.e. risk) for a given return.

-
search the docs for FindWallStreetGuru[] – Dr. belisarius Dec 8 '13 at 20:46
Hello MMA.SE, I vote for reopening this question!!! It's actually a very interesting optimization question, and Mathematica can easily do all the necessary computations. My answer is waiting for the reopening of this question!!! – Rod Dec 11 '13 at 13:01
@IstvánZachar I've edited the question to try to make it a bit more clear... Portfolio optimization is part of Finance theory, and for those who know it it's clear what results are expected by the OP. – Rod Dec 11 '13 at 13:11
I'm still wondering why people at MMA.SE don't like Finance questions... I know the question was badly formulated, but 7 downvotes without comments... a bit too much IMO... :-) – Rod Dec 11 '13 at 22:08
Unfortunate if the participants really don't like finance questions (really true?). This is an area where MMA is underutilized and could really grow. That's one of the goals of this site, right? To promote the growth of MMA by showing people how to use it. – George Wolfe Dec 29 '13 at 15:18

Well, let me try to answer the OP's question. And thanks MMA.SE, for reopening this interesting question!

# DATA

To answer this question, you have to get the data using Mathematica's FinancialData function. This was the only thing originally done by the OP!

First step: define which stocks will be included in the portfolio:

Portfolio = {"AAPL", "BA", "IBM", "BMW.DE", "DIS", "R", "PEP", "BRBY.L", "AXP", "BTI"};


Second step: get the data

data = FinancialData[#, "Price", {{2004}, {2011}, "Month"}][[All, 2]] & /@ Portfolio;


You can graphically verify the price behaviour of all porfolio components for the specified period:

ListLogPlot[data, PlotRange -> All, Joined -> True]


Third step: in order to perform the optimization, we have to work with returns, not prices!

Returns = Differences[Log[data[[#]]]] & /@ Range[10];


Now you can also graphically verify the returns behaviour for all portfolio components:

ListLinePlot[Returns, PlotRange -> All, ImageSize -> Medium]


A second possibility would be to use BoxPlots:

BoxWhiskerChart[Returns, "Outliers", ImageSize -> Large, ChartLabels -> Portfolio]


Fourth step (optional): in order to optimize (i.e., minimize) the portfolio risk, we have to find the returns relationship between all pairs of stocks. This is easily done with a correlation matrix. However, bear in mind that portfolio theory works with covariance matrices, and we will calculate them latter!

Correlation[Transpose@Returns] // MatrixForm


Another possibility would be to graphically plot the correlation matrix:

Legended[MatrixPlot[Correlation[Transpose[Returns]], ColorFunction -> #], BarLegend[{#, {-1, 1}}]] &@"ThermometerColors"


# THE THEORY

To perform the optimization, we have to define all necessary variables first. As we have 10 variables, we have to make the process of variables creation as simple as possible. Let's do it!

First step: define the amount of variables involved

n = 10;


Second step: we have to define a weighting vector

WeightsVector = Subscript[w, #] & /@ Range[n]


Third step: we have to define a mean vector

MeanVector = Subscript[\[Mu], #] & /@ Range[n]


Fourth step: we have to define a variance vector

VarianceVector = Subsuperscript[\[Sigma], #, 2] & /@ Range[n]


Fifth step: we have to define a standard deviation vector

SDVector = Subscript[\[Sigma], #] & /@ Range[n]


Sixth step: define the covariance matrix

CovMatrix = Array[\[Sigma], {n, n}] /. {\[Sigma][i_, j_] :> Subscript[\[Sigma], ToString@j <> ToString@i] /; i > j, \[Sigma][i_, j_] :> Subscript[\[Sigma], ToString@i <> ToString@j] /; i < j, \[Sigma][i_, j_] :>Subsuperscript[\[Sigma], i, 2] /; i == j};
CovMatrix // MatrixForm


With Mathematica it's easy to verify the Markowitz equation for the portfolio risk:

PortfolioVariance := WeightsVector.CovMatrix.WeightsVector;
PortfolioVariance // Expand


And the portfolio mean return can also be easily computed with Mathematica:

PortfolioMean := WeightsVector.MeanVector;
PortfolioMean


# ASSIGNING VALUES TO THE VARIABLES

Step 1: assign values to the mean vector

MeanVector = Mean@Transpose@Returns*12


Please observe that multiplying the average monthly return by 12 gives the expected annual return for the stock.

Step 2: assign values to the variance vector

VarianceVector = Variance@Transpose@Returns*12


Step 3: assign values to the standard deviation vector

SDVector = StandardDeviation@Transpose@Returns*Sqrt@12


Please observe that to annualize the standard deviation you have to multiply monthly standard deviation by the square root of 12.

Step 4: assign values to the covariance matrix

CovMatrix = Covariance@Transpose@Returns


# OPTIMIZATION

Before doing the optimization, we can use Mathematica to verify the Markowitz equation, now with all assigned values for the variables:

PortfolioVariance := WeightsVector.CovMatrix.WeightsVector;
PortfolioVariance // Expand


As we see, the only thing we have to find is exactly the weight that will be assigned for every portfolio component. We know that the weights of all portfolio components must sum up to one, and we will use it as a constraint for our optimization problem:

MV = FindMinimum[{PortfolioVariance, Total[WeightsVector] == 1}, WeightsVector]


Finally, in order to better interprete the results, we can plot the weights using a BarChart:

BarChart[{Last[MV[[2, #]]] & /@ Range[n]}, ImageSize -> Large, ChartLabels -> Portfolio]


As we see, in order to optimize the portfolio risk we have to buy 6 out of the 10 stocks and short sell 4 of them (those stocks with negative weights).

-
P.S.: no need for FindWallStreetGuru[]... :-) – Rod Dec 12 '13 at 14:57
Rod, this is a really nice answer, I am glad that this question is reopened: this thread could be the flagship of further finance-related questions. Two minor advices: your variables should start with lowercase letters (Returns is really close to Return). Second: try to be more concise. No need to denote each code line with a comment or with a title. The more concise and fluid your code is, the easier it is to copy and paste it by others. And n=10 really doesn't need comments. – István Zachar Dec 12 '13 at 18:23
@IstvánZachar Thanks István! My intention was actually to write my answer in an "paper"-like format... that's why I explained every line of code. But I do agree with you: sometimes I need to be more "concise"... :-) – Rod Dec 12 '13 at 20:49
this answer is outstanding – brown.2179 May 11 '15 at 22:44
portf = {"AAPL", "BA", "IBM", "BMW.DE", "DIS", "R", "PEP", "BRBY.L", "AXP", "BTI"};
prices = FinancialData[#, "Price", {{2004}, {2011}, "Month"}] & /@  portf;


Returns are often calculated as the difference of the logarithms of the prices:

Differences[Log@#] &[prices[[1, All, 2]]]


This works because $\log(\text{price}_{new})-\log(\text{price}_{old})=\log(\text{price}_{old}(1+r))-\log(\text{price}_{old})=\log(1+r)$, which is

Series[Log[o (1 + r)] - Log[o], {r, 0, 2}]


that is, approximately $r$.

But we can get returns from FiancialData right away using "FractionalChange" instead of "Price":

portReturns = FinancialData[#, "FractionalChange", {{2004}, {2011}, "Month"}] & /@ portf;


Can't hurt to check the data a bit. Let's see if we have data from the same dates:

Outer[
Length[Intersection[#1, #2]] &,
portReturns[[All, All, 1]],
portReturns[[All, All, 1]],
1
] // MatrixForm


It appears not all periods are exactly the same. So, if we want to be prudent we could use only the data for the periods that match.

overlappingDates = Intersection @@ (#[[All, 1]] & /@ portReturns);
portReturnsCleaned = Select[#, MemberQ[overlappingDates, #[[1]]] &][[All, 2]] & /@ portReturns;


Now, introduce symbolic weights and define portfolio return and variance in terms of them. The portfolio variance is the sum of the covariance matrix elements.

weights = {w1, w2, w3, w4, w5, w6, w7, w8, w9, w10};
portAverageReturns = 12 weights (Mean /@ portReturnsCleaned) // Total
portVar = 12 Total[Outer[Times, weights, weights] Covariance[portReturnsCleaned\[Transpose]], 2]


Let's find the lowest variance for a bunch of given returns (the so-called efficient frontier). The range of this will lie between:

12 Min@(Mean /@ portReturnsCleaned)


0.08960473674

12 Max@(Mean /@ portReturnsCleaned)


0.7151653802

(should have bought Apple stock)

The no short selling, no borrowing/lending case (weights sum to 1 and each weight is between 0 and 1):

effFrontier =
Table[
{Sqrt[
NMinimize[
{portVar,
Total[weights] == 1 &&
portAverageReturns == i &&
And @@ (0 <= # <= 1 & /@ weights)
}, weights
][[1]]
], i},
{i, 0.09, 0.7, .02}] // Quiet


I collected the square root of the variance (the standard deviations) here as this is usually considered as the measure of risk.

Find the minimum variance portfolio:

minimumVariance1 = {Sqrt[portVar], portAverageReturns} /.
NMinimize[{portVar, Total[weights] == 1 && And @@ (0 <= # <= 1 & /@ weights)}, weights][[2]]


{0.1292044085, 0.127437124}

Plotting this with 10,000 randomly selected portfolios:

Show[
ListLinePlot[effFrontier,
Epilog -> {Red, PointSize -> Large, Point[minimumVariance]},
Frame -> True,
FrameLabel->{"\[Sigma]","Expected portfolio return","No short selling, no borrowing/lending",""},
PlotRange -> {{0, Automatic}, Automatic}, BaseStyle -> 16,
ImageSize -> 500],
ListPlot[
Table[{Sqrt[portVar], portAverageReturns} /.
Thread[weights -> #/Total[#] &[RandomReal[{0, 1}, 10]]], {10000}]]
]


It appears pretty difficult to blindly guess an optimal portfolio.

Dropping the constraint of no short selling (positive weights) gets us better results:

effFrontier2 =
Table[{Sqrt[
NMinimize[{portVar, Total[weights] == 1 && portAverageReturns == i}, weights][[
1]]], i},
{i, 0.09, 0.7, .02}] // Quiet;
minimumVariance2 = {Sqrt[portVar], portAverageReturns} /.
NMinimize[{portVar, Total[weights] == 1}, weights][[2]]


One more step is to introduce lending/borrowing at the risk free rate:

portAverageReturns2 = α rf + 12 Total[(1 - α) weights (Mean /@ portReturnsCleaned)]
portVar2 = 12 Total[Outer[Times, (1 - α) weights, (1 - α) weights]
Covariance[portReturnsCleaned\[Transpose]], 2]


Assuming a risk free rate of 1%:

Block[{rf = .01},
effFrontier3 =
Table[{Sqrt[
NMinimize[{portVar2,
Total[weights] == 1 && portAverageReturns2 == i &&
And @@ (0 <= # <= 1 & /@ weights)},
Join[weights, {\[Alpha]}]][[1]]], i}, {i, 0.01, 0.7, .05}];
effFrontier4 =
Table[{Sqrt[
NMinimize[{portVar2,
Total[weights] == 1 && portAverageReturns2 == i &&
And @@ (# <= 1 & /@ weights)}, Join[weights, {\[Alpha]}]][[
1]]], i}, {i, 0.01, 0.7, .05}];
]

Show[
ListLinePlot[effFrontier,
Epilog -> {Red, PointSize -> Large, Point[minimumVariance],
Point[minimumVariance2]}, Frame -> True, PlotStyle -> Dashed,
PlotRange -> {{0, Automatic}, Automatic}, BaseStyle -> 16,
ImageSize -> 500,
FrameLabel -> {"\[Sigma]", "Expected portfolio return", "", ""},
PlotLegends ->
Placed[LineLegend[{Blue, Directive[Blue, Dashed], Darker@Green,
Directive[Darker@Green,
Dashed]}, {"Short & no borrowing/lending",
"No short & no borrowing/lending",
"Short & with borrowing/lending",
"No short & with borrowing/lending"}, LabelStyle -> 12],
Scaled[{0.25, 0.8}]]],
ListLinePlot[effFrontier2, Frame -> True,
PlotRange -> {{0, Automatic}, Automatic}, BaseStyle -> 16,
ImageSize -> 500],
ListLinePlot[effFrontier3, Frame -> True,
PlotRange -> {{0, Automatic}, Automatic}, BaseStyle -> 16,
ImageSize -> 500, PlotStyle -> Directive[Green, Dashed]],
ListLinePlot[effFrontier4, Frame -> True,
PlotRange -> {{0, Automatic}, Automatic}, BaseStyle -> 16,
ImageSize -> 500, PlotStyle -> Green],
ListPlot[Table[{Sqrt[portVar], portAverageReturns} /.
Thread[weights -> #/Total[#] &[RandomReal[{0, 1}, 10]]], {10000}]]
]


-
I was on vacations and couldn't see your answer before (nice one, btw). However, I'm still wondering why short sales have changed your efficient frontier if borrowing/lending is not allowed. I might be wrong, but as far as I remember there is no difference in the efficient frontier without borrowing/lending. – Rod Jan 7 '14 at 11:56
@rod That may be the case for the two-asset portfolio, which is what is generally plotted in textbooks. Generally, this is not true. Check these three sources: 1 (first picture), 2 (section 3.iii), 3 (page 10). – Sjoerd C. de Vries Jan 19 '14 at 0:36