How to speed up this code with NMaximize?

Question

I want to maximize the expected exponential growth rate of the portfolio, which contains 3 stocks.

I get the adjusted stock price for General Electric, Du Pont, and IBM.

ge =  FinancialData["GE",  {{1962, 01, 01}, {2015, 12, 31}}][[All, 2]];
dd =  FinancialData["DD",  {{1962, 01, 01}, {2015, 12, 31}}][[All, 2]];
ibm = FinancialData["IBM", {{1962, 01, 01}, {2015, 12, 31}}][[All, 2]];

The time step for a trading day, dt, is usually set at 1/252. To be more accurate, I set it as:

dt = (2015 - 1962 + 1)/Length@ge;

The realized continuously compounded returns, for 3 stocks, are calculated as follows:

{uge, udd, uibm} = Map[Log[Drop[#, 1]/Drop[#, -1]]/dt &, {ge, dd, ibm}];

Then I get the joint probability density function by interloping using the SmoothKernelDistribution:

pdfmulti = PDF[
   SmoothKernelDistribution[
     Transpose[{uge, udd, uibm}], 
     "LeastSquaresCrossValidation", "Gaussian"
   ]]

Let f1, f2, and f3 be the fraction of the capital spend on GE, DD, IBM. The expected exponential growth rate, G is calculated using the integral,

G[f1_?NumericQ, f2_?NumericQ, f3_?NumericQ] := 
  NIntegrate[
    Log[1 + f1 (Exp[u1 dt] - 1) + f2 (Exp[u2 dt] - 1) + f3 ( Exp[u3 dt] - 1)] pdfmulti[{u1, u2, u3}], 
    {u1, -70, 70}, {u2, -70, 70}, {u3, -70, 70}
  ]

Then, I tried to maximize G with respect to f1, f2, and f3, by using NMaximize

NMaximize[
  {G[f1, f2, f3], f1 >= 0 && f2 >= 0 && f3 >= 0 && f1 + f2 + f3 <= 1},
  {f1, f2, f3}, PrecisionGoal -> 5
]

It took a whole day, and still didn't finish computing. The error code returns are:

NIntegrate::slwcon: Numerical integration converging too slowly; suspect one of the following: singularity, value of the integration is 0, highly oscillatory integrand, or WorkingPrecision too small.

NIntegrate::eincr: The global error of the strategy GlobalAdaptive has increased more than 2000 times. The global error is expected to decrease monotonically after a number of integrand evaluations. Suspect one of the following: the working precision is insufficient for the specified precision goal; the integrand is highly oscillatory or it is not a (piecewise) smooth function; or the true value of the integral is 0. Increasing the value of the GlobalAdaptive option MaxErrorIncreases might lead to a convergent numerical integration. NIntegrate obtained 0.0002857958024361732 and 0.000010590285788411786 for the integral and error estimates. >>

Is there any way I could speed up this algorithm? (I thought the problem is probably that there is an interpolating function pdfmulti in NMaximize. )

Answer 1

Not a real answer, too long to put in a comment...

What I would suggest is to use smaller precision goals and restrain NIntegrate's adaptive algorithm. This way you can get an answer in a relatively short time, analyze does it make sense, and continue with refinements that require more computational time.

The code below produces results under 35s on my laptop.

ge = FinancialData["GE", {{1962, 01, 01}, {2015, 12, 31}}][[All, 2]];
dd = FinancialData["DD", {{1962, 01, 01}, {2015, 12, 31}}][[All, 2]];
ibm = FinancialData["IBM", {{1962, 01, 01}, {2015, 12, 31}}][[All, 2]];

dt = (2015 - 1962 + 1)/Length@ge;

{uge, udd, uibm} = 
  Map[Log[Drop[#, 1]/Drop[#, -1]]/dt &, {ge, dd, ibm}];

pdfmulti = 
  PDF[SmoothKernelDistribution[Transpose[{uge, udd, uibm}], 
    "LeastSquaresCrossValidation", "Gaussian"]];

G[f1_?NumericQ, f2_?NumericQ, f3_?NumericQ] := 
 NIntegrate[
  Log[1 + f1 (Exp[u1 dt] - 1) + f2 (Exp[u2 dt] - 1) + 
     f3 (Exp[u3 dt] - 1)] pdfmulti[{u1, u2, u3}], {u1, -70, 
   70}, {u2, -70, 70}, {u3, -70, 70}, MinRecursion -> 1, 
  MaxRecursion -> 1, PrecisionGoal -> 4, AccuracyGoal -> 4, 
  Method -> {"GlobalAdaptive", "SymbolicProcessing" -> 0}]

AbsoluteTiming[
 NMaximize[{G[f1, f2, f3], 
   f1 >= 0 && f2 >= 0 && f3 >= 0 && f1 + f2 + f3 <= 1}, {f1, f2, f3}, 
  PrecisionGoal -> 3]
 ]

(* {32.2225, {0.00346539, {f1 -> 0.656504, f2 -> 0.32803, 
   f3 -> 0.0154653}}} *)

Update

My suggestion might not be that applicable. Here are the results with different NIntegrate options that have little to do with the results above:

G[f1_?NumericQ, f2_?NumericQ, f3_?NumericQ] := 
 NIntegrate[
  Log[1 + f1 (Exp[u1 dt] - 1) + f2 (Exp[u2 dt] - 1) + 
     f3 (Exp[u3 dt] - 1)] pdfmulti[{u1, u2, u3}], {u1, -70, 
   70}, {u2, -70, 70}, {u3, -70, 70}, MinRecursion -> 2, 
  MaxRecursion -> 12, PrecisionGoal -> 3, AccuracyGoal -> 4, 
  Method -> {"GlobalAdaptive", "SymbolicProcessing" -> 0, 
    "SingularityHandler" -> None}]

AbsoluteTiming[
 NMaximize[{G[f1, f2, f3], 
   f1 >= 0 && f2 >= 0 && f3 >= 0 && f1 + f2 + f3 <= 1}, {f1, f2, f3}, 
  PrecisionGoal -> 3]
 ]

(* {887.217, {0.00057827, {f1 -> 0.815837, f2 -> 0.0288783, 
   f3 -> 0.155158}}} *)