Numerical Nonlinear Global Optimization Examples

Finding Multiple Optima, Method 1

Here is one way to get multiple minima: call (RefLink[NMinimize, paclet:ref/NMinimize]) multiple times with different random seeds, which will cause different optimization paths to be taken.

This defines a function with a whole ring of minima:

f[x_,y_]:=((((x^2)+(y^2)-16))^2);
Plot3D[f[x,y],{x,-5,5},{y,-5,5}]

This makes a table of solutions by using different random seeds:

pts=Table[NMinimize[f[x,y],{{x,-5,5},{y,-5,5}},Method->{"NelderMead","RandomSeed"->i}],{i,10}]

This turns the solutions into points and plots them on the contour plot of the function:

rainbow[a_]:=Hue[0.75 a, .5,1];
dots=Graphics[{PointSize[0.02],RGBColor[1,1,1],Point[{x,y}/.Last[#]]&/@pts}];
cplot=ContourPlot[f[x,y],{x,-5,5},{y,-5,5},ColorFunction->rainbow, Contours->4Range[0,10]^2,PlotPoints->50];
Show[cplot,dots]

Finding Multiple Optima, Method 2

Here is another way to get multiple minima: write the objective function in such a way as to make a list of every point that is visited, then select the points that have objective function values close to the final solution.

Define a function with a whole ring of minima:

Clear[f,pts,dots,cplot];
f[x_,y_]:=((((x^2)+(y^2)-16))^2);
Plot3D[f[x,y],{x,-5,5},{y,-5,5}]

(RefLink[Reap, paclet:ref/Reap]) returns the solution from (RefLink[NMinimize, paclet:ref/NMinimize]) and the points sown by (RefLink[EvaluationMonitor, paclet:ref/EvaluationMonitor]):

{sol, pts}=Reap[
NMinimize[f[x,y],{{x,-5,5},{y,-5,5}}, Method->"DifferentialEvolution", EvaluationMonitor:>Sow[{x,y},"VisitedPoint"]],
"VisitedPoint"];
sol

Find all the visited points that are close in objective function value to the final solution. Then color them white, color the final solution black, and show them on the contour plot of the function:

newpts=Cases[First[pts],x_/;Abs[f@@x-First[sol]]≤.05];
rainbow[a_]:=Hue[0.75 a, .5,1];
dots=Graphics[Join[{PointSize[0.02],RGBColor[1,1,1],Point[#]&/@newpts}, {{PointSize[0.02],RGBColor[0,0,0],Point[{x,y}/.Last[sol]]}}]];
cplot=ContourPlot[f[x,y],{x,-5,5},{y,-5,5},ColorFunction->rainbow, Contours->4Range[0,10]^2,PlotPoints->50];
Show[cplot,dots]

Finding a Nonlinear Fit of Data

This defines a model based on five random parameters:

Clear[f];
model=a+bCos[2Pict]+dSin[2Piet];
parameters={a,b,c,d,e};SeedRandom[121];paramrule=Thread[parameters->Table[RandomReal[],{5}]]

Create a function from the model and parameters, and generate sample points over the interval 0≤t≤2 π:

f[t_]:=Evaluate[model/.paramrule];
data={#,f[#]}&/@Table[t,{t,0,2Pi,.1}];

This plots the points and the solution from (RefLink[FindFit, paclet:ref/FindFit]). The solution gets trapped by a local minimum due to the trigonometric functions:

ffsol=FindFit[data,model,parameters,t];
lp=ListPlot[data,PlotStyle->{PointSize[0.02]}];nfp=Plot[model/.ffsol,{t,0,2Pi}];
Show[lp,nfp]

This generates a sum of squares from the data, and uses (RefLink[NMinimize, paclet:ref/NMinimize]) to find the minimum:

squares=Plus@@Table[((((model/.t->data[[i,1]])-data[[i,2]]))^2),{i,Length[data]}];
nminsol=NMinimize[squares,{#,0,1}&/@parameters,Method->{"DifferentialEvolution"}]

This plots the points and the solution from (RefLink[NMinimize, paclet:ref/NMinimize]):

nminp=Plot[model/.Last[nminsol],{t,0,2Pi}];
Show[lp,nminp]

Solve Example

(RefLink[Solve, paclet:ref/Solve]) cannot work with this system of equations because they are highly nonalgebraic:

Solve[Floor[(x^2)]==196&&Mod[x,10]==4,{x}]

Give (RefLink[NMinimize, paclet:ref/NMinimize]) a constant objective function, and the equations to be solved as constraints. It finds the solution:

NMinimize[{1,Floor[(x^2)]==196&&Mod[x,10]==6,-20<x<20},{x}]

Queens on a Chessboard

Clear[f,sol];

attackQ[pos1,pos2] is (RefLink[True, paclet:ref/True]) if and only if pos1 is attacking pos2:

attackQ[{i_Integer,xi_Integer},{j_Integer,xj_Integer}]:=Or[i-j==0,xi-xj==0,i-j==xi-xj,i-j==xj-xi]

countAttacks[vec] converts the vector of real numbers into a permutation of the queens and counts the number of attacks:

countAttacks[q:{_Real..}]:=Block[{qns=Ordering[q],n=Length[q]},Count[Flatten[Table[attackQ[{i,qns[[i]]},{j,qns[[j]]}],{i,1,n-1},{j,i+1,n}]],True]]

Given a permutation, this shows the arrangement:

queenPlot[vec_] :=Module[{veclength=Length[vec]},Show[Graphics[Join[ Table[Line[{{1,i},{veclength+1,i}}], {i,veclength+1}],Table[Line[{{i,1},{i,veclength+1}}], {i,veclength+1}]]],Graphics[Table[Disk[{i+.5,vec[[i]] +.5},0.25],{i,veclength}]],AspectRatio->1]]

Use (RefLinkPlain[DifferentialEvolution, paclet:tutorial/ConstrainedOptimizationGlobalNumerical#24713453]) to fit all the queens on the chessboard so that no queen is attacking another queen. Postprocessing is turned off because it is unlikely to help, given the discrete nature of the problem:

vars =Array[(Subscript[q, #])&,8];
{f,sol}=NMinimize[countAttacks[vars],vars,Method->{"DifferentialEvolution","PostProcess"->False}];
{f,Thread[vars->(sol=Ordering[sol[[All,2]]])]}

This shows the solution:

queenPlot[sol]