Einführungskurs/Extremwertsuche (Pascal)

Wiki-Quelltext dieser Seite.

<language>Pascal</language>
== Extremwertsuche nach dem Verfahren des Goldenen Schnitts ==

Die binäre Suche muss nicht zwingend zur Intervallhalbierung führen.<br /> 
Wir betrachten die Extremwertsuche nach dem Verfahren des Goldenen Schnitts zunächst für die Suche eines lokalen Minimums:

<table border="0">
<tr>
<td align="center">
[[Bild:Extremwert.gif]]<br />
Animation: Minimumsuche nach dem Verfahren des Goldenen Schnitts
</td>
<td>'''Algorithmus''' (Minimumsuche):
<ul>
<li>Lege ein Suchintervall durch zwei äußere Intervallgrenzen fest.</li>
<li>Zerlege dieses Suchintervall durch einen ''zweimaligen'' Goldenen Schnitt in 3 Teilintervalle.</li>
<li>Berechne die Funktionswerte an beiden Schnittstellen.</li>
<li>Das neue Suchintervall wird aus der Schnittstelle mit dem größeren der beiden Funktionswerte und einer der äußeren Intervallgrenzen derart gebildet, dass die Schnittstelle mit dem ''kleineren'' Funktionswert ''eingeschlossen'' wird.</li>
<li>Führe im neuen Suchintervall den Goldener Schnitt durch, der wieder zu 3 Teilintervallen führt.</li>
<li>Wiederhole das Verfahren solange, bis das Suchintervall einer hinreichend kleinen &epsilon;-Umgebung genügt.</li>
<li>Der Funktionswert eines Arguments aus dieser &epsilon;-Umgebung entspricht dem gesuchten Minimum.</li>
</ul>
</td>
</tr>
</table>

== Implementation ==

Mit einem kleinen Trick lässt sich ''ein und dieselbe'' Suchfunktion sowohl für lokale Minima als auch für lokale Maxima einsetzen. Der Vergleich der Funktionswerte wird mit einem Korrekturfaktor <math>k</math> geführt, der lediglich die Werte <math>1</math> oder <math>-1</math> annehmen kann, z.B.:

 if k*fkt(li)>k*fkt(re) then ...

Dieser Faktor kann als Parameter übergeben werden und hat die gleiche Wirkung wie die Umkehr des Relationszeichens bei einem herkömmlichen Vergleich.

<code id="4d30c76f25e10">
const genau=4;

function fkt(x: real): real;
 begin
  result:=3*sin(2*x);
 end;

function pot10(n: integer): real;
 var pot: real;
     i  : integer;
 begin
  pot:=1;
  for i:=1 to n do pot:=pot*10;
  result:=pot;
 end;

function runden(x: real; n: integer): real;
 begin
  result:=round(x*pot10(n))/pot10(n);
 end;

function suche(k: integer; xl, li, re, xr: real): real;
 var gs, eps: real;
 begin
  gs:=(sqrt(5)-1)/2;
  eps:=1/pot10(genau+2);   
  if xr-xl<eps then result:=(xl+xr)/2
  else
   if k*fkt(li)>k*fkt(re) then
    result:=suche(k, xl, re-gs*(re-xl), li, re)
   else
    result:=suche(k, li, re, li+gs*(xr-li), xr);
 end;

function teilausgabe(k: integer; von, bis, dx: real): integer;
 var anzahl        : integer;
     gs, schnitt   : real;
     xl, xr, yl, yr: real;
     x, y          : real;
 begin
  anzahl:=0;
  gs:=(sqrt(5)-1)/2;
  schnitt:=gs*dx;
  xl:=von; yl:=fkt(xl);
  while xl<bis do
  begin
   xr:=xl+dx; yr:=fkt(xr);
   if yl*yr>=0 then
   begin
    x:=suche(k, xl, xr-schnitt, xl+schnitt, xr);
    y:=fkt(x);
    if (k*y>k*yl) and (k*y>k*yr) then
    begin
     anzahl:=anzahl+1; 
     writeln('f('+runden(x, genau)+') '+chr(9)+'= '+runden(y, genau));
    end;
   end;
   xl:=xr; yl:=yr;
  end;
  result:=anzahl;
 end;

procedure extremwertausgabe(von, bis, dx: real);
 var anzahl: integer;
 begin
  writeln('Lokale Maxima:');
  anzahl:=teilausgabe(1, von, bis, dx);
  if anzahl=0 then writeln('--> Keine lokalen Maxima gefunden!');
  writeln('');
  writeln('Lokale Minima:');
  anzahl:=teilausgabe(-1, von, bis, dx);
  if anzahl=0 then writeln('--> Keine lokalen Minima gefunden!');
 end;
</code>

<run id="4d2bffd8079cf">
extremwertausgabe(-10, 10, 0.33);
</run>

Zurück zur [[Einführungskurs/Binäre Suche (Pascal)|Binären Suche]].