Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

share|improve this question
6  
search the docs for FindWallStreetGuru[] –  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
    
@IstvánZachar That's funny... anyway I'm doing it again! –  Rod Dec 11 '13 at 13:39
1  
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
show 6 more comments

2 Answers 2

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]

enter image description here

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]

enter image description here

A second possibility would be to use BoxPlots:

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

enter image description here

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

enter image description here

Another possibility would be to graphically plot the correlation matrix:

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

enter image description here

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]

enter image description here

Third step: we have to define a mean vector

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

enter image description here

Fourth step: we have to define a variance vector

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

enter image description here

Fifth step: we have to define a standard deviation vector

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

enter image description here

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

enter image description here

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

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

enter image description here

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

PortfolioMean := WeightsVector.MeanVector;
PortfolioMean

enter image description here

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

enter image description here

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]

enter image description here

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]

enter image description here

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).

share|improve this answer
    
P.S.: no need for FindWallStreetGuru[]... :-) –  Rod Dec 12 '13 at 14:57
2  
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
add comment
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}]

Mathematica graphics

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

Mathematica graphics

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}]]
 ]

Mathematica graphics

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]]

Mathematica graphics

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}]]
 ]

Mathematica graphics

share|improve this answer
    
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 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 at 0:36
add comment

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.