Bisektionsverfahren

[pszopp]

Hallo KeyBe,

hier ist mein Lösungs-Ansatz:

Delphi-Quellcode:

// Diese Delphi-Funktion stellt deine mathematische Funktion dar.
// Ich habe hier das Beispiel von 2x² - 14x + 4 genommen.
// Diesen Teil musst du dann selber anpassen.
function f(x: Double): Double;
begin
  Result := 2 * sqr(x) - 14 * x + 4;
end;


// Diese Funktion ist das Bisektions-Verfahren.
function Bisection(a, b: Double; aEpsilon: Double): Double;
var fa, fb: Double;
    lm: Double;
    fm: Double;
begin
  // Funktionswerte für a und b berechnen
  fa := f(a);
  fb := f(b);

  // Nachschauen ob fa als Null angesehen werden kann.
  if (SameValue(fa, 0, aEpsilon)) then begin
    Result := a;
{x} Exit;
  end;

  // Nachschauen ob fb als Null angesehen werden kann.
  if (SameValue(fb, 0, aEpsilon)) then begin
    Result := b;
{x} Exit;
  end;

  // Wenn nicht genau eine Nullstelle zwischen a und b dann Fehler erzeugen.
  // Führt zu Problemen, falls eine gerade Anzahl Nullstellen vorliegt.
  if ((fa * fb) > 0) then begin
    raise Exception.Create('keine Nullstelle');
  end;

  // Fuktionswert der Mitte des Intervalls von [a..b] berechnen.
  lm := (a + b) / 2;
  fm := f(lm);

  // Nachschauen, ob die Nullstelle im linken oder rechten Teilintervall liegt.
  // Dann in dem passenden Teilintervall weitersuchen.
  if ((fa * fm) < 0) then begin
    Result := Bisection(a, lm, aEpsilon);
  end
  else begin
    Result := Bisection(lm, b, aEpsilon);
  end;
end;


// Hier ist ein Beispiel-Aufruf.
procedure TForm1.Button1Click(Sender: TObject);
var lX0: Double;
    lMsg: string;
begin
  try
    // Nullstelle berechnen
    lX0 := Bisection(0, 5, 0.000001);

    // Meldung anzeigen.
    lMsg :=Format('An der Stelle %4.6f hat die Funktion den Wert %4.6f',
      [lX0, F(lX0)]);
    MessageDlg(lMsg, mtInformation, [mbOK], 0);

  except
    MessageDlg('Im angegebenen Intervall gibt es keine oder mehr als eine ' +
      'Nullstelle', mtWarning, [mbOK], 0);
  end; // except
end;

Damit es klappt, muss für SameValue die Unit Math eingebunden werden.

Viele Grüße,
pszopp