Einzelnen Beitrag anzeigen

Benutzerbild von Wolfgang Mix
Wolfgang Mix

Registriert seit: 13. Mai 2009
Ort: Lübeck
1.222 Beiträge
 
Delphi 2005 Personal
 
#30

Re: Quadratische Gleichungen vollständig lösen

  Alt 5. Nov 2009, 20:19
Ich habe mich noch einmal mit dem Thema beschäftigt und versucht,
die Verbesserungsvorschläge der Beteiigten zu diesem Thresd umzusetzen.
Daher stelle ich folgende Lösung zur Diskussion:

Delphi-Quellcode:
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls,[b]Math[/b];

type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Edit5: TEdit;
    Button1: TButton;
    Edit6: TEdit;
    procedure Button1Click(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

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

// Wolfgang Mix - Delphi-PRAXiS
// Solve quadratic equations
function SolveQuadraticEquation( a, b, c : Double ): MySolution;
var p, q , discriminant, 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;
    // calculate discriminant
    discriminant := sqr(p/2) - q;
    // calculate real value
    re:=-p/2;
    // calculate imaginary value
    im:=sqrt(abs(discriminant));

  if discriminant > 0 then
  begin // 2 solutions
    Result.a := -p/2 + sqrt( discriminant);
    Result.b := -p/2 - sqrt( discriminant);
    Result.c := 1;
  end
  else
  if Math.IsZero(discriminant) then //needs unit math
  begin // 1 solution
    Result.a := -p/2;
    Result.b := Result.a;
    Result.c := 2;
  end
  else
  if discriminant < 0 then
  begin // 2 complex solutions
     Result.a := re;
     Result.b := im;
     Result.c := 3;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var a,b,c: double;
    indicator:integer;
begin
   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;
     Edit4.Text:=FloatToStr(SolveQuadraticEquation(a,b,c).a);
     Edit5.Text:=FloatToStr(SolveQuadraticEquation(a,b,c).b);
     Edit6.Text:=IntToStr(indicator);
     case indicator of
       1: Label1.Caption:='2 real solutions';
       2: Label1.Caption:='1 real solution';
       3: Label1.Caption:='2 complex solutions';
     end;
   end;
end;

end.
Bedeutung von Rückgabewert c, wenn
c=1 --> 2 relle Lösungen Result[0] und Result[1]
c=2 --> 1 reelle Lösung Result[0] = Result[1]
c=3 --> 2 komplexe Lösungen Result[0] = Realteil
+- Result[1] = Imaginärteil

Nachdem die Lösung mittels PQ-Formel hier im Forum hinreichend diskutiert wurde
und wir zu einer befriedigenden Lösung in Post #30 gekommen sind, zeige ich
zusätzlich noch die Lösung mittels "Mitternachtformel", die wohl bei Lehrern/Dozenten
noch beliebter ist. da der Umweg über die Berechnung von p und q entfällt.
Zusätzlich habe ich mir im Unterschied zu oben noch die Diskriminante (c=4)
als 4. Rückgebewert zurückgeben lassen.
Wie man dann die Rückgabewerte ausgeben kann, zeige ich im Button1.Click.

Delphi-Quellcode:
//Wolfgang Mix - Delphi-PRAXiS
function SolveQuadraticEquation( a, b, c : Double ): MySolution;
var discriminant, 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]);
    // calculate discriminant
    discriminant := sqr(b)-4*a*c;;
    Result.d := discriminant;
    // calculate real value
    re:=-b/(2*a);
    // calculate imaginary value
    im:=sqrt(abs(discriminant))/(2*a);
  //Form1.Edit7.Text:=FloatToStr(discriminant);
  if discriminant > 0 then
  begin // 2 solutions
    Result.a := -b/(2*a) + sqrt( discriminant)/(2*a);
    Result.b := -b/(2*a) - sqrt( discriminant)/(2*a);
    Result.c := 1;
  end
  else
  if Math.IsZero(discriminant) then //needs unit math
  begin // 1 solution
    Result.a := -b/(2*a);
    Result.b := Result.a;
    Result.c := 2;
  end
  else
  if discriminant < 0 then
  begin // 2 complex solutions
     Result.a := re;
     Result.b := im;
     Result.c := 3;
  end;
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;
Der böse Lehrer (wm) verlangt jetzt noch von (Fach-)Gymnasiasten:
Beweisen Sie, daß PQ-Formel und "Mitternachtsformel" absolut identisch sind.
Das ist gemein von dem Typen

Gruß

Wolfgang
Wolfgang Mix
if you can't explain it simply you don't understand it well enough - A. Einstein
Mein Baby:http://www.epubli.de/shop/buch/Grund...41818516/52824
  Mit Zitat antworten Zitat