[Tutorial] Quadratische Gleichungen vollständig lösen

[gammatester]

Ein weiterer Bug und zwei Vorschläge:

Bug:
a=1, b=1e140, c=1
ergibt
X1= -2,14326739881213E123
X2= -1E140
a wird zwar erst richtig mit Vieta berechnet, dann aber im else-Zweig von 'p<0' überschrieben.

Vorschlag 1:
Das Demo-Programm ist so geändert, das nur einmal die Gleichung gelöst wird, und nicht 6! (in Worten sechsmal) bei komplexen Lösungen.

Vorschlag 2:
Der "Small p"-Zweig wurde entfernt, wenn er beigehalten werden soll (wofür keine Notwendigkeit besteht, für kleine negative p wird er zB ja auch nicht benutzt!), muß eine Fallunterscheidung Diskriminante <0 und >=0 eingebaut werden.

Hier der vollständige Code.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,Math, ComCtrls;

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Button1: TButton;
    Label1: TLabel;
    Edit4: TEdit;
    Edit5: TEdit;
    Button2: TButton;
    RichEdit1: TRichEdit;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$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;
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;
    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 begin
      Result.a := -p/2 + sqrt( discriminant);
      Result.b := q/Result.a;   //x2 mit Vieta
      Result.c := 1;
    end;
  end

  else

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

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

end;

procedure TForm1.Button1Click(Sender: TObject);
var a,b,c,discriminant: double;
    indicator:integer;
    qs: MySolution;

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
     {WE: Gleichung nur einmal lösen und Ergebnisse anzeigen}
     qs :=  SolveQuadraticEquation(a,b,c);
     indicator := qs.c;
     case indicator of
       1: Begin
            Label1.Caption:='2 real solutions';
            RichEdit1.Lines.Add ('X1= ' + FloatToStr(qs.a));
            RichEdit1.Lines.Add ('X2= ' + FloatToStr(qs.b));
          End;
       2: Begin
            Label1.Caption:='1 real solution';
            RichEdit1.Lines.Add ('X= ' + FloatToStr(qs.a));
          end;
       3: Begin
            Label1.Caption:='2 complex solutions';
            RichEdit1.Lines.Add ('X1= ' + FloatToStr(qs.a)+
                                      ' + ' + FloatToStr(qs.b)+ ' i ');
            RichEdit1.Lines.Add ('X2= ' + FloatToStr(qs.a)+
                                      ' - ' + FloatToStr(qs.b )+ ' i ');
          End;
     end;
     discriminant:= qs.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.