Extremwertsuche (Pascal)

Aus ProgrammingWiki

Archivierte Version vom 2011-01-10T19:01:54+00:00. Aktuelle Version

Extremwertsuche nach dem Verfahren des Goldenen Schnitts

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

Animation: Minimumsuche nach dem Verfahren des Goldenen Schnitts

Algorithmus (Minimumsuche):

Lege ein Suchintervall durch zwei äußere Intervallgrenzen fest.
Zerlege dieses Suchintervall durch einen zweimaligen Goldenen Schnitt in 3 Teilintervalle.
Berechne die Funktionswerte an beiden Schnittstellen.
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.
Führe im neuen Suchintervall den Goldener Schnitt durch, der wieder zu 3 Teilintervallen führt.
Wiederhole das Verfahren solange, bis das Suchintervall einer hinreichend kleinen ε-Umgebung genügt.
Der Funktionswert eines Arguments aus dieser ε-Umgebung entspricht dem gesuchten Minimum.

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 k geführt, der lediglich die Werte 1 oder -1 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.

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('+floattostr(runden(x, genau))+') '+chr(9)+'= '+floattostr(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;

<eval id="4d2a2e03f1a43"> begin</eval>

extremwertausgabe(-10, 10, 0.33);

end.

Zurück zur Binären Suche.