[Tutorial] Quadratische Gleichungen vollständig lösen

[Wolfgang Mix]

Mit den letzten wertvollen Tipps von Gammatester habe ich
mich zuerst noch einmal der pq-Formel zugewandt, die IF-Strukturen neu
sortiert und die Problematiken Overlow/Underflow sowie der
Auslöschung implementiert (Theorie datu findet Ihr
z.B. im PDF im Anhang). Für angemeldete DPler hänge ich das Projekt
hinten an.
Wäre schön, wenn Ihr das testen würdet und mir Bugs meldet.
Das Ganze soll ja am Ende ein Tutorial werden, das möglichst
fehlerfrei sein sollte.

Danke

Wolfgang

Delphi-Quellcode:

{$R *.dfm}

type
  MySolution = Record
    a,b,d:double;
    c:integer;// 1: 2 real solution; 2: 1 real solution;
              // 3: 2 complex solutions
end;

//Wolfgang Mix - Delphi-PRAXiS
function SolveQuadraticEquation( a, b, c : Double ): MySolution;
var  p, q , discriminant, discriminant2, re, im: Double;
label exit;
begin
  //  ax² + bx + c = 0
  if (a = 0) then
  raise Exception.CreateFmt
     ('a should not be zero, no quadratic equation',[result.a]);
  p := b / a;
  q := c / a;

  //if p is a very big number - sqr(p/2) > MaxDouble
  if abs(p)>sqrt(Math.MaxDouble) then
  begin
    //code
    showmessage('p is a very big number');
    //showmessage(floattostr(Math.MaxDouble));
    result.a:=abs(p) + sqrt(0.25 - (q/p)/p);
    result.b:=abs(p) - sqrt(0.25 - (q/p)/p);
    result.c:=1;
    result.d:=0.25 - (q/p)/p;
    goto exit;
  end
  else
  //if p is avery samall number - sqr(p/2) < MinDouble
  if (p>=0) and (p<sqrt(Math.MinDouble)) then
  begin
    //code
    showmessage('p is a very small number');
    result.a:=-p/2 + sqrt(sqr(p/2) -q);
    result.b:=-p/2 - sqrt(sqr(p/2) -q);
    result.c:=1;
    result.d:= sqr(p/2);
    goto exit;
  end;

  //  calculate discriminant
  discriminant  := sqr(p/2) - q;
  Result.d := discriminant;

  // calculate real value
  re:=-p/2;
  // calculate imaginary value
  im:=sqrt(abs(discriminant));
  //Form1.Edit7.Text:=FloatToStr(discriminant);

  if discriminant > 0 then
  begin // 2 solutions
    if p>0 then
    begin
      Result.b := -p/2 - sqrt(discriminant);
      Result.a := q/Result.b;   //x1 mit Vieta
      Result.c := 1;
    end
    else Result.a := -p/2 + sqrt( discriminant);
    if p<0 then    //
    begin
      Result.a := -p/2 + sqrt( discriminant);
      Result.b := q/Result.a;   //x2 mit Vieta
      Result.c := 1;
    end
    else Result.a := -p/2 + sqrt( discriminant);
  end

  else

  if discriminant < 0 then
  begin  // 2 complex solutions
     Result.a := re;
     Result.b := im;
     Result.c := 3;
     Result.d := discriminant;
  end
  else

  begin  // 2 equal solutions
    Result.a := -p/2;
    Result.b := Result.a;
    Result.c := 2;
    Result.d := discriminant;
  end;

  exit:

end;

procedure TForm1.Button1Click(Sender: TObject);
var a,b,c,discriminant: double;
    indicator:integer;
begin
   RichEdit1.Lines.Clear;
   a:=StrToFloat(Edit1.Text);
   b:=StrToFloat(Edit2.Text);
   c:=StrToFloat(Edit3.Text);
   if (a=0) then
   begin
     // Don't calculate
     showmessage ('a should not be zero, no quadratic equation');
     sleep(2000);
     exit;
   end
   else
   begin
     indicator:= SolveQuadraticEquation(a,b,c).c;
     case indicator of
       1: Begin
            Label1.Caption:='2 real solutions';
            RichEdit1.Lines.Add ('X1= ' +
            (FloatToStr(SolveQuadraticEquation(a,b,c).a)));
            RichEdit1.Lines.Add ('X2= ' +
            (FloatToStr(SolveQuadraticEquation(a,b,c).b)));
          End;
       2: Begin
            Label1.Caption:='1 real solution';
            RichEdit1.Lines.Add ('X= ' +
            (FloatToStr(SolveQuadraticEquation(a,b,c).a)));
          end;
       3: Begin
            Label1.Caption:='2 complex solutions';
            RichEdit1.Lines.Add ('X1= ' +
            (FloatToStr(SolveQuadraticEquation(a,b,c).a))+
            ' + ' + FloatToStr(SolveQuadraticEquation(a,b,c).b )+ ' i ');
            RichEdit1.Lines.Add ('X2= ' +
            (FloatToStr(SolveQuadraticEquation(a,b,c).a))+
            ' -  ' + FloatToStr(SolveQuadraticEquation(a,b,c).b )+ ' i ');
          End;
     end;
     discriminant:= SolveQuadraticEquation(a,b,c).d;
     Edit4.Text:=FloatToStr(discriminant);
     Edit5.Text:=IntToStr(indicator);
   end;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  close;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  RichEdit1.Clear;
end;

end.