Einführung in Mathematica XV

Minimumssuche

© Jürgen Schnack, 2016/05/31

Problem

Suchen das Minimum einer Funktion in einem hochdimensionalen Raum. 

Im folgenden werden verschiedene Mehoden an einem zweidimensionalen Beispiel vorgestellt.

Funktion

f[x_,y_]=(x+y+1)*(x+y)*(x+y+2)*(x+y+5)+10*(x-y)^2;

Plot3D[f[x,y],{x,-10,10},{y,-10,10}]

ContourPlot[f[x,y],{x,-10,10},{y,-10,10}]

Im Bereich -5 < x < 5 und -5 < y < 5 erwarten wir das Minimum. Es gibt zwei lokale Minima.

CP1=ContourPlot[f[x,y],{x,-5,5},{y,-5,5}]

Minimumsfunktion von Mathematica

FindMinimum[f[x,y],{x,y}]

Mal sehen, ob wir da auch hinkommen!

Gitter

NoOfPoints=50;
fMin=100000000.0;
For[i=-NoOfPoints,i<NoOfPoints+1,i++,
For[j=-NoOfPoints,j<NoOfPoints+1,j++,
xi=5.0*(i/NoOfPoints);
yj=5.0*(j/NoOfPoints);
If[f[xi,yj]<fMin,
fMin=f[xi,yj];xMin=xi;yMin=yj]]];

Print[xMin,"  ",yMin,"  ",fMin]

Sehr interessant!!! Ergebnis ist verschieden vom Mathematica-Ergebnis!!!

f[-2,-2]

Minimumsfunktion von Mathematica II

FindMinimum[f[x,y],{{x,-2},{y,-2}}]

Aha! Helfen hilft! 
Auch Mathematica findet nicht automatisch die richtige Lösung.

Zufallszahlen

NoOfRuns=10000;
fMin=100000000.0;
For[i=0,i<NoOfRuns,i++,
xi=RandomReal[{-5.0,5.0}] ;
yj=RandomReal[{-5.0,5.0}] ;
If[f[xi,yj]<fMin,
fMin=f[xi,yj];xMin=xi;yMin=yj]];

Print[xMin,"  ",yMin,"  ",fMin]

Pseudo-Gradientenverfahren I

In vielen interessanten Fällen kann man den Gradienten gar nicht analytisch bilden. Dann nimmt man z.B. den numerischen Gradienten oder tastet sich schrittweise vor, wie hier.

x0=3.0;y0=3.0;  (* Startwerte *)
Deltax=0.1;Deltay=0.1; (* Schrittweiten *)
KoordinatenPfad=Table[{x0,y0},{n,1,1}];
Length0=Length[KoordinatenPfad];
Weitersuchen=True;
While[Weitersuchen,
xneu=x0+Deltax;
yneu=y0;
If[f[xneu,yneu]<f[x0,y0],
x0=xneu;AppendTo[KoordinatenPfad,{x0,y0}],
xneu=x0-Deltax;
yneu=y0;
If[f[xneu,yneu]<f[x0,y0],
x0=xneu;AppendTo[KoordinatenPfad,{x0,y0}]]];
xneu=x0;
yneu=y0+Deltay;
If[f[xneu,yneu]<f[x0,y0],
y0=yneu;AppendTo[KoordinatenPfad,{x0,y0}],
xneu=x0;
yneu=y0-Deltay;
If[f[xneu,yneu]<f[x0,y0],
y0=yneu;AppendTo[KoordinatenPfad,{x0,y0}]]];
If[Length[KoordinatenPfad]==Length0,Weitersuchen=False,Length0=Length[KoordinatenPfad]];];

Print[TableForm[KoordinatenPfad]]

Pseudo-Gradientenverfahren II

Pfad im Parameterraum

KP1=ListPlot[KoordinatenPfad,PlotStyle->{Hue[0.0],PointSize[0.01]},
PlotRange->{{-5.0,5.0},{-5.0,5.0}}]

Show[CP1,KP1]

Super! Das Verfahren läuft in die gleiche Falle wie Mathematica !

Pseudo-Gradientenverfahren III

Andere Startwerte:

x0=-4.0;y0=-3.0;  (* Startwerte *)
Deltax=0.1;Deltay=0.1; (* Schrittweiten *)
KoordinatenPfad=Table[{x0,y0},{n,1,1}];
Length0=Length[KoordinatenPfad];
Weitersuchen=True;
While[Weitersuchen,
xneu=x0+Deltax;
yneu=y0;
If[f[xneu,yneu]<f[x0,y0],
x0=xneu;AppendTo[KoordinatenPfad,{x0,y0}],
xneu=x0-Deltax;
yneu=y0;
If[f[xneu,yneu]<f[x0,y0],
x0=xneu;AppendTo[KoordinatenPfad,{x0,y0}]]];
xneu=x0;
yneu=y0+Deltay;
If[f[xneu,yneu]<f[x0,y0],
y0=yneu;AppendTo[KoordinatenPfad,{x0,y0}],
xneu=x0;
yneu=y0-Deltay;
If[f[xneu,yneu]<f[x0,y0],
y0=yneu;AppendTo[KoordinatenPfad,{x0,y0}]]];
If[Length[KoordinatenPfad]==Length0,Weitersuchen=False,Length0=Length[KoordinatenPfad]];];

KP2=ListPlot[KoordinatenPfad,PlotStyle->{Hue[0.30],PointSize[0.01]},
PlotRange->{{-5.0,5.0},{-5.0,5.0}}];

Show[CP1,KP1,KP2]

Schlussfolgerung

In hochdimensionalen Räumen kann man sich in der Regel nicht
sicher sein, dass man das globale Minimum wirklich gefunden hat.

Man kann aber die Wahrscheinlichkeit dafür erhöhen, indem man viele Suchen mit unterschiedlichen Startvektoren durchführt.